xref: /csrg-svn/usr.bin/pascal/src/var.c (revision 18351)
1 /* Copyright (c) 1979 Regents of the University of California */
2 
3 #ifndef lint
4 static char sccsid[] = "@(#)var.c 2.2 03/15/85";
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( vp , w , line );
154 			vp -> extra_flags |= NGLOBAL;
155 		    } else {
156 			vp -> extra_flags |= NLOCAL;
157 		    }
158 #		endif PC
159 	}
160 #	ifdef PTREE
161 	    {
162 		pPointer	*Vars;
163 		pPointer	Var = VarDecl( ovidl , vtype );
164 
165 		pSeize( PorFHeader[ nesting ] );
166 		Vars = &( pDEF( PorFHeader[ nesting ] ).PorFVars );
167 		*Vars = ListAppend( *Vars , Var );
168 		pRelease( PorFHeader[ nesting ] );
169 	    }
170 #	endif
171 }
172 #endif
173 
174 varend()
175 {
176 
177 	foredecl();
178 #ifndef PI0
179 	sizes[cbn].om_max = sizes[cbn].curtmps.om_off;
180 #else
181 	send(REVVEND);
182 #endif
183 }
184 
185 /*
186  * Evening
187  */
188 long
189 leven(w)
190 	register long w;
191 {
192 	if (w < 0)
193 		return (w & 0xfffffffe);
194 	return ((w+1) & 0xfffffffe);
195 }
196 
197 #ifndef PC
198 int
199 even(w)
200 	register int w;
201 {
202 	return leven((long)w);
203 }
204 #endif
205 
206 /*
207  * Find the width of a type in bytes.
208  */
209 width(np)
210 	struct nl *np;
211 {
212 
213 	return (lwidth(np));
214 }
215 
216 long
217 lwidth(np)
218 	struct nl *np;
219 {
220 	register struct nl *p;
221 
222 	p = np;
223 	if (p == NIL)
224 		return (0);
225 loop:
226 	switch (p->class) {
227 		default:
228 			panic("wclass");
229 		case TYPE:
230 			switch (nloff(p)) {
231 				case TNIL:
232 					return (2);
233 				case TSTR:
234 				case TSET:
235 					panic("width");
236 				default:
237 					p = p->type;
238 					goto loop;
239 			}
240 		case ARRAY:
241 			return (aryconst(p, 0));
242 		case PTR:
243 			return ( sizeof ( int * ) );
244 		case FILET:
245 			return ( sizeof(struct iorec) + lwidth( p -> type ) );
246 		case CRANGE:
247 			p = p->type;
248 			goto loop;
249 		case RANGE:
250 			if (p->type == nl+TDOUBLE)
251 #ifdef DEBUG
252 				return (hp21mx ? 4 : 8);
253 #else
254 				return (8);
255 #endif
256 		case SCAL:
257 			return (bytes(p->range[0], p->range[1]));
258 		case SET:
259 			setran(p->type);
260 			/*
261 			 * Sets are some multiple of longs
262 			 */
263 			return roundup((int)((set.uprbp >> 3) + 1),
264 				(long)(sizeof(long)));
265 		case STR:
266 		case RECORD:
267 			return ( p->value[NL_OFFS] );
268 	}
269 }
270 
271     /*
272      *	round up x to a multiple of y
273      *	for computing offsets of aligned things.
274      *	y had better be positive.
275      *	rounding is in the direction of x.
276      */
277 long
278 roundup( x , y )
279     int			x;
280     register long	y;
281     {
282 
283 	if ( y == 0 ) {
284 	    return x;
285 	}
286 	if ( x >= 0 ) {
287 		return ( ( ( x + ( y - 1 ) ) / y ) * y );
288 	} else {
289 		return ( ( ( x - ( y - 1 ) ) / y ) * y );
290 	}
291     }
292 
293     /*
294      *	alignment of an object using the c alignment scheme
295      */
296 int
297 align( np )
298     struct nl	*np;
299     {
300 	register struct nl *p;
301 	long elementalign;
302 
303 	p = np;
304 	if ( p == NIL ) {
305 	    return 0;
306 	}
307 alignit:
308 	switch ( p -> class ) {
309 	    default:
310 		    panic( "align" );
311 	    case TYPE:
312 		    switch ( nloff( p ) ) {
313 			case TNIL:
314 				return A_POINT;
315 			case TSTR:
316 				return A_STRUCT;
317 			case TSET:
318 				return A_SET;
319 			default:
320 				p = p -> type;
321 				goto alignit;
322 		    }
323 	    case ARRAY:
324 			/*
325 			 * arrays are structures, since they can get
326 			 * assigned form/to as structure assignments.
327 			 * preserve internal alignment if it is greater.
328 			 */
329 		    elementalign = align(p -> type);
330 		    return elementalign > A_STRUCT ? elementalign : A_STRUCT;
331 	    case PTR:
332 		    return A_POINT;
333 	    case FILET:
334 		    return A_FILET;
335 	    case CRANGE:
336 	    case RANGE:
337 		    if ( p -> type == nl+TDOUBLE ) {
338 			return A_DOUBLE;
339 		    }
340 		    /* else, fall through */
341 	    case SCAL:
342 		    switch ( bytes( p -> range[0] , p -> range[1] ) ) {
343 			case 4:
344 			    return A_LONG;
345 			case 2:
346 			    return A_SHORT;
347 			case 1:
348 			    return A_CHAR;
349 			default:
350 			    panic( "align: scal" );
351 		    }
352 	    case SET:
353 		    return A_SET;
354 	    case STR:
355 			/*
356 			 * arrays of chars are structs
357 			 */
358 		    return A_STRUCT;
359 	    case RECORD:
360 			/*
361 			 * the alignment of a record is in its align_info field
362 			 * why don't we use this for the rest of the namelist?
363 			 */
364 		    return p -> align_info;
365 	}
366     }
367 
368 #ifdef PC
369     /*
370      *	output an alignment pseudo-op.
371      */
372 aligndot(alignment)
373     int	alignment;
374 #ifdef vax
375 {
376     switch (alignment) {
377 	case 1:
378 	    return;
379 	case 2:
380 	    putprintf("	.align 1", 0);
381 	    return;
382 	default:
383 	case 4:
384 	    putprintf("	.align 2", 0);
385 	    return;
386     }
387 }
388 #endif vax
389 #ifdef mc68000
390 {
391     switch (alignment) {
392 	case 1:
393 	    return;
394 	default:
395 	    putprintf("	.even", 0);
396 	    return;
397     }
398 }
399 #endif mc68000
400 #endif PC
401 
402 /*
403  * Return the width of an element
404  * of a n time subscripted np.
405  */
406 long aryconst(np, n)
407 	struct nl *np;
408 	int n;
409 {
410 	register struct nl *p;
411 	long s, d;
412 
413 	if ((p = np) == NIL)
414 		return (NIL);
415 	if (p->class != ARRAY)
416 		panic("ary");
417 	/*
418 	 * If it is a conformant array, we cannot find the width from
419 	 * the type.
420 	 */
421 	if (p->chain->class == CRANGE)
422 		return (NIL);
423 	s = lwidth(p->type);
424 	/*
425 	 * Arrays of anything but characters are word aligned.
426 	 */
427 	if (s & 1)
428 		if (s != 1)
429 			s++;
430 	/*
431 	 * Skip the first n subscripts
432 	 */
433 	while (n >= 0) {
434 		p = p->chain;
435 		n--;
436 	}
437 	/*
438 	 * Sum across remaining subscripts.
439 	 */
440 	while (p != NIL) {
441 		if (p->class != RANGE && p->class != SCAL)
442 			panic("aryran");
443 		d = p->range[1] - p->range[0] + 1;
444 		s *= d;
445 		p = p->chain;
446 	}
447 	return (s);
448 }
449 
450 /*
451  * Find the lower bound of a set, and also its size in bits.
452  */
453 setran(q)
454 	struct nl *q;
455 {
456 	register lb, ub;
457 	register struct nl *p;
458 
459 	p = q;
460 	if (p == NIL)
461 		return;
462 	lb = p->range[0];
463 	ub = p->range[1];
464 	if (p->class != RANGE && p->class != SCAL)
465 		panic("setran");
466 	set.lwrb = lb;
467 	/* set.(upperbound prime) = number of bits - 1; */
468 	set.uprbp = ub-lb;
469 }
470 
471 /*
472  * Return the number of bytes required to hold an arithmetic quantity
473  */
474 bytes(lb, ub)
475 	long lb, ub;
476 {
477 
478 #ifndef DEBUG
479 	if (lb < -32768 || ub > 32767)
480 		return (4);
481 	else if (lb < -128 || ub > 127)
482 		return (2);
483 #else
484 	if (!hp21mx && (lb < -32768 || ub > 32767))
485 		return (4);
486 	if (lb < -128 || ub > 127)
487 		return (2);
488 #endif
489 	else
490 		return (1);
491 }
492