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