Quick Search:

View

Revision:
Expand:  
Changeset: MAIN:ragge:20030729092018

Diff

Diff from 1.25 to:

Annotations

Annotate by Age | Author | Mixed | None
/fisheye/browse/pcc/pcc/mip/reader.c

Annotated File View

ragge
1.2
1 #if 0
ragge
1.1
2 static char *sccsid ="@(#)reader.c      4.8 (Berkeley) 12/10/87";
ragge
1.2
3 #endif
ragge
1.1
4
5 # include "pass2.h"
6
7 /*      some storage declarations */
8
9 int nrecur;
10 int lflag;
11 extern int Wflag;
ragge
1.9
12 int x2debug;
ragge
1.1
13 int udebug = 0;
14 int vdebug = 0;
15
16 OFFSZ tmpoff;  /* offset for first temporary, in bits for current block */
17 OFFSZ maxoff;  /* maximum temporary offset over all blocks in current ftn, in bits */
18 int maxtreg;
19
20 NODE *stotree;
21 int stocook;
22
23 OFFSZ baseoff = 0;
24 OFFSZ maxtemp = 0;
25
ragge
1.23
26 static struct templst {
27         struct templst *next;
28         int tempnr;
29         int tempoff;
30 } *templst;
31
ragge
1.10
32 int e2print(NODE *pint downint *aint *b);
ragge
1.23
33 static void splitline(NODE *);
ragge
1.8
34
ragge
1.17
35 static void
ragge
1.25
36 opchk(NODE *p)
37 {
38         int o = p->n_op;
39
40         if (o == ANDAND || o == OROR || o == COMOP || o == COLON ||
41             o == QUEST)
42                 cerror("op %s slipped through"opst[o]);
43 }
44
45 static void
ragge
1.2
46 p2compile(NODE *p)
47 {
ragge
1.15
48 #if !defined(MULTIPASS)
49         extern char *ftitle;
50 #endif
ragge
1.1
51
ragge
1.14
52         if (lflag)
53                 lineid(linenoftitle);
54
ragge
1.1
55         /* generate code for the tree p */
56 # ifndef BUG4
ragge
1.8
57         if (e2debugfwalkpe2print0 );
ragge
1.1
58 # endif
59
ragge
1.25
60 walkf(popchk);
61
ragge
1.1
62 # ifdef MYREADER
63         MYREADER(p);  /* do your own laundering of the input */
64 # endif
65         nrecur = 0;
ragge
1.25
66         codgen(pFOREFF);
ragge
1.1
67         reclaimpRNULL0 );
68         allchk();
69         /* can't do tcheck here; some stuff (e.g., attributes) may be around from first pass */
70         /* first pass will do it... */
ragge
1.2
71 }
ragge
1.1
72
ragge
1.17
73 static void newblock(int myregint aoff);
74 static void epilogue(int regsint autosint retlab);
75
ragge
1.2
76 void
ragge
1.17
77 pass2_compile(struct interpass *ip)
78 {
79         switch (ip->type) {
80         case IP_NODE:
81                 p2compile(ip->ip_node);
ragge
1.21
82                 tfree(ip->ip_node);
ragge
1.17
83                 break;
84         case IP_PROLOG:
85                 prologue(ip->ip_regsip->ip_auto);
86                 break;
87         case IP_NEWBLK:
88                 newblock(ip->ip_regsip->ip_auto);
89                 break;
90         case IP_EPILOG:
91                 epilogue(ip->ip_regsip->ip_autoip->ip_retl);
ragge
1.18
92                 break;
93         case IP_LOCCTR:
94                 setlocc(ip->ip_locc);
95                 break;
96         case IP_DEFLAB:
97                 deflab(ip->ip_lbl);
98                 break;
99         case IP_DEFNAM:
100                 defname(ip->ip_nameip->ip_vis);
101                 break;
ragge
1.17
102         default:
103                 cerror("pass2_compile %d"ip->type);
104         }
105 }
106
107 static void
ragge
1.16
108 newblock(int myregint aoff)
ragge
1.2
109 {
ragge
1.1
110         static int myftn = -1;
111
112         tmpoff = baseoff = (unsigned intaoff;
113         maxtreg = myreg;
114         ifmyftn != ftnno ){ /* beginning of function */
115                 maxoff = baseoff;
116                 myftn = ftnno;
117                 maxtemp = 0;
118                 }
119         else {
120                 ifbaseoff > maxoff ) maxoff = baseoff;
121                 /* maxoff at end of ftn is max of autos and temps over all blocks */
122                 }
123         setregs();
ragge
1.2
124 }
ragge
1.1
125
ragge
1.17
126 static void
ragge
1.16
127 epilogue(int regsint autosint retlab)
ragge
1.2
128 {
ragge
1.16
129         SETOFF(maxoffALSTACK);
ragge
1.23
130         templst = NULL;
ragge
1.16
131         eoftn(regsautosretlab);
ragge
1.2
132 }
ragge
1.1
133
ragge
1.25
134 #if 0
ragge
1.1
135 NODE *deltrees[DELAYS];
136 int deli;
137
ragge
1.23
138 void xtrcomop(NODE *p);
139 NODE *saveq[100];
140 int nsaveq = 0;
141
142 void
143 splitline(NODE *p)
144 {
145         int i;
146
147         nsaveq = 0;
148
149         for (i = 0i < nsaveqi++)
150                 codgen(saveq[i], FOREFF);
151         codgen(pFOREFF);
152 }
153
ragge
1.2
154 /*
155  * look in all legal places for COMOP's and ++ and -- ops to delay
156  * note; don't delay ++ and -- within calls or things like
157  * getchar (in their macro forms) will start behaving strangely
158  */
159 void
160 delay(NODE *p)
161 {
162         int i;
ragge
1.1
163
164         /* look for visible COMOPS, and rewrite repeatedly */
165
ragge
1.2
166         while (delay1(p))
167                 ;
ragge
1.1
168
169         /* look for visible, delayable ++ and -- */
170
171         deli = 0;
172         delay2p );
173         codgenpFOREFF );  /* do what is left */
ragge
1.2
174         fori = 0i<deli; ++i )
175                 codgendeltrees[i], FOREFF );  /* do the rest */
176 }
177
178 /*
179  * look for COMOPS
180  */
181 int
182 delay1(NODE *p)
183 {
184         int oty;
ragge
1.1
185
ragge
1.13
186         o = p->n_op;
ragge
1.1
187         ty = optypeo );
188         ifty == LTYPE ) return0 );
ragge
1.13
189         else ifty == UTYPE ) returndelay1p->n_left ) );
ragge
1.1
190
191         switcho ){
192
193         case QUEST:
194         case ANDAND:
195         case OROR:
196                 /* don't look on RHS */
ragge
1.13
197                 returndelay1(p->n_left ) );
ragge
1.1
198
199         case COMOP:  /* the meat of the routine */
ragge
1.13
200                 delayp->n_left );  /* completely evaluate the LHS */
ragge
1.1
201                 /* rewrite the COMOP */
202                 { register NODE *q;
ragge
1.13
203                         q = p->n_right;
204                         ncopypp->n_right );
ragge
1.19
205                         nfree(q);
206                 }
ragge
1.1
207                 return1 );
ragge
1.2
208         }
ragge
1.1
209
ragge
1.13
210         returndelay1(p->n_left) || delay1(p->n_right ) );
ragge
1.2
211 }
ragge
1.1
212
ragge
1.2
213 void
214 delay2(NODE *p)
215 {
ragge
1.1
216
217         /* look for delayable ++ and -- operators */
218
ragge
1.2
219         int oty;
ragge
1.13
220         o = p->n_op;
ragge
1.1
221         ty = optypeo );
222
223         switcho ){
224
225         case NOT:
226         case QUEST:
227         case ANDAND:
228         case OROR:
229         case CALL:
230         case UNARY CALL:
231         case STCALL:
232         case UNARY STCALL:
233         case FORTCALL:
234         case UNARY FORTCALL:
235         case COMOP:
236         case CBRANCH:
237                 /* for the moment, don't delay past a conditional context, or
ragge
1.2
238                  * inside of a call */
ragge
1.1
239                 return;
240
241         case UNARY MUL:
242                 /* if *p++, do not rewrite */
243                 ifautoincrp ) ) return;
244                 break;
245
246         case INCR:
247         case DECR:
248                 ifdeltestp ) ){
249                         ifdeli < DELAYS ){
250                                 register NODE *q;
251                                 deltrees[deli++] = tcopy(p);
ragge
1.13
252                                 q = p->n_left;
ragge
1.19
253                                 nfree(p->n_right);  /* zap constant */
ragge
1.1
254                                 ncopypq );
ragge
1.19
255                                 nfree(q);
ragge
1.1
256                                 return;
257                                 }
258                         }
259
260                 }
261
ragge
1.13
262         ifty == BITYPE ) delay2p->n_right );
263         ifty != LTYPE ) delay2p->n_left );
ragge
1.2
264 }
ragge
1.25
265 #endif
ragge
1.1
266
ragge
1.2
267 /*
268  * generate the code for p;
269  * order may call codgen recursively
270  * cookie is used to describe the context
271  */
272 void
273 codgen(NODE *pint cookie)
274 {
ragge
1.1
275
ragge
1.8
276         for (;;) {
ragge
1.1
277                 canon(p);  /* creats OREG from * if possible and does sucomp */
278                 stotree = NIL;
279 # ifndef BUG4
ragge
1.8
280                 if (e2debug) {
281                         printf("store called on:\n");
282                         fwalk(pe2print0);
283                 }
ragge
1.1
284 # endif
285                 store(p);
286                 ifstotree==NIL ) break;
287
288                 /* because it's minimal, can do w.o. stores */
289
290                 orderstotreestocook );
ragge
1.2
291         }
ragge
1.1
292         orderpcookie );
ragge
1.2
293 }
ragge
1.1
294
295 # ifndef BUG4
296 char *cnames[] = {
297         "SANY",
298         "SAREG",
299         "STAREG",
300         "SBREG",
301         "STBREG",
302         "SCC",
303         "SNAME",
304         "SCON",
305         "SFLD",
306         "SOREG",
307 # ifdef WCARD1
308         "WCARD1",
309 # else
310         "STARNM",
311 # endif
312 # ifdef WCARD2
313         "WCARD2",
314 # else
315         "STARREG",
316 # endif
317         "INTEMP",
318         "FORARG",
319         "SWADD",
320         0,
321         };
322
ragge
1.2
323 /*
324  * print a nice-looking description of cookie
325  */
326 void
327 prcook(int cookie)
328 {
ragge
1.1
329         int iflag;
330
331         ifcookie & SPECIAL ){
332                 ifcookie == SZERO ) printf"SZERO" );
333                 else ifcookie == SONE ) printf"SONE" );
334                 else ifcookie == SMONE ) printf"SMONE" );
335                 else ifcookie == SCCON ) printf"SCCON" );
336                 else ifcookie == SSCON ) printf"SSCON" );
337                 else ifcookie == SSOREG ) printf"SSOREG" );
338                 else printf"SPECIAL+%d"cookie & ~SPECIAL );
339                 return;
340                 }
341
342         flag = 0;
343         fori=0cnames[i]; ++i ){
344                 ifcookie & (1<<i) ){
345                         ifflag ) printf"|" );
346                         ++flag;
347                         printfcnames[i] );
348                         }
349                 }
350
ragge
1.2
351 }
ragge
1.1
352 # endif
353
354 int odebug = 0;
355
ragge
1.2
356 void
357 order(NODE *pint cook)
358 {
359         int otym;
ragge
1.1
360         int m1;
361         int cookie;
ragge
1.2
362         NODE *p1, *p2;
ragge
1.1
363
364         cookie = cook;
365         rcount();
366         canon(p);
ragge
1.13
367         rallo(pp->n_rall);
ragge
1.1
368         goto first;
369
ragge
1.8
370
371         /*
372          * by this time, p should be able to be generated without stores;
373          * the only question is how
374          */
ragge
1.1
375         again:
376
ragge
1.13
377         if (p->n_op == FREE)
ragge
1.19
378                 cerror("order");        /* whole tree was done */
ragge
1.1
379         cookie = cook;
380         rcount();
381         canon(p);
ragge
1.13
382         rallo(pp->n_rall);
ragge
1.8
383         /*
384          * if any rewriting and canonicalization has put
ragge
1.1
385          * the tree (p) into a shape that cook is happy
386          * with (exclusive of FOREFF, FORREW, and INTEMP)
387          * then we are done.
388          * this allows us to call order with shapes in
389          * addition to cookies and stop short if possible.
390          */
ragge
1.8
391         if (tshape(pcook &(~(FOREFF|FORREW|INTEMP))))
392                 return;
ragge
1.1
393
394         first:
395 # ifndef BUG4
ragge
1.8
396         if (odebug) {
397                 printf("order(%p, "p);
398                 prcook(cookie);
399                 printf(")\n");
400                 fwalk(pe2print0);
401         }
ragge
1.1
402 # endif
403
ragge
1.13
404         o = p->n_op;
ragge
1.1
405         ty = optype(o);
406
407         /* first of all, for most ops, see if it is in the table */
408
409         /* look for ops */
410
ragge
1.13
411         switch (m = p->n_op) {
ragge
1.1
412
413         default:
414                 /* look for op in table */
ragge
1.8
415                 for (;;) {
416                         if ((m = match(pcookie)) == MDONE)
417                                 goto cleanup;
418                         else if (m == MNOPE) {
419                                 if (!(cookie = nextcook(pcookie)))
420                                         goto nomat;
ragge
1.1
421                                 continue;
ragge
1.8
422                         } else
423                                 break;
424                 }
ragge
1.1
425                 break;
426
427         case COMOP:
428         case FORCE:
429         case CBRANCH:
430         case QUEST:
431         case ANDAND:
432         case OROR:
433         case NOT:
434         case UNARY CALL:
435         case CALL:
436         case UNARY STCALL:
437         case STCALL:
438         case UNARY FORTCALL:
439         case FORTCALL:
440                 /* don't even go near the table... */
441                 ;
442
ragge
1.8
443         }
ragge
1.25
444         /*
ragge
1.8
445          * get here to do rewriting if no match or
446          * fall through from above for hard ops
447          */
ragge
1.1
448
ragge
1.13
449         p1 = p->n_left;
ragge
1.8
450         if (ty == BITYPE)
ragge
1.13
451                 p2 = p->n_right;
ragge
1.8
452         else
453                 p2 = NIL;
ragge
1.1
454         
455 # ifndef BUG4
ragge
1.8
456         if (odebug) {
457                 printf("order(%p, "p);
458                 prcook(cook);
459                 printf("), cookie ");
460                 prcook(cookie);
461                 printf(", rewrite %s\n"opst[m]);
462         }
ragge
1.1
463 # endif
ragge
1.8
464         switch (m) {
ragge
1.1
465         default:
466                 nomat:
ragge
1.13
467                 cerror"no table entry for op %s"opst[p->n_op] );
ragge
1.1
468
469         case COMOP:
470                 codgenp1FOREFF );
ragge
1.13
471                 p2->n_rall = p->n_rall;
ragge
1.1
472                 codgenp2cookie );
473                 ncopypp2 );
ragge
1.19
474                 nfree(p2);
ragge
1.1
475                 goto cleanup;
476
477         case FORCE:
478                 /* recurse, letting the work be done by rallo */
479                 cook = INTAREG|INTBREG;
ragge
1.19
480                 order(p->n_leftcook);
481                 reclaim(pRLEFTcook);
ragge
1.1
482                 goto again;
483
484         case CBRANCH:
ragge
1.13
485                 o = p2->n_lval;
ragge
1.1
486                 cbranchp1, -1o );
ragge
1.19
487                 nfree(p2);
488                 nfree(p);
ragge
1.1
489                 return;
490
491         case QUEST:
492                 cbranchp1, -1m=getlab() );
ragge
1.13
493                 p2->n_left->n_rall = p->n_rall;
494                 codgenp2->n_leftINTAREG|INTBREG );
ragge
1.1
495                 /* force right to compute result into same reg used by left */
ragge
1.13
496                 p2->n_right->n_rall = p2->n_left->n_rval|MUSTDO;
497                 reclaimp2->n_leftRNULL0 );
ragge
1.1
498                 cbgen0m1 = getlab(), 'I' );
499                 deflabm );
ragge
1.13
500                 codgenp2->n_rightINTAREG|INTBREG );
ragge
1.1
501                 deflabm1 );
ragge
1.13
502                 p->n_op = REG;  /* set up node describing result */
503                 p->n_lval = 0;
504                 p->n_rval = p2->n_right->n_rval;
505                 p->n_type = p2->n_right->n_type;
506                 tfreep2->n_right );
ragge
1.19
507                 nfree(p2);
ragge
1.1
508                 goto cleanup;
509
510         case ANDAND:
511         case OROR:
512         case NOT:  /* logical operators */
513                 /* if here, must be a logical operator for 0-1 value */
ragge
1.20
514                 p1 = talloc();
515                 *p1 = *p;       /* hack to avoid clobber in reclaim() */
516                 cbranchp1, -1m=getlab() );
ragge
1.13
517                 p->n_op = CCODES;
518                 p->n_label = m;
ragge
1.1
519                 orderpINTAREG );
520                 goto cleanup;
521
522         case FLD:       /* fields of funny type */
ragge
1.13
523                 if ( p1->n_op == UNARY MUL ){
524                         offstarp1->n_left );
ragge
1.1
525                         goto again;
526                         }
527
528         case UNARY MINUS:
529                 orderp1INBREG|INAREG|SOREG );
530                 goto again;
531
532         case NAME:
533                 /* all leaves end up here ... */
534                 ifo == REG ) goto nomat;
535                 orderpINTAREG|INTBREG );
536                 goto again;
537
538         case INIT:
ragge
1.12
539                 uerror("init: illegal initialization");
ragge
1.1
540                 return;
541
542         case UNARY FORTCALL:
ragge
1.13
543                 p->n_right = NIL;
ragge
1.1
544         case FORTCALL:
ragge
1.13
545                 o = p->n_op = UNARY FORTCALL;
ragge
1.1
546                 ifgenfcallpcookie ) ) goto nomat;
547                 goto cleanup;
548
549         case UNARY CALL:
ragge
1.13
550                 p->n_right = NIL;
ragge
1.1
551         case CALL:
ragge
1.13
552                 o = p->n_op = UNARY CALL;
ragge
1.1
553                 ifgencallpcookie ) ) goto nomat;
554                 goto cleanup;
555
556         case UNARY STCALL:
ragge
1.13
557                 p->n_right = NIL;
ragge
1.1
558         case STCALL:
ragge
1.13
559                 o = p->n_op = UNARY STCALL;
ragge
1.1
560                 ifgenscallpcookie ) ) goto nomat;
561                 goto cleanup;
562
563                 /* if arguments are passed in register, care must be taken that reclaim
ragge
1.2
564                  * not throw away the register which now has the result... */
ragge
1.1
565
566         case UNARY MUL:
567                 ifcook == FOREFF ){
568                         /* do nothing */
ragge
1.13
569                         orderp->n_leftFOREFF );
ragge
1.19
570                         nfree(p);
ragge
1.1
571                         return;
ragge
1.19
572                 }
ragge
1.1
573 #ifdef R2REGS
574                 /* try to coax a tree into a doubly indexed OREG */
ragge
1.13
575                 p1 = p->n_left;
576                 ifp1->n_op == PLUS ) {
577                         ifISPTR(p1->n_left->n_type) &&
578                             offset(p1->n_righttlen(p)) >= 0 ) {
579                                 orderp1->n_leftINAREG|INTAREG );
ragge
1.1
580                                 goto again;
581                                 }
ragge
1.13
582                         ifISPTR(p1->n_right->n_type) &&
583                             offset(p1->n_lefttlen(p)) >= 0 ) {
584                                 orderp1->n_rightINAREG|INTAREG );
ragge
1.1
585                                 goto again;
586                                 }
587                         }
588 #endif
ragge
1.13
589                 offstarp->n_left );
ragge
1.1
590                 goto again;
591
592         case INCR:  /* INCR and DECR */
593                 ifsetincr(p) ) goto again;
594
595                 /* x++ becomes (x += 1) -1; */
596
597                 ifcook & FOREFF ){  /* result not needed so inc or dec and be done with it */
598                         /* x++ => x += 1 */
ragge
1.13
599                         p->n_op = (p->n_op==INCR)?ASG PLUS:ASG MINUS;
ragge
1.1
600                         goto again;
601                         }
602
603                 p1 = tcopy(p);
ragge
1.13
604                 reclaimp->n_leftRNULL0 );
605                 p->n_left = p1;
606                 p1->n_op = (p->n_op==INCR)?ASG PLUS:ASG MINUS;
607                 p->n_op = (p->n_op==INCR)?MINUS:PLUS;
ragge
1.1
608                 goto again;
609
610         case STASG:
611                 ifsetstrp ) ) goto again;
612                 goto nomat;
613
614         case ASG PLUS:  /* and other assignment ops */
615                 ifsetasop(p) ) goto again;
616
617                 /* there are assumed to be no side effects in LHS */
618
619                 p2 = tcopy(p);
ragge
1.13
620                 p->n_op = ASSIGN;
621                 reclaimp->n_rightRNULL0 );
622                 p->n_right = p2;
ragge
1.1
623                 canon(p);
ragge
1.13
624                 rallopp->n_rall );
ragge
1.1
625
626 # ifndef BUG4
ragge
1.8
627                 ifodebug ) fwalkpe2print0 );
ragge
1.1
628 # endif
629
ragge
1.13
630                 orderp2->n_leftINTBREG|INTAREG );
ragge
1.1
631                 orderp2INTBREG|INTAREG );
632                 goto again;
633
634         case ASSIGN:
ragge
1.8
635                 if (setasg(p))
636                         goto again;
ragge
1.1
637                 goto nomat;
638
639
640         case BITYPE:
641                 ifsetbinp ) ) goto again;
642                 /* try to replace binary ops by =ops */
643                 switch(o){
644
645                 case PLUS:
646                 case MINUS:
647                 case MUL:
648                 case DIV:
649                 case MOD:
650                 case AND:
651                 case OR:
652                 case ER:
653                 case LS:
654                 case RS:
ragge
1.13
655                         p->n_op = ASG o;
ragge
1.1
656                         goto again;
657                         }
658                 goto nomat;
659
660                 }
661
662         cleanup:
663
664         /* if it is not yet in the right state, put it there */
665
666         ifcook & FOREFF ){
667                 reclaimpRNULL0 );
668                 return;
669                 }
670
ragge
1.13
671         ifp->n_op==FREE ) return;
ragge
1.1
672
673         iftshapepcook ) ) return;
674
675         if( (m=match(p,cook) ) == MDONE ) return;
676
677         /* we are in bad shape, try one last chance */
ragge
1.8
678         if (lastchance(pcook))
679                 goto again;
ragge
1.1
680
681         goto nomat;
ragge
1.8
682 }
ragge
1.1
683
684 int callflag;
685 int fregs;
686
ragge
1.2
687 void
688 storep ) NODE *p; {
ragge
1.1
689
690         /* find a subtree of p which should be stored */
691
ragge
1.2
692         int oty;
ragge
1.1
693
ragge
1.13
694         o = p->n_op;
ragge
1.1
695         ty = optype(o);
696
697         ifty == LTYPE ) return;
698
699         switcho ){
700
701         case UNARY CALL:
702         case UNARY FORTCALL:
703         case UNARY STCALL:
704                 ++callflag;
705                 break;
706
707         case UNARY MUL:
ragge
1.13
708                 if (asgop(p->n_left->n_op))
709                         stoasg(p->n_leftUNARY MUL);
ragge
1.1
710                 break;
711
712         case CALL:
713         case FORTCALL:
714         case STCALL:
ragge
1.13
715                 storep->n_left );
716                 stoargp->n_righto );
ragge
1.1
717                 ++callflag;
718                 return;
719
720         case COMOP:
ragge
1.13
721                 markcallp->n_right );
722                 ifp->n_right->n_su > fregs ) SETSTOpINTEMP );
723                 storep->n_left );
ragge
1.1
724                 return;
725
726         case ANDAND:
727         case OROR:
728         case QUEST:
ragge
1.13
729                 markcallp->n_right );
730                 ifp->n_right->n_su > fregs ) SETSTOpINTEMP );
ragge
1.1
731         case CBRANCH:   /* to prevent complicated expressions on the LHS from being stored */
732         case NOT:
ragge
1.13
733                 constorep->n_left );
ragge
1.1
734                 return;
735
736                 }
737
ragge
1.11
738         if (ty == UTYPE) {
ragge
1.13
739                 store(p->n_left);
ragge
1.1
740                 return;
ragge
1.11
741         }
ragge
1.1
742
ragge
1.13
743         if (asgop(p->n_right->n_op))
744                 stoasg(p->n_righto);
ragge
1.1
745
ragge
1.13
746         ifp->n_su>fregs ){ /* must store */
ragge
1.1
747                 mkadrsp );  /* set up stotree and stocook to subtree
748                                  that must be stored */
749                 }
750
ragge
1.13
751         storep->n_right );
752         storep->n_left );
ragge
1.1
753         }
754
ragge
1.2
755 /*
756  * store conditional expressions
757  * the point is, avoid storing expressions in conditional
758  * conditional context, since the evaluation order is predetermined
759  */
760 void
761 constore(NODE *p)
762 {
ragge
1.13
763         switchp->n_op ) {
ragge
1.1
764
765         case ANDAND:
766         case OROR:
767         case QUEST:
ragge
1.13
768                 markcallp->n_right );
ragge
1.1
769         case NOT:
ragge
1.13
770                 constorep->n_left );
ragge
1.1
771                 return;
772
773                 }
774
775         storep );
ragge
1.2
776 }
ragge
1.1
777
ragge
1.2
778 /* mark off calls below the current node */
779 void
780 markcall(NODE *p)
781 {
ragge
1.1
782
783         again:
ragge
1.13
784         switchp->n_op ){
ragge
1.1
785
786         case UNARY CALL:
787         case UNARY STCALL:
788         case UNARY FORTCALL:
789         case CALL:
790         case STCALL:
791         case FORTCALL:
792                 ++callflag;
793                 return;
794
795                 }
796
ragge
1.13
797         switchoptypep->n_op ) ){
ragge
1.1
798
799         case BITYPE:
ragge
1.13
800                 markcallp->n_right );
ragge
1.1
801         case UTYPE:
ragge
1.13
802                 p = p->n_left;
ragge
1.1
803                 /* eliminate recursion (aren't I clever...) */
804                 goto again;
805         case LTYPE:
806                 return;
807                 }
808
ragge
1.2
809 }
ragge
1.1
810
ragge
1.2
811 void
812 stoarg(NODE *pint calltype)
813 {
ragge
1.1
814         /* arrange to store the args */
ragge
1.13
815         ifp->n_op == CM ){
816                 stoargp->n_leftcalltype );
817                 p = p->n_right ;
ragge
1.1
818                 }
819         ifcalltype == CALL ){
820                 STOARG(p);
821                 }
822         else ifcalltype == STCALL ){
823                 STOSTARG(p);
824                 }
825         else {
826                 STOFARG(p);
827                 }
828         callflag = 0;
829         store(p);
830 # ifndef NESTCALLS
831         ifcallflag ){ /* prevent two calls from being active at once  */
832                 SETSTO(p,INTEMP);
833                 store(p); /* do again to preserve bottom up nature....  */
ragge
1.2
834         }
ragge
1.1
835 #endif
ragge
1.2
836 }
ragge
1.1
837
838 int negrel[] = { NEEQGTGELTLEUGTUGEULTULE } ;  /* negatives of relationals */
839
ragge
1.2
840 /*
841  * evaluate p for truth value, and branch to true or false
842  * accordingly: label <0 means fall through
843  */
844
845 void
846 cbranch(NODE *pint trueint false)
847 {
848         int olabflabtlab;
ragge
1.1
849
850         lab = -1;
851
ragge
1.13
852         switcho=p->n_op ){
ragge
1.1
853
854         case ULE:
855         case ULT:
856         case UGE:
857         case UGT:
858         case EQ:
859         case NE:
860         case LE:
861         case LT:
862         case GE:
863         case GT:
864                 iftrue < 0 ){
ragge
1.13
865                         o = p->n_op = negrelo-EQ ];
ragge
1.1
866                         true = false;
867                         false = -1;
868                         }
869 #ifndef NOOPT
ragge
1.13
870                 ifp->n_right->n_op == ICON && p->n_right->n_lval == 0 && p->n_right->n_name[0] == '\0' ){
ragge
1.1
871                         switcho ){
872
873                         case UGT:
874                         case ULE:
ragge
1.13
875                                 o = p->n_op = (o==UGT)?NE:EQ;
ragge
1.1
876                         case EQ:
877                         case NE:
878                         case LE:
879                         case LT:
880                         case GE:
881                         case GT:
ragge
1.13
882                                 iflogop(p->n_left->n_op) ){
ragge
1.1
883                                         /* strange situation: e.g., (a!=0) == 0 */
ragge
1.13
884                                         /* must prevent reference to p->n_left->lable, so get 0/1 */
ragge
1.1
885                                         /* we could optimize, but why bother */
ragge
1.13
886                                         codgenp->n_leftINAREG|INBREG );
ragge
1.1
887                                         }
ragge
1.13
888                                 codgenp->n_leftFORCC );
ragge
1.1
889                                 cbgenotrue'I' );
890                                 break;
891
892                         case UGE:
ragge
1.13
893                                 codgen(p->n_leftFORCC);
ragge
1.1
894                                 cbgen0true'I' );  /* unconditional branch */
895                                 break;
896                         case ULT:
ragge
1.13
897                                 codgen(p->n_leftFORCC);
ragge
1.1
898                                 }
899                         }
900                 else
901 #endif
902                         {
ragge
1.13
903                         p->n_label = true;
ragge
1.1
904                         codgenpFORCC );
905                         }
906                 iffalse>=0 ) cbgen0false'I' );
907                 reclaimpRNULL0 );
908                 return;
909
910         case ANDAND:
911                 lab = false<0 ? getlab() : false ;
ragge
1.13
912                 cbranchp->n_left, -1lab );
913                 cbranchp->n_righttruefalse );
ragge
1.1
914                 iffalse < 0 ) deflablab );
ragge
1.19
915                 nfree(p);
ragge
1.1
916                 return;
917
918         case OROR:
919                 lab = true<0 ? getlab() : true;
ragge
1.13
920                 cbranchp->n_leftlab, -1 );
921                 cbranchp->n_righttruefalse );
ragge
1.1
922                 iftrue < 0 ) deflablab );
ragge
1.19
923                 nfree(p);
ragge
1.1
924                 return;
925
926         case NOT:
ragge
1.13
927                 cbranchp->n_leftfalsetrue );
ragge
1.19
928                 nfree(p);
ragge
1.1
929                 break;
930
931         case COMOP:
ragge
1.13
932                 codgenp->n_leftFOREFF );
ragge
1.19
933                 nfree(p);
ragge
1.13
934                 cbranchp->n_righttruefalse );
ragge
1.1
935                 return;
936
937         case QUEST:
938                 flab = false<0 ? getlab() : false;
939                 tlab = true<0 ? getlab() : true;
ragge
1.13
940                 cbranchp->n_left, -1lab = getlab() );
941                 cbranchp->n_right->n_lefttlabflab );
ragge
1.1
942                 deflablab );
ragge
1.13
943                 cbranchp->n_right->n_righttruefalse );
ragge
1.1
944                 iftrue < 0 ) deflabtlab);
945                 iffalse < 0 ) deflabflab );
ragge
1.19
946                 nfree(p->n_right);
947                 nfree(p);
ragge
1.1
948                 return;
949
950         case ICON:
ragge
1.13
951                 ifp->n_type != FLOAT && p->n_type != DOUBLE ){
ragge
1.1
952
ragge
1.13
953                         ifp->n_lval || p->n_name[0] ){
ragge
1.1
954                                 /* addresses of C objects a