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