xref: /csrg-svn/usr.bin/pascal/src/var.c (revision 3082)
1781Speter /* Copyright (c) 1979 Regents of the University of California */
2781Speter 
3*3082Smckusic static char sccsid[] = "@(#)var.c 1.6 03/08/81";
4781Speter 
5781Speter #include "whoami.h"
6781Speter #include "0.h"
7781Speter #include "align.h"
82075Smckusic #include "iorec.h"
9781Speter #ifdef PC
10781Speter #   include	"pc.h"
11781Speter #   include	"pcops.h"
12781Speter #endif PC
13781Speter 
14781Speter /*
15781Speter  * Declare variables of a var part.  DPOFF1 is
16781Speter  * the local variable storage for all prog/proc/func
17781Speter  * modules aside from the block mark.  The total size
18781Speter  * of all the local variables is entered into the
19781Speter  * size array.
20781Speter  */
21781Speter varbeg()
22781Speter {
23781Speter 
24837Speter /* this allows for multiple declaration
25781Speter  * parts except when the "standard"
26781Speter  * option has been specified.
27781Speter  * If routine segment is being compiled,
28781Speter  * do level one processing.
29781Speter  */
30781Speter 
31781Speter #ifndef PI1
32837Speter 	if (!progseen)
33837Speter 		level1();
34837Speter 	if ( parts[ cbn ] & RPRT ) {
35837Speter 	    if ( opt( 's' ) ) {
36781Speter 		standard();
37837Speter 	    } else {
38837Speter 		warning();
39837Speter 	    }
40837Speter 	    error("Variable declarations should precede routine declarations");
41781Speter 	}
42837Speter 	if ( parts[ cbn ] & VPRT ) {
43837Speter 	    if ( opt( 's' ) ) {
44837Speter 		standard();
45837Speter 	    } else {
46837Speter 		warning();
47837Speter 	    }
48837Speter 	    error("All variables should be declared in one var part");
49837Speter 	}
50837Speter 	parts[ cbn ] |= VPRT;
51781Speter #endif
52781Speter     /*
53781Speter      *  #ifndef PI0
54781Speter      *      sizes[cbn].om_max = sizes[cbn].om_off = -DPOFF1;
55781Speter      *  #endif
56781Speter      */
57781Speter 	forechain = NIL;
58781Speter #ifdef PI0
59781Speter 	send(REVVBEG);
60781Speter #endif
61781Speter }
62781Speter 
63781Speter var(vline, vidl, vtype)
64781Speter #ifdef PI0
65781Speter 	int vline, *vidl, *vtype;
66781Speter {
67781Speter 	register struct nl *np;
68781Speter 	register int *vl;
69781Speter 
70781Speter 	np = gtype(vtype);
71781Speter 	line = vline;
72781Speter 	for (vl = vidl; vl != NIL; vl = vl[2]) {
73781Speter 		}
74781Speter 	}
75781Speter 	send(REVVAR, vline, vidl, vtype);
76781Speter }
77781Speter #else
78781Speter 	int vline;
79781Speter 	register int *vidl;
80781Speter 	int *vtype;
81781Speter {
82781Speter 	register struct nl *np;
83781Speter 	register struct om *op;
84781Speter 	long w;
85781Speter 	int o2;
86781Speter 	int *ovidl = vidl;
87781Speter 
88781Speter 	np = gtype(vtype);
89781Speter 	line = vline;
90781Speter 	    /*
91781Speter 	     * widths are evened out
92781Speter 	     */
93781Speter 	w = (lwidth(np) + 1) &~ 1;
94781Speter 	op = &sizes[cbn];
95781Speter 	for (; vidl != NIL; vidl = vidl[2]) {
96781Speter #		ifdef OBJ
97*3082Smckusic 		    op->om_off = roundup((int)(op->om_off-w), (long)align(np));
98781Speter 		    o2 = op -> om_off;
99781Speter #		endif OBJ
100781Speter #		ifdef PC
101781Speter 		    if ( cbn == 1 ) {
102781Speter 				/*
103781Speter 				 * global variables are not accessed off the fp
104781Speter 				 * but rather by their names.
105781Speter 				 */
106781Speter 			    o2 = 0;
107781Speter 		    } else {
108781Speter 				/*
109781Speter 				 * locals are aligned, too.
110781Speter 				 */
111*3082Smckusic 			    op->om_off = roundup((int)(op->om_off - w),
112*3082Smckusic 				(long)align(np));
113781Speter 			    o2 = op -> om_off;
114781Speter 		    }
115781Speter #		endif PC
116781Speter 		enter(defnl(vidl[1], VAR, np, o2));
117781Speter 		if ( np -> nl_flags & NFILES ) {
118781Speter 		    dfiles[ cbn ] = TRUE;
119781Speter 		}
120781Speter #		ifdef PC
121781Speter 		    if ( cbn == 1 ) {
122781Speter 			putprintf( "	.data" , 0 );
123781Speter 			putprintf( "	.comm	" , 1 );
124781Speter 			putprintf( EXTFORMAT , 1 , vidl[1] );
125781Speter 			putprintf( ",%d" , 0 , w );
126781Speter 			putprintf( "	.text" , 0 );
1272165Speter 			stabgvar( vidl[1] , p2type( np ) , o2 , w , line );
128781Speter 		    }
129781Speter #		endif PC
130781Speter 	}
131781Speter #	ifdef PTREE
132781Speter 	    {
133781Speter 		pPointer	*Vars;
134781Speter 		pPointer	Var = VarDecl( ovidl , vtype );
135781Speter 
136781Speter 		pSeize( PorFHeader[ nesting ] );
137781Speter 		Vars = &( pDEF( PorFHeader[ nesting ] ).PorFVars );
138781Speter 		*Vars = ListAppend( *Vars , Var );
139781Speter 		pRelease( PorFHeader[ nesting ] );
140781Speter 	    }
141781Speter #	endif
142781Speter }
143781Speter #endif
144781Speter 
145781Speter varend()
146781Speter {
147781Speter 
148781Speter 	foredecl();
149781Speter #ifndef PI0
150781Speter 	sizes[cbn].om_max = sizes[cbn].om_off;
151781Speter #else
152781Speter 	send(REVVEND);
153781Speter #endif
154781Speter }
155781Speter 
156781Speter /*
157781Speter  * Evening
158781Speter  */
159*3082Smckusic long
160*3082Smckusic leven(w)
161*3082Smckusic 	register long w;
162*3082Smckusic {
163*3082Smckusic 	if (w < 0)
164*3082Smckusic 		return (w & 0xfffffffe);
165*3082Smckusic 	return ((w+1) & 0xfffffffe);
166*3082Smckusic }
167*3082Smckusic 
168*3082Smckusic int
169781Speter even(w)
170781Speter 	register int w;
171781Speter {
172*3082Smckusic 	return leven((long)w);
173781Speter }
174781Speter 
175781Speter /*
176781Speter  * Find the width of a type in bytes.
177781Speter  */
178781Speter width(np)
179781Speter 	struct nl *np;
180781Speter {
181781Speter 
182781Speter 	return (lwidth(np));
183781Speter }
184781Speter 
185781Speter long
186781Speter lwidth(np)
187781Speter 	struct nl *np;
188781Speter {
189781Speter 	register struct nl *p;
190781Speter 	long w;
191781Speter 
192781Speter 	p = np;
193781Speter 	if (p == NIL)
194781Speter 		return (0);
195781Speter loop:
196781Speter 	switch (p->class) {
197781Speter 		case TYPE:
198781Speter 			switch (nloff(p)) {
199781Speter 				case TNIL:
200781Speter 					return (2);
201781Speter 				case TSTR:
202781Speter 				case TSET:
203781Speter 					panic("width");
204781Speter 				default:
205781Speter 					p = p->type;
206781Speter 					goto loop;
207781Speter 			}
208781Speter 		case ARRAY:
209781Speter 			return (aryconst(p, 0));
210781Speter 		case PTR:
211781Speter 			return ( sizeof ( int * ) );
212781Speter 		case FILET:
2132075Smckusic 			return ( sizeof(struct iorec) + lwidth( p -> type ) );
214781Speter 		case RANGE:
215781Speter 			if (p->type == nl+TDOUBLE)
216781Speter #ifdef DEBUG
217781Speter 				return (hp21mx ? 4 : 8);
218781Speter #else
219781Speter 				return (8);
220781Speter #endif
221781Speter 		case SCAL:
222781Speter 			return (bytes(p->range[0], p->range[1]));
223781Speter 		case SET:
224781Speter 			setran(p->type);
225*3082Smckusic 			return roundup((int)((set.uprbp >> 3) + 1),
226*3082Smckusic 				(long)(A_SET));
227781Speter 		case STR:
228781Speter 		case RECORD:
229781Speter 			return ( p->value[NL_OFFS] );
230781Speter 		default:
231781Speter 			panic("wclass");
232781Speter 	}
233781Speter }
234781Speter 
235781Speter     /*
236781Speter      *	round up x to a multiple of y
237781Speter      *	for computing offsets of aligned things.
238781Speter      *	y had better be positive.
239781Speter      *	rounding is in the direction of x.
240781Speter      */
241781Speter long
242781Speter roundup( x , y )
243*3082Smckusic     int			x;
244781Speter     register long	y;
245781Speter     {
246781Speter 
247781Speter 	if ( y == 0 ) {
248781Speter 	    return 0;
249781Speter 	}
250781Speter 	if ( x >= 0 ) {
251781Speter 		return ( ( ( x + ( y - 1 ) ) / y ) * y );
252781Speter 	} else {
253781Speter 		return ( ( ( x - ( y - 1 ) ) / y ) * y );
254781Speter 	}
255781Speter     }
256781Speter 
257781Speter     /*
258781Speter      *	alignment of an object using the c alignment scheme
259781Speter      */
260781Speter int
261781Speter align( np )
262781Speter     struct nl	*np;
263781Speter     {
264781Speter 	register struct nl *p;
265781Speter 
266781Speter 	p = np;
267781Speter 	if ( p == NIL ) {
268781Speter 	    return 0;
269781Speter 	}
270781Speter alignit:
271781Speter 	switch ( p -> class ) {
272781Speter 	    case TYPE:
273781Speter 		    switch ( nloff( p ) ) {
274781Speter 			case TNIL:
275781Speter 				return A_POINT;
276781Speter 			case TSTR:
277781Speter 				return A_CHAR;
278781Speter 			case TSET:
279781Speter 				return A_SET;
280781Speter 			default:
281781Speter 				p = p -> type;
282781Speter 				goto alignit;
283781Speter 		    }
284781Speter 	    case ARRAY:
285781Speter 			/*
286781Speter 			 * arrays are aligned as their component types
287781Speter 			 */
288781Speter 		    p = p -> type;
289781Speter 		    goto alignit;
290781Speter 	    case PTR:
291781Speter 		    return A_POINT;
292781Speter 	    case FILET:
293781Speter 		    return A_FILET;
294781Speter 	    case RANGE:
295781Speter 		    if ( p -> type == nl+TDOUBLE ) {
296781Speter 			return A_DOUBLE;
297781Speter 		    }
298781Speter 		    /* else, fall through */
299781Speter 	    case SCAL:
300781Speter 		    switch ( bytes( p -> range[0] , p -> range[1] ) ) {
301781Speter 			case 4:
302781Speter 			    return A_LONG;
303781Speter 			case 2:
304781Speter 			    return A_SHORT;
305781Speter 			case 1:
306781Speter 			    return A_CHAR;
307781Speter 			default:
308781Speter 			    panic( "align: scal" );
309781Speter 		    }
310781Speter 	    case SET:
311781Speter 		    return A_SET;
312781Speter 	    case STR:
313781Speter 		    return A_CHAR;
314781Speter 	    case RECORD:
315781Speter 			/*
316781Speter 			 * follow chain through all fields in record,
317781Speter 			 * taking max of alignments of types of fields.
318781Speter 			 * short circuit out if i reach the maximum alignment.
319781Speter 			 * this is pretty likely, as A_MAX is only 4.
320781Speter 			 */
321781Speter 		    {
322781Speter 			register long recalign;
323781Speter 			register long fieldalign;
324781Speter 
325781Speter 			recalign = A_MIN;
326781Speter 			p = p -> chain;
327781Speter 			while ( ( p != NIL ) && ( recalign < A_MAX ) ) {
328781Speter 			    fieldalign = align( p -> type );
329781Speter 			    if ( fieldalign > recalign ) {
330781Speter 				recalign = fieldalign;
331781Speter 			    }
332781Speter 			    p = p -> chain;
333781Speter 			}
334781Speter 			return recalign;
335781Speter 		    }
336781Speter 	    default:
337781Speter 		    panic( "align" );
338781Speter 	}
339781Speter     }
340781Speter 
341781Speter /*
342781Speter  * Return the width of an element
343781Speter  * of a n time subscripted np.
344781Speter  */
345781Speter long aryconst(np, n)
346781Speter 	struct nl *np;
347781Speter 	int n;
348781Speter {
349781Speter 	register struct nl *p;
350781Speter 	long s, d;
351781Speter 
352781Speter 	if ((p = np) == NIL)
353781Speter 		return (NIL);
354781Speter 	if (p->class != ARRAY)
355781Speter 		panic("ary");
356781Speter 	s = lwidth(p->type);
357781Speter 	/*
358781Speter 	 * Arrays of anything but characters are word aligned.
359781Speter 	 */
360781Speter 	if (s & 1)
361781Speter 		if (s != 1)
362781Speter 			s++;
363781Speter 	/*
364781Speter 	 * Skip the first n subscripts
365781Speter 	 */
366781Speter 	while (n >= 0) {
367781Speter 		p = p->chain;
368781Speter 		n--;
369781Speter 	}
370781Speter 	/*
371781Speter 	 * Sum across remaining subscripts.
372781Speter 	 */
373781Speter 	while (p != NIL) {
374781Speter 		if (p->class != RANGE && p->class != SCAL)
375781Speter 			panic("aryran");
376781Speter 		d = p->range[1] - p->range[0] + 1;
377781Speter 		s *= d;
378781Speter 		p = p->chain;
379781Speter 	}
380781Speter 	return (s);
381781Speter }
382781Speter 
383781Speter /*
384781Speter  * Find the lower bound of a set, and also its size in bits.
385781Speter  */
386781Speter setran(q)
387781Speter 	struct nl *q;
388781Speter {
389781Speter 	register lb, ub;
390781Speter 	register struct nl *p;
391781Speter 
392781Speter 	p = q;
393781Speter 	if (p == NIL)
394781Speter 		return (NIL);
395781Speter 	lb = p->range[0];
396781Speter 	ub = p->range[1];
397781Speter 	if (p->class != RANGE && p->class != SCAL)
398781Speter 		panic("setran");
399781Speter 	set.lwrb = lb;
400781Speter 	/* set.(upperbound prime) = number of bits - 1; */
401781Speter 	set.uprbp = ub-lb;
402781Speter }
403781Speter 
404781Speter /*
405781Speter  * Return the number of bytes required to hold an arithmetic quantity
406781Speter  */
407781Speter bytes(lb, ub)
408781Speter 	long lb, ub;
409781Speter {
410781Speter 
411781Speter #ifndef DEBUG
412781Speter 	if (lb < -32768 || ub > 32767)
413781Speter 		return (4);
414781Speter 	else if (lb < -128 || ub > 127)
415781Speter 		return (2);
416781Speter #else
417781Speter 	if (!hp21mx && (lb < -32768 || ub > 32767))
418781Speter 		return (4);
419781Speter 	if (lb < -128 || ub > 127)
420781Speter 		return (2);
421781Speter #endif
422781Speter 	else
423781Speter 		return (1);
424781Speter }
425