1 /* 2 * Copyright (c) 1980 Regents of the University of California. 3 * All rights reserved. The Berkeley software License Agreement 4 * specifies the terms and conditions for redistribution. 5 */ 6 7 #ifndef lint 8 static char sccsid[] = "@(#)putpcc.c 5.1 (Berkeley) 6/7/85"; 9 #endif not lint 10 11 /* 12 * putpcc.c 13 * 14 * Intermediate code generation for S. C. Johnson C compilers 15 * New version using binary polish postfix intermediate 16 * 17 * University of Utah CS Dept modification history: 18 * 19 * $Header: putpcc.c,v 3.2 85/03/25 09:35:57 root Exp $ 20 * $Log: putpcc.c,v $ 21 * Revision 3.2 85/03/25 09:35:57 root 22 * fseek return -1 on error. 23 * 24 * Revision 3.1 85/02/27 19:06:55 donn 25 * Changed to use pcc.h instead of pccdefs.h. 26 * 27 * Revision 2.12 85/02/22 01:05:54 donn 28 * putaddr() didn't know about intrinsic functions... 29 * 30 * Revision 2.11 84/11/28 21:28:49 donn 31 * Hacked putop() to handle any character expression being converted to int, 32 * not just function calls. Previously it bombed on concatenations. 33 * 34 * Revision 2.10 84/11/01 22:07:07 donn 35 * Yet another try at getting putop() to work right. It appears that the 36 * second pass can't abide certain explicit conversions (e.g. short to long) 37 * so the conversion code in putop() tries to remove them. I think this 38 * version (finally) works. 39 * 40 * Revision 2.9 84/10/29 02:30:57 donn 41 * Earlier fix to putop() for conversions was insufficient -- we NEVER want to 42 * see the type of the left operand of the thing left over from stripping off 43 * conversions... 44 * 45 * Revision 2.8 84/09/18 03:09:21 donn 46 * Fixed bug in putop() where the left operand of an addrblock was being 47 * extracted... This caused an extremely obscure conversion error when 48 * an array of longs was subscripted by a short. 49 * 50 * Revision 2.7 84/08/19 20:10:19 donn 51 * Removed stuff in putbranch that treats STGARG parameters specially -- the 52 * bug in the code generation pass that motivated it has been fixed. 53 * 54 * Revision 2.6 84/08/07 21:32:23 donn 55 * Bumped the size of the buffer for the intermediate code file from 0.5K 56 * to 4K on a VAX. 57 * 58 * Revision 2.5 84/08/04 20:26:43 donn 59 * Fixed a goof in the new putbranch() -- it now calls mkaltemp instead of 60 * mktemp(). Correction due to Jerry Berkman. 61 * 62 * Revision 2.4 84/07/24 19:07:15 donn 63 * Fixed bug reported by Craig Leres in which putmnmx() mistakenly assumed 64 * that mkaltemp() returns tempblocks, and tried to free them with frtemp(). 65 * 66 * Revision 2.3 84/07/19 17:22:09 donn 67 * Changed putch1() so that OPPAREN expressions of type CHARACTER are legal. 68 * 69 * Revision 2.2 84/07/19 12:30:38 donn 70 * Fixed a type clash in Bob Corbett's new putbranch(). 71 * 72 * Revision 2.1 84/07/19 12:04:27 donn 73 * Changed comment headers for UofU. 74 * 75 * Revision 1.8 84/07/19 11:38:23 donn 76 * Replaced putbranch() routine so that you can ASSIGN into argument variables. 77 * The code is from Bob Corbett, donated by Jerry Berkman. 78 * 79 * Revision 1.7 84/05/31 00:48:32 donn 80 * Fixed an extremely obscure bug dealing with the comparison of CHARACTER*1 81 * expressions -- a foulup in the order of COMOP and the comparison caused 82 * one operand of the comparison to be garbage. 83 * 84 * Revision 1.6 84/04/16 09:54:19 donn 85 * Backed out earlier fix for bug where items in the argtemplist were 86 * (incorrectly) being given away; this is now fixed in mkargtemp(). 87 * 88 * Revision 1.5 84/03/23 22:49:48 donn 89 * Took out the initialization of the subroutine argument temporary list in 90 * putcall() -- it needs to be done once per statement instead of once per call. 91 * 92 * Revision 1.4 84/03/01 06:48:05 donn 93 * Fixed bug in Bob Corbett's code for argument temporaries that caused an 94 * addrblock to get thrown out inadvertently when it was needed for recycling 95 * purposes later on. 96 * 97 * Revision 1.3 84/02/26 06:32:38 donn 98 * Added Berkeley changes to move data definitions around and reduce offsets. 99 * 100 * Revision 1.2 84/02/26 06:27:45 donn 101 * Added code to catch TTEMP values passed to putx(). 102 * 103 */ 104 105 #if FAMILY != PCC 106 WRONG put FILE !!!! 107 #endif 108 109 #include "defs.h" 110 #include <pcc.h> 111 112 Addrp putcall(), putcxeq(), putcx1(), realpart(); 113 expptr imagpart(); 114 ftnint lencat(); 115 116 #define FOUR 4 117 extern int ops2[]; 118 extern int types2[]; 119 120 #if HERE==VAX || HERE == TAHOE 121 #define PCC_BUFFMAX 1024 122 #else 123 #define PCC_BUFFMAX 128 124 #endif 125 static long int p2buff[PCC_BUFFMAX]; 126 static long int *p2bufp = &p2buff[0]; 127 static long int *p2bufend = &p2buff[PCC_BUFFMAX]; 128 129 130 puthead(s, class) 131 char *s; 132 int class; 133 { 134 char buff[100]; 135 #if TARGET == VAX || TARGET == TAHOE 136 if(s) 137 p2ps("\t.globl\t_%s", s); 138 #endif 139 /* put out fake copy of left bracket line, to be redone later */ 140 if( ! headerdone ) 141 { 142 #if FAMILY == PCC 143 p2flush(); 144 #endif 145 headoffset = ftell(textfile); 146 prhead(textfile); 147 headerdone = YES; 148 p2triple(PCCF_FEXPR, (strlen(infname)+ALILONG-1)/ALILONG, 0); 149 p2str(infname); 150 #if TARGET == PDP11 151 /* fake jump to start the optimizer */ 152 if(class != CLBLOCK) 153 putgoto( fudgelabel = newlabel() ); 154 #endif 155 156 #if TARGET == VAX || TARGET == TAHOE 157 /* jump from top to bottom */ 158 if(s!=CNULL && class!=CLBLOCK) 159 { 160 int proflab = newlabel(); 161 p2pass("\t.align\t1"); 162 p2ps("_%s:", s); 163 p2pi("\t.word\tLWM%d", procno); 164 prsave(proflab); 165 #if TARGET == VAX 166 p2pi("\tjbr\tL%d", 167 #else 168 putgoto( 169 #endif 170 fudgelabel = newlabel()); 171 } 172 #endif 173 } 174 } 175 176 177 178 179 180 /* It is necessary to precede each procedure with a "left bracket" 181 * line that tells pass 2 how many register variables and how 182 * much automatic space is required for the function. This compiler 183 * does not know how much automatic space is needed until the 184 * entire procedure has been processed. Therefore, "puthead" 185 * is called at the begining to record the current location in textfile, 186 * then to put out a placeholder left bracket line. This procedure 187 * repositions the file and rewrites that line, then puts the 188 * file pointer back to the end of the file. 189 */ 190 191 putbracket() 192 { 193 long int hereoffset; 194 195 #if FAMILY == PCC 196 p2flush(); 197 #endif 198 hereoffset = ftell(textfile); 199 if(fseek(textfile, headoffset, 0) == -1) 200 fatal("fseek failed"); 201 prhead(textfile); 202 if(fseek(textfile, hereoffset, 0) == -1) 203 fatal("fseek failed 2"); 204 } 205 206 207 208 209 putrbrack(k) 210 int k; 211 { 212 p2op(PCCF_FRBRAC, k); 213 } 214 215 216 217 putnreg() 218 { 219 } 220 221 222 223 224 225 226 puteof() 227 { 228 p2op(PCCF_FEOF, 0); 229 p2flush(); 230 } 231 232 233 234 putstmt() 235 { 236 p2triple(PCCF_FEXPR, 0, lineno); 237 } 238 239 240 241 242 /* put out code for if( ! p) goto l */ 243 putif(p,l) 244 register expptr p; 245 int l; 246 { 247 register int k; 248 249 if( ( k = (p = fixtype(p))->headblock.vtype) != TYLOGICAL) 250 { 251 if(k != TYERROR) 252 err("non-logical expression in IF statement"); 253 frexpr(p); 254 } 255 else 256 { 257 putex1(p); 258 p2icon( (long int) l , PCCT_INT); 259 p2op(PCC_CBRANCH, 0); 260 putstmt(); 261 } 262 } 263 264 265 266 267 268 /* put out code for goto l */ 269 putgoto(label) 270 int label; 271 { 272 p2triple(PCC_GOTO, 1, label); 273 putstmt(); 274 } 275 276 277 /* branch to address constant or integer variable */ 278 putbranch(p) 279 register Addrp p; 280 { 281 putex1((expptr) p); 282 p2op(PCC_GOTO, PCCT_INT); 283 putstmt(); 284 } 285 286 287 288 /* put out label l: */ 289 putlabel(label) 290 int label; 291 { 292 p2op(PCCF_FLABEL, label); 293 } 294 295 296 297 298 putexpr(p) 299 expptr p; 300 { 301 putex1(p); 302 putstmt(); 303 } 304 305 306 307 308 putcmgo(index, nlab, labs) 309 expptr index; 310 int nlab; 311 struct Labelblock *labs[]; 312 { 313 int i, labarray, skiplabel; 314 315 if(! ISINT(index->headblock.vtype) ) 316 { 317 execerr("computed goto index must be integer", CNULL); 318 return; 319 } 320 321 #if TARGET == VAX || TARGET == TAHOE 322 /* use special case instruction */ 323 casegoto(index, nlab, labs); 324 #else 325 labarray = newlabel(); 326 preven(ALIADDR); 327 prlabel(asmfile, labarray); 328 prcona(asmfile, (ftnint) (skiplabel = newlabel()) ); 329 for(i = 0 ; i < nlab ; ++i) 330 if( labs[i] ) 331 prcona(asmfile, (ftnint)(labs[i]->labelno) ); 332 prcmgoto(index, nlab, skiplabel, labarray); 333 putlabel(skiplabel); 334 #endif 335 } 336 337 putx(p) 338 expptr p; 339 { 340 char *memname(); 341 int opc; 342 int ncomma; 343 int type, k; 344 345 if (!p) 346 return; 347 348 switch(p->tag) 349 { 350 case TERROR: 351 free( (charptr) p ); 352 break; 353 354 case TCONST: 355 switch(type = p->constblock.vtype) 356 { 357 case TYLOGICAL: 358 type = tyint; 359 case TYLONG: 360 case TYSHORT: 361 p2icon(p->constblock.const.ci, types2[type]); 362 free( (charptr) p ); 363 break; 364 365 case TYADDR: 366 p2triple(PCC_ICON, 1, PCCT_INT|PCCTM_PTR); 367 p2word(0L); 368 p2name(memname(STGCONST, 369 (int) p->constblock.const.ci) ); 370 free( (charptr) p ); 371 break; 372 373 default: 374 putx( putconst(p) ); 375 break; 376 } 377 break; 378 379 case TEXPR: 380 switch(opc = p->exprblock.opcode) 381 { 382 case OPCALL: 383 case OPCCALL: 384 if( ISCOMPLEX(p->exprblock.vtype) ) 385 putcxop(p); 386 else putcall(p); 387 break; 388 389 case OPMIN: 390 case OPMAX: 391 putmnmx(p); 392 break; 393 394 395 case OPASSIGN: 396 if(ISCOMPLEX(p->exprblock.leftp->headblock.vtype) 397 || ISCOMPLEX(p->exprblock.rightp->headblock.vtype) ) 398 frexpr( putcxeq(p) ); 399 else if( ISCHAR(p) ) 400 putcheq(p); 401 else 402 goto putopp; 403 break; 404 405 case OPEQ: 406 case OPNE: 407 if( ISCOMPLEX(p->exprblock.leftp->headblock.vtype) || 408 ISCOMPLEX(p->exprblock.rightp->headblock.vtype) ) 409 { 410 putcxcmp(p); 411 break; 412 } 413 case OPLT: 414 case OPLE: 415 case OPGT: 416 case OPGE: 417 if(ISCHAR(p->exprblock.leftp)) 418 { 419 putchcmp(p); 420 break; 421 } 422 goto putopp; 423 424 case OPPOWER: 425 putpower(p); 426 break; 427 428 case OPSTAR: 429 #if FAMILY == PCC 430 /* m * (2**k) -> m<<k */ 431 if(INT(p->exprblock.leftp->headblock.vtype) && 432 ISICON(p->exprblock.rightp) && 433 ( (k = log2(p->exprblock.rightp->constblock.const.ci))>0) ) 434 { 435 p->exprblock.opcode = OPLSHIFT; 436 frexpr(p->exprblock.rightp); 437 p->exprblock.rightp = ICON(k); 438 goto putopp; 439 } 440 #endif 441 442 case OPMOD: 443 goto putopp; 444 case OPPLUS: 445 case OPMINUS: 446 case OPSLASH: 447 case OPNEG: 448 if( ISCOMPLEX(p->exprblock.vtype) ) 449 putcxop(p); 450 else goto putopp; 451 break; 452 453 case OPCONV: 454 if( ISCOMPLEX(p->exprblock.vtype) ) 455 putcxop(p); 456 else if( ISCOMPLEX(p->exprblock.leftp->headblock.vtype) ) 457 { 458 ncomma = 0; 459 putx( mkconv(p->exprblock.vtype, 460 realpart(putcx1(p->exprblock.leftp, 461 &ncomma)))); 462 putcomma(ncomma, p->exprblock.vtype, NO); 463 free( (charptr) p ); 464 } 465 else goto putopp; 466 break; 467 468 case OPNOT: 469 case OPOR: 470 case OPAND: 471 case OPEQV: 472 case OPNEQV: 473 case OPADDR: 474 case OPPLUSEQ: 475 case OPSTAREQ: 476 case OPCOMMA: 477 case OPQUEST: 478 case OPCOLON: 479 case OPBITOR: 480 case OPBITAND: 481 case OPBITXOR: 482 case OPBITNOT: 483 case OPLSHIFT: 484 case OPRSHIFT: 485 putopp: 486 putop(p); 487 break; 488 489 case OPPAREN: 490 putx (p->exprblock.leftp); 491 break; 492 default: 493 badop("putx", opc); 494 } 495 break; 496 497 case TADDR: 498 putaddr(p, YES); 499 break; 500 501 case TTEMP: 502 /* 503 * This type is sometimes passed to putx when errors occur 504 * upstream, I don't know why. 505 */ 506 frexpr(p); 507 break; 508 509 default: 510 badtag("putx", p->tag); 511 } 512 } 513 514 515 516 LOCAL putop(p) 517 expptr p; 518 { 519 int k; 520 expptr lp, tp; 521 int pt, lt, tt; 522 int comma; 523 Addrp putch1(); 524 525 switch(p->exprblock.opcode) /* check for special cases and rewrite */ 526 { 527 case OPCONV: 528 tt = pt = p->exprblock.vtype; 529 lp = p->exprblock.leftp; 530 lt = lp->headblock.vtype; 531 #if TARGET == VAX 532 if (pt == TYREAL && lt == TYDREAL) 533 { 534 putx(lp); 535 p2op(PCC_SCONV, PCCT_FLOAT); 536 return; 537 } 538 #endif 539 while(p->tag==TEXPR && p->exprblock.opcode==OPCONV && ( 540 #if TARGET != TAHOE 541 (ISREAL(pt)&&ISREAL(lt)) || 542 #endif 543 (INT(pt)&&(ONEOF(lt,MSKINT|MSKADDR|MSKCHAR|M(TYSUBR)))) )) 544 { 545 #if SZINT < SZLONG 546 if(lp->tag != TEXPR) 547 { 548 if(pt==TYINT && lt==TYLONG) 549 break; 550 if(lt==TYINT && pt==TYLONG) 551 break; 552 } 553 #endif 554 555 #if TARGET == VAX 556 if(pt==TYDREAL && lt==TYREAL) 557 { 558 if(lp->tag==TEXPR && 559 lp->exprblock.opcode==OPCONV && 560 lp->exprblock.leftp->headblock.vtype==TYDREAL) 561 { 562 putx(lp->exprblock.leftp); 563 p2op(PCC_SCONV, PCCT_FLOAT); 564 p2op(PCC_SCONV, PCCT_DOUBLE); 565 free( (charptr) p ); 566 return; 567 } 568 else break; 569 } 570 #endif 571 if(lt==TYCHAR && lp->tag==TEXPR) 572 { 573 int ncomma = 0; 574 p->exprblock.leftp = (expptr) putch1(lp, &ncomma); 575 putop(p); 576 putcomma(ncomma, pt, NO); 577 free( (charptr) p ); 578 return; 579 } 580 free( (charptr) p ); 581 p = lp; 582 pt = lt; 583 if (p->tag == TEXPR) 584 { 585 lp = p->exprblock.leftp; 586 lt = lp->headblock.vtype; 587 } 588 } 589 if(p->tag==TEXPR && p->exprblock.opcode==OPCONV) 590 break; 591 putx(p); 592 if (types2[tt] != types2[pt] && 593 ! ( (ISREAL(tt)&&ISREAL(pt)) || 594 (INT(tt)&&(ONEOF(pt,MSKINT|MSKADDR|MSKCHAR|M(TYSUBR)))) )) 595 p2op(PCC_SCONV,types2[tt]); 596 return; 597 598 case OPADDR: 599 comma = NO; 600 lp = p->exprblock.leftp; 601 if(lp->tag != TADDR) 602 { 603 tp = (expptr) mkaltemp 604 (lp->headblock.vtype,lp->headblock.vleng); 605 putx( mkexpr(OPASSIGN, cpexpr(tp), lp) ); 606 lp = tp; 607 comma = YES; 608 } 609 putaddr(lp, NO); 610 if(comma) 611 putcomma(1, TYINT, NO); 612 free( (charptr) p ); 613 return; 614 #if TARGET == VAX || TARGET == TAHOE 615 /* take advantage of a glitch in the code generator that does not check 616 the type clash in an assignment or comparison of an integer zero and 617 a floating left operand, and generates optimal code for the correct 618 type. (The PCC has no floating-constant node to encode this correctly.) 619 */ 620 case OPASSIGN: 621 case OPLT: 622 case OPLE: 623 case OPGT: 624 case OPGE: 625 case OPEQ: 626 case OPNE: 627 if(ISREAL(p->exprblock.leftp->headblock.vtype) && 628 ISREAL(p->exprblock.rightp->headblock.vtype) && 629 ISCONST(p->exprblock.rightp) && 630 p->exprblock.rightp->constblock.const.cd[0]==0) 631 { 632 p->exprblock.rightp->constblock.vtype = TYINT; 633 p->exprblock.rightp->constblock.const.ci = 0; 634 } 635 #endif 636 } 637 638 if( (k = ops2[p->exprblock.opcode]) <= 0) 639 badop("putop", p->exprblock.opcode); 640 putx(p->exprblock.leftp); 641 if(p->exprblock.rightp) 642 putx(p->exprblock.rightp); 643 p2op(k, types2[p->exprblock.vtype]); 644 645 if(p->exprblock.vleng) 646 frexpr(p->exprblock.vleng); 647 free( (charptr) p ); 648 } 649 650 putforce(t, p) 651 int t; 652 expptr p; 653 { 654 p = mkconv(t, fixtype(p)); 655 putx(p); 656 p2op(PCC_FORCE, 657 #if TARGET == TAHOE 658 (t==TYLONG ? PCCT_LONG : (t==TYREAL ? PCCT_FLOAT : PCCT_DOUBLE)) ); 659 #else 660 (t==TYSHORT ? PCCT_SHORT : (t==TYLONG ? PCCT_LONG : PCCT_DOUBLE)) ); 661 #endif 662 putstmt(); 663 } 664 665 666 667 LOCAL putpower(p) 668 expptr p; 669 { 670 expptr base; 671 Addrp t1, t2; 672 ftnint k; 673 int type; 674 int ncomma; 675 676 if(!ISICON(p->exprblock.rightp) || 677 (k = p->exprblock.rightp->constblock.const.ci)<2) 678 fatal("putpower: bad call"); 679 base = p->exprblock.leftp; 680 type = base->headblock.vtype; 681 682 if ((k == 2) && base->tag == TADDR && ISCONST(base->addrblock.memoffset)) 683 { 684 putx( mkexpr(OPSTAR,cpexpr(base),cpexpr(base))); 685 686 return; 687 } 688 t1 = mkaltemp(type, PNULL); 689 t2 = NULL; 690 ncomma = 1; 691 putassign(cpexpr(t1), cpexpr(base) ); 692 693 for( ; (k&1)==0 && k>2 ; k>>=1 ) 694 { 695 ++ncomma; 696 putsteq(t1, t1); 697 } 698 699 if(k == 2) 700 putx( mkexpr(OPSTAR, cpexpr(t1), cpexpr(t1)) ); 701 else 702 { 703 t2 = mkaltemp(type, PNULL); 704 ++ncomma; 705 putassign(cpexpr(t2), cpexpr(t1)); 706 707 for(k>>=1 ; k>1 ; k>>=1) 708 { 709 ++ncomma; 710 putsteq(t1, t1); 711 if(k & 1) 712 { 713 ++ncomma; 714 putsteq(t2, t1); 715 } 716 } 717 putx( mkexpr(OPSTAR, cpexpr(t2), 718 mkexpr(OPSTAR, cpexpr(t1), cpexpr(t1)) )); 719 } 720 putcomma(ncomma, type, NO); 721 frexpr(t1); 722 if(t2) 723 frexpr(t2); 724 frexpr(p); 725 } 726 727 728 729 730 LOCAL Addrp intdouble(p, ncommap) 731 Addrp p; 732 int *ncommap; 733 { 734 register Addrp t; 735 736 t = mkaltemp(TYDREAL, PNULL); 737 ++*ncommap; 738 putassign(cpexpr(t), p); 739 return(t); 740 } 741 742 743 744 745 746 LOCAL Addrp putcxeq(p) 747 register expptr p; 748 { 749 register Addrp lp, rp; 750 int ncomma; 751 752 if(p->tag != TEXPR) 753 badtag("putcxeq", p->tag); 754 755 ncomma = 0; 756 lp = putcx1(p->exprblock.leftp, &ncomma); 757 rp = putcx1(p->exprblock.rightp, &ncomma); 758 putassign(realpart(lp), realpart(rp)); 759 if( ISCOMPLEX(p->exprblock.vtype) ) 760 { 761 ++ncomma; 762 putassign(imagpart(lp), imagpart(rp)); 763 } 764 putcomma(ncomma, TYREAL, NO); 765 frexpr(rp); 766 free( (charptr) p ); 767 return(lp); 768 } 769 770 771 772 LOCAL putcxop(p) 773 expptr p; 774 { 775 Addrp putcx1(); 776 int ncomma; 777 778 ncomma = 0; 779 putaddr( putcx1(p, &ncomma), NO); 780 putcomma(ncomma, TYINT, NO); 781 } 782 783 784 785 LOCAL Addrp putcx1(p, ncommap) 786 register expptr p; 787 int *ncommap; 788 { 789 expptr q; 790 Addrp lp, rp; 791 register Addrp resp; 792 int opcode; 793 int ltype, rtype; 794 expptr mkrealcon(); 795 796 if(p == NULL) 797 return(NULL); 798 799 switch(p->tag) 800 { 801 case TCONST: 802 if( ISCOMPLEX(p->constblock.vtype) ) 803 p = (expptr) putconst(p); 804 return( (Addrp) p ); 805 806 case TADDR: 807 if( ! addressable(p) ) 808 { 809 ++*ncommap; 810 resp = mkaltemp(tyint, PNULL); 811 putassign( cpexpr(resp), p->addrblock.memoffset ); 812 p->addrblock.memoffset = (expptr)resp; 813 } 814 return( (Addrp) p ); 815 816 case TEXPR: 817 if( ISCOMPLEX(p->exprblock.vtype) ) 818 break; 819 ++*ncommap; 820 resp = mkaltemp(TYDREAL, NO); 821 putassign( cpexpr(resp), p); 822 return(resp); 823 824 default: 825 badtag("putcx1", p->tag); 826 } 827 828 opcode = p->exprblock.opcode; 829 if(opcode==OPCALL || opcode==OPCCALL) 830 { 831 ++*ncommap; 832 return( putcall(p) ); 833 } 834 else if(opcode == OPASSIGN) 835 { 836 ++*ncommap; 837 return( putcxeq(p) ); 838 } 839 resp = mkaltemp(p->exprblock.vtype, PNULL); 840 if(lp = putcx1(p->exprblock.leftp, ncommap) ) 841 ltype = lp->vtype; 842 if(rp = putcx1(p->exprblock.rightp, ncommap) ) 843 rtype = rp->vtype; 844 845 switch(opcode) 846 { 847 case OPPAREN: 848 frexpr (resp); 849 resp = lp; 850 lp = NULL; 851 break; 852 853 case OPCOMMA: 854 frexpr(resp); 855 resp = rp; 856 rp = NULL; 857 break; 858 859 case OPNEG: 860 putassign( realpart(resp), mkexpr(OPNEG, realpart(lp), ENULL) ); 861 putassign( imagpart(resp), mkexpr(OPNEG, imagpart(lp), ENULL) ); 862 *ncommap += 2; 863 break; 864 865 case OPPLUS: 866 case OPMINUS: 867 putassign( realpart(resp), 868 mkexpr(opcode, realpart(lp), realpart(rp) )); 869 if(rtype < TYCOMPLEX) 870 putassign( imagpart(resp), imagpart(lp) ); 871 else if(ltype < TYCOMPLEX) 872 { 873 if(opcode == OPPLUS) 874 putassign( imagpart(resp), imagpart(rp) ); 875 else putassign( imagpart(resp), 876 mkexpr(OPNEG, imagpart(rp), ENULL) ); 877 } 878 else 879 putassign( imagpart(resp), 880 mkexpr(opcode, imagpart(lp), imagpart(rp) )); 881 882 *ncommap += 2; 883 break; 884 885 case OPSTAR: 886 if(ltype < TYCOMPLEX) 887 { 888 if( ISINT(ltype) ) 889 lp = intdouble(lp, ncommap); 890 putassign( realpart(resp), 891 mkexpr(OPSTAR, cpexpr(lp), realpart(rp) )); 892 putassign( imagpart(resp), 893 mkexpr(OPSTAR, cpexpr(lp), imagpart(rp) )); 894 } 895 else if(rtype < TYCOMPLEX) 896 { 897 if( ISINT(rtype) ) 898 rp = intdouble(rp, ncommap); 899 putassign( realpart(resp), 900 mkexpr(OPSTAR, cpexpr(rp), realpart(lp) )); 901 putassign( imagpart(resp), 902 mkexpr(OPSTAR, cpexpr(rp), imagpart(lp) )); 903 } 904 else { 905 putassign( realpart(resp), mkexpr(OPMINUS, 906 mkexpr(OPSTAR, realpart(lp), realpart(rp)), 907 mkexpr(OPSTAR, imagpart(lp), imagpart(rp)) )); 908 putassign( imagpart(resp), mkexpr(OPPLUS, 909 mkexpr(OPSTAR, realpart(lp), imagpart(rp)), 910 mkexpr(OPSTAR, imagpart(lp), realpart(rp)) )); 911 } 912 *ncommap += 2; 913 break; 914 915 case OPSLASH: 916 /* fixexpr has already replaced all divisions 917 * by a complex by a function call 918 */ 919 if( ISINT(rtype) ) 920 rp = intdouble(rp, ncommap); 921 putassign( realpart(resp), 922 mkexpr(OPSLASH, realpart(lp), cpexpr(rp)) ); 923 putassign( imagpart(resp), 924 mkexpr(OPSLASH, imagpart(lp), cpexpr(rp)) ); 925 *ncommap += 2; 926 break; 927 928 case OPCONV: 929 putassign( realpart(resp), realpart(lp) ); 930 if( ISCOMPLEX(lp->vtype) ) 931 q = imagpart(lp); 932 else if(rp != NULL) 933 q = (expptr) realpart(rp); 934 else 935 q = mkrealcon(TYDREAL, 0.0); 936 putassign( imagpart(resp), q); 937 *ncommap += 2; 938 break; 939 940 default: 941 badop("putcx1", opcode); 942 } 943 944 frexpr(lp); 945 frexpr(rp); 946 free( (charptr) p ); 947 return(resp); 948 } 949 950 951 952 953 LOCAL putcxcmp(p) 954 register expptr p; 955 { 956 int opcode; 957 int ncomma; 958 register Addrp lp, rp; 959 expptr q; 960 961 if(p->tag != TEXPR) 962 badtag("putcxcmp", p->tag); 963 964 ncomma = 0; 965 opcode = p->exprblock.opcode; 966 lp = putcx1(p->exprblock.leftp, &ncomma); 967 rp = putcx1(p->exprblock.rightp, &ncomma); 968 969 q = mkexpr( opcode==OPEQ ? OPAND : OPOR , 970 mkexpr(opcode, realpart(lp), realpart(rp)), 971 mkexpr(opcode, imagpart(lp), imagpart(rp)) ); 972 putx( fixexpr(q) ); 973 putcomma(ncomma, TYINT, NO); 974 975 free( (charptr) lp); 976 free( (charptr) rp); 977 free( (charptr) p ); 978 } 979 980 LOCAL Addrp putch1(p, ncommap) 981 register expptr p; 982 int * ncommap; 983 { 984 register Addrp t; 985 986 switch(p->tag) 987 { 988 case TCONST: 989 return( putconst(p) ); 990 991 case TADDR: 992 return( (Addrp) p ); 993 994 case TEXPR: 995 ++*ncommap; 996 997 switch(p->exprblock.opcode) 998 { 999 expptr q; 1000 1001 case OPCALL: 1002 case OPCCALL: 1003 t = putcall(p); 1004 break; 1005 1006 case OPPAREN: 1007 --*ncommap; 1008 t = putch1(p->exprblock.leftp, ncommap); 1009 break; 1010 1011 case OPCONCAT: 1012 t = mkaltemp(TYCHAR, ICON(lencat(p)) ); 1013 q = (expptr) cpexpr(p->headblock.vleng); 1014 putcat( cpexpr(t), p ); 1015 /* put the correct length on the block */ 1016 frexpr(t->vleng); 1017 t->vleng = q; 1018 1019 break; 1020 1021 case OPCONV: 1022 if(!ISICON(p->exprblock.vleng) 1023 || p->exprblock.vleng->constblock.const.ci!=1 1024 || ! INT(p->exprblock.leftp->headblock.vtype) ) 1025 fatal("putch1: bad character conversion"); 1026 t = mkaltemp(TYCHAR, ICON(1) ); 1027 putop( mkexpr(OPASSIGN, cpexpr(t), p) ); 1028 break; 1029 default: 1030 badop("putch1", p->exprblock.opcode); 1031 } 1032 return(t); 1033 1034 default: 1035 badtag("putch1", p->tag); 1036 } 1037 /* NOTREACHED */ 1038 } 1039 1040 1041 1042 1043 LOCAL putchop(p) 1044 expptr p; 1045 { 1046 int ncomma; 1047 1048 ncomma = 0; 1049 putaddr( putch1(p, &ncomma) , NO ); 1050 putcomma(ncomma, TYCHAR, YES); 1051 } 1052 1053 1054 1055 1056 LOCAL putcheq(p) 1057 register expptr p; 1058 { 1059 int ncomma; 1060 expptr lp, rp; 1061 1062 if(p->tag != TEXPR) 1063 badtag("putcheq", p->tag); 1064 1065 ncomma = 0; 1066 lp = p->exprblock.leftp; 1067 rp = p->exprblock.rightp; 1068 if( rp->tag==TEXPR && rp->exprblock.opcode==OPCONCAT ) 1069 putcat(lp, rp); 1070 else if( ISONE(lp->headblock.vleng) && ISONE(rp->headblock.vleng) ) 1071 { 1072 putaddr( putch1(lp, &ncomma) , YES ); 1073 putaddr( putch1(rp, &ncomma) , YES ); 1074 putcomma(ncomma, TYINT, NO); 1075 p2op(PCC_ASSIGN, PCCT_CHAR); 1076 } 1077 else 1078 { 1079 putx( call2(TYINT, "s_copy", lp, rp) ); 1080 putcomma(ncomma, TYINT, NO); 1081 } 1082 1083 frexpr(p->exprblock.vleng); 1084 free( (charptr) p ); 1085 } 1086 1087 1088 1089 1090 LOCAL putchcmp(p) 1091 register expptr p; 1092 { 1093 int ncomma; 1094 expptr lp, rp; 1095 1096 if(p->tag != TEXPR) 1097 badtag("putchcmp", p->tag); 1098 1099 ncomma = 0; 1100 lp = p->exprblock.leftp; 1101 rp = p->exprblock.rightp; 1102 1103 if(ISONE(lp->headblock.vleng) && ISONE(rp->headblock.vleng) ) 1104 { 1105 putaddr( putch1(lp, &ncomma) , YES ); 1106 putcomma(ncomma, TYINT, NO); 1107 ncomma = 0; 1108 putaddr( putch1(rp, &ncomma) , YES ); 1109 putcomma(ncomma, TYINT, NO); 1110 p2op(ops2[p->exprblock.opcode], PCCT_CHAR); 1111 free( (charptr) p ); 1112 } 1113 else 1114 { 1115 p->exprblock.leftp = call2(TYINT,"s_cmp", lp, rp); 1116 p->exprblock.rightp = ICON(0); 1117 putop(p); 1118 } 1119 } 1120 1121 1122 1123 1124 1125 LOCAL putcat(lhs, rhs) 1126 register Addrp lhs; 1127 register expptr rhs; 1128 { 1129 int n, ncomma; 1130 Addrp lp, cp; 1131 1132 ncomma = 0; 1133 n = ncat(rhs); 1134 lp = mkaltmpn(n, TYLENG, PNULL); 1135 cp = mkaltmpn(n, TYADDR, PNULL); 1136 1137 n = 0; 1138 putct1(rhs, lp, cp, &n, &ncomma); 1139 1140 putx( call4(TYSUBR, "s_cat", lhs, cp, lp, mkconv(TYLONG, ICON(n)) ) ); 1141 putcomma(ncomma, TYINT, NO); 1142 } 1143 1144 1145 1146 1147 1148 LOCAL putct1(q, lp, cp, ip, ncommap) 1149 register expptr q; 1150 register Addrp lp, cp; 1151 int *ip, *ncommap; 1152 { 1153 int i; 1154 Addrp lp1, cp1; 1155 1156 if(q->tag==TEXPR && q->exprblock.opcode==OPCONCAT) 1157 { 1158 putct1(q->exprblock.leftp, lp, cp, ip, ncommap); 1159 putct1(q->exprblock.rightp, lp, cp , ip, ncommap); 1160 frexpr(q->exprblock.vleng); 1161 free( (charptr) q ); 1162 } 1163 else 1164 { 1165 i = (*ip)++; 1166 lp1 = (Addrp) cpexpr(lp); 1167 lp1->memoffset = mkexpr(OPPLUS,lp1->memoffset, ICON(i*SZLENG)); 1168 cp1 = (Addrp) cpexpr(cp); 1169 cp1->memoffset = mkexpr(OPPLUS, cp1->memoffset, ICON(i*SZADDR)); 1170 putassign( lp1, cpexpr(q->headblock.vleng) ); 1171 putassign( cp1, addrof(putch1(q,ncommap)) ); 1172 *ncommap += 2; 1173 } 1174 } 1175 1176 LOCAL putaddr(p, indir) 1177 register Addrp p; 1178 int indir; 1179 { 1180 int type, type2, funct; 1181 ftnint offset, simoffset(); 1182 expptr offp, shorten(); 1183 1184 if( p->tag==TERROR || (p->memoffset!=NULL && ISERROR(p->memoffset)) ) 1185 { 1186 frexpr(p); 1187 return; 1188 } 1189 if (p->tag != TADDR) badtag ("putaddr",p->tag); 1190 1191 type = p->vtype; 1192 type2 = types2[type]; 1193 funct = (p->vclass==CLPROC ? PCCTM_FTN<<2 : 0); 1194 1195 offp = (p->memoffset ? (expptr) cpexpr(p->memoffset) : (expptr)NULL ); 1196 1197 1198 #if (FUDGEOFFSET != 1) 1199 if(offp) 1200 offp = mkexpr(OPSTAR, ICON(FUDGEOFFSET), offp); 1201 #endif 1202 1203 offset = simoffset( &offp ); 1204 #if SZINT < SZLONG 1205 if(offp) 1206 if(shortsubs) 1207 offp = shorten(offp); 1208 else 1209 offp = mkconv(TYINT, offp); 1210 #else 1211 if(offp) 1212 offp = mkconv(TYINT, offp); 1213 #endif 1214 1215 if (p->vclass == CLVAR 1216 && (p->vstg == STGBSS || p->vstg == STGEQUIV) 1217 && SMALLVAR(p->varsize) 1218 && offset >= -32768 && offset <= 32767) 1219 { 1220 anylocals = YES; 1221 if (indir && !offp) 1222 p2ldisp(offset, memname(p->vstg, p->memno), type2); 1223 else 1224 { 1225 p2reg(LVARREG, type2 | PCCTM_PTR); 1226 p2triple(PCC_ICON, 1, PCCT_INT); 1227 p2word(offset); 1228 p2ndisp(memname(p->vstg, p->memno)); 1229 p2op(PCC_PLUS, type2 | PCCTM_PTR); 1230 if (offp) 1231 { 1232 putx(offp); 1233 p2op(PCC_PLUS, type2 | PCCTM_PTR); 1234 } 1235 if (indir) 1236 p2op(PCC_DEREF, type2); 1237 } 1238 frexpr((tagptr) p); 1239 return; 1240 } 1241 1242 switch(p->vstg) 1243 { 1244 case STGAUTO: 1245 if(indir && !offp) 1246 { 1247 p2oreg(offset, AUTOREG, type2); 1248 break; 1249 } 1250 1251 if(!indir && !offp && !offset) 1252 { 1253 p2reg(AUTOREG, type2 | PCCTM_PTR); 1254 break; 1255 } 1256 1257 p2reg(AUTOREG, type2 | PCCTM_PTR); 1258 if(offp) 1259 { 1260 putx(offp); 1261 if(offset) 1262 p2icon(offset, PCCT_INT); 1263 } 1264 else 1265 p2icon(offset, PCCT_INT); 1266 if(offp && offset) 1267 p2op(PCC_PLUS, type2 | PCCTM_PTR); 1268 p2op(PCC_PLUS, type2 | PCCTM_PTR); 1269 if(indir) 1270 p2op(PCC_DEREF, type2); 1271 break; 1272 1273 case STGARG: 1274 p2oreg( 1275 #ifdef ARGOFFSET 1276 ARGOFFSET + 1277 #endif 1278 (ftnint) (FUDGEOFFSET*p->memno), 1279 ARGREG, type2 | PCCTM_PTR | funct ); 1280 1281 based: 1282 if(offset) 1283 { 1284 p2icon(offset, PCCT_INT); 1285 p2op(PCC_PLUS, type2 | PCCTM_PTR); 1286 } 1287 if(offp) 1288 { 1289 putx(offp); 1290 p2op(PCC_PLUS, type2 | PCCTM_PTR); 1291 } 1292 if(indir) 1293 p2op(PCC_DEREF, type2); 1294 break; 1295 1296 case STGLENG: 1297 if(indir) 1298 { 1299 p2oreg( 1300 #ifdef ARGOFFSET 1301 ARGOFFSET + 1302 #endif 1303 (ftnint) (FUDGEOFFSET*p->memno), 1304 ARGREG, type2 ); 1305 } 1306 else { 1307 p2reg(ARGREG, type2 | PCCTM_PTR ); 1308 p2icon( 1309 #ifdef ARGOFFSET 1310 ARGOFFSET + 1311 #endif 1312 (ftnint) (FUDGEOFFSET*p->memno), PCCT_INT); 1313 p2op(PCC_PLUS, type2 | PCCTM_PTR ); 1314 } 1315 break; 1316 1317 1318 case STGBSS: 1319 case STGINIT: 1320 case STGEXT: 1321 case STGINTR: 1322 case STGCOMMON: 1323 case STGEQUIV: 1324 case STGCONST: 1325 if(offp) 1326 { 1327 putx(offp); 1328 putmem(p, PCC_ICON, offset); 1329 p2op(PCC_PLUS, type2 | PCCTM_PTR); 1330 if(indir) 1331 p2op(PCC_DEREF, type2); 1332 } 1333 else 1334 putmem(p, (indir ? PCC_NAME : PCC_ICON), offset); 1335 1336 break; 1337 1338 case STGREG: 1339 if(indir) 1340 p2reg(p->memno, type2); 1341 else 1342 fatal("attempt to take address of a register"); 1343 break; 1344 1345 case STGPREG: 1346 if(indir && !offp) 1347 p2oreg(offset, p->memno, type2); 1348 else 1349 { 1350 p2reg(p->memno, type2 | PCCTM_PTR); 1351 goto based; 1352 } 1353 break; 1354 1355 default: 1356 badstg("putaddr", p->vstg); 1357 } 1358 frexpr(p); 1359 } 1360 1361 1362 1363 1364 LOCAL putmem(p, class, offset) 1365 expptr p; 1366 int class; 1367 ftnint offset; 1368 { 1369 int type2; 1370 int funct; 1371 char *name, *memname(); 1372 1373 funct = (p->headblock.vclass==CLPROC ? PCCTM_FTN<<2 : 0); 1374 type2 = types2[p->headblock.vtype]; 1375 if(p->headblock.vclass == CLPROC) 1376 type2 |= (PCCTM_FTN<<2); 1377 name = memname(p->addrblock.vstg, p->addrblock.memno); 1378 if(class == PCC_ICON) 1379 { 1380 p2triple(PCC_ICON, name[0]!='\0', type2|PCCTM_PTR); 1381 p2word(offset); 1382 if(name[0]) 1383 p2name(name); 1384 } 1385 else 1386 { 1387 p2triple(PCC_NAME, offset!=0, type2); 1388 if(offset != 0) 1389 p2word(offset); 1390 p2name(name); 1391 } 1392 } 1393 1394 1395 1396 LOCAL Addrp putcall(p) 1397 register Exprp p; 1398 { 1399 chainp arglist, charsp, cp; 1400 int n, first; 1401 Addrp t; 1402 register expptr q; 1403 Addrp fval, mkargtemp(); 1404 int type, type2, ctype, qtype, indir; 1405 1406 type2 = types2[type = p->vtype]; 1407 charsp = NULL; 1408 indir = (p->opcode == OPCCALL); 1409 n = 0; 1410 first = YES; 1411 1412 if(p->rightp) 1413 { 1414 arglist = p->rightp->listblock.listp; 1415 free( (charptr) (p->rightp) ); 1416 } 1417 else 1418 arglist = NULL; 1419 1420 for(cp = arglist ; cp ; cp = cp->nextp) 1421 { 1422 q = (expptr) cp->datap; 1423 if(indir) 1424 ++n; 1425 else { 1426 q = (expptr) (cp->datap); 1427 if( ISCONST(q) ) 1428 { 1429 q = (expptr) putconst(q); 1430 cp->datap = (tagptr) q; 1431 } 1432 if( ISCHAR(q) && q->headblock.vclass!=CLPROC ) 1433 { 1434 charsp = hookup(charsp, 1435 mkchain(cpexpr(q->headblock.vleng), 1436 CHNULL)); 1437 n += 2; 1438 } 1439 else 1440 n += 1; 1441 } 1442 } 1443 1444 if(type == TYCHAR) 1445 { 1446 if( ISICON(p->vleng) ) 1447 { 1448 fval = mkargtemp(TYCHAR, p->vleng); 1449 n += 2; 1450 } 1451 else { 1452 err("adjustable character function"); 1453 return; 1454 } 1455 } 1456 else if( ISCOMPLEX(type) ) 1457 { 1458 fval = mkargtemp(type, PNULL); 1459 n += 1; 1460 } 1461 else 1462 fval = NULL; 1463 1464 ctype = (fval ? PCCT_INT : type2); 1465 putaddr(p->leftp, NO); 1466 1467 if(fval) 1468 { 1469 first = NO; 1470 putaddr( cpexpr(fval), NO); 1471 if(type==TYCHAR) 1472 { 1473 putx( mkconv(TYLENG,p->vleng) ); 1474 p2op(PCC_CM, type2); 1475 } 1476 } 1477 1478 for(cp = arglist ; cp ; cp = cp->nextp) 1479 { 1480 q = (expptr) (cp->datap); 1481 if(q->tag==TADDR && (indir || q->addrblock.vstg!=STGREG) ) 1482 putaddr(q, indir && q->addrblock.vtype!=TYCHAR); 1483 else if( ISCOMPLEX(q->headblock.vtype) ) 1484 putcxop(q); 1485 else if (ISCHAR(q) ) 1486 putchop(q); 1487 else if( ! ISERROR(q) ) 1488 { 1489 if(indir) 1490 putx(q); 1491 else { 1492 t = mkargtemp(qtype = q->headblock.vtype, 1493 q->headblock.vleng); 1494 putassign( cpexpr(t), q ); 1495 putaddr(t, NO); 1496 putcomma(1, qtype, YES); 1497 } 1498 } 1499 if(first) 1500 first = NO; 1501 else 1502 p2op(PCC_CM, type2); 1503 } 1504 1505 if(arglist) 1506 frchain(&arglist); 1507 for(cp = charsp ; cp ; cp = cp->nextp) 1508 { 1509 putx( mkconv(TYLENG,cp->datap) ); 1510 p2op(PCC_CM, type2); 1511 } 1512 frchain(&charsp); 1513 #if TARGET == TAHOE 1514 if(indir && ctype==PCCT_FLOAT) /* function opcodes */ 1515 p2op(PCC_FORTCALL, ctype); 1516 else 1517 #endif 1518 p2op(n>0 ? PCC_CALL : PCC_UCALL , ctype); 1519 free( (charptr) p ); 1520 return(fval); 1521 } 1522 1523 1524 1525 LOCAL putmnmx(p) 1526 register expptr p; 1527 { 1528 int op, type; 1529 int ncomma; 1530 expptr qp; 1531 chainp p0, p1; 1532 Addrp sp, tp; 1533 1534 if(p->tag != TEXPR) 1535 badtag("putmnmx", p->tag); 1536 1537 type = p->exprblock.vtype; 1538 op = (p->exprblock.opcode==OPMIN ? OPLT : OPGT ); 1539 p0 = p->exprblock.leftp->listblock.listp; 1540 free( (charptr) (p->exprblock.leftp) ); 1541 free( (charptr) p ); 1542 1543 sp = mkaltemp(type, PNULL); 1544 tp = mkaltemp(type, PNULL); 1545 qp = mkexpr(OPCOLON, cpexpr(tp), cpexpr(sp)); 1546 qp = mkexpr(OPQUEST, mkexpr(op, cpexpr(tp),cpexpr(sp)), qp); 1547 qp = fixexpr(qp); 1548 1549 ncomma = 1; 1550 putassign( cpexpr(sp), p0->datap ); 1551 1552 for(p1 = p0->nextp ; p1 ; p1 = p1->nextp) 1553 { 1554 ++ncomma; 1555 putassign( cpexpr(tp), p1->datap ); 1556 if(p1->nextp) 1557 { 1558 ++ncomma; 1559 putassign( cpexpr(sp), cpexpr(qp) ); 1560 } 1561 else 1562 putx(qp); 1563 } 1564 1565 putcomma(ncomma, type, NO); 1566 frexpr(sp); 1567 frexpr(tp); 1568 frchain( &p0 ); 1569 } 1570 1571 1572 1573 1574 LOCAL putcomma(n, type, indir) 1575 int n, type, indir; 1576 { 1577 type = types2[type]; 1578 if(indir) 1579 type |= PCCTM_PTR; 1580 while(--n >= 0) 1581 p2op(PCC_COMOP, type); 1582 } 1583 1584 1585 1586 1587 ftnint simoffset(p0) 1588 expptr *p0; 1589 { 1590 ftnint offset, prod; 1591 register expptr p, lp, rp; 1592 1593 offset = 0; 1594 p = *p0; 1595 if(p == NULL) 1596 return(0); 1597 1598 if( ! ISINT(p->headblock.vtype) ) 1599 return(0); 1600 1601 if(p->tag==TEXPR && p->exprblock.opcode==OPSTAR) 1602 { 1603 lp = p->exprblock.leftp; 1604 rp = p->exprblock.rightp; 1605 if(ISICON(rp) && lp->tag==TEXPR && 1606 lp->exprblock.opcode==OPPLUS && ISICON(lp->exprblock.rightp)) 1607 { 1608 p->exprblock.opcode = OPPLUS; 1609 lp->exprblock.opcode = OPSTAR; 1610 prod = rp->constblock.const.ci * 1611 lp->exprblock.rightp->constblock.const.ci; 1612 lp->exprblock.rightp->constblock.const.ci = rp->constblock.const.ci; 1613 rp->constblock.const.ci = prod; 1614 } 1615 } 1616 1617 if(p->tag==TEXPR && p->exprblock.opcode==OPPLUS && 1618 ISICON(p->exprblock.rightp)) 1619 { 1620 rp = p->exprblock.rightp; 1621 lp = p->exprblock.leftp; 1622 offset += rp->constblock.const.ci; 1623 frexpr(rp); 1624 free( (charptr) p ); 1625 *p0 = lp; 1626 } 1627 1628 if( ISCONST(p) ) 1629 { 1630 offset += p->constblock.const.ci; 1631 frexpr(p); 1632 *p0 = NULL; 1633 } 1634 1635 return(offset); 1636 } 1637 1638 1639 1640 1641 1642 p2op(op, type) 1643 int op, type; 1644 { 1645 p2triple(op, 0, type); 1646 } 1647 1648 p2icon(offset, type) 1649 ftnint offset; 1650 int type; 1651 { 1652 p2triple(PCC_ICON, 0, type); 1653 p2word(offset); 1654 } 1655 1656 1657 1658 1659 p2oreg(offset, reg, type) 1660 ftnint offset; 1661 int reg, type; 1662 { 1663 p2triple(PCC_OREG, reg, type); 1664 p2word(offset); 1665 p2name(""); 1666 } 1667 1668 1669 1670 1671 p2reg(reg, type) 1672 int reg, type; 1673 { 1674 p2triple(PCC_REG, reg, type); 1675 } 1676 1677 1678 1679 p2pi(s, i) 1680 char *s; 1681 int i; 1682 { 1683 char buff[100]; 1684 sprintf(buff, s, i); 1685 p2pass(buff); 1686 } 1687 1688 1689 1690 p2pij(s, i, j) 1691 char *s; 1692 int i, j; 1693 { 1694 char buff[100]; 1695 sprintf(buff, s, i, j); 1696 p2pass(buff); 1697 } 1698 1699 1700 1701 1702 p2ps(s, t) 1703 char *s, *t; 1704 { 1705 char buff[100]; 1706 sprintf(buff, s, t); 1707 p2pass(buff); 1708 } 1709 1710 1711 1712 1713 p2pass(s) 1714 char *s; 1715 { 1716 p2triple(PCCF_FTEXT, (strlen(s) + ALILONG-1)/ALILONG, 0); 1717 p2str(s); 1718 } 1719 1720 1721 1722 1723 p2str(s) 1724 register char *s; 1725 { 1726 union { long int word; char str[SZLONG]; } u; 1727 register int i; 1728 1729 i = 0; 1730 u.word = 0; 1731 while(*s) 1732 { 1733 u.str[i++] = *s++; 1734 if(i == SZLONG) 1735 { 1736 p2word(u.word); 1737 u.word = 0; 1738 i = 0; 1739 } 1740 } 1741 if(i > 0) 1742 p2word(u.word); 1743 } 1744 1745 1746 1747 1748 p2triple(op, var, type) 1749 int op, var, type; 1750 { 1751 register long word; 1752 word = PCCM_TRIPLE(op, var, type); 1753 p2word(word); 1754 } 1755 1756 1757 1758 1759 1760 p2name(s) 1761 register char *s; 1762 { 1763 register int i; 1764 1765 #ifdef UCBPASS2 1766 /* arbitrary length names, terminated by a null, 1767 padded to a full word */ 1768 1769 # define WL sizeof(long int) 1770 union { long int word; char str[WL]; } w; 1771 1772 w.word = 0; 1773 i = 0; 1774 while(w.str[i++] = *s++) 1775 if(i == WL) 1776 { 1777 p2word(w.word); 1778 w.word = 0; 1779 i = 0; 1780 } 1781 if(i > 0) 1782 p2word(w.word); 1783 #else 1784 /* standard intermediate, names are 8 characters long */ 1785 1786 union { long int word[2]; char str[8]; } u; 1787 1788 u.word[0] = u.word[1] = 0; 1789 for(i = 0 ; i<8 && *s ; ++i) 1790 u.str[i] = *s++; 1791 p2word(u.word[0]); 1792 p2word(u.word[1]); 1793 1794 #endif 1795 1796 } 1797 1798 1799 1800 1801 p2word(w) 1802 long int w; 1803 { 1804 *p2bufp++ = w; 1805 if(p2bufp >= p2bufend) 1806 p2flush(); 1807 } 1808 1809 1810 1811 p2flush() 1812 { 1813 if(p2bufp > p2buff) 1814 write(fileno(textfile), p2buff, (p2bufp-p2buff)*sizeof(long int)); 1815 p2bufp = p2buff; 1816 } 1817 1818 1819 1820 LOCAL 1821 p2ldisp(offset, vname, type) 1822 ftnint offset; 1823 char *vname; 1824 int type; 1825 { 1826 char buff[100]; 1827 1828 sprintf(buff, "%s-v.%d", vname, bsslabel); 1829 p2triple(PCC_OREG, LVARREG, type); 1830 p2word(offset); 1831 p2name(buff); 1832 } 1833 1834 1835 1836 p2ndisp(vname) 1837 char *vname; 1838 { 1839 char buff[100]; 1840 1841 sprintf(buff, "%s-v.%d", vname, bsslabel); 1842 p2name(buff); 1843 } 1844