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