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