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