|
|
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.