xref: /original-bsd/usr.bin/pascal/src/var.c (revision 96c0f48c)
1 /* Copyright (c) 1979 Regents of the University of California */
2 
3 static	char sccsid[] = "@(#)var.c 1.3 09/02/80";
4 
5 #include "whoami.h"
6 #include "0.h"
7 #include "align.h"
8 #ifdef PC
9 #   include	"pc.h"
10 #   include	"pcops.h"
11 #   include	"iorec.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 		    }
128 		    stabvar( vidl[1] , p2type( np ) , cbn , o2 , w , line );
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 #			ifdef OBJ
206 			    return ( sizeof ( int * ) );
207 #			endif OBJ
208 #			ifdef PC
209 			    return ( sizeof(struct iorec)
210 				    + lwidth( p -> type ) );
211 #			endif PC
212 		case RANGE:
213 			if (p->type == nl+TDOUBLE)
214 #ifdef DEBUG
215 				return (hp21mx ? 4 : 8);
216 #else
217 				return (8);
218 #endif
219 		case SCAL:
220 			return (bytes(p->range[0], p->range[1]));
221 		case SET:
222 			setran(p->type);
223 			return roundup( ( set.uprbp >> 3 ) + 1 , A_SET );
224 		case STR:
225 		case RECORD:
226 			return ( p->value[NL_OFFS] );
227 		default:
228 			panic("wclass");
229 	}
230 }
231 
232     /*
233      *	round up x to a multiple of y
234      *	for computing offsets of aligned things.
235      *	y had better be positive.
236      *	rounding is in the direction of x.
237      */
238 long
239 roundup( x , y )
240     long		x;
241     register long	y;
242     {
243 
244 	if ( y == 0 ) {
245 	    return 0;
246 	}
247 	if ( x >= 0 ) {
248 		return ( ( ( x + ( y - 1 ) ) / y ) * y );
249 	} else {
250 		return ( ( ( x - ( y - 1 ) ) / y ) * y );
251 	}
252     }
253 
254     /*
255      *	alignment of an object using the c alignment scheme
256      */
257 int
258 align( np )
259     struct nl	*np;
260     {
261 	register struct nl *p;
262 
263 	p = np;
264 	if ( p == NIL ) {
265 	    return 0;
266 	}
267 alignit:
268 	switch ( p -> class ) {
269 	    case TYPE:
270 		    switch ( nloff( p ) ) {
271 			case TNIL:
272 				return A_POINT;
273 			case TSTR:
274 				return A_CHAR;
275 			case TSET:
276 				return A_SET;
277 			default:
278 				p = p -> type;
279 				goto alignit;
280 		    }
281 	    case ARRAY:
282 			/*
283 			 * arrays are aligned as their component types
284 			 */
285 		    p = p -> type;
286 		    goto alignit;
287 	    case PTR:
288 		    return A_POINT;
289 	    case FILET:
290 		    return A_FILET;
291 	    case RANGE:
292 		    if ( p -> type == nl+TDOUBLE ) {
293 			return A_DOUBLE;
294 		    }
295 		    /* else, fall through */
296 	    case SCAL:
297 		    switch ( bytes( p -> range[0] , p -> range[1] ) ) {
298 			case 4:
299 			    return A_LONG;
300 			case 2:
301 			    return A_SHORT;
302 			case 1:
303 			    return A_CHAR;
304 			default:
305 			    panic( "align: scal" );
306 		    }
307 	    case SET:
308 		    return A_SET;
309 	    case STR:
310 		    return A_CHAR;
311 	    case RECORD:
312 			/*
313 			 * follow chain through all fields in record,
314 			 * taking max of alignments of types of fields.
315 			 * short circuit out if i reach the maximum alignment.
316 			 * this is pretty likely, as A_MAX is only 4.
317 			 */
318 		    {
319 			register long recalign;
320 			register long fieldalign;
321 
322 			recalign = A_MIN;
323 			p = p -> chain;
324 			while ( ( p != NIL ) && ( recalign < A_MAX ) ) {
325 			    fieldalign = align( p -> type );
326 			    if ( fieldalign > recalign ) {
327 				recalign = fieldalign;
328 			    }
329 			    p = p -> chain;
330 			}
331 			return recalign;
332 		    }
333 	    default:
334 		    panic( "align" );
335 	}
336     }
337 
338 /*
339  * Return the width of an element
340  * of a n time subscripted np.
341  */
342 long aryconst(np, n)
343 	struct nl *np;
344 	int n;
345 {
346 	register struct nl *p;
347 	long s, d;
348 
349 	if ((p = np) == NIL)
350 		return (NIL);
351 	if (p->class != ARRAY)
352 		panic("ary");
353 	s = lwidth(p->type);
354 	/*
355 	 * Arrays of anything but characters are word aligned.
356 	 */
357 	if (s & 1)
358 		if (s != 1)
359 			s++;
360 	/*
361 	 * Skip the first n subscripts
362 	 */
363 	while (n >= 0) {
364 		p = p->chain;
365 		n--;
366 	}
367 	/*
368 	 * Sum across remaining subscripts.
369 	 */
370 	while (p != NIL) {
371 		if (p->class != RANGE && p->class != SCAL)
372 			panic("aryran");
373 		d = p->range[1] - p->range[0] + 1;
374 		s *= d;
375 		p = p->chain;
376 	}
377 	return (s);
378 }
379 
380 /*
381  * Find the lower bound of a set, and also its size in bits.
382  */
383 setran(q)
384 	struct nl *q;
385 {
386 	register lb, ub;
387 	register struct nl *p;
388 
389 	p = q;
390 	if (p == NIL)
391 		return (NIL);
392 	lb = p->range[0];
393 	ub = p->range[1];
394 	if (p->class != RANGE && p->class != SCAL)
395 		panic("setran");
396 	set.lwrb = lb;
397 	/* set.(upperbound prime) = number of bits - 1; */
398 	set.uprbp = ub-lb;
399 }
400 
401 /*
402  * Return the number of bytes required to hold an arithmetic quantity
403  */
404 bytes(lb, ub)
405 	long lb, ub;
406 {
407 
408 #ifndef DEBUG
409 	if (lb < -32768 || ub > 32767)
410 		return (4);
411 	else if (lb < -128 || ub > 127)
412 		return (2);
413 #else
414 	if (!hp21mx && (lb < -32768 || ub > 32767))
415 		return (4);
416 	if (lb < -128 || ub > 127)
417 		return (2);
418 #endif
419 	else
420 		return (1);
421 }
422