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