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