|
|
1.1 ! root 1: /* Copyright (c) 1979 Regents of the University of California */ ! 2: ! 3: static char sccsid[] = "@(#)put.c 1.3 10/2/80"; ! 4: ! 5: #include "whoami.h" ! 6: #include "opcode.h" ! 7: #include "0.h" ! 8: #include "objfmt.h" ! 9: #ifdef PC ! 10: # include "pc.h" ! 11: #endif PC ! 12: ! 13: short *obufp = obuf; ! 14: ! 15: /* ! 16: * If DEBUG is defined, include the table ! 17: * of the printing opcode names. ! 18: */ ! 19: #ifdef DEBUG ! 20: #include "OPnames.h" ! 21: #endif ! 22: ! 23: #ifdef OBJ ! 24: /* ! 25: * Put is responsible for the interpreter equivalent of code ! 26: * generation. Since the interpreter is specifically designed ! 27: * for Pascal, little work is required here. ! 28: */ ! 29: put(a) ! 30: { ! 31: register int *p, i; ! 32: register char *cp; ! 33: int n, subop, suboppr, op, oldlc, w; ! 34: char *string; ! 35: static int casewrd; ! 36: ! 37: /* ! 38: * It would be nice to do some more ! 39: * optimizations here. The work ! 40: * done to collapse offsets in lval ! 41: * should be done here, the IFEQ etc ! 42: * relational operators could be used ! 43: * etc. ! 44: */ ! 45: oldlc = lc; ! 46: if (cgenflg < 0) ! 47: /* ! 48: * code disabled - do nothing ! 49: */ ! 50: return (oldlc); ! 51: p = &a; ! 52: n = *p++; ! 53: suboppr = subop = (*p>>8) & 0377; ! 54: op = *p & 0377; ! 55: string = 0; ! 56: #ifdef DEBUG ! 57: if ((cp = otext[op]) == NIL) { ! 58: printf("op= %o\n", op); ! 59: panic("put"); ! 60: } ! 61: #endif ! 62: switch (op) { ! 63: case O_ABORT: ! 64: cp = "*"; ! 65: break; ! 66: case O_LINO: ! 67: /***** ! 68: if (line == codeline) ! 69: return (oldlc); ! 70: codeline = line; ! 71: *****/ ! 72: case O_NEW: ! 73: case O_DISPOSE: ! 74: case O_AS: ! 75: case O_IND: ! 76: case O_LVCON: ! 77: case O_CON: ! 78: case O_OFF: ! 79: case O_INX2: ! 80: case O_INX4: ! 81: case O_CARD: ! 82: case O_ADDT: ! 83: case O_SUBT: ! 84: case O_MULT: ! 85: case O_IN: ! 86: case O_CASE1OP: ! 87: case O_CASE2OP: ! 88: case O_CASE4OP: ! 89: case O_FRTN: ! 90: case O_WRITES: ! 91: case O_WRITEF: ! 92: case O_MAX: ! 93: case O_MIN: ! 94: case O_PACK: ! 95: case O_UNPACK: ! 96: case O_ARGV: ! 97: case O_CTTOT: ! 98: case O_INCT: ! 99: case O_RANG2: ! 100: case O_RSNG2: ! 101: case O_RANG42: ! 102: case O_RSNG42: ! 103: if (p[1] == 0) ! 104: break; ! 105: case O_CON2: ! 106: case O_CON24: ! 107: if (p[1] < 128 && p[1] >= -128) { ! 108: suboppr = subop = p[1]; ! 109: p++; ! 110: n--; ! 111: if (op == O_CON2) { ! 112: op = O_CON1; ! 113: cp = otext[O_CON1]; ! 114: } ! 115: if (op == O_CON24) { ! 116: op = O_CON14; ! 117: cp = otext[O_CON14]; ! 118: } ! 119: } ! 120: break; ! 121: case O_CON8: ! 122: { ! 123: short *sp = &p[1]; ! 124: ! 125: #ifdef DEBUG ! 126: if ( opt( 'k' ) ) ! 127: printf ( ")#%5d\tCON8\t%10.3f\n" , ! 128: lc - HEADER_BYTES , ! 129: * ( ( double * ) &p[1] ) ); ! 130: #endif ! 131: word ( op ); ! 132: for ( i = 1 ; i <= 4 ; i ++ ) ! 133: word ( *sp ++ ); ! 134: return ( oldlc ); ! 135: } ! 136: default: ! 137: if (op >= O_REL2 && op <= O_REL84) { ! 138: if ((i = (subop >> 1) * 5 ) >= 30) ! 139: i -= 30; ! 140: else ! 141: i += 2; ! 142: #ifdef DEBUG ! 143: string = &"IFEQ\0IFNE\0IFLT\0IFGT\0IFLE\0IFGE"[i]; ! 144: #endif ! 145: suboppr = 0; ! 146: } ! 147: break; ! 148: case O_IF: ! 149: case O_TRA: ! 150: /***** ! 151: codeline = 0; ! 152: *****/ ! 153: case O_FOR1U: ! 154: case O_FOR2U: ! 155: case O_FOR4U: ! 156: case O_FOR1D: ! 157: case O_FOR2D: ! 158: case O_FOR4D: ! 159: /* relative addressing */ ! 160: p[1] -= ( unsigned ) lc + 2; ! 161: break; ! 162: case O_CONG: ! 163: i = p[1]; ! 164: cp = * ( ( char ** ) &p[2] ) ; ! 165: #ifdef DEBUG ! 166: if (opt('k')) ! 167: printf(")#%5d\tCONG:%d\t%s\n", ! 168: lc - HEADER_BYTES, i, cp); ! 169: #endif ! 170: if (i <= 127) ! 171: word(O_CON | i << 8); ! 172: else { ! 173: word(O_CON); ! 174: word(i); ! 175: } ! 176: while (i > 0) { ! 177: w = *cp ? *cp++ : ' '; ! 178: w |= (*cp ? *cp++ : ' ') << 8; ! 179: word(w); ! 180: i -= 2; ! 181: } ! 182: return (oldlc); ! 183: case O_CONC: ! 184: #ifdef DEBUG ! 185: (string = "'x'")[1] = p[1]; ! 186: #endif ! 187: suboppr = 0; ! 188: op = O_CON1; ! 189: cp = otext[O_CON1]; ! 190: subop = p[1]; ! 191: goto around; ! 192: case O_CONC4: ! 193: #ifdef DEBUG ! 194: (string = "'x'")[1] = p[1]; ! 195: #endif ! 196: suboppr = 0; ! 197: op = O_CON14; ! 198: subop = p[1]; ! 199: goto around; ! 200: case O_CON1: ! 201: case O_CON14: ! 202: suboppr = subop = p[1]; ! 203: around: ! 204: n--; ! 205: break; ! 206: case O_CASEBEG: ! 207: casewrd = 0; ! 208: return (oldlc); ! 209: case O_CASEEND: ! 210: if ((unsigned) lc & 1) { ! 211: lc--; ! 212: word(casewrd); ! 213: } ! 214: return (oldlc); ! 215: case O_CASE1: ! 216: #ifdef DEBUG ! 217: if (opt('k')) ! 218: printf(")#%5d\tCASE1\t%d\n" ! 219: , lc - HEADER_BYTES ! 220: , ( int ) *( ( long * ) &p[1] ) ); ! 221: #endif ! 222: /* ! 223: * this to build a byte size case table ! 224: * saving bytes across calls in casewrd ! 225: * so they can be put out by word() ! 226: */ ! 227: lc++; ! 228: if ((unsigned) lc & 1) ! 229: casewrd = *( ( long * ) &p[1] ) & 0377; ! 230: else { ! 231: lc -= 2; ! 232: word ( casewrd ! 233: | ( ( int ) *( ( long * ) &p[1] ) << 8 ) ); ! 234: } ! 235: return (oldlc); ! 236: case O_CASE2: ! 237: #ifdef DEBUG ! 238: if (opt('k')) ! 239: printf(")#%5d\tCASE2\t%d\n" ! 240: , lc - HEADER_BYTES ! 241: , ( int ) *( ( long * ) &p[1] ) ); ! 242: #endif ! 243: word( ( short ) *( ( long * ) &p[1] ) ); ! 244: return (oldlc); ! 245: case O_FCALL: ! 246: if (p[1] == 0) ! 247: goto longgen; ! 248: /* and fall through */ ! 249: case O_PUSH: ! 250: if (p[1] == 0) ! 251: return (oldlc); ! 252: if (p[1] < 128 && p[1] >= -128) { ! 253: suboppr = subop = p[1]; ! 254: p++; ! 255: n--; ! 256: break; ! 257: } ! 258: goto longgen; ! 259: case O_TRA4: ! 260: case O_CALL: ! 261: case O_FSAV: ! 262: case O_GOTO: ! 263: case O_NAM: ! 264: case O_READE: ! 265: /* absolute long addressing */ ! 266: p[1] -= HEADER_BYTES; ! 267: goto longgen; ! 268: case O_RV1: ! 269: case O_RV14: ! 270: case O_RV2: ! 271: case O_RV24: ! 272: case O_RV4: ! 273: case O_RV8: ! 274: case O_RV: ! 275: case O_LV: ! 276: if (p[1] < SHORTADDR && p[1] >= -SHORTADDR) ! 277: break; ! 278: else { ! 279: op += O_LRV - O_RV; ! 280: cp = otext[op]; ! 281: } ! 282: case O_BEG: ! 283: case O_NODUMP: ! 284: case O_CON4: ! 285: case O_CASE4: ! 286: case O_RANG4: ! 287: case O_RANG24: ! 288: case O_RSNG4: ! 289: case O_RSNG24: ! 290: longgen: ! 291: { ! 292: short *sp = &p[1]; ! 293: long *lp = &p[1]; ! 294: ! 295: n = (n << 1) - 1; ! 296: if ( op == O_LRV ) ! 297: n--; ! 298: #ifdef DEBUG ! 299: if (opt('k')) ! 300: { ! 301: printf( ")#%5d\t%s" , lc - HEADER_BYTES , cp+1 ); ! 302: if (suboppr) ! 303: printf(":%1d", suboppr); ! 304: for ( i = 1 ; i < n ! 305: ; i += sizeof ( long )/sizeof ( short ) ) ! 306: printf( "\t%D " , *lp ++ ); ! 307: pchr ( '\n' ); ! 308: } ! 309: #endif ! 310: if ( op != O_CASE4 ) ! 311: word ( op | subop<<8 ); ! 312: for ( i = 1 ; i < n ; i ++ ) ! 313: word ( *sp ++ ); ! 314: return ( oldlc ); ! 315: } ! 316: } ! 317: #ifdef DEBUG ! 318: if (opt('k')) { ! 319: printf(")#%5d\t%s", lc - HEADER_BYTES, cp+1); ! 320: if (suboppr) ! 321: printf(":%d", suboppr); ! 322: if (string) ! 323: printf("\t%s",string); ! 324: if (n > 1) ! 325: pchr('\t'); ! 326: for (i=1; i<n; i++) ! 327: printf("%d ", ( short ) p[i]); ! 328: pchr('\n'); ! 329: } ! 330: #endif ! 331: if (op != NIL) ! 332: word(op | subop << 8); ! 333: for (i=1; i<n; i++) ! 334: word(p[i]); ! 335: return (oldlc); ! 336: } ! 337: #endif OBJ ! 338: ! 339: /* ! 340: * listnames outputs a list of enumerated type names which ! 341: * can then be selected from to output a TSCAL ! 342: * a pointer to the address in the code of the namelist ! 343: * is kept in value[ NL_ELABEL ]. ! 344: */ ! 345: listnames(ap) ! 346: ! 347: register struct nl *ap; ! 348: { ! 349: struct nl *next; ! 350: register int oldlc, len; ! 351: register unsigned w; ! 352: register char *strptr; ! 353: ! 354: if (cgenflg < 0) ! 355: /* code is off - do nothing */ ! 356: return(NIL); ! 357: if (ap->class != TYPE) ! 358: ap = ap->type; ! 359: if (ap->value[ NL_ELABEL ] != 0) { ! 360: /* the list already exists */ ! 361: return( ap -> value[ NL_ELABEL ] ); ! 362: } ! 363: # ifdef OBJ ! 364: oldlc = lc; ! 365: put(2, O_TRA, lc); ! 366: ap->value[ NL_ELABEL ] = lc; ! 367: # endif OBJ ! 368: # ifdef PC ! 369: putprintf( " .data" , 0 ); ! 370: putprintf( " .align 1" , 0 ); ! 371: ap -> value[ NL_ELABEL ] = getlab(); ! 372: putlab( ap -> value[ NL_ELABEL ] ); ! 373: # endif PC ! 374: /* number of scalars */ ! 375: next = ap->type; ! 376: len = next->range[1]-next->range[0]+1; ! 377: # ifdef OBJ ! 378: put(2, O_CASE2, len); ! 379: # endif OBJ ! 380: # ifdef PC ! 381: putprintf( " .word %d" , 0 , len ); ! 382: # endif PC ! 383: /* offsets of each scalar name */ ! 384: len = (len+1)*sizeof(short); ! 385: # ifdef OBJ ! 386: put(2, O_CASE2, len); ! 387: # endif OBJ ! 388: # ifdef PC ! 389: putprintf( " .word %d" , 0 , len ); ! 390: # endif PC ! 391: next = ap->chain; ! 392: do { ! 393: for(strptr = next->symbol; *strptr++; len++) ! 394: continue; ! 395: len++; ! 396: # ifdef OBJ ! 397: put(2, O_CASE2, len); ! 398: # endif OBJ ! 399: # ifdef PC ! 400: putprintf( " .word %d" , 0 , len ); ! 401: # endif PC ! 402: } while (next = next->chain); ! 403: /* list of scalar names */ ! 404: strptr = getnext(ap, &next); ! 405: # ifdef OBJ ! 406: do { ! 407: w = (unsigned) *strptr; ! 408: if (!*strptr++) ! 409: strptr = getnext(next, &next); ! 410: w |= *strptr << 8; ! 411: if (!*strptr++) ! 412: strptr = getnext(next, &next); ! 413: word(w); ! 414: } while (next); ! 415: /* jump over the mess */ ! 416: patch(oldlc); ! 417: # endif OBJ ! 418: # ifdef PC ! 419: while ( next ) { ! 420: while ( *strptr ) { ! 421: putprintf( " .byte 0%o" , 1 , *strptr++ ); ! 422: for ( w = 2 ; ( w <= 8 ) && *strptr ; w ++ ) { ! 423: putprintf( ",0%o" , 1 , *strptr++ ); ! 424: } ! 425: putprintf( "" , 0 ); ! 426: } ! 427: putprintf( " .byte 0" , 0 ); ! 428: strptr = getnext( next , &next ); ! 429: } ! 430: putprintf( " .text" , 0 ); ! 431: # endif PC ! 432: return( ap -> value[ NL_ELABEL ] ); ! 433: } ! 434: ! 435: getnext(next, new) ! 436: ! 437: struct nl *next, **new; ! 438: { ! 439: if (next != NIL) { ! 440: next = next->chain; ! 441: *new = next; ! 442: } ! 443: if (next == NIL) ! 444: return(""); ! 445: #ifdef OBJ ! 446: if (opt('k') && cgenflg >= 0) ! 447: printf(")#%5d\t\t\"%s\"\n", lc-HEADER_BYTES, next->symbol); ! 448: #endif ! 449: return(next->symbol); ! 450: } ! 451: ! 452: #ifdef OBJ ! 453: /* ! 454: * Putspace puts out a table ! 455: * of nothing to leave space ! 456: * for the case branch table e.g. ! 457: */ ! 458: putspace(n) ! 459: int n; ! 460: { ! 461: register i; ! 462: ! 463: if (cgenflg < 0) ! 464: /* ! 465: * code disabled - do nothing ! 466: */ ! 467: return(lc); ! 468: #ifdef DEBUG ! 469: if (opt('k')) ! 470: printf(")#%5d\t.=.+%d\n", lc - HEADER_BYTES, n); ! 471: #endif ! 472: for (i = even(n); i > 0; i -= 2) ! 473: word(0); ! 474: } ! 475: ! 476: putstr(sptr, padding) ! 477: ! 478: char *sptr; ! 479: int padding; ! 480: { ! 481: register unsigned short w; ! 482: register char *strptr = sptr; ! 483: register int pad = padding; ! 484: ! 485: if (cgenflg < 0) ! 486: /* ! 487: * code disabled - do nothing ! 488: */ ! 489: return(lc); ! 490: #ifdef DEBUG ! 491: if (opt('k')) ! 492: printf(")#%5D\t\t\"%s\"\n", lc-HEADER_BYTES, strptr); ! 493: #endif ! 494: if (pad == 0) { ! 495: do { ! 496: w = (unsigned short) * strptr; ! 497: if (w) ! 498: w |= *++strptr << 8; ! 499: word(w); ! 500: } while (*strptr++); ! 501: } else { ! 502: do { ! 503: w = (unsigned short) * strptr; ! 504: if (w) { ! 505: if (*++strptr) ! 506: w |= *strptr << 8; ! 507: else { ! 508: w |= ' ' << 8; ! 509: pad--; ! 510: } ! 511: word(w); ! 512: } ! 513: } while (*strptr++); ! 514: while (pad > 1) { ! 515: word(' '); ! 516: pad -= 2; ! 517: } ! 518: if (pad == 1) ! 519: word(' '); ! 520: else ! 521: word(0); ! 522: } ! 523: } ! 524: #endif OBJ ! 525: ! 526: lenstr(sptr, padding) ! 527: ! 528: char *sptr; ! 529: int padding; ! 530: ! 531: { ! 532: register int cnt; ! 533: register char *strptr = sptr; ! 534: ! 535: cnt = padding; ! 536: do { ! 537: cnt++; ! 538: } while (*strptr++); ! 539: return((++cnt) & ~1); ! 540: } ! 541: ! 542: /* ! 543: * Patch repairs the branch ! 544: * at location loc to come ! 545: * to the current location. ! 546: * for PC, this puts down the label ! 547: * and the branch just references that label. ! 548: * lets here it for two pass assemblers. ! 549: */ ! 550: patch(loc) ! 551: { ! 552: ! 553: # ifdef OBJ ! 554: patchfil(loc, lc-loc-2, 1); ! 555: # endif OBJ ! 556: # ifdef PC ! 557: putlab( loc ); ! 558: # endif PC ! 559: } ! 560: ! 561: #ifdef OBJ ! 562: patch4(loc) ! 563: { ! 564: ! 565: patchfil(loc, lc - HEADER_BYTES, 2); ! 566: } ! 567: ! 568: /* ! 569: * Patchfil makes loc+2 have value ! 570: * as its contents. ! 571: */ ! 572: patchfil(loc, value, words) ! 573: PTR_DCL loc; ! 574: int value, words; ! 575: { ! 576: register i; ! 577: ! 578: if (cgenflg < 0) ! 579: return; ! 580: if (loc > (unsigned) lc) ! 581: panic("patchfil"); ! 582: #ifdef DEBUG ! 583: if (opt('k')) ! 584: printf(")#\tpatch %u %d\n", loc - HEADER_BYTES, value); ! 585: #endif ! 586: do { ! 587: i = ((unsigned) loc + 2 - ((unsigned) lc & ~01777))/2; ! 588: if (i >= 0 && i < 1024) ! 589: obuf[i] = value; ! 590: else { ! 591: lseek(ofil, (long) loc+2, 0); ! 592: write(ofil, &value, 2); ! 593: lseek(ofil, (long) 0, 2); ! 594: } ! 595: loc += 2; ! 596: value = value >> 16; ! 597: } while (--words); ! 598: } ! 599: ! 600: /* ! 601: * Put the word o into the code ! 602: */ ! 603: word(o) ! 604: int o; ! 605: { ! 606: ! 607: *obufp = o; ! 608: obufp++; ! 609: lc += 2; ! 610: if (obufp >= obuf+512) ! 611: pflush(); ! 612: } ! 613: ! 614: extern char *obj; ! 615: /* ! 616: * Flush the code buffer ! 617: */ ! 618: pflush() ! 619: { ! 620: register i; ! 621: ! 622: i = (obufp - ( ( short * ) obuf ) ) * 2; ! 623: if (i != 0 && write(ofil, obuf, i) != i) ! 624: perror(obj), pexit(DIED); ! 625: obufp = obuf; ! 626: } ! 627: #endif OBJ ! 628: ! 629: /* ! 630: * Getlab - returns the location counter. ! 631: * included here for the eventual code generator. ! 632: * for PC, thank you! ! 633: */ ! 634: getlab() ! 635: { ! 636: # ifdef OBJ ! 637: ! 638: return (lc); ! 639: # endif OBJ ! 640: # ifdef PC ! 641: static long lastlabel; ! 642: ! 643: return ( ++lastlabel ); ! 644: # endif PC ! 645: } ! 646: ! 647: /* ! 648: * Putlab - lay down a label. ! 649: * for PC, just print the label name with a colon after it. ! 650: */ ! 651: putlab(l) ! 652: int l; ! 653: { ! 654: ! 655: # ifdef PC ! 656: putprintf( PREFIXFORMAT , 1 , LABELPREFIX , l ); ! 657: putprintf( ":" , 0 ); ! 658: # endif PC ! 659: return (l); ! 660: } ! 661:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.