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