1 /* Copyright (c) 1979 Regents of the University of California */ 2 3 static char sccsid[] = "@(#)put.c 1.23 04/08/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 } 774