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