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