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