xref: /original-bsd/usr.bin/pascal/src/var.c (revision fbed46ce)
1 /* Copyright (c) 1979 Regents of the University of California */
2 
3 static char sccsid[] = "@(#)var.c 1.11 07/23/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 	w = lwidth(np);
92 	op = &sizes[cbn];
93 	for (; vidl != NIL; vidl = vidl[2]) {
94 #		ifdef OBJ
95 		    op->curtmps.om_off =
96 			roundup((int)(op->curtmps.om_off-w), (long)align(np));
97 		    o2 = op -> curtmps.om_off;
98 #		endif OBJ
99 #		ifdef PC
100 		    if ( cbn == 1 ) {
101 				/*
102 				 * global variables are not accessed off the fp
103 				 * but rather by their names.
104 				 */
105 			    o2 = 0;
106 		    } else {
107 				/*
108 				 * locals are aligned, too.
109 				 */
110 			    op->curtmps.om_off =
111 				roundup((int)(op->curtmps.om_off - w),
112 				(long)align(np));
113 			    o2 = op -> curtmps.om_off;
114 		    }
115 #		endif PC
116 		vp = enter(defnl(vidl[1], VAR, np, o2));
117 		if ( np -> nl_flags & NFILES ) {
118 		    dfiles[ cbn ] = TRUE;
119 		}
120 #		ifdef PC
121 		    if ( cbn == 1 ) {
122 			putprintf( "	.data" , 0 );
123 			putprintf( "	.align	%d" , 0 , dotalign(align(np)));
124 			putprintf( "	.comm	" , 1 );
125 			putprintf( EXTFORMAT , 1 , vidl[1] );
126 			putprintf( ",%d" , 0 , w );
127 			putprintf( "	.text" , 0 );
128 			stabgvar( vidl[1] , p2type( np ) , o2 , w , line );
129 			vp -> extra_flags |= NGLOBAL;
130 		    } else {
131 			vp -> extra_flags |= NLOCAL;
132 		    }
133 #		endif PC
134 	}
135 #	ifdef PTREE
136 	    {
137 		pPointer	*Vars;
138 		pPointer	Var = VarDecl( ovidl , vtype );
139 
140 		pSeize( PorFHeader[ nesting ] );
141 		Vars = &( pDEF( PorFHeader[ nesting ] ).PorFVars );
142 		*Vars = ListAppend( *Vars , Var );
143 		pRelease( PorFHeader[ nesting ] );
144 	    }
145 #	endif
146 }
147 #endif
148 
149 varend()
150 {
151 
152 	foredecl();
153 #ifndef PI0
154 	sizes[cbn].om_max = sizes[cbn].curtmps.om_off;
155 #else
156 	send(REVVEND);
157 #endif
158 }
159 
160 /*
161  * Evening
162  */
163 long
164 leven(w)
165 	register long w;
166 {
167 	if (w < 0)
168 		return (w & 0xfffffffe);
169 	return ((w+1) & 0xfffffffe);
170 }
171 
172 int
173 even(w)
174 	register int w;
175 {
176 	return leven((long)w);
177 }
178 
179 /*
180  * Find the width of a type in bytes.
181  */
182 width(np)
183 	struct nl *np;
184 {
185 
186 	return (lwidth(np));
187 }
188 
189 long
190 lwidth(np)
191 	struct nl *np;
192 {
193 	register struct nl *p;
194 	long w;
195 
196 	p = np;
197 	if (p == NIL)
198 		return (0);
199 loop:
200 	switch (p->class) {
201 		case TYPE:
202 			switch (nloff(p)) {
203 				case TNIL:
204 					return (2);
205 				case TSTR:
206 				case TSET:
207 					panic("width");
208 				default:
209 					p = p->type;
210 					goto loop;
211 			}
212 		case ARRAY:
213 			return (aryconst(p, 0));
214 		case PTR:
215 			return ( sizeof ( int * ) );
216 		case FILET:
217 			return ( sizeof(struct iorec) + lwidth( p -> type ) );
218 		case RANGE:
219 			if (p->type == nl+TDOUBLE)
220 #ifdef DEBUG
221 				return (hp21mx ? 4 : 8);
222 #else
223 				return (8);
224 #endif
225 		case SCAL:
226 			return (bytes(p->range[0], p->range[1]));
227 		case SET:
228 			setran(p->type);
229 			return roundup((int)((set.uprbp >> 3) + 1),
230 				(long)(A_SET));
231 		case STR:
232 		case RECORD:
233 			return ( p->value[NL_OFFS] );
234 		default:
235 			panic("wclass");
236 	}
237 }
238 
239     /*
240      *	round up x to a multiple of y
241      *	for computing offsets of aligned things.
242      *	y had better be positive.
243      *	rounding is in the direction of x.
244      */
245 long
246 roundup( x , y )
247     int			x;
248     register long	y;
249     {
250 
251 	if ( y == 0 ) {
252 	    return x;
253 	}
254 	if ( x >= 0 ) {
255 		return ( ( ( x + ( y - 1 ) ) / y ) * y );
256 	} else {
257 		return ( ( ( x - ( y - 1 ) ) / y ) * y );
258 	}
259     }
260 
261     /*
262      *	alignment of an object using the c alignment scheme
263      */
264 int
265 align( np )
266     struct nl	*np;
267     {
268 	register struct nl *p;
269 
270 	p = np;
271 	if ( p == NIL ) {
272 	    return 0;
273 	}
274 alignit:
275 	switch ( p -> class ) {
276 	    case TYPE:
277 		    switch ( nloff( p ) ) {
278 			case TNIL:
279 				return A_POINT;
280 			case TSTR:
281 				return A_CHAR;
282 			case TSET:
283 				return A_SET;
284 			default:
285 				p = p -> type;
286 				goto alignit;
287 		    }
288 	    case ARRAY:
289 			/*
290 			 * arrays are aligned as their component types
291 			 */
292 		    p = p -> type;
293 		    goto alignit;
294 	    case PTR:
295 		    return A_POINT;
296 	    case FILET:
297 		    return A_FILET;
298 	    case RANGE:
299 		    if ( p -> type == nl+TDOUBLE ) {
300 			return A_DOUBLE;
301 		    }
302 		    /* else, fall through */
303 	    case SCAL:
304 		    switch ( bytes( p -> range[0] , p -> range[1] ) ) {
305 			case 4:
306 			    return A_LONG;
307 			case 2:
308 			    return A_SHORT;
309 			case 1:
310 			    return A_CHAR;
311 			default:
312 			    panic( "align: scal" );
313 		    }
314 	    case SET:
315 		    return A_SET;
316 	    case STR:
317 		    return A_CHAR;
318 	    case RECORD:
319 			/*
320 			 * follow chain through all fields in record,
321 			 * taking max of alignments of types of fields.
322 			 * short circuit out if i reach the maximum alignment.
323 			 * this is pretty likely, as A_MAX is only 4.
324 			 */
325 		    {
326 			register long recalign;
327 			register long fieldalign;
328 
329 			recalign = A_MIN;
330 			p = p -> chain;
331 			while ( ( p != NIL ) && ( recalign < A_MAX ) ) {
332 			    fieldalign = align( p -> type );
333 			    if ( fieldalign > recalign ) {
334 				recalign = fieldalign;
335 			    }
336 			    p = p -> chain;
337 			}
338 			return recalign;
339 		    }
340 	    default:
341 		    panic( "align" );
342 	}
343     }
344 
345     /*
346      *	given an alignment, return power of two for .align pseudo-op
347      */
348 dotalign( alignment )
349     int	alignment;
350 {
351 
352     switch ( alignment ) {
353 	case A_CHAR:		/*
354 				 * also
355 				 *	A_STRUCT
356 				 */
357 		return 0;
358 	case A_SHORT:
359 		return 1;
360 	case A_LONG:		/*
361 				 * also
362 				 *	A_POINT, A_INT, A_FLOAT, A_DOUBLE,
363 				 *	A_STACK, A_FILET, A_SET
364 				 */
365 		return 2;
366     }
367 }
368 
369 /*
370  * Return the width of an element
371  * of a n time subscripted np.
372  */
373 long aryconst(np, n)
374 	struct nl *np;
375 	int n;
376 {
377 	register struct nl *p;
378 	long s, d;
379 
380 	if ((p = np) == NIL)
381 		return (NIL);
382 	if (p->class != ARRAY)
383 		panic("ary");
384 	s = lwidth(p->type);
385 	/*
386 	 * Arrays of anything but characters are word aligned.
387 	 */
388 	if (s & 1)
389 		if (s != 1)
390 			s++;
391 	/*
392 	 * Skip the first n subscripts
393 	 */
394 	while (n >= 0) {
395 		p = p->chain;
396 		n--;
397 	}
398 	/*
399 	 * Sum across remaining subscripts.
400 	 */
401 	while (p != NIL) {
402 		if (p->class != RANGE && p->class != SCAL)
403 			panic("aryran");
404 		d = p->range[1] - p->range[0] + 1;
405 		s *= d;
406 		p = p->chain;
407 	}
408 	return (s);
409 }
410 
411 /*
412  * Find the lower bound of a set, and also its size in bits.
413  */
414 setran(q)
415 	struct nl *q;
416 {
417 	register lb, ub;
418 	register struct nl *p;
419 
420 	p = q;
421 	if (p == NIL)
422 		return (NIL);
423 	lb = p->range[0];
424 	ub = p->range[1];
425 	if (p->class != RANGE && p->class != SCAL)
426 		panic("setran");
427 	set.lwrb = lb;
428 	/* set.(upperbound prime) = number of bits - 1; */
429 	set.uprbp = ub-lb;
430 }
431 
432 /*
433  * Return the number of bytes required to hold an arithmetic quantity
434  */
435 bytes(lb, ub)
436 	long lb, ub;
437 {
438 
439 #ifndef DEBUG
440 	if (lb < -32768 || ub > 32767)
441 		return (4);
442 	else if (lb < -128 || ub > 127)
443 		return (2);
444 #else
445 	if (!hp21mx && (lb < -32768 || ub > 32767))
446 		return (4);
447 	if (lb < -128 || ub > 127)
448 		return (2);
449 #endif
450 	else
451 		return (1);
452 }
453