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