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