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