xref: /csrg-svn/usr.bin/pascal/src/var.c (revision 11822)
1781Speter /* Copyright (c) 1979 Regents of the University of California */
2781Speter 
3*11822Smckusick static char sccsid[] = "@(#)var.c 1.16 04/01/83";
4781Speter 
5781Speter #include "whoami.h"
6781Speter #include "0.h"
710664Speter #include "objfmt.h"
8781Speter #include "align.h"
92075Smckusic #include "iorec.h"
10781Speter #ifdef PC
11781Speter #   include	"pc.h"
12781Speter #   include	"pcops.h"
13781Speter #endif PC
1411336Speter #include "tmps.h"
15781Speter 
16781Speter /*
17781Speter  * Declare variables of a var part.  DPOFF1 is
18781Speter  * the local variable storage for all prog/proc/func
19781Speter  * modules aside from the block mark.  The total size
20781Speter  * of all the local variables is entered into the
21781Speter  * size array.
22781Speter  */
237951Speter varbeg( lineofyvar , r )
247951Speter     int	lineofyvar;
25781Speter {
267951Speter     static bool	var_order = FALSE;
277951Speter     static bool	var_seen = FALSE;
28781Speter 
29837Speter /* this allows for multiple declaration
30781Speter  * parts except when the "standard"
31781Speter  * option has been specified.
32781Speter  * If routine segment is being compiled,
33781Speter  * do level one processing.
34781Speter  */
35781Speter 
36781Speter #ifndef PI1
37837Speter 	if (!progseen)
38837Speter 		level1();
397951Speter 	line = lineofyvar;
40837Speter 	if ( parts[ cbn ] & RPRT ) {
41837Speter 	    if ( opt( 's' ) ) {
42781Speter 		standard();
437951Speter 		error("Variable declarations should precede routine declarations");
44837Speter 	    } else {
457951Speter 		if ( !var_order ) {
467951Speter 		    var_order = TRUE;
477951Speter 		    warning();
487951Speter 		    error("Variable declarations should precede routine declarations");
497951Speter 		}
50837Speter 	    }
51781Speter 	}
52837Speter 	if ( parts[ cbn ] & VPRT ) {
53837Speter 	    if ( opt( 's' ) ) {
54837Speter 		standard();
557951Speter 		error("All variables should be declared in one var part");
56837Speter 	    } else {
577951Speter 		if ( !var_seen ) {
587951Speter 		    var_seen = TRUE;
597951Speter 		    warning();
607951Speter 		    error("All variables should be declared in one var part");
617951Speter 		}
62837Speter 	    }
63837Speter 	}
64837Speter 	parts[ cbn ] |= VPRT;
65781Speter #endif
66781Speter     /*
67781Speter      *  #ifndef PI0
683229Smckusic      *      sizes[cbn].om_max = sizes[cbn].curtmps.om_off = -DPOFF1;
69781Speter      *  #endif
70781Speter      */
71781Speter 	forechain = NIL;
72781Speter #ifdef PI0
73781Speter 	send(REVVBEG);
74781Speter #endif
75781Speter }
76781Speter 
77781Speter var(vline, vidl, vtype)
78781Speter #ifdef PI0
79781Speter 	int vline, *vidl, *vtype;
80781Speter {
81781Speter 	register struct nl *np;
82781Speter 	register int *vl;
83781Speter 
84781Speter 	np = gtype(vtype);
85781Speter 	line = vline;
86781Speter 	for (vl = vidl; vl != NIL; vl = vl[2]) {
87781Speter 		}
88781Speter 	}
89781Speter 	send(REVVAR, vline, vidl, vtype);
90781Speter }
91781Speter #else
92781Speter 	int vline;
93781Speter 	register int *vidl;
94781Speter 	int *vtype;
95781Speter {
96781Speter 	register struct nl *np;
97781Speter 	register struct om *op;
98781Speter 	long w;
99781Speter 	int o2;
100781Speter 	int *ovidl = vidl;
1013836Speter 	struct nl	*vp;
102781Speter 
103781Speter 	np = gtype(vtype);
104781Speter 	line = vline;
1053949Speter 	w = lwidth(np);
106781Speter 	op = &sizes[cbn];
107781Speter 	for (; vidl != NIL; vidl = vidl[2]) {
108781Speter #		ifdef OBJ
1093235Smckusic 		    op->curtmps.om_off =
1103235Smckusic 			roundup((int)(op->curtmps.om_off-w), (long)align(np));
1113235Smckusic 		    o2 = op -> curtmps.om_off;
112781Speter #		endif OBJ
113781Speter #		ifdef PC
114781Speter 		    if ( cbn == 1 ) {
115781Speter 				/*
116781Speter 				 * global variables are not accessed off the fp
117781Speter 				 * but rather by their names.
118781Speter 				 */
119781Speter 			    o2 = 0;
120781Speter 		    } else {
121781Speter 				/*
122781Speter 				 * locals are aligned, too.
123781Speter 				 */
1243229Smckusic 			    op->curtmps.om_off =
1253229Smckusic 				roundup((int)(op->curtmps.om_off - w),
1263082Smckusic 				(long)align(np));
1273229Smckusic 			    o2 = op -> curtmps.om_off;
128781Speter 		    }
129781Speter #		endif PC
1303836Speter 		vp = enter(defnl(vidl[1], VAR, np, o2));
131781Speter 		if ( np -> nl_flags & NFILES ) {
132781Speter 		    dfiles[ cbn ] = TRUE;
133781Speter 		}
134781Speter #		ifdef PC
135781Speter 		    if ( cbn == 1 ) {
136781Speter 			putprintf( "	.data" , 0 );
13710664Speter 			aligndot(align(np));
138781Speter 			putprintf( "	.comm	" , 1 );
139781Speter 			putprintf( EXTFORMAT , 1 , vidl[1] );
140781Speter 			putprintf( ",%d" , 0 , w );
141781Speter 			putprintf( "	.text" , 0 );
1422165Speter 			stabgvar( vidl[1] , p2type( np ) , o2 , w , line );
1433836Speter 			vp -> extra_flags |= NGLOBAL;
1443836Speter 		    } else {
1453836Speter 			vp -> extra_flags |= NLOCAL;
146781Speter 		    }
147781Speter #		endif PC
148781Speter 	}
149781Speter #	ifdef PTREE
150781Speter 	    {
151781Speter 		pPointer	*Vars;
152781Speter 		pPointer	Var = VarDecl( ovidl , vtype );
153781Speter 
154781Speter 		pSeize( PorFHeader[ nesting ] );
155781Speter 		Vars = &( pDEF( PorFHeader[ nesting ] ).PorFVars );
156781Speter 		*Vars = ListAppend( *Vars , Var );
157781Speter 		pRelease( PorFHeader[ nesting ] );
158781Speter 	    }
159781Speter #	endif
160781Speter }
161781Speter #endif
162781Speter 
163781Speter varend()
164781Speter {
165781Speter 
166781Speter 	foredecl();
167781Speter #ifndef PI0
1683229Smckusic 	sizes[cbn].om_max = sizes[cbn].curtmps.om_off;
169781Speter #else
170781Speter 	send(REVVEND);
171781Speter #endif
172781Speter }
173781Speter 
174781Speter /*
175781Speter  * Evening
176781Speter  */
1773082Smckusic long
1783082Smckusic leven(w)
1793082Smckusic 	register long w;
1803082Smckusic {
1813082Smckusic 	if (w < 0)
1823082Smckusic 		return (w & 0xfffffffe);
1833082Smckusic 	return ((w+1) & 0xfffffffe);
1843082Smckusic }
1853082Smckusic 
1863082Smckusic int
187781Speter even(w)
188781Speter 	register int w;
189781Speter {
1903082Smckusic 	return leven((long)w);
191781Speter }
192781Speter 
193781Speter /*
194781Speter  * Find the width of a type in bytes.
195781Speter  */
196781Speter width(np)
197781Speter 	struct nl *np;
198781Speter {
199781Speter 
200781Speter 	return (lwidth(np));
201781Speter }
202781Speter 
203781Speter long
204781Speter lwidth(np)
205781Speter 	struct nl *np;
206781Speter {
207781Speter 	register struct nl *p;
208781Speter 	long w;
209781Speter 
210781Speter 	p = np;
211781Speter 	if (p == NIL)
212781Speter 		return (0);
213781Speter loop:
214781Speter 	switch (p->class) {
215781Speter 		case TYPE:
216781Speter 			switch (nloff(p)) {
217781Speter 				case TNIL:
218781Speter 					return (2);
219781Speter 				case TSTR:
220781Speter 				case TSET:
221781Speter 					panic("width");
222781Speter 				default:
223781Speter 					p = p->type;
224781Speter 					goto loop;
225781Speter 			}
226781Speter 		case ARRAY:
227781Speter 			return (aryconst(p, 0));
228781Speter 		case PTR:
229781Speter 			return ( sizeof ( int * ) );
230781Speter 		case FILET:
2312075Smckusic 			return ( sizeof(struct iorec) + lwidth( p -> type ) );
232781Speter 		case RANGE:
233781Speter 			if (p->type == nl+TDOUBLE)
234781Speter #ifdef DEBUG
235781Speter 				return (hp21mx ? 4 : 8);
236781Speter #else
237781Speter 				return (8);
238781Speter #endif
239781Speter 		case SCAL:
240781Speter 			return (bytes(p->range[0], p->range[1]));
241781Speter 		case SET:
242781Speter 			setran(p->type);
243*11822Smckusick 			/*
244*11822Smckusick 			 * Sets are some multiple of longs
245*11822Smckusick 			 */
2463082Smckusic 			return roundup((int)((set.uprbp >> 3) + 1),
247*11822Smckusick 				(long)(sizeof(long)));
248781Speter 		case STR:
249781Speter 		case RECORD:
250781Speter 			return ( p->value[NL_OFFS] );
251781Speter 		default:
252781Speter 			panic("wclass");
253781Speter 	}
254781Speter }
255781Speter 
256781Speter     /*
257781Speter      *	round up x to a multiple of y
258781Speter      *	for computing offsets of aligned things.
259781Speter      *	y had better be positive.
260781Speter      *	rounding is in the direction of x.
261781Speter      */
262781Speter long
263781Speter roundup( x , y )
2643082Smckusic     int			x;
265781Speter     register long	y;
266781Speter     {
267781Speter 
268781Speter 	if ( y == 0 ) {
2694030Smckusic 	    return x;
270781Speter 	}
271781Speter 	if ( x >= 0 ) {
272781Speter 		return ( ( ( x + ( y - 1 ) ) / y ) * y );
273781Speter 	} else {
274781Speter 		return ( ( ( x - ( y - 1 ) ) / y ) * y );
275781Speter 	}
276781Speter     }
277781Speter 
278781Speter     /*
279781Speter      *	alignment of an object using the c alignment scheme
280781Speter      */
281781Speter int
282781Speter align( np )
283781Speter     struct nl	*np;
284781Speter     {
285781Speter 	register struct nl *p;
286*11822Smckusick 	long elementalign;
287781Speter 
288781Speter 	p = np;
289781Speter 	if ( p == NIL ) {
290781Speter 	    return 0;
291781Speter 	}
292781Speter alignit:
293781Speter 	switch ( p -> class ) {
294781Speter 	    case TYPE:
295781Speter 		    switch ( nloff( p ) ) {
296781Speter 			case TNIL:
297781Speter 				return A_POINT;
298781Speter 			case TSTR:
29910664Speter 				return A_STRUCT;
300781Speter 			case TSET:
301781Speter 				return A_SET;
302781Speter 			default:
303781Speter 				p = p -> type;
304781Speter 				goto alignit;
305781Speter 		    }
306781Speter 	    case ARRAY:
307781Speter 			/*
308*11822Smckusick 			 * arrays are structures, since they can get
30910664Speter 			 * assigned form/to as structure assignments.
310*11822Smckusick 			 * preserve internal alignment if it is greater.
311781Speter 			 */
312*11822Smckusick 		    elementalign = align(p -> type);
313*11822Smckusick 		    return elementalign > A_STRUCT ? elementalign : A_STRUCT;
314781Speter 	    case PTR:
315781Speter 		    return A_POINT;
316781Speter 	    case FILET:
317781Speter 		    return A_FILET;
318781Speter 	    case RANGE:
319781Speter 		    if ( p -> type == nl+TDOUBLE ) {
320781Speter 			return A_DOUBLE;
321781Speter 		    }
322781Speter 		    /* else, fall through */
323781Speter 	    case SCAL:
324781Speter 		    switch ( bytes( p -> range[0] , p -> range[1] ) ) {
325781Speter 			case 4:
326781Speter 			    return A_LONG;
327781Speter 			case 2:
328781Speter 			    return A_SHORT;
329781Speter 			case 1:
330781Speter 			    return A_CHAR;
331781Speter 			default:
332781Speter 			    panic( "align: scal" );
333781Speter 		    }
334781Speter 	    case SET:
335781Speter 		    return A_SET;
336781Speter 	    case STR:
33710664Speter 			/*
33810664Speter 			 * arrays of chars are structs
33910664Speter 			 */
34010664Speter 		    return A_STRUCT;
341781Speter 	    case RECORD:
342781Speter 			/*
3438681Speter 			 * the alignment of a record is in its align_info field
3448681Speter 			 * why don't we use this for the rest of the namelist?
345781Speter 			 */
3468681Speter 		    return p -> align_info;
347781Speter 	    default:
348781Speter 		    panic( "align" );
349781Speter 	}
350781Speter     }
351781Speter 
35210664Speter #ifdef PC
3533949Speter     /*
35410664Speter      *	output an alignment pseudo-op.
3553949Speter      */
35610664Speter aligndot(alignment)
3573949Speter     int	alignment;
35810664Speter #ifdef vax
3593949Speter {
36010664Speter     switch (alignment) {
36110664Speter 	case 1:
36210664Speter 	    return;
36310664Speter 	case 2:
36410664Speter 	    putprintf("	.align 1", 0);
36510664Speter 	    return;
36610664Speter 	default:
36710664Speter 	case 4:
36810664Speter 	    putprintf("	.align 2", 0);
36910664Speter 	    return;
3703949Speter     }
3713949Speter }
37210664Speter #endif vax
37310664Speter #ifdef mc68000
37410664Speter {
37510664Speter     switch (alignment) {
37610664Speter 	case 1:
37710664Speter 	    return;
37810664Speter 	default:
37910664Speter 	    putprintf("	.even", 0);
38010664Speter 	    return;
38110664Speter     }
38210664Speter }
38310664Speter #endif mc68000
38410664Speter #endif PC
38510664Speter 
386781Speter /*
387781Speter  * Return the width of an element
388781Speter  * of a n time subscripted np.
389781Speter  */
390781Speter long aryconst(np, n)
391781Speter 	struct nl *np;
392781Speter 	int n;
393781Speter {
394781Speter 	register struct nl *p;
395781Speter 	long s, d;
396781Speter 
397781Speter 	if ((p = np) == NIL)
398781Speter 		return (NIL);
399781Speter 	if (p->class != ARRAY)
400781Speter 		panic("ary");
401781Speter 	s = lwidth(p->type);
402781Speter 	/*
403781Speter 	 * Arrays of anything but characters are word aligned.
404781Speter 	 */
405781Speter 	if (s & 1)
406781Speter 		if (s != 1)
407781Speter 			s++;
408781Speter 	/*
409781Speter 	 * Skip the first n subscripts
410781Speter 	 */
411781Speter 	while (n >= 0) {
412781Speter 		p = p->chain;
413781Speter 		n--;
414781Speter 	}
415781Speter 	/*
416781Speter 	 * Sum across remaining subscripts.
417781Speter 	 */
418781Speter 	while (p != NIL) {
419781Speter 		if (p->class != RANGE && p->class != SCAL)
420781Speter 			panic("aryran");
421781Speter 		d = p->range[1] - p->range[0] + 1;
422781Speter 		s *= d;
423781Speter 		p = p->chain;
424781Speter 	}
425781Speter 	return (s);
426781Speter }
427781Speter 
428781Speter /*
429781Speter  * Find the lower bound of a set, and also its size in bits.
430781Speter  */
431781Speter setran(q)
432781Speter 	struct nl *q;
433781Speter {
434781Speter 	register lb, ub;
435781Speter 	register struct nl *p;
436781Speter 
437781Speter 	p = q;
438781Speter 	if (p == NIL)
439781Speter 		return (NIL);
440781Speter 	lb = p->range[0];
441781Speter 	ub = p->range[1];
442781Speter 	if (p->class != RANGE && p->class != SCAL)
443781Speter 		panic("setran");
444781Speter 	set.lwrb = lb;
445781Speter 	/* set.(upperbound prime) = number of bits - 1; */
446781Speter 	set.uprbp = ub-lb;
447781Speter }
448781Speter 
449781Speter /*
450781Speter  * Return the number of bytes required to hold an arithmetic quantity
451781Speter  */
452781Speter bytes(lb, ub)
453781Speter 	long lb, ub;
454781Speter {
455781Speter 
456781Speter #ifndef DEBUG
457781Speter 	if (lb < -32768 || ub > 32767)
458781Speter 		return (4);
459781Speter 	else if (lb < -128 || ub > 127)
460781Speter 		return (2);
461781Speter #else
462781Speter 	if (!hp21mx && (lb < -32768 || ub > 32767))
463781Speter 		return (4);
464781Speter 	if (lb < -128 || ub > 127)
465781Speter 		return (2);
466781Speter #endif
467781Speter 	else
468781Speter 		return (1);
469781Speter }
470