xref: /csrg-svn/usr.bin/pascal/src/var.c (revision 10664)
1781Speter /* Copyright (c) 1979 Regents of the University of California */
2781Speter 
3*10664Speter static char sccsid[] = "@(#)var.c 1.14 02/01/83";
4781Speter 
5781Speter #include "whoami.h"
6781Speter #include "0.h"
7*10664Speter #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
14781Speter 
15781Speter /*
16781Speter  * Declare variables of a var part.  DPOFF1 is
17781Speter  * the local variable storage for all prog/proc/func
18781Speter  * modules aside from the block mark.  The total size
19781Speter  * of all the local variables is entered into the
20781Speter  * size array.
21781Speter  */
227951Speter varbeg( lineofyvar , r )
237951Speter     int	lineofyvar;
24781Speter {
257951Speter     static bool	var_order = FALSE;
267951Speter     static bool	var_seen = FALSE;
27781Speter 
28837Speter /* this allows for multiple declaration
29781Speter  * parts except when the "standard"
30781Speter  * option has been specified.
31781Speter  * If routine segment is being compiled,
32781Speter  * do level one processing.
33781Speter  */
34781Speter 
35781Speter #ifndef PI1
36837Speter 	if (!progseen)
37837Speter 		level1();
387951Speter 	line = lineofyvar;
39837Speter 	if ( parts[ cbn ] & RPRT ) {
40837Speter 	    if ( opt( 's' ) ) {
41781Speter 		standard();
427951Speter 		error("Variable declarations should precede routine declarations");
43837Speter 	    } else {
447951Speter 		if ( !var_order ) {
457951Speter 		    var_order = TRUE;
467951Speter 		    warning();
477951Speter 		    error("Variable declarations should precede routine declarations");
487951Speter 		}
49837Speter 	    }
50781Speter 	}
51837Speter 	if ( parts[ cbn ] & VPRT ) {
52837Speter 	    if ( opt( 's' ) ) {
53837Speter 		standard();
547951Speter 		error("All variables should be declared in one var part");
55837Speter 	    } else {
567951Speter 		if ( !var_seen ) {
577951Speter 		    var_seen = TRUE;
587951Speter 		    warning();
597951Speter 		    error("All variables should be declared in one var part");
607951Speter 		}
61837Speter 	    }
62837Speter 	}
63837Speter 	parts[ cbn ] |= VPRT;
64781Speter #endif
65781Speter     /*
66781Speter      *  #ifndef PI0
673229Smckusic      *      sizes[cbn].om_max = sizes[cbn].curtmps.om_off = -DPOFF1;
68781Speter      *  #endif
69781Speter      */
70781Speter 	forechain = NIL;
71781Speter #ifdef PI0
72781Speter 	send(REVVBEG);
73781Speter #endif
74781Speter }
75781Speter 
76781Speter var(vline, vidl, vtype)
77781Speter #ifdef PI0
78781Speter 	int vline, *vidl, *vtype;
79781Speter {
80781Speter 	register struct nl *np;
81781Speter 	register int *vl;
82781Speter 
83781Speter 	np = gtype(vtype);
84781Speter 	line = vline;
85781Speter 	for (vl = vidl; vl != NIL; vl = vl[2]) {
86781Speter 		}
87781Speter 	}
88781Speter 	send(REVVAR, vline, vidl, vtype);
89781Speter }
90781Speter #else
91781Speter 	int vline;
92781Speter 	register int *vidl;
93781Speter 	int *vtype;
94781Speter {
95781Speter 	register struct nl *np;
96781Speter 	register struct om *op;
97781Speter 	long w;
98781Speter 	int o2;
99781Speter 	int *ovidl = vidl;
1003836Speter 	struct nl	*vp;
101781Speter 
102781Speter 	np = gtype(vtype);
103781Speter 	line = vline;
1043949Speter 	w = lwidth(np);
105781Speter 	op = &sizes[cbn];
106781Speter 	for (; vidl != NIL; vidl = vidl[2]) {
107781Speter #		ifdef OBJ
1083235Smckusic 		    op->curtmps.om_off =
1093235Smckusic 			roundup((int)(op->curtmps.om_off-w), (long)align(np));
1103235Smckusic 		    o2 = op -> curtmps.om_off;
111781Speter #		endif OBJ
112781Speter #		ifdef PC
113781Speter 		    if ( cbn == 1 ) {
114781Speter 				/*
115781Speter 				 * global variables are not accessed off the fp
116781Speter 				 * but rather by their names.
117781Speter 				 */
118781Speter 			    o2 = 0;
119781Speter 		    } else {
120781Speter 				/*
121781Speter 				 * locals are aligned, too.
122781Speter 				 */
1233229Smckusic 			    op->curtmps.om_off =
1243229Smckusic 				roundup((int)(op->curtmps.om_off - w),
1253082Smckusic 				(long)align(np));
1263229Smckusic 			    o2 = op -> curtmps.om_off;
127781Speter 		    }
128781Speter #		endif PC
1293836Speter 		vp = enter(defnl(vidl[1], VAR, np, o2));
130781Speter 		if ( np -> nl_flags & NFILES ) {
131781Speter 		    dfiles[ cbn ] = TRUE;
132781Speter 		}
133781Speter #		ifdef PC
134781Speter 		    if ( cbn == 1 ) {
135781Speter 			putprintf( "	.data" , 0 );
136*10664Speter 			aligndot(align(np));
137781Speter 			putprintf( "	.comm	" , 1 );
138781Speter 			putprintf( EXTFORMAT , 1 , vidl[1] );
139781Speter 			putprintf( ",%d" , 0 , w );
140781Speter 			putprintf( "	.text" , 0 );
1412165Speter 			stabgvar( vidl[1] , p2type( np ) , o2 , w , line );
1423836Speter 			vp -> extra_flags |= NGLOBAL;
1433836Speter 		    } else {
1443836Speter 			vp -> extra_flags |= NLOCAL;
145781Speter 		    }
146781Speter #		endif PC
147781Speter 	}
148781Speter #	ifdef PTREE
149781Speter 	    {
150781Speter 		pPointer	*Vars;
151781Speter 		pPointer	Var = VarDecl( ovidl , vtype );
152781Speter 
153781Speter 		pSeize( PorFHeader[ nesting ] );
154781Speter 		Vars = &( pDEF( PorFHeader[ nesting ] ).PorFVars );
155781Speter 		*Vars = ListAppend( *Vars , Var );
156781Speter 		pRelease( PorFHeader[ nesting ] );
157781Speter 	    }
158781Speter #	endif
159781Speter }
160781Speter #endif
161781Speter 
162781Speter varend()
163781Speter {
164781Speter 
165781Speter 	foredecl();
166781Speter #ifndef PI0
1673229Smckusic 	sizes[cbn].om_max = sizes[cbn].curtmps.om_off;
168781Speter #else
169781Speter 	send(REVVEND);
170781Speter #endif
171781Speter }
172781Speter 
173781Speter /*
174781Speter  * Evening
175781Speter  */
1763082Smckusic long
1773082Smckusic leven(w)
1783082Smckusic 	register long w;
1793082Smckusic {
1803082Smckusic 	if (w < 0)
1813082Smckusic 		return (w & 0xfffffffe);
1823082Smckusic 	return ((w+1) & 0xfffffffe);
1833082Smckusic }
1843082Smckusic 
1853082Smckusic int
186781Speter even(w)
187781Speter 	register int w;
188781Speter {
1893082Smckusic 	return leven((long)w);
190781Speter }
191781Speter 
192781Speter /*
193781Speter  * Find the width of a type in bytes.
194781Speter  */
195781Speter width(np)
196781Speter 	struct nl *np;
197781Speter {
198781Speter 
199781Speter 	return (lwidth(np));
200781Speter }
201781Speter 
202781Speter long
203781Speter lwidth(np)
204781Speter 	struct nl *np;
205781Speter {
206781Speter 	register struct nl *p;
207781Speter 	long w;
208781Speter 
209781Speter 	p = np;
210781Speter 	if (p == NIL)
211781Speter 		return (0);
212781Speter loop:
213781Speter 	switch (p->class) {
214781Speter 		case TYPE:
215781Speter 			switch (nloff(p)) {
216781Speter 				case TNIL:
217781Speter 					return (2);
218781Speter 				case TSTR:
219781Speter 				case TSET:
220781Speter 					panic("width");
221781Speter 				default:
222781Speter 					p = p->type;
223781Speter 					goto loop;
224781Speter 			}
225781Speter 		case ARRAY:
226781Speter 			return (aryconst(p, 0));
227781Speter 		case PTR:
228781Speter 			return ( sizeof ( int * ) );
229781Speter 		case FILET:
2302075Smckusic 			return ( sizeof(struct iorec) + lwidth( p -> type ) );
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);
2423082Smckusic 			return roundup((int)((set.uprbp >> 3) + 1),
2433082Smckusic 				(long)(A_SET));
244781Speter 		case STR:
245781Speter 		case RECORD:
246781Speter 			return ( p->value[NL_OFFS] );
247781Speter 		default:
248781Speter 			panic("wclass");
249781Speter 	}
250781Speter }
251781Speter 
252781Speter     /*
253781Speter      *	round up x to a multiple of y
254781Speter      *	for computing offsets of aligned things.
255781Speter      *	y had better be positive.
256781Speter      *	rounding is in the direction of x.
257781Speter      */
258781Speter long
259781Speter roundup( x , y )
2603082Smckusic     int			x;
261781Speter     register long	y;
262781Speter     {
263781Speter 
264781Speter 	if ( y == 0 ) {
2654030Smckusic 	    return x;
266781Speter 	}
267781Speter 	if ( x >= 0 ) {
268781Speter 		return ( ( ( x + ( y - 1 ) ) / y ) * y );
269781Speter 	} else {
270781Speter 		return ( ( ( x - ( y - 1 ) ) / y ) * y );
271781Speter 	}
272781Speter     }
273781Speter 
274781Speter     /*
275781Speter      *	alignment of an object using the c alignment scheme
276781Speter      */
277781Speter int
278781Speter align( np )
279781Speter     struct nl	*np;
280781Speter     {
281781Speter 	register struct nl *p;
282781Speter 
283781Speter 	p = np;
284781Speter 	if ( p == NIL ) {
285781Speter 	    return 0;
286781Speter 	}
287781Speter alignit:
288781Speter 	switch ( p -> class ) {
289781Speter 	    case TYPE:
290781Speter 		    switch ( nloff( p ) ) {
291781Speter 			case TNIL:
292781Speter 				return A_POINT;
293781Speter 			case TSTR:
294*10664Speter 				return A_STRUCT;
295781Speter 			case TSET:
296781Speter 				return A_SET;
297781Speter 			default:
298781Speter 				p = p -> type;
299781Speter 				goto alignit;
300781Speter 		    }
301781Speter 	    case ARRAY:
302781Speter 			/*
303*10664Speter 			 * strings are structures, since they can get
304*10664Speter 			 * assigned form/to as structure assignments.
305*10664Speter 			 * other arrays are aligned as their component types
306781Speter 			 */
307*10664Speter 		    if ( p -> type == nl+T1CHAR ) {
308*10664Speter 			return A_STRUCT;
309*10664Speter 		    }
310781Speter 		    p = p -> type;
311781Speter 		    goto alignit;
312781Speter 	    case PTR:
313781Speter 		    return A_POINT;
314781Speter 	    case FILET:
315781Speter 		    return A_FILET;
316781Speter 	    case RANGE:
317781Speter 		    if ( p -> type == nl+TDOUBLE ) {
318781Speter 			return A_DOUBLE;
319781Speter 		    }
320781Speter 		    /* else, fall through */
321781Speter 	    case SCAL:
322781Speter 		    switch ( bytes( p -> range[0] , p -> range[1] ) ) {
323781Speter 			case 4:
324781Speter 			    return A_LONG;
325781Speter 			case 2:
326781Speter 			    return A_SHORT;
327781Speter 			case 1:
328781Speter 			    return A_CHAR;
329781Speter 			default:
330781Speter 			    panic( "align: scal" );
331781Speter 		    }
332781Speter 	    case SET:
333781Speter 		    return A_SET;
334781Speter 	    case STR:
335*10664Speter 			/*
336*10664Speter 			 * arrays of chars are structs
337*10664Speter 			 */
338*10664Speter 		    return A_STRUCT;
339781Speter 	    case RECORD:
340781Speter 			/*
3418681Speter 			 * the alignment of a record is in its align_info field
3428681Speter 			 * why don't we use this for the rest of the namelist?
343781Speter 			 */
3448681Speter 		    return p -> align_info;
345781Speter 	    default:
346781Speter 		    panic( "align" );
347781Speter 	}
348781Speter     }
349781Speter 
350*10664Speter #ifdef PC
3513949Speter     /*
352*10664Speter      *	output an alignment pseudo-op.
3533949Speter      */
354*10664Speter aligndot(alignment)
3553949Speter     int	alignment;
356*10664Speter #ifdef vax
3573949Speter {
358*10664Speter     switch (alignment) {
359*10664Speter 	case 1:
360*10664Speter 	    return;
361*10664Speter 	case 2:
362*10664Speter 	    putprintf("	.align 1", 0);
363*10664Speter 	    return;
364*10664Speter 	default:
365*10664Speter 	case 4:
366*10664Speter 	    putprintf("	.align 2", 0);
367*10664Speter 	    return;
3683949Speter     }
3693949Speter }
370*10664Speter #endif vax
371*10664Speter #ifdef mc68000
372*10664Speter {
373*10664Speter     switch (alignment) {
374*10664Speter 	case 1:
375*10664Speter 	    return;
376*10664Speter 	default:
377*10664Speter 	    putprintf("	.even", 0);
378*10664Speter 	    return;
379*10664Speter     }
380*10664Speter }
381*10664Speter #endif mc68000
382*10664Speter #endif PC
383*10664Speter 
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");
399781Speter 	s = lwidth(p->type);
400781Speter 	/*
401781Speter 	 * Arrays of anything but characters are word aligned.
402781Speter 	 */
403781Speter 	if (s & 1)
404781Speter 		if (s != 1)
405781Speter 			s++;
406781Speter 	/*
407781Speter 	 * Skip the first n subscripts
408781Speter 	 */
409781Speter 	while (n >= 0) {
410781Speter 		p = p->chain;
411781Speter 		n--;
412781Speter 	}
413781Speter 	/*
414781Speter 	 * Sum across remaining subscripts.
415781Speter 	 */
416781Speter 	while (p != NIL) {
417781Speter 		if (p->class != RANGE && p->class != SCAL)
418781Speter 			panic("aryran");
419781Speter 		d = p->range[1] - p->range[0] + 1;
420781Speter 		s *= d;
421781Speter 		p = p->chain;
422781Speter 	}
423781Speter 	return (s);
424781Speter }
425781Speter 
426781Speter /*
427781Speter  * Find the lower bound of a set, and also its size in bits.
428781Speter  */
429781Speter setran(q)
430781Speter 	struct nl *q;
431781Speter {
432781Speter 	register lb, ub;
433781Speter 	register struct nl *p;
434781Speter 
435781Speter 	p = q;
436781Speter 	if (p == NIL)
437781Speter 		return (NIL);
438781Speter 	lb = p->range[0];
439781Speter 	ub = p->range[1];
440781Speter 	if (p->class != RANGE && p->class != SCAL)
441781Speter 		panic("setran");
442781Speter 	set.lwrb = lb;
443781Speter 	/* set.(upperbound prime) = number of bits - 1; */
444781Speter 	set.uprbp = ub-lb;
445781Speter }
446781Speter 
447781Speter /*
448781Speter  * Return the number of bytes required to hold an arithmetic quantity
449781Speter  */
450781Speter bytes(lb, ub)
451781Speter 	long lb, ub;
452781Speter {
453781Speter 
454781Speter #ifndef DEBUG
455781Speter 	if (lb < -32768 || ub > 32767)
456781Speter 		return (4);
457781Speter 	else if (lb < -128 || ub > 127)
458781Speter 		return (2);
459781Speter #else
460781Speter 	if (!hp21mx && (lb < -32768 || ub > 32767))
461781Speter 		return (4);
462781Speter 	if (lb < -128 || ub > 127)
463781Speter 		return (2);
464781Speter #endif
465781Speter 	else
466781Speter 		return (1);
467781Speter }
468