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