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