![[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] / 43BSD / usr.bin / f77 / src / f77pass1|
Return to putpcc.c CVS log | Up to [CSRG BSD Unix] / 43BSD / usr.bin / f77 / src / f77pass1 |
1.1 root 1: /*
2: * Copyright (c) 1980 Regents of the University of California.
3: * All rights reserved. The Berkeley software License Agreement
4: * specifies the terms and conditions for redistribution.
5: */
6:
7: #ifndef lint
8: static char sccsid[] = "@(#)putpcc.c 5.2 (Berkeley) 3/9/86";
9: #endif not lint
10:
11: /*
12: * putpcc.c
13: *
14: * Intermediate code generation for S. C. Johnson C compilers
15: * New version using binary polish postfix intermediate
16: *
17: * University of Utah CS Dept modification history:
18: *
19: * $Header: putpcc.c,v 5.2 86/03/04 17:49:38 donn Exp $
20: * $Log: putpcc.c,v $
21: * Revision 5.2 86/03/04 17:49:38 donn
22: * Change putct1() to emit the memoffset before the vleng -- the memoffset
23: * may define a temporary which is used by the vleng to avoid repeated
24: * evaluation of an expression with side effects.
25: *
26: * Revision 5.1 85/08/10 03:49:26 donn
27: * 4.3 alpha
28: *
29: * Revision 3.2 85/03/25 09:35:57 root
30: * fseek return -1 on error.
31: *
32: * Revision 3.1 85/02/27 19:06:55 donn
33: * Changed to use pcc.h instead of pccdefs.h.
34: *
35: * Revision 2.12 85/02/22 01:05:54 donn
36: * putaddr() didn't know about intrinsic functions...
37: *
38: * Revision 2.11 84/11/28 21:28:49 donn
39: * Hacked putop() to handle any character expression being converted to int,
40: * not just function calls. Previously it bombed on concatenations.
41: *
42: * Revision 2.10 84/11/01 22:07:07 donn
43: * Yet another try at getting putop() to work right. It appears that the
44: * second pass can't abide certain explicit conversions (e.g. short to long)
45: * so the conversion code in putop() tries to remove them. I think this
46: * version (finally) works.
47: *
48: * Revision 2.9 84/10/29 02:30:57 donn
49: * Earlier fix to putop() for conversions was insufficient -- we NEVER want to
50: * see the type of the left operand of the thing left over from stripping off
51: * conversions...
52: *
53: * Revision 2.8 84/09/18 03:09:21 donn
54: * Fixed bug in putop() where the left operand of an addrblock was being
55: * extracted... This caused an extremely obscure conversion error when
56: * an array of longs was subscripted by a short.
57: *
58: * Revision 2.7 84/08/19 20:10:19 donn
59: * Removed stuff in putbranch that treats STGARG parameters specially -- the
60: * bug in the code generation pass that motivated it has been fixed.
61: *
62: * Revision 2.6 84/08/07 21:32:23 donn
63: * Bumped the size of the buffer for the intermediate code file from 0.5K
64: * to 4K on a VAX.
65: *
66: * Revision 2.5 84/08/04 20:26:43 donn
67: * Fixed a goof in the new putbranch() -- it now calls mkaltemp instead of
68: * mktemp(). Correction due to Jerry Berkman.
69: *
70: * Revision 2.4 84/07/24 19:07:15 donn
71: * Fixed bug reported by Craig Leres in which putmnmx() mistakenly assumed
72: * that mkaltemp() returns tempblocks, and tried to free them with frtemp().
73: *
74: * Revision 2.3 84/07/19 17:22:09 donn
75: * Changed putch1() so that OPPAREN expressions of type CHARACTER are legal.
76: *
77: * Revision 2.2 84/07/19 12:30:38 donn
78: * Fixed a type clash in Bob Corbett's new putbranch().
79: *
80: * Revision 2.1 84/07/19 12:04:27 donn
81: * Changed comment headers for UofU.
82: *
83: * Revision 1.8 84/07/19 11:38:23 donn
84: * Replaced putbranch() routine so that you can ASSIGN into argument variables.
85: * The code is from Bob Corbett, donated by Jerry Berkman.
86: *
87: * Revision 1.7 84/05/31 00:48:32 donn
88: * Fixed an extremely obscure bug dealing with the comparison of CHARACTER*1
89: * expressions -- a foulup in the order of COMOP and the comparison caused
90: * one operand of the comparison to be garbage.
91: *
92: * Revision 1.6 84/04/16 09:54:19 donn
93: * Backed out earlier fix for bug where items in the argtemplist were
94: * (incorrectly) being given away; this is now fixed in mkargtemp().
95: *
96: * Revision 1.5 84/03/23 22:49:48 donn
97: * Took out the initialization of the subroutine argument temporary list in
98: * putcall() -- it needs to be done once per statement instead of once per call.
99: *
100: * Revision 1.4 84/03/01 06:48:05 donn
101: * Fixed bug in Bob Corbett's code for argument temporaries that caused an
102: * addrblock to get thrown out inadvertently when it was needed for recycling
103: * purposes later on.
104: *
105: * Revision 1.3 84/02/26 06:32:38 donn
106: * Added Berkeley changes to move data definitions around and reduce offsets.
107: *
108: * Revision 1.2 84/02/26 06:27:45 donn
109: * Added code to catch TTEMP values passed to putx().
110: *
111: */
112:
113: #if FAMILY != PCC
114: WRONG put FILE !!!!
115: #endif
116:
117: #include "defs.h"
118: #include <pcc.h>
119:
120: Addrp putcall(), putcxeq(), putcx1(), realpart();
121: expptr imagpart();
122: ftnint lencat();
123:
124: #define FOUR 4
125: extern int ops2[];
126: extern int types2[];
127:
128: #if HERE==VAX
129: #define PCC_BUFFMAX 1024
130: #else
131: #define PCC_BUFFMAX 128
132: #endif
133: static long int p2buff[PCC_BUFFMAX];
134: static long int *p2bufp = &p2buff[0];
135: static long int *p2bufend = &p2buff[PCC_BUFFMAX];
136:
137:
138: puthead(s, class)
139: char *s;
140: int class;
141: {
142: char buff[100];
143: #if TARGET == VAX
144: if(s)
145: p2ps("\t.globl\t_%s", s);
146: #endif
147: /* put out fake copy of left bracket line, to be redone later */
148: if( ! headerdone )
149: {
150: #if FAMILY == PCC
151: p2flush();
152: #endif
153: headoffset = ftell(textfile);
154: prhead(textfile);
155: headerdone = YES;
156: p2triple(PCCF_FEXPR, (strlen(infname)+FOUR-1)/FOUR, 0);
157: p2str(infname);
158: #if TARGET == PDP11
159: /* fake jump to start the optimizer */
160: if(class != CLBLOCK)
161: putgoto( fudgelabel = newlabel() );
162: #endif
163:
164: #if TARGET == VAX
165: /* jump from top to bottom */
166: if(s!=CNULL && class!=CLBLOCK)
167: {
168: int proflab = newlabel();
169: p2ps("_%s:", s);
170: p2pi("\t.word\tLWM%d", procno);
171: prsave(proflab);
172: p2pi("\tjbr\tL%d", fudgelabel = newlabel());
173: }
174: #endif
175: }
176: }
177:
178:
179:
180:
181:
182: /* It is necessary to precede each procedure with a "left bracket"
183: * line that tells pass 2 how many register variables and how
184: * much automatic space is required for the function. This compiler
185: * does not know how much automatic space is needed until the
186: * entire procedure has been processed. Therefore, "puthead"
187: * is called at the begining to record the current location in textfile,
188: * then to put out a placeholder left bracket line. This procedure
189: * repositions the file and rewrites that line, then puts the
190: * file pointer back to the end of the file.
191: */
192:
193: putbracket()
194: {
195: long int hereoffset;
196:
197: #if FAMILY == PCC
198: p2flush();
199: #endif
200: hereoffset = ftell(textfile);
201: if(fseek(textfile, headoffset, 0) == -1)
202: fatal("fseek failed");
203: prhead(textfile);
204: if(fseek(textfile, hereoffset, 0) == -1)
205: fatal("fseek failed 2");
206: }
207:
208:
209:
210:
211: putrbrack(k)
212: int k;
213: {
214: p2op(PCCF_FRBRAC, k);
215: }
216:
217:
218:
219: putnreg()
220: {
221: }
222:
223:
224:
225:
226:
227:
228: puteof()
229: {
230: p2op(PCCF_FEOF, 0);
231: p2flush();
232: }
233:
234:
235:
236: putstmt()
237: {
238: p2triple(PCCF_FEXPR, 0, lineno);
239: }
240:
241:
242:
243:
244: /* put out code for if( ! p) goto l */
245: putif(p,l)
246: register expptr p;
247: int l;
248: {
249: register int k;
250:
251: if( ( k = (p = fixtype(p))->headblock.vtype) != TYLOGICAL)
252: {
253: if(k != TYERROR)
254: err("non-logical expression in IF statement");
255: frexpr(p);
256: }
257: else
258: {
259: putex1(p);
260: p2icon( (long int) l , PCCT_INT);
261: p2op(PCC_CBRANCH, 0);
262: putstmt();
263: }
264: }
265:
266:
267:
268:
269:
270: /* put out code for goto l */
271: putgoto(label)
272: int label;
273: {
274: p2triple(PCC_GOTO, 1, label);
275: putstmt();
276: }
277:
278:
279: /* branch to address constant or integer variable */
280: putbranch(p)
281: register Addrp p;
282: {
283: putex1((expptr) p);
284: p2op(PCC_GOTO, PCCT_INT);
285: putstmt();
286: }
287:
288:
289:
290: /* put out label l: */
291: putlabel(label)
292: int label;
293: {
294: p2op(PCCF_FLABEL, label);
295: }
296:
297:
298:
299:
300: putexpr(p)
301: expptr p;
302: {
303: putex1(p);
304: putstmt();
305: }
306:
307:
308:
309:
310: putcmgo(index, nlab, labs)
311: expptr index;
312: int nlab;
313: struct Labelblock *labs[];
314: {
315: int i, labarray, skiplabel;
316:
317: if(! ISINT(index->headblock.vtype) )
318: {
319: execerr("computed goto index must be integer", CNULL);
320: return;
321: }
322:
323: #if TARGET == VAX
324: /* use special case instruction */
325: vaxgoto(index, nlab, labs);
326: #else
327: labarray = newlabel();
328: preven(ALIADDR);
329: prlabel(asmfile, labarray);
330: prcona(asmfile, (ftnint) (skiplabel = newlabel()) );
331: for(i = 0 ; i < nlab ; ++i)
332: if( labs[i] )
333: prcona(asmfile, (ftnint)(labs[i]->labelno) );
334: prcmgoto(index, nlab, skiplabel, labarray);
335: putlabel(skiplabel);
336: #endif
337: }
338:
339: putx(p)
340: expptr p;
341: {
342: char *memname();
343: int opc;
344: int ncomma;
345: int type, k;
346:
347: if (!p)
348: return;
349:
350: switch(p->tag)
351: {
352: case TERROR:
353: free( (charptr) p );
354: break;
355:
356: case TCONST:
357: switch(type = p->constblock.vtype)
358: {
359: case TYLOGICAL:
360: type = tyint;
361: case TYLONG:
362: case TYSHORT:
363: p2icon(p->constblock.const.ci, types2[type]);
364: free( (charptr) p );
365: break;
366:
367: case TYADDR:
368: p2triple(PCC_ICON, 1, PCCT_INT|PCCTM_PTR);
369: p2word(0L);
370: p2name(memname(STGCONST,
371: (int) p->constblock.const.ci) );
372: free( (charptr) p );
373: break;
374:
375: default:
376: putx( putconst(p) );
377: break;
378: }
379: break;
380:
381: case TEXPR:
382: switch(opc = p->exprblock.opcode)
383: {
384: case OPCALL:
385: case OPCCALL:
386: if( ISCOMPLEX(p->exprblock.vtype) )
387: putcxop(p);
388: else putcall(p);
389: break;
390:
391: case OPMIN:
392: case OPMAX:
393: putmnmx(p);
394: break;
395:
396:
397: case OPASSIGN:
398: if(ISCOMPLEX(p->exprblock.leftp->headblock.vtype)
399: || ISCOMPLEX(p->exprblock.rightp->headblock.vtype) )
400: frexpr( putcxeq(p) );
401: else if( ISCHAR(p) )
402: putcheq(p);
403: else
404: goto putopp;
405: break;
406:
407: case OPEQ:
408: case OPNE:
409: if( ISCOMPLEX(p->exprblock.leftp->headblock.vtype) ||
410: ISCOMPLEX(p->exprblock.rightp->headblock.vtype) )
411: {
412: putcxcmp(p);
413: break;
414: }
415: case OPLT:
416: case OPLE:
417: case OPGT:
418: case OPGE:
419: if(ISCHAR(p->exprblock.leftp))
420: {
421: putchcmp(p);
422: break;
423: }
424: goto putopp;
425:
426: case OPPOWER:
427: putpower(p);
428: break;
429:
430: case OPSTAR:
431: #if FAMILY == PCC
432: /* m * (2**k) -> m<<k */
433: if(INT(p->exprblock.leftp->headblock.vtype) &&
434: ISICON(p->exprblock.rightp) &&
435: ( (k = log2(p->exprblock.rightp->constblock.const.ci))>0) )
436: {
437: p->exprblock.opcode = OPLSHIFT;
438: frexpr(p->exprblock.rightp);
439: p->exprblock.rightp = ICON(k);
440: goto putopp;
441: }
442: #endif
443:
444: case OPMOD:
445: goto putopp;
446: case OPPLUS:
447: case OPMINUS:
448: case OPSLASH:
449: case OPNEG:
450: if( ISCOMPLEX(p->exprblock.vtype) )
451: putcxop(p);
452: else goto putopp;
453: break;
454:
455: case OPCONV:
456: if( ISCOMPLEX(p->exprblock.vtype) )
457: putcxop(p);
458: else if( ISCOMPLEX(p->exprblock.leftp->headblock.vtype) )
459: {
460: ncomma = 0;
461: putx( mkconv(p->exprblock.vtype,
462: realpart(putcx1(p->exprblock.leftp,
463: &ncomma))));
464: putcomma(ncomma, p->exprblock.vtype, NO);
465: free( (charptr) p );
466: }
467: else goto putopp;
468: break;
469:
470: case OPNOT:
471: case OPOR:
472: case OPAND:
473: case OPEQV:
474: case OPNEQV:
475: case OPADDR:
476: case OPPLUSEQ:
477: case OPSTAREQ:
478: case OPCOMMA:
479: case OPQUEST:
480: case OPCOLON:
481: case OPBITOR:
482: case OPBITAND:
483: case OPBITXOR:
484: case OPBITNOT:
485: case OPLSHIFT:
486: case OPRSHIFT:
487: putopp:
488: putop(p);
489: break;
490:
491: case OPPAREN:
492: putx (p->exprblock.leftp);
493: break;
494: default:
495: badop("putx", opc);
496: }
497: break;
498:
499: case TADDR:
500: putaddr(p, YES);
501: break;
502:
503: case TTEMP:
504: /*
505: * This type is sometimes passed to putx when errors occur
506: * upstream, I don't know why.
507: */
508: frexpr(p);
509: break;
510:
511: default:
512: badtag("putx", p->tag);
513: }
514: }
515:
516:
517:
518: LOCAL putop(p)
519: expptr p;
520: {
521: int k;
522: expptr lp, tp;
523: int pt, lt, tt;
524: int comma;
525: Addrp putch1();
526:
527: switch(p->exprblock.opcode) /* check for special cases and rewrite */
528: {
529: case OPCONV:
530: tt = pt = p->exprblock.vtype;
531: lp = p->exprblock.leftp;
532: lt = lp->headblock.vtype;
533: if (pt == TYREAL && lt == TYDREAL)
534: {
535: putx(lp);
536: p2op(PCC_SCONV, PCCT_FLOAT);
537: return;
538: }
539: while(p->tag==TEXPR && p->exprblock.opcode==OPCONV &&
540: ( (ISREAL(pt)&&ISREAL(lt)) ||
541: (INT(pt)&&(ONEOF(lt,MSKINT|MSKADDR|MSKCHAR|M(TYSUBR)))) ))
542: {
543: #if SZINT < SZLONG
544: if(lp->tag != TEXPR)
545: {
546: if(pt==TYINT && lt==TYLONG)
547: break;
548: if(lt==TYINT && pt==TYLONG)
549: break;
550: }
551: #endif
552:
553: #if TARGET == VAX
554: if(pt==TYDREAL && lt==TYREAL)
555: {
556: if(lp->tag==TEXPR &&
557: lp->exprblock.opcode==OPCONV &&
558: lp->exprblock.leftp->headblock.vtype==TYDREAL)
559: {
560: putx(lp->exprblock.leftp);
561: p2op(PCC_SCONV, PCCT_FLOAT);
562: p2op(PCC_SCONV, PCCT_DOUBLE);
563: free( (charptr) p );
564: return;
565: }
566: else break;
567: }
568: #endif
569: if(lt==TYCHAR && lp->tag==TEXPR)
570: {
571: int ncomma = 0;
572: p->exprblock.leftp = (expptr) putch1(lp, &ncomma);
573: putop(p);
574: putcomma(ncomma, pt, NO);
575: free( (charptr) p );
576: return;
577: }
578: free( (charptr) p );
579: p = lp;
580: pt = lt;
581: if (p->tag == TEXPR)
582: {
583: lp = p->exprblock.leftp;
584: lt = lp->headblock.vtype;
585: }
586: }
587: if(p->tag==TEXPR && p->exprblock.opcode==OPCONV)
588: break;
589: putx(p);
590: if (types2[tt] != types2[pt] &&
591: ! ( (ISREAL(tt)&&ISREAL(pt)) ||
592: (INT(tt)&&(ONEOF(pt,MSKINT|MSKADDR|MSKCHAR|M(TYSUBR)))) ))
593: p2op(PCC_SCONV,types2[tt]);
594: return;
595:
596: case OPADDR:
597: comma = NO;
598: lp = p->exprblock.leftp;
599: if(lp->tag != TADDR)
600: {
601: tp = (expptr) mkaltemp
602: (lp->headblock.vtype,lp->headblock.vleng);
603: putx( mkexpr(OPASSIGN, cpexpr(tp), lp) );
604: lp = tp;
605: comma = YES;
606: }
607: putaddr(lp, NO);
608: if(comma)
609: putcomma(1, TYINT, NO);
610: free( (charptr) p );
611: return;
612: #if TARGET == VAX
613: /* take advantage of a glitch in the code generator that does not check
614: the type clash in an assignment or comparison of an integer zero and
615: a floating left operand, and generates optimal code for the correct
616: type. (The PCC has no floating-constant node to encode this correctly.)
617: */
618: case OPASSIGN:
619: case OPLT:
620: case OPLE:
621: case OPGT:
622: case OPGE:
623: case OPEQ:
624: case OPNE:
625: if(ISREAL(p->exprblock.leftp->headblock.vtype) &&
626: ISREAL(p->exprblock.rightp->headblock.vtype) &&
627: ISCONST(p->exprblock.rightp) &&
628: p->exprblock.rightp->constblock.const.cd[0]==0)
629: {
630: p->exprblock.rightp->constblock.vtype = TYINT;
631: p->exprblock.rightp->constblock.const.ci = 0;
632: }
633: #endif
634: }
635:
636: if( (k = ops2[p->exprblock.opcode]) <= 0)
637: badop("putop", p->exprblock.opcode);
638: putx(p->exprblock.leftp);
639: if(p->exprblock.rightp)
640: putx(p->exprblock.rightp);
641: p2op(k, types2[p->exprblock.vtype]);
642:
643: if(p->exprblock.vleng)
644: frexpr(p->exprblock.vleng);
645: free( (charptr) p );
646: }
647:
648: putforce(t, p)
649: int t;
650: expptr p;
651: {
652: p = mkconv(t, fixtype(p));
653: putx(p);
654: p2op(PCC_FORCE,
655: (t==TYSHORT ? PCCT_SHORT : (t==TYLONG ? PCCT_LONG : PCCT_DOUBLE)) );
656: putstmt();
657: }
658:
659:
660:
661: LOCAL putpower(p)
662: expptr p;
663: {
664: expptr base;
665: Addrp t1, t2;
666: ftnint k;
667: int type;
668: int ncomma;
669:
670: if(!ISICON(p->exprblock.rightp) ||
671: (k = p->exprblock.rightp->constblock.const.ci)<2)
672: fatal("putpower: bad call");
673: base = p->exprblock.leftp;
674: type = base->headblock.vtype;
675:
676: if ((k == 2) && base->tag == TADDR && ISCONST(base->addrblock.memoffset))
677: {
678: putx( mkexpr(OPSTAR,cpexpr(base),cpexpr(base)));
679:
680: return;
681: }
682: t1 = mkaltemp(type, PNULL);
683: t2 = NULL;
684: ncomma = 1;
685: putassign(cpexpr(t1), cpexpr(base) );
686:
687: for( ; (k&1)==0 && k>2 ; k>>=1 )
688: {
689: ++ncomma;
690: putsteq(t1, t1);
691: }
692:
693: if(k == 2)
694: putx( mkexpr(OPSTAR, cpexpr(t1), cpexpr(t1)) );
695: else
696: {
697: t2 = mkaltemp(type, PNULL);
698: ++ncomma;
699: putassign(cpexpr(t2), cpexpr(t1));
700:
701: for(k>>=1 ; k>1 ; k>>=1)
702: {
703: ++ncomma;
704: putsteq(t1, t1);
705: if(k & 1)
706: {
707: ++ncomma;
708: putsteq(t2, t1);
709: }
710: }
711: putx( mkexpr(OPSTAR, cpexpr(t2),
712: mkexpr(OPSTAR, cpexpr(t1), cpexpr(t1)) ));
713: }
714: putcomma(ncomma, type, NO);
715: frexpr(t1);
716: if(t2)
717: frexpr(t2);
718: frexpr(p);
719: }
720:
721:
722:
723:
724: LOCAL Addrp intdouble(p, ncommap)
725: Addrp p;
726: int *ncommap;
727: {
728: register Addrp t;
729:
730: t = mkaltemp(TYDREAL, PNULL);
731: ++*ncommap;
732: putassign(cpexpr(t), p);
733: return(t);
734: }
735:
736:
737:
738:
739:
740: LOCAL Addrp putcxeq(p)
741: register expptr p;
742: {
743: register Addrp lp, rp;
744: int ncomma;
745:
746: if(p->tag != TEXPR)
747: badtag("putcxeq", p->tag);
748:
749: ncomma = 0;
750: lp = putcx1(p->exprblock.leftp, &ncomma);
751: rp = putcx1(p->exprblock.rightp, &ncomma);
752: putassign(realpart(lp), realpart(rp));
753: if( ISCOMPLEX(p->exprblock.vtype) )
754: {
755: ++ncomma;
756: putassign(imagpart(lp), imagpart(rp));
757: }
758: putcomma(ncomma, TYREAL, NO);
759: frexpr(rp);
760: free( (charptr) p );
761: return(lp);
762: }
763:
764:
765:
766: LOCAL putcxop(p)
767: expptr p;
768: {
769: Addrp putcx1();
770: int ncomma;
771:
772: ncomma = 0;
773: putaddr( putcx1(p, &ncomma), NO);
774: putcomma(ncomma, TYINT, NO);
775: }
776:
777:
778:
779: LOCAL Addrp putcx1(p, ncommap)
780: register expptr p;
781: int *ncommap;
782: {
783: expptr q;
784: Addrp lp, rp;
785: register Addrp resp;
786: int opcode;
787: int ltype, rtype;
788: expptr mkrealcon();
789:
790: if(p == NULL)
791: return(NULL);
792:
793: switch(p->tag)
794: {
795: case TCONST:
796: if( ISCOMPLEX(p->constblock.vtype) )
797: p = (expptr) putconst(p);
798: return( (Addrp) p );
799:
800: case TADDR:
801: if( ! addressable(p) )
802: {
803: ++*ncommap;
804: resp = mkaltemp(tyint, PNULL);
805: putassign( cpexpr(resp), p->addrblock.memoffset );
806: p->addrblock.memoffset = (expptr)resp;
807: }
808: return( (Addrp) p );
809:
810: case TEXPR:
811: if( ISCOMPLEX(p->exprblock.vtype) )
812: break;
813: ++*ncommap;
814: resp = mkaltemp(TYDREAL, NO);
815: putassign( cpexpr(resp), p);
816: return(resp);
817:
818: default:
819: badtag("putcx1", p->tag);
820: }
821:
822: opcode = p->exprblock.opcode;
823: if(opcode==OPCALL || opcode==OPCCALL)
824: {
825: ++*ncommap;
826: return( putcall(p) );
827: }
828: else if(opcode == OPASSIGN)
829: {
830: ++*ncommap;
831: return( putcxeq(p) );
832: }
833: resp = mkaltemp(p->exprblock.vtype, PNULL);
834: if(lp = putcx1(p->exprblock.leftp, ncommap) )
835: ltype = lp->vtype;
836: if(rp = putcx1(p->exprblock.rightp, ncommap) )
837: rtype = rp->vtype;
838:
839: switch(opcode)
840: {
841: case OPPAREN:
842: frexpr (resp);
843: resp = lp;
844: lp = NULL;
845: break;
846:
847: case OPCOMMA:
848: frexpr(resp);
849: resp = rp;
850: rp = NULL;
851: break;
852:
853: case OPNEG:
854: putassign( realpart(resp), mkexpr(OPNEG, realpart(lp), ENULL) );
855: putassign( imagpart(resp), mkexpr(OPNEG, imagpart(lp), ENULL) );
856: *ncommap += 2;
857: break;
858:
859: case OPPLUS:
860: case OPMINUS:
861: putassign( realpart(resp),
862: mkexpr(opcode, realpart(lp), realpart(rp) ));
863: if(rtype < TYCOMPLEX)
864: putassign( imagpart(resp), imagpart(lp) );
865: else if(ltype < TYCOMPLEX)
866: {
867: if(opcode == OPPLUS)
868: putassign( imagpart(resp), imagpart(rp) );
869: else putassign( imagpart(resp),
870: mkexpr(OPNEG, imagpart(rp), ENULL) );
871: }
872: else
873: putassign( imagpart(resp),
874: mkexpr(opcode, imagpart(lp), imagpart(rp) ));
875:
876: *ncommap += 2;
877: break;
878:
879: case OPSTAR:
880: if(ltype < TYCOMPLEX)
881: {
882: if( ISINT(ltype) )
883: lp = intdouble(lp, ncommap);
884: putassign( realpart(resp),
885: mkexpr(OPSTAR, cpexpr(lp), realpart(rp) ));
886: putassign( imagpart(resp),
887: mkexpr(OPSTAR, cpexpr(lp), imagpart(rp) ));
888: }
889: else if(rtype < TYCOMPLEX)
890: {
891: if( ISINT(rtype) )
892: rp = intdouble(rp, ncommap);
893: putassign( realpart(resp),
894: mkexpr(OPSTAR, cpexpr(rp), realpart(lp) ));
895: putassign( imagpart(resp),
896: mkexpr(OPSTAR, cpexpr(rp), imagpart(lp) ));
897: }
898: else {
899: putassign( realpart(resp), mkexpr(OPMINUS,
900: mkexpr(OPSTAR, realpart(lp), realpart(rp)),
901: mkexpr(OPSTAR, imagpart(lp), imagpart(rp)) ));
902: putassign( imagpart(resp), mkexpr(OPPLUS,
903: mkexpr(OPSTAR, realpart(lp), imagpart(rp)),
904: mkexpr(OPSTAR, imagpart(lp), realpart(rp)) ));
905: }
906: *ncommap += 2;
907: break;
908:
909: case OPSLASH:
910: /* fixexpr has already replaced all divisions
911: * by a complex by a function call
912: */
913: if( ISINT(rtype) )
914: rp = intdouble(rp, ncommap);
915: putassign( realpart(resp),
916: mkexpr(OPSLASH, realpart(lp), cpexpr(rp)) );
917: putassign( imagpart(resp),
918: mkexpr(OPSLASH, imagpart(lp), cpexpr(rp)) );
919: *ncommap += 2;
920: break;
921:
922: case OPCONV:
923: putassign( realpart(resp), realpart(lp) );
924: if( ISCOMPLEX(lp->vtype) )
925: q = imagpart(lp);
926: else if(rp != NULL)
927: q = (expptr) realpart(rp);
928: else
929: q = mkrealcon(TYDREAL, 0.0);
930: putassign( imagpart(resp), q);
931: *ncommap += 2;
932: break;
933:
934: default:
935: badop("putcx1", opcode);
936: }
937:
938: frexpr(lp);
939: frexpr(rp);
940: free( (charptr) p );
941: return(resp);
942: }
943:
944:
945:
946:
947: LOCAL putcxcmp(p)
948: register expptr p;
949: {
950: int opcode;
951: int ncomma;
952: register Addrp lp, rp;
953: expptr q;
954:
955: if(p->tag != TEXPR)
956: badtag("putcxcmp", p->tag);
957:
958: ncomma = 0;
959: opcode = p->exprblock.opcode;
960: lp = putcx1(p->exprblock.leftp, &ncomma);
961: rp = putcx1(p->exprblock.rightp, &ncomma);
962:
963: q = mkexpr( opcode==OPEQ ? OPAND : OPOR ,
964: mkexpr(opcode, realpart(lp), realpart(rp)),
965: mkexpr(opcode, imagpart(lp), imagpart(rp)) );
966: putx( fixexpr(q) );
967: putcomma(ncomma, TYINT, NO);
968:
969: free( (charptr) lp);
970: free( (charptr) rp);
971: free( (charptr) p );
972: }
973:
974: LOCAL Addrp putch1(p, ncommap)
975: register expptr p;
976: int * ncommap;
977: {
978: register Addrp t;
979:
980: switch(p->tag)
981: {
982: case TCONST:
983: return( putconst(p) );
984:
985: case TADDR:
986: return( (Addrp) p );
987:
988: case TEXPR:
989: ++*ncommap;
990:
991: switch(p->exprblock.opcode)
992: {
993: expptr q;
994:
995: case OPCALL:
996: case OPCCALL:
997: t = putcall(p);
998: break;
999:
1000: case OPPAREN:
1001: --*ncommap;
1002: t = putch1(p->exprblock.leftp, ncommap);
1003: break;
1004:
1005: case OPCONCAT:
1006: t = mkaltemp(TYCHAR, ICON(lencat(p)) );
1007: q = (expptr) cpexpr(p->headblock.vleng);
1008: putcat( cpexpr(t), p );
1009: /* put the correct length on the block */
1010: frexpr(t->vleng);
1011: t->vleng = q;
1012:
1013: break;
1014:
1015: case OPCONV:
1016: if(!ISICON(p->exprblock.vleng)
1017: || p->exprblock.vleng->constblock.const.ci!=1
1018: || ! INT(p->exprblock.leftp->headblock.vtype) )
1019: fatal("putch1: bad character conversion");
1020: t = mkaltemp(TYCHAR, ICON(1) );
1021: putop( mkexpr(OPASSIGN, cpexpr(t), p) );
1022: break;
1023: default:
1024: badop("putch1", p->exprblock.opcode);
1025: }
1026: return(t);
1027:
1028: default:
1029: badtag("putch1", p->tag);
1030: }
1031: /* NOTREACHED */
1032: }
1033:
1034:
1035:
1036:
1037: LOCAL putchop(p)
1038: expptr p;
1039: {
1040: int ncomma;
1041:
1042: ncomma = 0;
1043: putaddr( putch1(p, &ncomma) , NO );
1044: putcomma(ncomma, TYCHAR, YES);
1045: }
1046:
1047:
1048:
1049:
1050: LOCAL putcheq(p)
1051: register expptr p;
1052: {
1053: int ncomma;
1054: expptr lp, rp;
1055:
1056: if(p->tag != TEXPR)
1057: badtag("putcheq", p->tag);
1058:
1059: ncomma = 0;
1060: lp = p->exprblock.leftp;
1061: rp = p->exprblock.rightp;
1062: if( rp->tag==TEXPR && rp->exprblock.opcode==OPCONCAT )
1063: putcat(lp, rp);
1064: else if( ISONE(lp->headblock.vleng) && ISONE(rp->headblock.vleng) )
1065: {
1066: putaddr( putch1(lp, &ncomma) , YES );
1067: putaddr( putch1(rp, &ncomma) , YES );
1068: putcomma(ncomma, TYINT, NO);
1069: p2op(PCC_ASSIGN, PCCT_CHAR);
1070: }
1071: else
1072: {
1073: putx( call2(TYINT, "s_copy", lp, rp) );
1074: putcomma(ncomma, TYINT, NO);
1075: }
1076:
1077: frexpr(p->exprblock.vleng);
1078: free( (charptr) p );
1079: }
1080:
1081:
1082:
1083:
1084: LOCAL putchcmp(p)
1085: register expptr p;
1086: {
1087: int ncomma;
1088: expptr lp, rp;
1089:
1090: if(p->tag != TEXPR)
1091: badtag("putchcmp", p->tag);
1092:
1093: ncomma = 0;
1094: lp = p->exprblock.leftp;
1095: rp = p->exprblock.rightp;
1096:
1097: if(ISONE(lp->headblock.vleng) && ISONE(rp->headblock.vleng) )
1098: {
1099: putaddr( putch1(lp, &ncomma) , YES );
1100: putcomma(ncomma, TYINT, NO);
1101: ncomma = 0;
1102: putaddr( putch1(rp, &ncomma) , YES );
1103: putcomma(ncomma, TYINT, NO);
1104: p2op(ops2[p->exprblock.opcode], PCCT_CHAR);
1105: free( (charptr) p );
1106: }
1107: else
1108: {
1109: p->exprblock.leftp = call2(TYINT,"s_cmp", lp, rp);
1110: p->exprblock.rightp = ICON(0);
1111: putop(p);
1112: }
1113: }
1114:
1115:
1116:
1117:
1118:
1119: LOCAL putcat(lhs, rhs)
1120: register Addrp lhs;
1121: register expptr rhs;
1122: {
1123: int n, ncomma;
1124: Addrp lp, cp;
1125:
1126: ncomma = 0;
1127: n = ncat(rhs);
1128: lp = mkaltmpn(n, TYLENG, PNULL);
1129: cp = mkaltmpn(n, TYADDR, PNULL);
1130:
1131: n = 0;
1132: putct1(rhs, lp, cp, &n, &ncomma);
1133:
1134: putx( call4(TYSUBR, "s_cat", lhs, cp, lp, mkconv(TYLONG, ICON(n)) ) );
1135: putcomma(ncomma, TYINT, NO);
1136: }
1137:
1138:
1139:
1140:
1141:
1142: LOCAL putct1(q, lp, cp, ip, ncommap)
1143: register expptr q;
1144: register Addrp lp, cp;
1145: int *ip, *ncommap;
1146: {
1147: int i;
1148: Addrp lp1, cp1;
1149:
1150: if(q->tag==TEXPR && q->exprblock.opcode==OPCONCAT)
1151: {
1152: putct1(q->exprblock.leftp, lp, cp, ip, ncommap);
1153: putct1(q->exprblock.rightp, lp, cp , ip, ncommap);
1154: frexpr(q->exprblock.vleng);
1155: free( (charptr) q );
1156: }
1157: else
1158: {
1159: i = (*ip)++;
1160: cp1 = (Addrp) cpexpr(cp);
1161: cp1->memoffset = mkexpr(OPPLUS, cp1->memoffset, ICON(i*SZADDR));
1162: lp1 = (Addrp) cpexpr(lp);
1163: lp1->memoffset = mkexpr(OPPLUS,lp1->memoffset, ICON(i*SZLENG));
1164: putassign( cp1, addrof(putch1(cpexpr(q),ncommap)) );
1165: putassign( lp1, q->headblock.vleng );
1166: free( (charptr) q );
1167: *ncommap += 2;
1168: }
1169: }
1170:
1171: LOCAL putaddr(p, indir)
1172: register Addrp p;
1173: int indir;
1174: {
1175: int type, type2, funct;
1176: ftnint offset, simoffset();
1177: expptr offp, shorten();
1178:
1179: if( p->tag==TERROR || (p->memoffset!=NULL && ISERROR(p->memoffset)) )
1180: {
1181: frexpr(p);
1182: return;
1183: }
1184: if (p->tag != TADDR) badtag ("putaddr",p->tag);
1185:
1186: type = p->vtype;
1187: type2 = types2[type];
1188: funct = (p->vclass==CLPROC ? PCCTM_FTN<<2 : 0);
1189:
1190: offp = (p->memoffset ? (expptr) cpexpr(p->memoffset) : (expptr)NULL );
1191:
1192:
1193: #if (FUDGEOFFSET != 1)
1194: if(offp)
1195: offp = mkexpr(OPSTAR, ICON(FUDGEOFFSET), offp);
1196: #endif
1197:
1198: offset = simoffset( &offp );
1199: #if SZINT < SZLONG
1200: if(offp)
1201: if(shortsubs)
1202: offp = shorten(offp);
1203: else
1204: offp = mkconv(TYINT, offp);
1205: #else
1206: if(offp)
1207: offp = mkconv(TYINT, offp);
1208: #endif
1209:
1210: if (p->vclass == CLVAR
1211: && (p->vstg == STGBSS || p->vstg == STGEQUIV)
1212: && SMALLVAR(p->varsize)
1213: && offset >= -32768 && offset <= 32767)
1214: {
1215: anylocals = YES;
1216: if (indir && !offp)
1217: p2ldisp(offset, memname(p->vstg, p->memno), type2);
1218: else
1219: {
1220: p2reg(11, type2 | PCCTM_PTR);
1221: p2triple(PCC_ICON, 1, PCCT_INT);
1222: p2word(offset);
1223: p2ndisp(memname(p->vstg, p->memno));
1224: p2op(PCC_PLUS, type2 | PCCTM_PTR);
1225: if (offp)
1226: {
1227: putx(offp);
1228: p2op(PCC_PLUS, type2 | PCCTM_PTR);
1229: }
1230: if (indir)
1231: p2op(PCC_DEREF, type2);
1232: }
1233: frexpr((tagptr) p);
1234: return;
1235: }
1236:
1237: switch(p->vstg)
1238: {
1239: case STGAUTO:
1240: if(indir && !offp)
1241: {
1242: p2oreg(offset, AUTOREG, type2);
1243: break;
1244: }
1245:
1246: if(!indir && !offp && !offset)
1247: {
1248: p2reg(AUTOREG, type2 | PCCTM_PTR);
1249: break;
1250: }
1251:
1252: p2reg(AUTOREG, type2 | PCCTM_PTR);
1253: if(offp)
1254: {
1255: putx(offp);
1256: if(offset)
1257: p2icon(offset, PCCT_INT);
1258: }
1259: else
1260: p2icon(offset, PCCT_INT);
1261: if(offp && offset)
1262: p2op(PCC_PLUS, type2 | PCCTM_PTR);
1263: p2op(PCC_PLUS, type2 | PCCTM_PTR);
1264: if(indir)
1265: p2op(PCC_DEREF, type2);
1266: break;
1267:
1268: case STGARG:
1269: p2oreg(
1270: #ifdef ARGOFFSET
1271: ARGOFFSET +
1272: #endif
1273: (ftnint) (FUDGEOFFSET*p->memno),
1274: ARGREG, type2 | PCCTM_PTR | funct );
1275:
1276: based:
1277: if(offset)
1278: {
1279: p2icon(offset, PCCT_INT);
1280: p2op(PCC_PLUS, type2 | PCCTM_PTR);
1281: }
1282: if(offp)
1283: {
1284: putx(offp);
1285: p2op(PCC_PLUS, type2 | PCCTM_PTR);
1286: }
1287: if(indir)
1288: p2op(PCC_DEREF, type2);
1289: break;
1290:
1291: case STGLENG:
1292: if(indir)
1293: {
1294: p2oreg(
1295: #ifdef ARGOFFSET
1296: ARGOFFSET +
1297: #endif
1298: (ftnint) (FUDGEOFFSET*p->memno),
1299: ARGREG, type2 );
1300: }
1301: else {
1302: p2reg(ARGREG, type2 | PCCTM_PTR );
1303: p2icon(
1304: #ifdef ARGOFFSET
1305: ARGOFFSET +
1306: #endif
1307: (ftnint) (FUDGEOFFSET*p->memno), PCCT_INT);
1308: p2op(PCC_PLUS, type2 | PCCTM_PTR );
1309: }
1310: break;
1311:
1312:
1313: case STGBSS:
1314: case STGINIT:
1315: case STGEXT:
1316: case STGINTR:
1317: case STGCOMMON:
1318: case STGEQUIV:
1319: case STGCONST:
1320: if(offp)
1321: {
1322: putx(offp);
1323: putmem(p, PCC_ICON, offset);
1324: p2op(PCC_PLUS, type2 | PCCTM_PTR);
1325: if(indir)
1326: p2op(PCC_DEREF, type2);
1327: }
1328: else
1329: putmem(p, (indir ? PCC_NAME : PCC_ICON), offset);
1330:
1331: break;
1332:
1333: case STGREG:
1334: if(indir)
1335: p2reg(p->memno, type2);
1336: else
1337: fatal("attempt to take address of a register");
1338: break;
1339:
1340: case STGPREG:
1341: if(indir && !offp)
1342: p2oreg(offset, p->memno, type2);
1343: else
1344: {
1345: p2reg(p->memno, type2 | PCCTM_PTR);
1346: goto based;
1347: }
1348: break;
1349:
1350: default:
1351: badstg("putaddr", p->vstg);
1352: }
1353: frexpr(p);
1354: }
1355:
1356:
1357:
1358:
1359: LOCAL putmem(p, class, offset)
1360: expptr p;
1361: int class;
1362: ftnint offset;
1363: {
1364: int type2;
1365: int funct;
1366: char *name, *memname();
1367:
1368: funct = (p->headblock.vclass==CLPROC ? PCCTM_FTN<<2 : 0);
1369: type2 = types2[p->headblock.vtype];
1370: if(p->headblock.vclass == CLPROC)
1371: type2 |= (PCCTM_FTN<<2);
1372: name = memname(p->addrblock.vstg, p->addrblock.memno);
1373: if(class == PCC_ICON)
1374: {
1375: p2triple(PCC_ICON, name[0]!='\0', type2|PCCTM_PTR);
1376: p2word(offset);
1377: if(name[0])
1378: p2name(name);
1379: }
1380: else
1381: {
1382: p2triple(PCC_NAME, offset!=0, type2);
1383: if(offset != 0)
1384: p2word(offset);
1385: p2name(name);
1386: }
1387: }
1388:
1389:
1390:
1391: LOCAL Addrp putcall(p)
1392: register Exprp p;
1393: {
1394: chainp arglist, charsp, cp;
1395: int n, first;
1396: Addrp t;
1397: register expptr q;
1398: Addrp fval, mkargtemp();
1399: int type, type2, ctype, qtype, indir;
1400:
1401: type2 = types2[type = p->vtype];
1402: charsp = NULL;
1403: indir = (p->opcode == OPCCALL);
1404: n = 0;
1405: first = YES;
1406:
1407: if(p->rightp)
1408: {
1409: arglist = p->rightp->listblock.listp;
1410: free( (charptr) (p->rightp) );
1411: }
1412: else
1413: arglist = NULL;
1414:
1415: for(cp = arglist ; cp ; cp = cp->nextp)
1416: {
1417: q = (expptr) cp->datap;
1418: if(indir)
1419: ++n;
1420: else {
1421: q = (expptr) (cp->datap);
1422: if( ISCONST(q) )
1423: {
1424: q = (expptr) putconst(q);
1425: cp->datap = (tagptr) q;
1426: }
1427: if( ISCHAR(q) && q->headblock.vclass!=CLPROC )
1428: {
1429: charsp = hookup(charsp,
1430: mkchain(cpexpr(q->headblock.vleng),
1431: CHNULL));
1432: n += 2;
1433: }
1434: else
1435: n += 1;
1436: }
1437: }
1438:
1439: if(type == TYCHAR)
1440: {
1441: if( ISICON(p->vleng) )
1442: {
1443: fval = mkargtemp(TYCHAR, p->vleng);
1444: n += 2;
1445: }
1446: else {
1447: err("adjustable character function");
1448: return;
1449: }
1450: }
1451: else if( ISCOMPLEX(type) )
1452: {
1453: fval = mkargtemp(type, PNULL);
1454: n += 1;
1455: }
1456: else
1457: fval = NULL;
1458:
1459: ctype = (fval ? PCCT_INT : type2);
1460: putaddr(p->leftp, NO);
1461:
1462: if(fval)
1463: {
1464: first = NO;
1465: putaddr( cpexpr(fval), NO);
1466: if(type==TYCHAR)
1467: {
1468: putx( mkconv(TYLENG,p->vleng) );
1469: p2op(PCC_CM, type2);
1470: }
1471: }
1472:
1473: for(cp = arglist ; cp ; cp = cp->nextp)
1474: {
1475: q = (expptr) (cp->datap);
1476: if(q->tag==TADDR && (indir || q->addrblock.vstg!=STGREG) )
1477: putaddr(q, indir && q->addrblock.vtype!=TYCHAR);
1478: else if( ISCOMPLEX(q->headblock.vtype) )
1479: putcxop(q);
1480: else if (ISCHAR(q) )
1481: putchop(q);
1482: else if( ! ISERROR(q) )
1483: {
1484: if(indir)
1485: putx(q);
1486: else {
1487: t = mkargtemp(qtype = q->headblock.vtype,
1488: q->headblock.vleng);
1489: putassign( cpexpr(t), q );
1490: putaddr(t, NO);
1491: putcomma(1, qtype, YES);
1492: }
1493: }
1494: if(first)
1495: first = NO;
1496: else
1497: p2op(PCC_CM, type2);
1498: }
1499:
1500: if(arglist)
1501: frchain(&arglist);
1502: for(cp = charsp ; cp ; cp = cp->nextp)
1503: {
1504: putx( mkconv(TYLENG,cp->datap) );
1505: p2op(PCC_CM, type2);
1506: }
1507: frchain(&charsp);
1508: p2op(n>0 ? PCC_CALL : PCC_UCALL , ctype);
1509: free( (charptr) p );
1510: return(fval);
1511: }
1512:
1513:
1514:
1515: LOCAL putmnmx(p)
1516: register expptr p;
1517: {
1518: int op, type;
1519: int ncomma;
1520: expptr qp;
1521: chainp p0, p1;
1522: Addrp sp, tp;
1523:
1524: if(p->tag != TEXPR)
1525: badtag("putmnmx", p->tag);
1526:
1527: type = p->exprblock.vtype;
1528: op = (p->exprblock.opcode==OPMIN ? OPLT : OPGT );
1529: p0 = p->exprblock.leftp->listblock.listp;
1530: free( (charptr) (p->exprblock.leftp) );
1531: free( (charptr) p );
1532:
1533: sp = mkaltemp(type, PNULL);
1534: tp = mkaltemp(type, PNULL);
1535: qp = mkexpr(OPCOLON, cpexpr(tp), cpexpr(sp));
1536: qp = mkexpr(OPQUEST, mkexpr(op, cpexpr(tp),cpexpr(sp)), qp);
1537: qp = fixexpr(qp);
1538:
1539: ncomma = 1;
1540: putassign( cpexpr(sp), p0->datap );
1541:
1542: for(p1 = p0->nextp ; p1 ; p1 = p1->nextp)
1543: {
1544: ++ncomma;
1545: putassign( cpexpr(tp), p1->datap );
1546: if(p1->nextp)
1547: {
1548: ++ncomma;
1549: putassign( cpexpr(sp), cpexpr(qp) );
1550: }
1551: else
1552: putx(qp);
1553: }
1554:
1555: putcomma(ncomma, type, NO);
1556: frexpr(sp);
1557: frexpr(tp);
1558: frchain( &p0 );
1559: }
1560:
1561:
1562:
1563:
1564: LOCAL putcomma(n, type, indir)
1565: int n, type, indir;
1566: {
1567: type = types2[type];
1568: if(indir)
1569: type |= PCCTM_PTR;
1570: while(--n >= 0)
1571: p2op(PCC_COMOP, type);
1572: }
1573:
1574:
1575:
1576:
1577: ftnint simoffset(p0)
1578: expptr *p0;
1579: {
1580: ftnint offset, prod;
1581: register expptr p, lp, rp;
1582:
1583: offset = 0;
1584: p = *p0;
1585: if(p == NULL)
1586: return(0);
1587:
1588: if( ! ISINT(p->headblock.vtype) )
1589: return(0);
1590:
1591: if(p->tag==TEXPR && p->exprblock.opcode==OPSTAR)
1592: {
1593: lp = p->exprblock.leftp;
1594: rp = p->exprblock.rightp;
1595: if(ISICON(rp) && lp->tag==TEXPR &&
1596: lp->exprblock.opcode==OPPLUS && ISICON(lp->exprblock.rightp))
1597: {
1598: p->exprblock.opcode = OPPLUS;
1599: lp->exprblock.opcode = OPSTAR;
1600: prod = rp->constblock.const.ci *
1601: lp->exprblock.rightp->constblock.const.ci;
1602: lp->exprblock.rightp->constblock.const.ci = rp->constblock.const.ci;
1603: rp->constblock.const.ci = prod;
1604: }
1605: }
1606:
1607: if(p->tag==TEXPR && p->exprblock.opcode==OPPLUS &&
1608: ISICON(p->exprblock.rightp))
1609: {
1610: rp = p->exprblock.rightp;
1611: lp = p->exprblock.leftp;
1612: offset += rp->constblock.const.ci;
1613: frexpr(rp);
1614: free( (charptr) p );
1615: *p0 = lp;
1616: }
1617:
1618: if( ISCONST(p) )
1619: {
1620: offset += p->constblock.const.ci;
1621: frexpr(p);
1622: *p0 = NULL;
1623: }
1624:
1625: return(offset);
1626: }
1627:
1628:
1629:
1630:
1631:
1632: p2op(op, type)
1633: int op, type;
1634: {
1635: p2triple(op, 0, type);
1636: }
1637:
1638: p2icon(offset, type)
1639: ftnint offset;
1640: int type;
1641: {
1642: p2triple(PCC_ICON, 0, type);
1643: p2word(offset);
1644: }
1645:
1646:
1647:
1648:
1649: p2oreg(offset, reg, type)
1650: ftnint offset;
1651: int reg, type;
1652: {
1653: p2triple(PCC_OREG, reg, type);
1654: p2word(offset);
1655: p2name("");
1656: }
1657:
1658:
1659:
1660:
1661: p2reg(reg, type)
1662: int reg, type;
1663: {
1664: p2triple(PCC_REG, reg, type);
1665: }
1666:
1667:
1668:
1669: p2pi(s, i)
1670: char *s;
1671: int i;
1672: {
1673: char buff[100];
1674: sprintf(buff, s, i);
1675: p2pass(buff);
1676: }
1677:
1678:
1679:
1680: p2pij(s, i, j)
1681: char *s;
1682: int i, j;
1683: {
1684: char buff[100];
1685: sprintf(buff, s, i, j);
1686: p2pass(buff);
1687: }
1688:
1689:
1690:
1691:
1692: p2ps(s, t)
1693: char *s, *t;
1694: {
1695: char buff[100];
1696: sprintf(buff, s, t);
1697: p2pass(buff);
1698: }
1699:
1700:
1701:
1702:
1703: p2pass(s)
1704: char *s;
1705: {
1706: p2triple(PCCF_FTEXT, (strlen(s) + FOUR-1)/FOUR, 0);
1707: p2str(s);
1708: }
1709:
1710:
1711:
1712:
1713: p2str(s)
1714: register char *s;
1715: {
1716: union { long int word; char str[FOUR]; } u;
1717: register int i;
1718:
1719: i = 0;
1720: u.word = 0;
1721: while(*s)
1722: {
1723: u.str[i++] = *s++;
1724: if(i == FOUR)
1725: {
1726: p2word(u.word);
1727: u.word = 0;
1728: i = 0;
1729: }
1730: }
1731: if(i > 0)
1732: p2word(u.word);
1733: }
1734:
1735:
1736:
1737:
1738: p2triple(op, var, type)
1739: int op, var, type;
1740: {
1741: register long word;
1742: word = PCCM_TRIPLE(op, var, type);
1743: p2word(word);
1744: }
1745:
1746:
1747:
1748:
1749:
1750: p2name(s)
1751: register char *s;
1752: {
1753: register int i;
1754:
1755: #ifdef UCBPASS2
1756: /* arbitrary length names, terminated by a null,
1757: padded to a full word */
1758:
1759: # define WL sizeof(long int)
1760: union { long int word; char str[WL]; } w;
1761:
1762: w.word = 0;
1763: i = 0;
1764: while(w.str[i++] = *s++)
1765: if(i == WL)
1766: {
1767: p2word(w.word);
1768: w.word = 0;
1769: i = 0;
1770: }
1771: if(i > 0)
1772: p2word(w.word);
1773: #else
1774: /* standard intermediate, names are 8 characters long */
1775:
1776: union { long int word[2]; char str[8]; } u;
1777:
1778: u.word[0] = u.word[1] = 0;
1779: for(i = 0 ; i<8 && *s ; ++i)
1780: u.str[i] = *s++;
1781: p2word(u.word[0]);
1782: p2word(u.word[1]);
1783:
1784: #endif
1785:
1786: }
1787:
1788:
1789:
1790:
1791: p2word(w)
1792: long int w;
1793: {
1794: *p2bufp++ = w;
1795: if(p2bufp >= p2bufend)
1796: p2flush();
1797: }
1798:
1799:
1800:
1801: p2flush()
1802: {
1803: if(p2bufp > p2buff)
1804: write(fileno(textfile), p2buff, (p2bufp-p2buff)*sizeof(long int));
1805: p2bufp = p2buff;
1806: }
1807:
1808:
1809:
1810: LOCAL
1811: p2ldisp(offset, vname, type)
1812: ftnint offset;
1813: char *vname;
1814: int type;
1815: {
1816: char buff[100];
1817:
1818: sprintf(buff, "%s-v.%d", vname, bsslabel);
1819: p2triple(PCC_OREG, 11, type);
1820: p2word(offset);
1821: p2name(buff);
1822: }
1823:
1824:
1825:
1826: p2ndisp(vname)
1827: char *vname;
1828: {
1829: char buff[100];
1830:
1831: sprintf(buff, "%s-v.%d", vname, bsslabel);
1832: p2name(buff);
1833: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.