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