xref: /csrg-svn/usr.bin/pascal/src/var.c (revision 30038)
122201Sdist /*
222201Sdist  * Copyright (c) 1980 Regents of the University of California.
322201Sdist  * All rights reserved.  The Berkeley software License Agreement
422201Sdist  * specifies the terms and conditions for redistribution.
522201Sdist  */
6781Speter 
718351Smckusick #ifndef lint
8*30038Smckusick static char sccsid[] = "@(#)var.c	5.4 (Berkeley) 11/12/86";
922201Sdist #endif not lint
10781Speter 
11781Speter #include "whoami.h"
12781Speter #include "0.h"
1310664Speter #include "objfmt.h"
14781Speter #include "align.h"
152075Smckusic #include "iorec.h"
16781Speter #ifdef PC
17781Speter #   include	"pc.h"
18781Speter #endif PC
1911336Speter #include "tmps.h"
2018351Smckusick #include "tree_ty.h"
21781Speter 
22781Speter /*
23781Speter  * Declare variables of a var part.  DPOFF1 is
24781Speter  * the local variable storage for all prog/proc/func
25781Speter  * modules aside from the block mark.  The total size
26781Speter  * of all the local variables is entered into the
27781Speter  * size array.
28781Speter  */
2918351Smckusick /*ARGSUSED*/
307951Speter varbeg( lineofyvar , r )
317951Speter     int	lineofyvar;
32781Speter {
337951Speter     static bool	var_order = FALSE;
347951Speter     static bool	var_seen = FALSE;
35781Speter 
36837Speter /* this allows for multiple declaration
37781Speter  * parts except when the "standard"
38781Speter  * option has been specified.
39781Speter  * If routine segment is being compiled,
40781Speter  * do level one processing.
41781Speter  */
42781Speter 
43781Speter #ifndef PI1
44837Speter 	if (!progseen)
45837Speter 		level1();
467951Speter 	line = lineofyvar;
47837Speter 	if ( parts[ cbn ] & RPRT ) {
48837Speter 	    if ( opt( 's' ) ) {
49781Speter 		standard();
507951Speter 		error("Variable declarations should precede routine declarations");
51837Speter 	    } else {
527951Speter 		if ( !var_order ) {
537951Speter 		    var_order = TRUE;
547951Speter 		    warning();
557951Speter 		    error("Variable declarations should precede routine declarations");
567951Speter 		}
57837Speter 	    }
58781Speter 	}
59837Speter 	if ( parts[ cbn ] & VPRT ) {
60837Speter 	    if ( opt( 's' ) ) {
61837Speter 		standard();
627951Speter 		error("All variables should be declared in one var part");
63837Speter 	    } else {
647951Speter 		if ( !var_seen ) {
657951Speter 		    var_seen = TRUE;
667951Speter 		    warning();
677951Speter 		    error("All variables should be declared in one var part");
687951Speter 		}
69837Speter 	    }
70837Speter 	}
71837Speter 	parts[ cbn ] |= VPRT;
72781Speter #endif
73781Speter     /*
74781Speter      *  #ifndef PI0
753229Smckusic      *      sizes[cbn].om_max = sizes[cbn].curtmps.om_off = -DPOFF1;
76781Speter      *  #endif
77781Speter      */
78781Speter 	forechain = NIL;
79781Speter #ifdef PI0
80781Speter 	send(REVVBEG);
81781Speter #endif
82781Speter }
83781Speter 
84781Speter var(vline, vidl, vtype)
85781Speter #ifdef PI0
8618351Smckusick 	int vline;
8718351Smckusick 	struct tnode *vidl, *vtype;
88781Speter {
89781Speter 	register struct nl *np;
9018351Smckusick 	register struct tnode *vl;
91781Speter 
92781Speter 	np = gtype(vtype);
93781Speter 	line = vline;
9418351Smckusick 	/* why is this here? */
9518351Smckusick 	for (vl = vidl; vl != TR_NIL; vl = vl->list_node.next) {
96781Speter 		}
97781Speter 	}
98781Speter 	send(REVVAR, vline, vidl, vtype);
99781Speter }
100781Speter #else
101781Speter 	int vline;
10218351Smckusick 	register struct tnode *vidl;
10318351Smckusick 	struct tnode *vtype;
104781Speter {
105781Speter 	register struct nl *np;
106781Speter 	register struct om *op;
107781Speter 	long w;
108781Speter 	int o2;
10918351Smckusick #ifdef PC
1103836Speter 	struct nl	*vp;
11118351Smckusick #endif
112781Speter 
113781Speter 	np = gtype(vtype);
114781Speter 	line = vline;
1153949Speter 	w = lwidth(np);
116781Speter 	op = &sizes[cbn];
11718351Smckusick 	for (; vidl != TR_NIL; vidl = vidl->list_node.next) {
118781Speter #		ifdef OBJ
1193235Smckusic 		    op->curtmps.om_off =
1203235Smckusic 			roundup((int)(op->curtmps.om_off-w), (long)align(np));
1213235Smckusic 		    o2 = op -> curtmps.om_off;
122781Speter #		endif OBJ
123781Speter #		ifdef PC
124781Speter 		    if ( cbn == 1 ) {
125781Speter 				/*
126781Speter 				 * global variables are not accessed off the fp
127781Speter 				 * but rather by their names.
128781Speter 				 */
129781Speter 			    o2 = 0;
130781Speter 		    } else {
131781Speter 				/*
132781Speter 				 * locals are aligned, too.
133781Speter 				 */
1343229Smckusic 			    op->curtmps.om_off =
1353229Smckusic 				roundup((int)(op->curtmps.om_off - w),
1363082Smckusic 				(long)align(np));
1373229Smckusic 			    o2 = op -> curtmps.om_off;
138781Speter 		    }
139781Speter #		endif PC
14018351Smckusick #		ifdef PC
14118351Smckusick 		vp = enter(defnl((char *) vidl->list_node.list, VAR, np, o2));
14218351Smckusick #		else
14318351Smckusick 		(void) enter(defnl((char *) vidl->list_node.list, VAR, np, o2));
14418351Smckusick #		endif
14524053Smckusick 		if ( np != NLNIL && (np -> nl_flags & NFILES) ) {
146781Speter 		    dfiles[ cbn ] = TRUE;
147781Speter 		}
148781Speter #		ifdef PC
149781Speter 		    if ( cbn == 1 ) {
150781Speter 			putprintf( "	.data" , 0 );
15110664Speter 			aligndot(align(np));
152781Speter 			putprintf( "	.comm	" , 1 );
15318351Smckusick 			putprintf( EXTFORMAT , 1 , (int) vidl->list_node.list );
15418351Smckusick 			putprintf( ",%d" , 0 , (int) w );
155781Speter 			putprintf( "	.text" , 0 );
15618351Smckusick 			stabgvar( vp , w , line );
1573836Speter 			vp -> extra_flags |= NGLOBAL;
1583836Speter 		    } else {
1593836Speter 			vp -> extra_flags |= NLOCAL;
160781Speter 		    }
161781Speter #		endif PC
162781Speter 	}
163781Speter #	ifdef PTREE
164781Speter 	    {
165781Speter 		pPointer	*Vars;
166781Speter 		pPointer	Var = VarDecl( ovidl , vtype );
167781Speter 
168781Speter 		pSeize( PorFHeader[ nesting ] );
169781Speter 		Vars = &( pDEF( PorFHeader[ nesting ] ).PorFVars );
170781Speter 		*Vars = ListAppend( *Vars , Var );
171781Speter 		pRelease( PorFHeader[ nesting ] );
172781Speter 	    }
173781Speter #	endif
174781Speter }
175781Speter #endif
176781Speter 
177781Speter varend()
178781Speter {
179781Speter 
180781Speter 	foredecl();
181781Speter #ifndef PI0
1823229Smckusic 	sizes[cbn].om_max = sizes[cbn].curtmps.om_off;
183781Speter #else
184781Speter 	send(REVVEND);
185781Speter #endif
186781Speter }
187781Speter 
188781Speter /*
189781Speter  * Find the width of a type in bytes.
190781Speter  */
191781Speter width(np)
192781Speter 	struct nl *np;
193781Speter {
194781Speter 
195781Speter 	return (lwidth(np));
196781Speter }
197781Speter 
198781Speter long
199781Speter lwidth(np)
200781Speter 	struct nl *np;
201781Speter {
202781Speter 	register struct nl *p;
203781Speter 
204781Speter 	p = np;
205781Speter 	if (p == NIL)
206781Speter 		return (0);
207781Speter loop:
208781Speter 	switch (p->class) {
20918351Smckusick 		default:
21018351Smckusick 			panic("wclass");
211781Speter 		case TYPE:
212781Speter 			switch (nloff(p)) {
213781Speter 				case TNIL:
214781Speter 					return (2);
215781Speter 				case TSTR:
216781Speter 				case TSET:
217781Speter 					panic("width");
218781Speter 				default:
219781Speter 					p = p->type;
220781Speter 					goto loop;
221781Speter 			}
222781Speter 		case ARRAY:
223781Speter 			return (aryconst(p, 0));
224781Speter 		case PTR:
225781Speter 			return ( sizeof ( int * ) );
226781Speter 		case FILET:
2272075Smckusic 			return ( sizeof(struct iorec) + lwidth( p -> type ) );
22818351Smckusick 		case CRANGE:
22918351Smckusick 			p = p->type;
23018351Smckusick 			goto loop;
231781Speter 		case RANGE:
232781Speter 			if (p->type == nl+TDOUBLE)
233781Speter #ifdef DEBUG
234781Speter 				return (hp21mx ? 4 : 8);
235781Speter #else
236781Speter 				return (8);
237781Speter #endif
238781Speter 		case SCAL:
239781Speter 			return (bytes(p->range[0], p->range[1]));
240781Speter 		case SET:
241781Speter 			setran(p->type);
24211822Smckusick 			/*
24311822Smckusick 			 * Sets are some multiple of longs
24411822Smckusick 			 */
2453082Smckusic 			return roundup((int)((set.uprbp >> 3) + 1),
24611822Smckusick 				(long)(sizeof(long)));
247781Speter 		case STR:
248781Speter 		case RECORD:
249781Speter 			return ( p->value[NL_OFFS] );
250781Speter 	}
251781Speter }
252781Speter 
253781Speter     /*
254781Speter      *	round up x to a multiple of y
255781Speter      *	for computing offsets of aligned things.
256781Speter      *	y had better be positive.
257781Speter      *	rounding is in the direction of x.
258781Speter      */
259781Speter long
260781Speter roundup( x , y )
2613082Smckusic     int			x;
262781Speter     register long	y;
263781Speter     {
264781Speter 
265781Speter 	if ( y == 0 ) {
2664030Smckusic 	    return x;
267781Speter 	}
268781Speter 	if ( x >= 0 ) {
269781Speter 		return ( ( ( x + ( y - 1 ) ) / y ) * y );
270781Speter 	} else {
271781Speter 		return ( ( ( x - ( y - 1 ) ) / y ) * y );
272781Speter 	}
273781Speter     }
274781Speter 
275781Speter     /*
276781Speter      *	alignment of an object using the c alignment scheme
277781Speter      */
278781Speter int
279781Speter align( np )
280781Speter     struct nl	*np;
281781Speter     {
282781Speter 	register struct nl *p;
28311822Smckusick 	long elementalign;
284781Speter 
285781Speter 	p = np;
286781Speter 	if ( p == NIL ) {
287781Speter 	    return 0;
288781Speter 	}
289781Speter alignit:
290781Speter 	switch ( p -> class ) {
29118351Smckusick 	    default:
29218351Smckusick 		    panic( "align" );
293781Speter 	    case TYPE:
294781Speter 		    switch ( nloff( p ) ) {
295781Speter 			case TNIL:
296781Speter 				return A_POINT;
297781Speter 			case TSTR:
29810664Speter 				return A_STRUCT;
299781Speter 			case TSET:
300781Speter 				return A_SET;
301781Speter 			default:
302781Speter 				p = p -> type;
303781Speter 				goto alignit;
304781Speter 		    }
305781Speter 	    case ARRAY:
306781Speter 			/*
30711822Smckusick 			 * arrays are structures, since they can get
30810664Speter 			 * assigned form/to as structure assignments.
30911822Smckusick 			 * preserve internal alignment if it is greater.
310781Speter 			 */
31111822Smckusick 		    elementalign = align(p -> type);
31211822Smckusick 		    return elementalign > A_STRUCT ? elementalign : A_STRUCT;
313781Speter 	    case PTR:
314781Speter 		    return A_POINT;
315781Speter 	    case FILET:
316781Speter 		    return A_FILET;
31718351Smckusick 	    case CRANGE:
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 	}
348781Speter     }
349781Speter 
35010664Speter #ifdef PC
3513949Speter     /*
35210664Speter      *	output an alignment pseudo-op.
3533949Speter      */
35410664Speter aligndot(alignment)
3553949Speter     int	alignment;
356*30038Smckusick #if defined(vax) || defined(tahoe)
3573949Speter {
35810664Speter     switch (alignment) {
35910664Speter 	case 1:
36010664Speter 	    return;
36110664Speter 	case 2:
36210664Speter 	    putprintf("	.align 1", 0);
36310664Speter 	    return;
36410664Speter 	default:
36510664Speter 	case 4:
36610664Speter 	    putprintf("	.align 2", 0);
36710664Speter 	    return;
3683949Speter     }
3693949Speter }
370*30038Smckusick #endif vax || tahoe
37110664Speter #ifdef mc68000
37210664Speter {
37310664Speter     switch (alignment) {
37410664Speter 	case 1:
37510664Speter 	    return;
37610664Speter 	default:
37710664Speter 	    putprintf("	.even", 0);
37810664Speter 	    return;
37910664Speter     }
38010664Speter }
38110664Speter #endif mc68000
38210664Speter #endif PC
38310664Speter 
384781Speter /*
385781Speter  * Return the width of an element
386781Speter  * of a n time subscripted np.
387781Speter  */
388781Speter long aryconst(np, n)
389781Speter 	struct nl *np;
390781Speter 	int n;
391781Speter {
392781Speter 	register struct nl *p;
393781Speter 	long s, d;
394781Speter 
395781Speter 	if ((p = np) == NIL)
396781Speter 		return (NIL);
397781Speter 	if (p->class != ARRAY)
398781Speter 		panic("ary");
39918351Smckusick 	/*
40018351Smckusick 	 * If it is a conformant array, we cannot find the width from
40118351Smckusick 	 * the type.
40218351Smckusick 	 */
40318351Smckusick 	if (p->chain->class == CRANGE)
40418351Smckusick 		return (NIL);
405781Speter 	s = lwidth(p->type);
406781Speter 	/*
407781Speter 	 * Arrays of anything but characters are word aligned.
408781Speter 	 */
409781Speter 	if (s & 1)
410781Speter 		if (s != 1)
411781Speter 			s++;
412781Speter 	/*
413781Speter 	 * Skip the first n subscripts
414781Speter 	 */
415781Speter 	while (n >= 0) {
416781Speter 		p = p->chain;
417781Speter 		n--;
418781Speter 	}
419781Speter 	/*
420781Speter 	 * Sum across remaining subscripts.
421781Speter 	 */
422781Speter 	while (p != NIL) {
423781Speter 		if (p->class != RANGE && p->class != SCAL)
424781Speter 			panic("aryran");
425781Speter 		d = p->range[1] - p->range[0] + 1;
426781Speter 		s *= d;
427781Speter 		p = p->chain;
428781Speter 	}
429781Speter 	return (s);
430781Speter }
431781Speter 
432781Speter /*
433781Speter  * Find the lower bound of a set, and also its size in bits.
434781Speter  */
435781Speter setran(q)
436781Speter 	struct nl *q;
437781Speter {
438781Speter 	register lb, ub;
439781Speter 	register struct nl *p;
440781Speter 
441781Speter 	p = q;
442781Speter 	if (p == NIL)
44318351Smckusick 		return;
444781Speter 	lb = p->range[0];
445781Speter 	ub = p->range[1];
446781Speter 	if (p->class != RANGE && p->class != SCAL)
447781Speter 		panic("setran");
448781Speter 	set.lwrb = lb;
449781Speter 	/* set.(upperbound prime) = number of bits - 1; */
450781Speter 	set.uprbp = ub-lb;
451781Speter }
452781Speter 
453781Speter /*
454781Speter  * Return the number of bytes required to hold an arithmetic quantity
455781Speter  */
456781Speter bytes(lb, ub)
457781Speter 	long lb, ub;
458781Speter {
459781Speter 
460781Speter #ifndef DEBUG
461781Speter 	if (lb < -32768 || ub > 32767)
462781Speter 		return (4);
463781Speter 	else if (lb < -128 || ub > 127)
464781Speter 		return (2);
465781Speter #else
466781Speter 	if (!hp21mx && (lb < -32768 || ub > 32767))
467781Speter 		return (4);
468781Speter 	if (lb < -128 || ub > 127)
469781Speter 		return (2);
470781Speter #endif
471781Speter 	else
472781Speter 		return (1);
473781Speter }
474