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