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