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