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