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