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