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