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