xref: /csrg-svn/usr.bin/pascal/src/var.c (revision 3836)
1 /* Copyright (c) 1979 Regents of the University of California */
2 
3 static char sccsid[] = "@(#)var.c 1.9 06/01/81";
4 
5 #include "whoami.h"
6 #include "0.h"
7 #include "align.h"
8 #include "iorec.h"
9 #ifdef PC
10 #   include	"pc.h"
11 #   include	"pcops.h"
12 #endif PC
13 
14 /*
15  * Declare variables of a var part.  DPOFF1 is
16  * the local variable storage for all prog/proc/func
17  * modules aside from the block mark.  The total size
18  * of all the local variables is entered into the
19  * size array.
20  */
21 varbeg()
22 {
23 
24 /* this allows for multiple declaration
25  * parts except when the "standard"
26  * option has been specified.
27  * If routine segment is being compiled,
28  * do level one processing.
29  */
30 
31 #ifndef PI1
32 	if (!progseen)
33 		level1();
34 	if ( parts[ cbn ] & RPRT ) {
35 	    if ( opt( 's' ) ) {
36 		standard();
37 	    } else {
38 		warning();
39 	    }
40 	    error("Variable declarations should precede routine declarations");
41 	}
42 	if ( parts[ cbn ] & VPRT ) {
43 	    if ( opt( 's' ) ) {
44 		standard();
45 	    } else {
46 		warning();
47 	    }
48 	    error("All variables should be declared in one var part");
49 	}
50 	parts[ cbn ] |= VPRT;
51 #endif
52     /*
53      *  #ifndef PI0
54      *      sizes[cbn].om_max = sizes[cbn].curtmps.om_off = -DPOFF1;
55      *  #endif
56      */
57 	forechain = NIL;
58 #ifdef PI0
59 	send(REVVBEG);
60 #endif
61 }
62 
63 var(vline, vidl, vtype)
64 #ifdef PI0
65 	int vline, *vidl, *vtype;
66 {
67 	register struct nl *np;
68 	register int *vl;
69 
70 	np = gtype(vtype);
71 	line = vline;
72 	for (vl = vidl; vl != NIL; vl = vl[2]) {
73 		}
74 	}
75 	send(REVVAR, vline, vidl, vtype);
76 }
77 #else
78 	int vline;
79 	register int *vidl;
80 	int *vtype;
81 {
82 	register struct nl *np;
83 	register struct om *op;
84 	long w;
85 	int o2;
86 	int *ovidl = vidl;
87 	struct nl	*vp;
88 
89 	np = gtype(vtype);
90 	line = vline;
91 	    /*
92 	     * widths are evened out
93 	     */
94 	w = (lwidth(np) + 1) &~ 1;
95 	op = &sizes[cbn];
96 	for (; vidl != NIL; vidl = vidl[2]) {
97 #		ifdef OBJ
98 		    op->curtmps.om_off =
99 			roundup((int)(op->curtmps.om_off-w), (long)align(np));
100 		    o2 = op -> curtmps.om_off;
101 #		endif OBJ
102 #		ifdef PC
103 		    if ( cbn == 1 ) {
104 				/*
105 				 * global variables are not accessed off the fp
106 				 * but rather by their names.
107 				 */
108 			    o2 = 0;
109 		    } else {
110 				/*
111 				 * locals are aligned, too.
112 				 */
113 			    op->curtmps.om_off =
114 				roundup((int)(op->curtmps.om_off - w),
115 				(long)align(np));
116 			    o2 = op -> curtmps.om_off;
117 		    }
118 #		endif PC
119 		vp = enter(defnl(vidl[1], VAR, np, o2));
120 		if ( np -> nl_flags & NFILES ) {
121 		    dfiles[ cbn ] = TRUE;
122 		}
123 #		ifdef PC
124 		    if ( cbn == 1 ) {
125 			putprintf( "	.data" , 0 );
126 			putprintf( "	.comm	" , 1 );
127 			putprintf( EXTFORMAT , 1 , vidl[1] );
128 			putprintf( ",%d" , 0 , w );
129 			putprintf( "	.text" , 0 );
130 			stabgvar( vidl[1] , p2type( np ) , o2 , w , line );
131 			vp -> extra_flags |= NGLOBAL;
132 		    } else {
133 			vp -> extra_flags |= NLOCAL;
134 		    }
135 #		endif PC
136 	}
137 #	ifdef PTREE
138 	    {
139 		pPointer	*Vars;
140 		pPointer	Var = VarDecl( ovidl , vtype );
141 
142 		pSeize( PorFHeader[ nesting ] );
143 		Vars = &( pDEF( PorFHeader[ nesting ] ).PorFVars );
144 		*Vars = ListAppend( *Vars , Var );
145 		pRelease( PorFHeader[ nesting ] );
146 	    }
147 #	endif
148 }
149 #endif
150 
151 varend()
152 {
153 
154 	foredecl();
155 #ifndef PI0
156 	sizes[cbn].om_max = sizes[cbn].curtmps.om_off;
157 #else
158 	send(REVVEND);
159 #endif
160 }
161 
162 /*
163  * Evening
164  */
165 long
166 leven(w)
167 	register long w;
168 {
169 	if (w < 0)
170 		return (w & 0xfffffffe);
171 	return ((w+1) & 0xfffffffe);
172 }
173 
174 int
175 even(w)
176 	register int w;
177 {
178 	return leven((long)w);
179 }
180 
181 /*
182  * Find the width of a type in bytes.
183  */
184 width(np)
185 	struct nl *np;
186 {
187 
188 	return (lwidth(np));
189 }
190 
191 long
192 lwidth(np)
193 	struct nl *np;
194 {
195 	register struct nl *p;
196 	long w;
197 
198 	p = np;
199 	if (p == NIL)
200 		return (0);
201 loop:
202 	switch (p->class) {
203 		case TYPE:
204 			switch (nloff(p)) {
205 				case TNIL:
206 					return (2);
207 				case TSTR:
208 				case TSET:
209 					panic("width");
210 				default:
211 					p = p->type;
212 					goto loop;
213 			}
214 		case ARRAY:
215 			return (aryconst(p, 0));
216 		case PTR:
217 			return ( sizeof ( int * ) );
218 		case FILET:
219 			return ( sizeof(struct iorec) + lwidth( p -> type ) );
220 		case RANGE:
221 			if (p->type == nl+TDOUBLE)
222 #ifdef DEBUG
223 				return (hp21mx ? 4 : 8);
224 #else
225 				return (8);
226 #endif
227 		case SCAL:
228 			return (bytes(p->range[0], p->range[1]));
229 		case SET:
230 			setran(p->type);
231 			return roundup((int)((set.uprbp >> 3) + 1),
232 				(long)(A_SET));
233 		case STR:
234 		case RECORD:
235 			return ( p->value[NL_OFFS] );
236 		default:
237 			panic("wclass");
238 	}
239 }
240 
241     /*
242      *	round up x to a multiple of y
243      *	for computing offsets of aligned things.
244      *	y had better be positive.
245      *	rounding is in the direction of x.
246      */
247 long
248 roundup( x , y )
249     int			x;
250     register long	y;
251     {
252 
253 	if ( y == 0 ) {
254 	    return 0;
255 	}
256 	if ( x >= 0 ) {
257 		return ( ( ( x + ( y - 1 ) ) / y ) * y );
258 	} else {
259 		return ( ( ( x - ( y - 1 ) ) / y ) * y );
260 	}
261     }
262 
263     /*
264      *	alignment of an object using the c alignment scheme
265      */
266 int
267 align( np )
268     struct nl	*np;
269     {
270 	register struct nl *p;
271 
272 	p = np;
273 	if ( p == NIL ) {
274 	    return 0;
275 	}
276 alignit:
277 	switch ( p -> class ) {
278 	    case TYPE:
279 		    switch ( nloff( p ) ) {
280 			case TNIL:
281 				return A_POINT;
282 			case TSTR:
283 				return A_CHAR;
284 			case TSET:
285 				return A_SET;
286 			default:
287 				p = p -> type;
288 				goto alignit;
289 		    }
290 	    case ARRAY:
291 			/*
292 			 * arrays are aligned as their component types
293 			 */
294 		    p = p -> type;
295 		    goto alignit;
296 	    case PTR:
297 		    return A_POINT;
298 	    case FILET:
299 		    return A_FILET;
300 	    case RANGE:
301 		    if ( p -> type == nl+TDOUBLE ) {
302 			return A_DOUBLE;
303 		    }
304 		    /* else, fall through */
305 	    case SCAL:
306 		    switch ( bytes( p -> range[0] , p -> range[1] ) ) {
307 			case 4:
308 			    return A_LONG;
309 			case 2:
310 			    return A_SHORT;
311 			case 1:
312 			    return A_CHAR;
313 			default:
314 			    panic( "align: scal" );
315 		    }
316 	    case SET:
317 		    return A_SET;
318 	    case STR:
319 		    return A_CHAR;
320 	    case RECORD:
321 			/*
322 			 * follow chain through all fields in record,
323 			 * taking max of alignments of types of fields.
324 			 * short circuit out if i reach the maximum alignment.
325 			 * this is pretty likely, as A_MAX is only 4.
326 			 */
327 		    {
328 			register long recalign;
329 			register long fieldalign;
330 
331 			recalign = A_MIN;
332 			p = p -> chain;
333 			while ( ( p != NIL ) && ( recalign < A_MAX ) ) {
334 			    fieldalign = align( p -> type );
335 			    if ( fieldalign > recalign ) {
336 				recalign = fieldalign;
337 			    }
338 			    p = p -> chain;
339 			}
340 			return recalign;
341 		    }
342 	    default:
343 		    panic( "align" );
344 	}
345     }
346 
347 /*
348  * Return the width of an element
349  * of a n time subscripted np.
350  */
351 long aryconst(np, n)
352 	struct nl *np;
353 	int n;
354 {
355 	register struct nl *p;
356 	long s, d;
357 
358 	if ((p = np) == NIL)
359 		return (NIL);
360 	if (p->class != ARRAY)
361 		panic("ary");
362 	s = lwidth(p->type);
363 	/*
364 	 * Arrays of anything but characters are word aligned.
365 	 */
366 	if (s & 1)
367 		if (s != 1)
368 			s++;
369 	/*
370 	 * Skip the first n subscripts
371 	 */
372 	while (n >= 0) {
373 		p = p->chain;
374 		n--;
375 	}
376 	/*
377 	 * Sum across remaining subscripts.
378 	 */
379 	while (p != NIL) {
380 		if (p->class != RANGE && p->class != SCAL)
381 			panic("aryran");
382 		d = p->range[1] - p->range[0] + 1;
383 		s *= d;
384 		p = p->chain;
385 	}
386 	return (s);
387 }
388 
389 /*
390  * Find the lower bound of a set, and also its size in bits.
391  */
392 setran(q)
393 	struct nl *q;
394 {
395 	register lb, ub;
396 	register struct nl *p;
397 
398 	p = q;
399 	if (p == NIL)
400 		return (NIL);
401 	lb = p->range[0];
402 	ub = p->range[1];
403 	if (p->class != RANGE && p->class != SCAL)
404 		panic("setran");
405 	set.lwrb = lb;
406 	/* set.(upperbound prime) = number of bits - 1; */
407 	set.uprbp = ub-lb;
408 }
409 
410 /*
411  * Return the number of bytes required to hold an arithmetic quantity
412  */
413 bytes(lb, ub)
414 	long lb, ub;
415 {
416 
417 #ifndef DEBUG
418 	if (lb < -32768 || ub > 32767)
419 		return (4);
420 	else if (lb < -128 || ub > 127)
421 		return (2);
422 #else
423 	if (!hp21mx && (lb < -32768 || ub > 32767))
424 		return (4);
425 	if (lb < -128 || ub > 127)
426 		return (2);
427 #endif
428 	else
429 		return (1);
430 }
431