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