|
|
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 &&
1.1.1.2 ! root 95: ml == DOUBLE &&
1.1 root 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;
1.1.1.2 ! root 154: if (m == USHORT && ml == CHAR) return(p);
1.1 root 155: p->in.op = FREE;
156: return( p->in.left ); /* conversion gets clobbered */
157:
158: case QUEST: /* the right side should be COLON */
159: if((r = p->in.right)->in.op == SCONV) {
160: p->in.right = r->in.left;
161: p->in.type = r->in.left->in.type;
162: r->in.left = p;
163: return(r);
164: }
165: return(p);
166:
167: case PVCONV:
168: case PMCONV:
169: if( p->in.right->in.op != ICON ) cerror( "bad conversion", 0);
170: p->in.op = FREE;
171: return( buildtree( o==PMCONV?MUL:DIV, p->in.left, p->in.right ) );
172:
173: case FLD:
174: /* make sure that the second pass does not make the
175: descendant of a FLD operator into a doubly indexed OREG */
176:
177: if( p->in.left->in.op == UNARY MUL
178: && (r=p->in.left->in.left)->in.op == PCONV)
179: if( r->in.left->in.op == PLUS || r->in.left->in.op == MINUS )
180: if( ISPTR(r->in.type) ) {
181: if( ISUNSIGNED(p->in.left->in.type) )
182: p->in.left->in.type = UNSIGNED;
183: else
184: p->in.left->in.type = INT;
185: }
186: break;
187: case FORTCALL: /* arg must be FLOAT */
188: if((r = p->in.right)->in.type != FLOAT)
189: p->in.right = clocal(makety(r, FLOAT, 0, FLOAT));
190: return(p);
191: }
192:
193: /* if both sides are FLOAT, so is the op */
194: if(optype(o)!=LTYPE && p->in.left->in.type==DOUBLE &&
195: (o==UNARY MINUS || optype(o)==BITYPE && p->in.right->in.type==DOUBLE)) {
196: r = p->in.left;
197: if(r->in.op==SCONV && r->in.left->in.type==FLOAT) {
198: if(optype(o)==BITYPE) {
199: r = p->in.right;
200: if(r->in.op==SCONV && r->in.left->in.type==FLOAT) {
201: r->in.op = FREE;
202: p->in.right = r->in.left;
203: } else if(r->in.op==FCON)
204: r->in.type = FLOAT;
205: else
206: return(p);
207: }
208: r = p->in.left;
209: p->in.left = r->in.left;
210: } else if(optype(o)==BITYPE && r->in.op==FCON) {
211: r = p->in.right;
212: if(!(r->in.op==SCONV && r->in.left->in.type==FLOAT))
213: return(p);
214: p->in.right = r->in.left;
215: p->in.left->in.type = FLOAT;
216: } else
217: return(p);
218: if(p->in.type==DOUBLE) {
219: p->in.type = FLOAT;
220: r->in.left = p;
221: return(r);
222: } else { /* usually logop */
223: r->in.op = FREE;
224: return(p);
225: }
226: }
227: return(p);
228: }
229:
230: andable( p ) NODE *p; {
231: return(1); /* all names can have & taken on them */
232: }
233:
234: cendarg(){ /* at the end of the arguments of a ftn, set the automatic offset */
235: autooff = AUTOINIT;
236: }
237:
238: cisreg( t ) TWORD t; { /* is an automatic variable of type t OK for a register variable */
239:
240: if( t==INT || t==UNSIGNED || t==LONG || t==ULONG /* tbl */
241: #ifdef REG_CHAR
242: || t==CHAR || t==UCHAR || t==SHORT || t==USHORT /* tbl */
243: #endif
1.1.1.2 ! root 244: || ISPTR(t) || t == FLOAT) return (1); /* wnj */
1.1 root 245: return(0);
246: }
247:
248: NODE *
249: offcon( off, t, d, s ) OFFSZ off; TWORD t; {
250:
251: /* return a node, for structure references, which is suitable for
252: being added to a pointer of type t, in order to be off bits offset
253: into a structure */
254:
255: register NODE *p;
256:
257: /* t, d, and s are the type, dimension offset, and sizeoffset */
258: /* in general they are necessary for offcon, but not on H'well */
259:
260: p = bcon(0);
261: p->tn.lval = off/SZCHAR;
262: return(p);
263:
264: }
265:
266:
267: static inwd /* current bit offsed in word */;
268: static CONSZ word /* word being built from fields */;
269:
270: incode( p, sz ) register NODE *p; {
271:
272: /* generate initialization code for assigning a constant c
273: to a field of width sz */
274: /* we assume that the proper alignment has been obtained */
275: /* inoff is updated to have the proper final value */
276: /* we also assume sz < SZINT */
277:
278: inwd += sz;
279: if(inwd > SZINT) cerror("incode: field > int");
280: word |= (p->tn.lval&((1L<<sz)-1)) << (SZINT-inwd);
281: inoff += sz;
282: if(inoff%SZINT == 0) {
283: printf( " .long 0x%08X\n", word);
284: word = inwd = 0;
285: }
286: }
287:
288: # ifdef PRTDCON
289: prtdcon( p ) register NODE *p; {
290: int i;
291:
292: if( p->in.op == FCON ){
293: if(p->fpn.dval == 0) {
294: p->in.op = ICON;
295: p->tn.rval = NONAME;
296: return;
297: }
298: locctr( DATA );
299: defalign( ALDOUBLE );
300: deflab( i = getlab() );
301: # ifndef SFCON
302: fincode( p->fpn.dval, p->in.type==DOUBLE ? SZDOUBLE : SZFLOAT);
303: # else
304: p->in.type = fincode( p->fpn.dval, 0 );
305: # endif
306: p->tn.lval = 0;
307: p->tn.rval = -i;
308: p->in.op = NAME;
309: }
310: }
311: # endif
312:
313: fincode( d, sz ) double d; register int sz; {
314: /*
315: * output code to initialize space of size sz to the value d
316: * the proper alignment has been obtained
317: * inoff is updated to have the proper final value
318: * this code should be the same for PDP, VAX and Tahoe
319: * SFCON makes use of value to determine type - only where
320: * float<->double conversions are ignored.
321: */
322:
323: register struct sh4 {
324: unsigned short sh[4];
325: } *x;
326: # ifdef SFCON
327: register int type;
328: # else
329: float f;
330:
331: if(sz == SZFLOAT) { /* force rounding */
332: f = d;
333: d = f;
334: }
335: # endif
336:
337: x = (struct sh4 *)&d;
338: printf(" .long 0x%04x%04x", x->sh[0], x->sh[1]);
339: # ifdef SFCON
340: if(sz==0)
341: if(x->sh[2]==0 && x->sh[3]==0) {
342: sz = SZFLOAT;
343: type = FLOAT;
344: } else {
345: sz = SZDOUBLE;
346: type = DOUBLE;
347: }
348: # endif
349: if(sz == SZDOUBLE) {
350: printf(", 0x%04x%04x", x->sh[2], x->sh[3]);
351: printf(" # .double %.17g\n", d);
352: } else
353: printf(" # .float %.8g\n", d);
354: inoff += sz;
355: # ifdef SFCON
356: return type;
357: # endif
358: }
359:
360: cinit( p, sz ) NODE *p; {
361: /* arrange for the initialization of p into a space of
362: size sz */
363: /* the proper alignment has been opbtained */
364: /* inoff is updated to have the proper final value */
365: ecode( p );
366: inoff += sz;
367: }
368:
369: vfdzero( n ){ /* define n bits of zeros in a vfd */
370:
371: if( n <= 0 ) return;
372:
373: inwd += n;
374: inoff += n;
375: if( inoff%ALINT ==0 ) {
376: printf( " .long 0x%08X\n", word );
377: word = inwd = 0;
378: }
379: }
380:
381: char *
382: exname( p ) char *p; {
383: /* make a name look like an external name in the local machine */
384:
385: #ifndef FLEXNAMES
386: static char text[NCHNAM+1];
387: #else
388: static char text[BUFSIZ+1];
389: #endif
390:
391: register int i;
392:
393: text[0] = '_';
394: #ifndef FLEXNAMES
395: for( i=1; *p&&i<NCHNAM; ++i ){
396: #else
397: for( i=1; *p; ++i ){
398: #endif
399: text[i] = *p++;
400: }
401:
402: text[i] = '\0';
403: #ifndef FLEXNAMES
404: text[NCHNAM] = '\0'; /* truncate */
405: #endif
406:
407: return( text );
408: }
409:
410: ctype( type )TWORD type;{ /* map types which are not defined on the local machine */
411: switch( BTYPE(type) ){
412:
413: case LONG:
414: MODTYPE(type,INT);
415: break;
416:
417: case ULONG:
418: MODTYPE(type,UNSIGNED);
419: }
420: return( type );
421: }
422:
423: noinit() { /* curid is a variable which is defined but
424: is not initialized (and not a function );
425: This routine returns the stroage class for an uninitialized declaration */
426:
427: return(EXTERN);
428:
429: }
430:
431: commdec( id ){ /* make a common declaration for id, if reasonable */
432: register struct symtab *q;
433: OFFSZ off, tsize();
434:
435: q = &stab[id];
436: printf( " .comm %s,", exname( q->sname ) );
437: off = tsize( q->stype, q->dimoff, q->sizoff );
438: printf( "%d" /*CONFMT*/, off/SZCHAR );
439: printf( "\n" );
440: }
441:
442:
443: isitfloat( s ) char *s; {
444: double atof();
445: dcon = atof(s);
446: return( FCON );
447: }
448:
449: ecode( p ) NODE *p; {
450:
451: /* walk the tree and write out the nodes.. */
452:
453: if( nerrors ) return;
454: p2tree( p );
455: p2compile( p );
456: }
457:
458: #ifndef ONEPASS
459: tlen(p) NODE *p;
460: {
461: switch(p->in.type) {
462: case CHAR:
463: case UCHAR:
464: return(1);
465:
466: case SHORT:
467: case USHORT:
468: return(2);
469:
470: case DOUBLE:
471: return(8);
472:
473: default:
474: return(4);
475: }
476: }
477: #endif
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.