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