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