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