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