xref: /csrg-svn/usr.bin/pascal/src/var.c (revision 15021)
1 /* Copyright (c) 1979 Regents of the University of California */
2 
3 #ifndef lint
4 static char sccsid[] = "@(#)var.c 1.18 09/19/83";
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 RANGE:
248 			if (p->type == nl+TDOUBLE)
249 #ifdef DEBUG
250 				return (hp21mx ? 4 : 8);
251 #else
252 				return (8);
253 #endif
254 		case SCAL:
255 			return (bytes(p->range[0], p->range[1]));
256 		case SET:
257 			setran(p->type);
258 			/*
259 			 * Sets are some multiple of longs
260 			 */
261 			return roundup((int)((set.uprbp >> 3) + 1),
262 				(long)(sizeof(long)));
263 		case STR:
264 		case RECORD:
265 			return ( p->value[NL_OFFS] );
266 	}
267 }
268 
269     /*
270      *	round up x to a multiple of y
271      *	for computing offsets of aligned things.
272      *	y had better be positive.
273      *	rounding is in the direction of x.
274      */
275 long
276 roundup( x , y )
277     int			x;
278     register long	y;
279     {
280 
281 	if ( y == 0 ) {
282 	    return x;
283 	}
284 	if ( x >= 0 ) {
285 		return ( ( ( x + ( y - 1 ) ) / y ) * y );
286 	} else {
287 		return ( ( ( x - ( y - 1 ) ) / y ) * y );
288 	}
289     }
290 
291     /*
292      *	alignment of an object using the c alignment scheme
293      */
294 int
295 align( np )
296     struct nl	*np;
297     {
298 	register struct nl *p;
299 	long elementalign;
300 
301 	p = np;
302 	if ( p == NIL ) {
303 	    return 0;
304 	}
305 alignit:
306 	switch ( p -> class ) {
307 	    default:
308 		    panic( "align" );
309 	    case TYPE:
310 		    switch ( nloff( p ) ) {
311 			case TNIL:
312 				return A_POINT;
313 			case TSTR:
314 				return A_STRUCT;
315 			case TSET:
316 				return A_SET;
317 			default:
318 				p = p -> type;
319 				goto alignit;
320 		    }
321 	    case ARRAY:
322 			/*
323 			 * arrays are structures, since they can get
324 			 * assigned form/to as structure assignments.
325 			 * preserve internal alignment if it is greater.
326 			 */
327 		    elementalign = align(p -> type);
328 		    return elementalign > A_STRUCT ? elementalign : A_STRUCT;
329 	    case PTR:
330 		    return A_POINT;
331 	    case FILET:
332 		    return A_FILET;
333 	    case RANGE:
334 		    if ( p -> type == nl+TDOUBLE ) {
335 			return A_DOUBLE;
336 		    }
337 		    /* else, fall through */
338 	    case SCAL:
339 		    switch ( bytes( p -> range[0] , p -> range[1] ) ) {
340 			case 4:
341 			    return A_LONG;
342 			case 2:
343 			    return A_SHORT;
344 			case 1:
345 			    return A_CHAR;
346 			default:
347 			    panic( "align: scal" );
348 		    }
349 	    case SET:
350 		    return A_SET;
351 	    case STR:
352 			/*
353 			 * arrays of chars are structs
354 			 */
355 		    return A_STRUCT;
356 	    case RECORD:
357 			/*
358 			 * the alignment of a record is in its align_info field
359 			 * why don't we use this for the rest of the namelist?
360 			 */
361 		    return p -> align_info;
362 	}
363     }
364 
365 #ifdef PC
366     /*
367      *	output an alignment pseudo-op.
368      */
369 aligndot(alignment)
370     int	alignment;
371 #ifdef vax
372 {
373     switch (alignment) {
374 	case 1:
375 	    return;
376 	case 2:
377 	    putprintf("	.align 1", 0);
378 	    return;
379 	default:
380 	case 4:
381 	    putprintf("	.align 2", 0);
382 	    return;
383     }
384 }
385 #endif vax
386 #ifdef mc68000
387 {
388     switch (alignment) {
389 	case 1:
390 	    return;
391 	default:
392 	    putprintf("	.even", 0);
393 	    return;
394     }
395 }
396 #endif mc68000
397 #endif PC
398 
399 /*
400  * Return the width of an element
401  * of a n time subscripted np.
402  */
403 long aryconst(np, n)
404 	struct nl *np;
405 	int n;
406 {
407 	register struct nl *p;
408 	long s, d;
409 
410 	if ((p = np) == NIL)
411 		return (NIL);
412 	if (p->class != ARRAY)
413 		panic("ary");
414 	s = lwidth(p->type);
415 	/*
416 	 * Arrays of anything but characters are word aligned.
417 	 */
418 	if (s & 1)
419 		if (s != 1)
420 			s++;
421 	/*
422 	 * Skip the first n subscripts
423 	 */
424 	while (n >= 0) {
425 		p = p->chain;
426 		n--;
427 	}
428 	/*
429 	 * Sum across remaining subscripts.
430 	 */
431 	while (p != NIL) {
432 		if (p->class != RANGE && p->class != SCAL)
433 			panic("aryran");
434 		d = p->range[1] - p->range[0] + 1;
435 		s *= d;
436 		p = p->chain;
437 	}
438 	return (s);
439 }
440 
441 /*
442  * Find the lower bound of a set, and also its size in bits.
443  */
444 setran(q)
445 	struct nl *q;
446 {
447 	register lb, ub;
448 	register struct nl *p;
449 
450 	p = q;
451 	if (p == NIL)
452 		return;
453 	lb = p->range[0];
454 	ub = p->range[1];
455 	if (p->class != RANGE && p->class != SCAL)
456 		panic("setran");
457 	set.lwrb = lb;
458 	/* set.(upperbound prime) = number of bits - 1; */
459 	set.uprbp = ub-lb;
460 }
461 
462 /*
463  * Return the number of bytes required to hold an arithmetic quantity
464  */
465 bytes(lb, ub)
466 	long lb, ub;
467 {
468 
469 #ifndef DEBUG
470 	if (lb < -32768 || ub > 32767)
471 		return (4);
472 	else if (lb < -128 || ub > 127)
473 		return (2);
474 #else
475 	if (!hp21mx && (lb < -32768 || ub > 32767))
476 		return (4);
477 	if (lb < -128 || ub > 127)
478 		return (2);
479 #endif
480 	else
481 		return (1);
482 }
483