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