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