1 #ifndef lint
2 static char sccsid[] = "@(#)local.c 1.10 (Berkeley) 12/10/87";
3 #endif
4
5 # include "pass1.h"
6
7 /* this file contains code which is dependent on the target machine */
8
9 NODE *
clocal(p)10 clocal(p) register NODE *p; {
11
12 /* this is called to do local transformations on
13 an expression tree preparitory to its being
14 written out in intermediate code.
15 */
16
17 /* the major essential job is rewriting the
18 automatic variables and arguments in terms of
19 REG and OREG nodes */
20 /* conversion ops which are not necessary are also clobbered here */
21 /* in addition, any special features (such as rewriting
22 exclusive or) are easily handled here as well */
23
24 register struct symtab *q;
25 register NODE *r;
26 register int o;
27 register int m, ml;
28
29 switch( o = p->in.op ){
30
31 case NAME:
32 if( p->tn.rval < 0 ) { /* already processed; ignore... */
33 return(p);
34 }
35 q = &stab[p->tn.rval];
36 switch( q->sclass ){
37
38 case AUTO:
39 case PARAM:
40 /* fake up a structure reference */
41 r = block( REG, NIL, NIL, PTR+STRTY, 0, 0 );
42 r->tn.lval = 0;
43 r->tn.rval = STKREG;
44 p = stref( block( STREF, r, p, 0, 0, 0 ) );
45 break;
46
47 case ULABEL:
48 case LABEL:
49 case STATIC:
50 if( q->slevel == 0 ) break;
51 p->tn.lval = 0;
52 p->tn.rval = -q->offset;
53 break;
54
55 case REGISTER:
56 p->in.op = REG;
57 p->tn.lval = 0;
58 p->tn.rval = q->offset;
59 #ifdef REG_CHAR
60 m = p->in.type;
61 if( m==CHAR || m==SHORT )
62 p->in.type = INT;
63 else if( m==UCHAR || m==USHORT )
64 p->in.type = UNSIGNED;
65 #endif
66 break;
67
68 }
69 break;
70
71 case LT:
72 case LE:
73 case GT:
74 case GE:
75 if( ISPTR( p->in.left->in.type ) || ISPTR( p->in.right->in.type ) ){
76 p->in.op += (ULT-LT);
77 }
78 break;
79
80 case PCONV:
81 /* do pointer conversions for char and longs */
82 ml = p->in.left->in.type;
83 if( ( ml==CHAR || ml==UCHAR || ml==SHORT || ml==USHORT ) && p->in.left->in.op != ICON ) break;
84
85 /* pointers all have the same representation; the type is inherited */
86
87 p->in.left->in.type = p->in.type;
88 p->in.left->fn.cdim = p->fn.cdim;
89 p->in.left->fn.csiz = p->fn.csiz;
90 p->in.op = FREE;
91 return( p->in.left );
92
93 case SCONV:
94 m = p->in.type;
95 ml = p->in.left->in.type;
96 if(m == ml)
97 goto clobber;
98 o = p->in.left->in.op;
99 if(m == FLOAT || m == DOUBLE) {
100 if(o==SCONV &&
101 ml == DOUBLE &&
102 p->in.left->in.left->in.type==m) {
103 p->in.op = p->in.left->in.op = FREE;
104 return(p->in.left->in.left);
105 }
106 /* see makety() for constant conversions */
107 break;
108 }
109 if(ml == FLOAT || ml == DOUBLE){
110 if(o != FCON && o != DCON)
111 break;
112 ml = ISUNSIGNED(m) ? UNSIGNED : INT; /* LONG? */
113 r = block( ICON, (NODE *)NULL, (NODE *)NULL, ml, 0, 0 );
114 if( o == FCON )
115 r->tn.lval = ml == INT ?
116 (int) p->in.left->fpn.fval :
117 (unsigned) p->in.left->fpn.fval;
118 else
119 r->tn.lval = ml == INT ?
120 (int) p->in.left->dpn.dval :
121 (unsigned) p->in.left->dpn.dval;
122 r->tn.rval = NONAME;
123 p->in.left->in.op = FREE;
124 p->in.left = r;
125 o = ICON;
126 if( m == ml )
127 goto clobber;
128 }
129 /* now, look for conversions downwards */
130
131 if( o == ICON ){ /* simulate the conversion here */
132 CONSZ val;
133 val = p->in.left->tn.lval;
134 switch( m ){
135 case CHAR:
136 p->in.left->tn.lval = (char) val;
137 break;
138 case UCHAR:
139 p->in.left->tn.lval = val & 0XFF;
140 break;
141 case USHORT:
142 p->in.left->tn.lval = val & 0XFFFFL;
143 break;
144 case SHORT:
145 p->in.left->tn.lval = (short)val;
146 break;
147 case UNSIGNED:
148 p->in.left->tn.lval = val & 0xFFFFFFFFL;
149 break;
150 case INT:
151 p->in.left->tn.lval = (int)val;
152 break;
153 }
154 p->in.left->in.type = m;
155 }
156 else
157 break;
158
159 clobber:
160 p->in.op = FREE;
161 return( p->in.left ); /* conversion gets clobbered */
162
163 case PVCONV:
164 case PMCONV:
165 if( p->in.right->in.op != ICON ) cerror( "bad conversion", 0);
166 p->in.op = FREE;
167 return( buildtree( o==PMCONV?MUL:DIV, p->in.left, p->in.right ) );
168
169 case FLD:
170 /* make sure that the second pass does not make the
171 descendant of a FLD operator into a doubly indexed OREG */
172
173 if( p->in.left->in.op == UNARY MUL
174 && (r=p->in.left->in.left)->in.op == PCONV)
175 if( r->in.left->in.op == PLUS || r->in.left->in.op == MINUS )
176 if( ISPTR(r->in.type) ) {
177 if( ISUNSIGNED(p->in.left->in.type) )
178 p->in.left->in.type = UNSIGNED;
179 else
180 p->in.left->in.type = INT;
181 }
182 break;
183 case FORTCALL: /* arg must be FLOAT */
184 if((r = p->in.right)->in.type != FLOAT)
185 p->in.right = clocal(makety(r, FLOAT, 0, FLOAT));
186 return(p);
187 }
188
189 return(p);
190 }
191
192 /*ARGSUSED*/
andable(p)193 andable( p ) NODE *p; {
194 return(1); /* all names can have & taken on them */
195 }
196
cendarg()197 cendarg(){ /* at the end of the arguments of a ftn, set the automatic offset */
198 autooff = AUTOINIT;
199 }
200
cisreg(t)201 cisreg( t ) TWORD t; { /* is an automatic variable of type t OK for a register variable */
202
203 if( t==INT || t==UNSIGNED || t==LONG || t==ULONG /* tbl */
204 #ifdef REG_CHAR
205 || t==CHAR || t==UCHAR || t==SHORT || t==USHORT /* tbl */
206 #endif
207 || ISPTR(t) || t == FLOAT) return (1); /* wnj */
208 return(0);
209 }
210
211 /*ARGSUSED*/
212 NODE *
offcon(off,t,d,s)213 offcon( off, t, d, s ) OFFSZ off; TWORD t; {
214
215 /* return a node, for structure references, which is suitable for
216 being added to a pointer of type t, in order to be off bits offset
217 into a structure */
218
219 register NODE *p;
220
221 /* t, d, and s are the type, dimension offset, and sizeoffset */
222 /* in general they are necessary for offcon, but not on Tahoe */
223
224 p = bcon(0);
225 p->tn.lval = off/SZCHAR;
226 return(p);
227
228 }
229
230
231 static inwd /* current bit offsed in word */;
232 static CONSZ word /* word being built from fields */;
233
incode(p,sz)234 incode( p, sz ) register NODE *p; {
235
236 /* generate initialization code for assigning a constant c
237 to a field of width sz */
238 /* we assume that the proper alignment has been obtained */
239 /* inoff is updated to have the proper final value */
240 /* we also assume sz < SZINT */
241
242 if(nerrors) return;
243 inwd += sz;
244 if(inwd > SZINT) cerror("incode: field > int");
245 word |= (p->tn.lval&((1L<<sz)-1)) << (SZINT-inwd);
246 inoff += sz;
247 if(inoff%SZINT == 0) {
248 printf( " .long 0x%lx\n", word);
249 word = inwd = 0;
250 }
251 }
252
fincode(d,sz)253 fincode( d, sz ) double d; register int sz; {
254 /*
255 * output code to initialize space of size sz to the value d
256 * the proper alignment has been obtained
257 * inoff is updated to have the proper final value.
258 */
259
260 register struct sh4 {
261 unsigned short sh[4];
262 } *x;
263 float f;
264
265 if (nerrors) return;
266 if(sz == SZFLOAT) { /* force rounding */
267 f = d;
268 d = f;
269 }
270
271 x = (struct sh4 *)&d;
272 printf(" .long 0x%04x%04x", x->sh[0], x->sh[1]);
273 if(sz == SZDOUBLE) {
274 printf(", 0x%04x%04x", x->sh[2], x->sh[3]);
275 printf(" # .double %.17g\n", d);
276 } else
277 printf(" # .float %.8g\n", d);
278 inoff += sz;
279 }
280
cinit(p,sz)281 cinit( p, sz ) NODE *p; {
282 NODE *l;
283
284 /*
285 * as a favor (?) to people who want to write
286 * int i = 9600/134.5;
287 * we will, under the proper circumstances, do
288 * a coercion here.
289 */
290 switch (p->in.type) {
291 case INT:
292 case UNSIGNED:
293 l = p->in.left;
294 if (l->in.op != SCONV ||
295 (l->in.left->tn.op != DCON && l->in.left->tn.op != FCON))
296 break;
297 l->in.op = FREE;
298 l = l->in.left;
299 l->tn.lval = l->tn.op == DCON ? (long)(l->dpn.dval) :
300 (long)(l->fpn.fval);
301 l->tn.rval = NONAME;
302 l->tn.op = ICON;
303 l->tn.type = INT;
304 p->in.left = l;
305 break;
306 }
307 /* arrange for the initialization of p into a space of size sz */
308 /* the proper alignment has been opbtained */
309 /* inoff is updated to have the proper final value */
310 ecode( p );
311 inoff += sz;
312 }
313
vfdzero(n)314 vfdzero( n ){ /* define n bits of zeros in a vfd */
315
316 if( n <= 0 ) return;
317
318 if (nerrors) return;
319 inwd += n;
320 inoff += n;
321 if( inoff%ALINT ==0 ) {
322 printf( " .long 0x%lx\n", word );
323 word = inwd = 0;
324 }
325 }
326
327 char *
exname(p)328 exname( p ) char *p; {
329 /* make a name look like an external name in the local machine */
330
331 #ifndef FLEXNAMES
332 static char text[NCHNAM+1];
333 #else
334 static char text[BUFSIZ+1];
335 #endif
336
337 register int i;
338
339 text[0] = '_';
340 #ifndef FLEXNAMES
341 for( i=1; *p&&i<NCHNAM; ++i )
342 #else
343 for( i=1; *p; ++i )
344 #endif
345 text[i] = *p++;
346
347 text[i] = '\0';
348 #ifndef FLEXNAMES
349 text[NCHNAM] = '\0'; /* truncate */
350 #endif
351
352 return( text );
353 }
354
ctype(type)355 ctype( type ) TWORD type;
356 { /* map types which are not defined on the local machine */
357 switch( BTYPE(type) ){
358
359 case LONG:
360 MODTYPE(type,INT);
361 break;
362
363 case ULONG:
364 MODTYPE(type,UNSIGNED);
365 }
366 return( type );
367 }
368
noinit()369 noinit() { /* curid is a variable which is defined but
370 is not initialized (and not a function );
371 This routine returns the stroage class for an uninitialized declaration */
372
373 return(EXTERN);
374
375 }
376
commdec(id)377 commdec( id ){ /* make a common declaration for id, if reasonable */
378 register struct symtab *q;
379 OFFSZ off, tsize();
380
381 if (nerrors) return;
382 q = &stab[id];
383 printf( " .comm %s,", exname( q->sname ) );
384 off = tsize( q->stype, q->dimoff, q->sizoff );
385 printf( "%d\n" /*CONFMT*/, off/SZCHAR );
386 }
387
prtdcon(p)388 prtdcon(p)
389 register NODE *p;
390 {
391 register int o = p->in.op;
392 int i;
393
394 if (o != DCON && o != FCON)
395 return;
396 /*
397 * Clobber constants of value zero so
398 * we can generate more efficient code.
399 */
400 if ((o == DCON && p->dpn.dval == 0) ||
401 (o == FCON && p->fpn.fval == 0)) {
402 p->in.op = ICON;
403 p->tn.rval = NONAME;
404 return;
405 }
406 locctr(DATA);
407 defalign(o == DCON ? ALDOUBLE : ALFLOAT);
408 deflab(i = getlab());
409 if (o == FCON)
410 fincode(p->fpn.fval, SZFLOAT);
411 else
412 fincode(p->dpn.dval, SZDOUBLE);
413 p->tn.lval = 0;
414 p->tn.rval = -i;
415 p->in.type = (o == DCON ? DOUBLE : FLOAT);
416 p->in.op = NAME;
417 }
418
ecode(p)419 ecode( p ) NODE *p; {
420
421 /* walk the tree and write out the nodes.. */
422
423 if( nerrors ) return;
424 p2tree( p );
425 p2compile( p );
426 }
427
428 #ifndef ONEPASS
tlen(p)429 tlen(p) NODE *p;
430 {
431 switch(p->in.type) {
432 case CHAR:
433 case UCHAR:
434 return(1);
435
436 case SHORT:
437 case USHORT:
438 return(SZSHORT/SZCHAR);
439
440 case DOUBLE:
441 return(SZDOUBLE/SZCHAR);
442
443 default:
444 return(SZINT/SZCHAR);
445 }
446 }
447 #endif
448