![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to exec.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / usr.bin / f77 / src / f77pass1|
Return to exec.c CVS log | Up to [CSRG BSD Unix] / 43BSD / usr.bin / f77 / src / f77pass1 |
1.1 root 1: /*
2: * Copyright (c) 1980 Regents of the University of California.
3: * All rights reserved. The Berkeley software License Agreement
4: * specifies the terms and conditions for redistribution.
5: */
6:
7: #ifndef lint
8: static char sccsid[] = "@(#)exec.c 5.5 (Berkeley) 1/7/86";
9: #endif not lint
10:
11: /*
12: * exec.c
13: *
14: * Routines for handling the semantics of control structures.
15: * F77 compiler, pass 1.
16: *
17: * University of Utah CS Dept modification history:
18: *
19: * $Log: exec.c,v $
20: * Revision 5.6 85/12/20 19:42:46 donn
21: * Change style of error reporting in last fix.
22: *
23: * Revision 5.5 85/12/20 18:54:10 donn
24: * Complain about calls to things which aren't subroutines.
25: *
26: * Revision 5.4 85/12/18 19:57:58 donn
27: * Assignment statements are executable statements -- advance the magic
28: * parser state to forbid DATA statements and statement functions.
29: *
30: * Revision 5.3 85/11/25 00:23:49 donn
31: * 4.3 beta
32: *
33: * Revision 5.2 85/08/10 04:07:36 donn
34: * Changed an error message to correct spelling and be more accurate.
35: * From Jerry Berkman.
36: *
37: * Revision 2.3 85/03/18 08:03:31 donn
38: * Hacks for conversions from type address to numeric type -- prevent addresses
39: * from being stored in shorts and prevent warnings about implicit conversions.
40: *
41: * Revision 2.2 84/09/03 23:18:30 donn
42: * When a DO loop had the same variable as its loop variable and its limit,
43: * the limit temporary was assigned to AFTER the original value of the variable
44: * was destroyed by assigning the initial value to the loop variable. I
45: * swapped the operands of a comparison and changed the direction of the
46: * operator... This only affected programs when optimizing. (This may not
47: * be enough if something alters the order of evaluation of side effects
48: * later on... sigh.)
49: *
50: * Revision 2.1 84/07/19 12:02:53 donn
51: * Changed comment headers for UofU.
52: *
53: * Revision 1.3 84/07/12 18:35:12 donn
54: * Added change to enddo() to detect open 'if' blocks at the ends of loops.
55: *
56: * Revision 1.2 84/06/08 11:22:53 donn
57: * Fixed bug in exdo() -- if a loop parameter contained an instance of the loop
58: * variable and the optimizer was off, the loop variable got converted to
59: * register before the parameters were processed and so the loop parameters
60: * were initialized from garbage in the register instead of the memory version
61: * of the loop variable.
62: *
63: */
64:
65: #include "defs.h"
66: #include "optim.h"
67:
68:
69: /* Logical IF codes
70: */
71:
72:
73: exif(p)
74: expptr p;
75: {
76: register int k;
77: pushctl(CTLIF);
78: ctlstack->elselabel = newlabel();
79:
80: if( ( k = (p = fixtype(p))->headblock.vtype) != TYLOGICAL)
81: {
82: if(k != TYERROR)
83: err("non-logical expression in IF statement");
84: frexpr(p);
85: }
86: else if (optimflag)
87: optbuff (SKIFN, p, ctlstack->elselabel, 0);
88: else
89: putif (p, ctlstack->elselabel);
90: }
91:
92:
93:
94: exelif(p)
95: expptr p;
96: {
97: int k,oldelse;
98:
99: if( ( k = (p = fixtype(p))->headblock.vtype) != TYLOGICAL)
100: {
101: if(k != TYERROR)
102: err("non-logical expression in IF statement");
103: frexpr(p);
104: }
105: else {
106: if(ctlstack->ctltype == CTLIF)
107: {
108: if(ctlstack->endlabel == 0) ctlstack->endlabel = newlabel();
109: oldelse=ctlstack->elselabel;
110: ctlstack->elselabel = newlabel();
111: if (optimflag)
112: {
113: optbuff (SKGOTO, 0, ctlstack->endlabel, 0);
114: optbuff (SKLABEL, 0, oldelse, 0);
115: optbuff (SKIFN, p, ctlstack->elselabel, 0);
116: }
117: else
118: {
119: putgoto (ctlstack->endlabel);
120: putlabel (oldelse);
121: putif (p, ctlstack->elselabel);
122: }
123: }
124: else execerr("elseif out of place", CNULL);
125: }
126: }
127:
128:
129:
130:
131:
132: exelse()
133: {
134: if(ctlstack->ctltype==CTLIF)
135: {
136: if(ctlstack->endlabel == 0)
137: ctlstack->endlabel = newlabel();
138: ctlstack->ctltype = CTLELSE;
139: if (optimflag)
140: {
141: optbuff (SKGOTO, 0, ctlstack->endlabel, 0);
142: optbuff (SKLABEL, 0, ctlstack->elselabel, 0);
143: }
144: else
145: {
146: putgoto (ctlstack->endlabel);
147: putlabel (ctlstack->elselabel);
148: }
149: }
150:
151: else execerr("else out of place", CNULL);
152: }
153:
154:
155: exendif()
156: {
157: if (ctlstack->ctltype == CTLIF)
158: {
159: if (optimflag)
160: {
161: optbuff (SKLABEL, 0, ctlstack->elselabel, 0);
162: if (ctlstack->endlabel)
163: optbuff (SKLABEL, 0, ctlstack->endlabel, 0);
164: }
165: else
166: {
167: putlabel (ctlstack->elselabel);
168: if (ctlstack->endlabel)
169: putlabel (ctlstack->endlabel);
170: }
171: popctl ();
172: }
173: else if (ctlstack->ctltype == CTLELSE)
174: {
175: if (optimflag)
176: optbuff (SKLABEL, 0, ctlstack->endlabel, 0);
177: else
178: putlabel (ctlstack->endlabel);
179: popctl ();
180: }
181: else
182: execerr("endif out of place", CNULL);
183: }
184:
185:
186:
187: LOCAL pushctl(code)
188: int code;
189: {
190: register int i;
191:
192: /* fprintf(diagfile,"old blklevel %d \n",blklevel); dmpframe(ctlstack); */
193: if(++ctlstack >= lastctl)
194: many("loops or if-then-elses", 'c');
195: ctlstack->ctltype = code;
196: for(i = 0 ; i < 4 ; ++i)
197: ctlstack->ctlabels[i] = 0;
198: ++blklevel;
199: }
200:
201:
202: LOCAL popctl()
203: {
204: if( ctlstack-- < ctls )
205: fatal("control stack empty");
206: --blklevel;
207: }
208:
209:
210:
211: LOCAL poplab()
212: {
213: register struct Labelblock *lp;
214:
215: for(lp = labeltab ; lp < highlabtab ; ++lp)
216: if(lp->labdefined)
217: {
218: /* mark all labels in inner blocks unreachable */
219: if(lp->blklevel > blklevel)
220: lp->labinacc = YES;
221: }
222: else if(lp->blklevel > blklevel)
223: {
224: /* move all labels referred to in inner blocks out a level */
225: lp->blklevel = blklevel;
226: }
227: }
228:
229:
230:
231: /* BRANCHING CODE
232: */
233:
234: exgoto(lab)
235: struct Labelblock *lab;
236: {
237: if (optimflag)
238: optbuff (SKGOTO, 0, lab->labelno, 0);
239: else
240: putgoto (lab->labelno);
241: }
242:
243:
244:
245:
246:
247:
248:
249: exequals(lp, rp)
250: register struct Primblock *lp;
251: register expptr rp;
252: {
253: register Namep np;
254:
255: if(lp->tag != TPRIM)
256: {
257: err("assignment to a non-variable");
258: frexpr(lp);
259: frexpr(rp);
260: }
261: else if(lp->namep->vclass!=CLVAR && lp->argsp)
262: {
263: if(parstate >= INEXEC)
264: err("undimensioned array or statement function out of order");
265: else
266: mkstfunct(lp, rp);
267: }
268: else
269: {
270: np = (Namep) lp->namep;
271: if (np->vclass == CLPROC && np->vprocclass == PTHISPROC
272: && proctype == TYSUBR)
273: {
274: err("assignment to a subroutine name");
275: return;
276: }
277: if(parstate < INDATA)
278: enddcl();
279: parstate = INEXEC;
280: if (optimflag)
281: optbuff (SKEQ, mkexpr(OPASSIGN, mklhs(lp), fixtype(rp)), 0, 0);
282: else
283: puteq (mklhs(lp), fixtype(rp));
284: }
285: }
286:
287:
288:
289: mkstfunct(lp, rp)
290: struct Primblock *lp;
291: expptr rp;
292: {
293: register struct Primblock *p;
294: register Namep np;
295: chainp args;
296:
297: if(parstate < INDATA)
298: {
299: enddcl();
300: parstate = INDATA;
301: }
302:
303: np = lp->namep;
304: if(np->vclass == CLUNKNOWN)
305: np->vclass = CLPROC;
306: else
307: {
308: dclerr("redeclaration of statement function", np);
309: return;
310: }
311: np->vprocclass = PSTFUNCT;
312: np->vstg = STGSTFUNCT;
313: impldcl(np);
314: args = (lp->argsp ? lp->argsp->listp : CHNULL);
315: np->varxptr.vstfdesc = mkchain(args , rp );
316:
317: for( ; args ; args = args->nextp)
318: if( args->datap->tag!=TPRIM ||
319: (p = (struct Primblock *) (args->datap) )->argsp ||
320: p->fcharp || p->lcharp )
321: err("non-variable argument in statement function definition");
322: else
323: {
324: args->datap = (tagptr) (p->namep);
325: vardcl(p->namep);
326: free(p);
327: }
328: }
329:
330:
331:
332: excall(name, args, nstars, labels)
333: Namep name;
334: struct Listblock *args;
335: int nstars;
336: struct Labelblock *labels[ ];
337: {
338: register expptr p;
339:
340: if (name->vdcldone)
341: if (name->vclass != CLPROC && name->vclass != CLENTRY)
342: {
343: dclerr("call to non-subroutine", name);
344: return;
345: }
346: else if (name->vtype != TYSUBR)
347: {
348: dclerr("subroutine invocation of function", name);
349: return;
350: }
351: settype(name, TYSUBR, ENULL);
352: p = mkfunct( mkprim(name, args, CHNULL) );
353: p->exprblock.vtype = p->exprblock.leftp->headblock.vtype = TYINT;
354: if (nstars > 0)
355: if (optimflag)
356: optbuff (SKCMGOTO, p, nstars, labels);
357: else
358: putcmgo (p, nstars, labels);
359: else
360: if (optimflag)
361: optbuff (SKCALL, p, 0, 0);
362: else
363: putexpr (p);
364: }
365:
366:
367:
368: exstop(stop, p)
369: int stop;
370: register expptr p;
371: {
372: char *q;
373: int n;
374: expptr mkstrcon();
375:
376: if(p)
377: {
378: if( ! ISCONST(p) )
379: {
380: execerr("pause/stop argument must be constant", CNULL);
381: frexpr(p);
382: p = mkstrcon(0, CNULL);
383: }
384: else if( ISINT(p->constblock.vtype) )
385: {
386: q = convic(p->constblock.const.ci);
387: n = strlen(q);
388: if(n > 0)
389: {
390: p->constblock.const.ccp = copyn(n, q);
391: p->constblock.vtype = TYCHAR;
392: p->constblock.vleng = (expptr) ICON(n);
393: }
394: else
395: p = (expptr) mkstrcon(0, CNULL);
396: }
397: else if(p->constblock.vtype != TYCHAR)
398: {
399: execerr("pause/stop argument must be integer or string", CNULL);
400: p = (expptr) mkstrcon(0, CNULL);
401: }
402: }
403: else p = (expptr) mkstrcon(0, CNULL);
404:
405: if (optimflag)
406: optbuff ((stop ? SKSTOP : SKPAUSE), p, 0, 0);
407: else
408: putexpr (call1(TYSUBR, (stop ? "s_stop" : "s_paus"), p));
409: }
410:
411:
412: /* UCB DO LOOP CODE */
413:
414: #define DOINIT par[0]
415: #define DOLIMIT par[1]
416: #define DOINCR par[2]
417:
418: #define CONSTINIT const[0]
419: #define CONSTLIMIT const[1]
420: #define CONSTINCR const[2]
421:
422: #define VARSTEP 0
423: #define POSSTEP 1
424: #define NEGSTEP 2
425:
426:
427: exdo(range, spec)
428: int range;
429: chainp spec;
430:
431: {
432: register expptr p, q;
433: expptr q1;
434: register Namep np;
435: chainp cp;
436: register int i;
437: int dotype, incsign;
438: Addrp dovarp, dostgp;
439: expptr par[3];
440: expptr const[3];
441: Slotp doslot;
442:
443: pushctl(CTLDO);
444: dorange = ctlstack->dolabel = range;
445: np = (Namep) (spec->datap);
446: ctlstack->donamep = NULL;
447: if(np->vdovar)
448: {
449: errstr("nested loops with variable %s", varstr(VL,np->varname));
450: return;
451: }
452:
453: dovarp = mkplace(np);
454: dotype = dovarp->vtype;
455:
456: if( ! ONEOF(dotype, MSKINT|MSKREAL) )
457: {
458: err("bad type on DO variable");
459: return;
460: }
461:
462:
463: for(i=0 , cp = spec->nextp ; cp!=NULL && i<3 ; cp = cp->nextp)
464: {
465: p = fixtype((expptr) cpexpr((tagptr) q = cp->datap));
466: if(!ONEOF(p->headblock.vtype, MSKINT|MSKREAL) )
467: {
468: err("bad type on DO parameter");
469: return;
470: }
471:
472:
473: if (ISCONST(q))
474: const[i] = mkconv(dotype, q);
475: else
476: {
477: frexpr(q);
478: const[i] = NULL;
479: }
480:
481: par[i++] = mkconv(dotype, p);
482: }
483:
484: frchain(&spec);
485: switch(i)
486: {
487: case 0:
488: case 1:
489: err("too few DO parameters");
490: return;
491:
492: case 2:
493: DOINCR = (expptr) ICON(1);
494: CONSTINCR = ICON(1);
495:
496: case 3:
497: break;
498:
499: default:
500: err("too many DO parameters");
501: return;
502: }
503:
504: ctlstack->donamep = np;
505:
506: np->vdovar = YES;
507: if( !optimflag && enregister(np) )
508: {
509: /* stgp points to a storage version, varp to a register version */
510: dostgp = dovarp;
511: dovarp = mkplace(np);
512: }
513: else
514: dostgp = NULL;
515:
516: for (i = 0; i < 4; i++)
517: ctlstack->ctlabels[i] = newlabel();
518:
519: if( CONSTLIMIT )
520: ctlstack->domax = DOLIMIT;
521: else
522: ctlstack->domax = (expptr) mktemp(dotype, PNULL);
523:
524: if( CONSTINCR )
525: {
526: ctlstack->dostep = DOINCR;
527: if( (incsign = conssgn(CONSTINCR)) == 0)
528: err("zero DO increment");
529: ctlstack->dostepsign = (incsign > 0 ? POSSTEP : NEGSTEP);
530: }
531: else
532: {
533: ctlstack->dostep = (expptr) mktemp(dotype, PNULL);
534: ctlstack->dostepsign = VARSTEP;
535: }
536:
537: if (optimflag)
538: doslot = optbuff (SKDOHEAD,0,0,ctlstack);
539:
540: if( CONSTLIMIT && CONSTINIT && ctlstack->dostepsign!=VARSTEP)
541: {
542: if (optimflag)
543: optbuff (SKEQ,mkexpr(OPASSIGN,cpexpr(dovarp),cpexpr(DOINIT)),
544: 0,0);
545: else
546: puteq (cpexpr(dovarp), cpexpr(DOINIT));
547: if( ! onetripflag )
548: {
549: q = mkexpr(OPMINUS, cpexpr(CONSTLIMIT), cpexpr(CONSTINIT));
550: if((incsign * conssgn(q)) == -1)
551: {
552: warn("DO range never executed");
553: if (optimflag)
554: optbuff (SKGOTO,0,ctlstack->endlabel,0);
555: else
556: putgoto (ctlstack->endlabel);
557: }
558: frexpr(q);
559: }
560: }
561:
562:
563: else if (ctlstack->dostepsign != VARSTEP && !onetripflag)
564: {
565: if (CONSTLIMIT)
566: q = (expptr) cpexpr(ctlstack->domax);
567: else
568: q = mkexpr(OPASSIGN, cpexpr(ctlstack->domax), DOLIMIT);
569: q1 = mkexpr(OPASSIGN, cpexpr(dovarp), DOINIT);
570: q = mkexpr( (ctlstack->dostepsign == POSSTEP ? OPGE : OPLE),
571: q, q1);
572: if (optimflag)
573: optbuff (SKIFN,q, ctlstack->endlabel,0);
574: else
575: putif (q, ctlstack->endlabel);
576: }
577: else
578: {
579: if (!CONSTLIMIT)
580: if (optimflag)
581: optbuff (SKEQ,
582: mkexpr(OPASSIGN,cpexpr(ctlstack->domax),DOLIMIT),0,0);
583: else
584: puteq (cpexpr(ctlstack->domax), DOLIMIT);
585: q = DOINIT;
586: if (!onetripflag)
587: q = mkexpr(OPMINUS, q,
588: mkexpr(OPASSIGN, cpexpr(ctlstack->dostep),
589: DOINCR) );
590: if (optimflag)
591: optbuff (SKEQ,mkexpr(OPASSIGN,cpexpr(dovarp), q),0,0);
592: else
593: puteq (cpexpr(dovarp), q);
594: if (onetripflag && ctlstack->dostepsign == VARSTEP)
595: if (optimflag)
596: optbuff (SKEQ,
597: mkexpr(OPASSIGN,cpexpr(ctlstack->dostep),DOINCR),0,0);
598: else
599: puteq (cpexpr(ctlstack->dostep), DOINCR);
600: }
601:
602: if (ctlstack->dostepsign == VARSTEP)
603: {
604: expptr incr,test;
605: if (onetripflag)
606: if (optimflag)
607: optbuff (SKGOTO,0,ctlstack->dobodylabel,0);
608: else
609: putgoto (ctlstack->dobodylabel);
610: else
611: if (optimflag)
612: optbuff (SKIFN,mkexpr(OPGE, cpexpr(ctlstack->dostep), ICON(0)),
613: ctlstack->doneglabel,0);
614: else
615: putif (mkexpr(OPGE, cpexpr(ctlstack->dostep), ICON(0)),
616: ctlstack->doneglabel);
617: if (optimflag)
618: optbuff (SKLABEL,0,ctlstack->doposlabel,0);
619: else
620: putlabel (ctlstack->doposlabel);
621: incr = mkexpr(OPPLUSEQ, cpexpr(dovarp), cpexpr(ctlstack->dostep));
622: test = mkexpr(OPLE, incr, cpexpr(ctlstack->domax));
623: if (optimflag)
624: optbuff (SKIFN,test, ctlstack->endlabel,0);
625: else
626: putif (test, ctlstack->endlabel);
627: }
628:
629: if (optimflag)
630: optbuff (SKLABEL,0,ctlstack->dobodylabel,0);
631: else
632: putlabel (ctlstack->dobodylabel);
633: if (dostgp)
634: {
635: if (optimflag)
636: optbuff (SKEQ,mkexpr(OPASSIGN,dostgp, dovarp),0,0);
637: else
638: puteq (dostgp, dovarp);
639: }
640: else
641: frexpr(dovarp);
642: if (optimflag)
643: doslot->nullslot = optbuff (SKNULL,0,0,0);
644:
645: frexpr(CONSTINIT);
646: frexpr(CONSTLIMIT);
647: frexpr(CONSTINCR);
648: }
649:
650:
651: enddo(here)
652: int here;
653:
654: {
655: register struct Ctlframe *q;
656: Namep np;
657: Addrp ap, rv;
658: expptr t;
659: register int i;
660: Slotp doslot;
661:
662: while (here == dorange)
663: {
664: while (ctlstack->ctltype == CTLIF || ctlstack->ctltype == CTLELSE)
665: {
666: execerr("missing endif", CNULL);
667: exendif();
668: }
669:
670: if (np = ctlstack->donamep)
671: {
672: rv = mkplace (np);
673:
674: t = mkexpr(OPPLUSEQ, cpexpr(rv), cpexpr(ctlstack->dostep) );
675:
676: if (optimflag)
677: doslot = optbuff (SKENDDO,0,0,ctlstack);
678:
679: if (ctlstack->dostepsign == VARSTEP)
680: if (optimflag)
681: {
682: optbuff (SKIFN,
683: mkexpr(OPLE, cpexpr(ctlstack->dostep), ICON(0)),
684: ctlstack->doposlabel,0);
685: optbuff (SKLABEL,0,ctlstack->doneglabel,0);
686: optbuff (SKIFN,mkexpr(OPLT, t, ctlstack->domax),
687: ctlstack->dobodylabel,0);
688: }
689: else
690: {
691: putif (mkexpr(OPLE, cpexpr(ctlstack->dostep), ICON(0)),
692: ctlstack->doposlabel);
693: putlabel (ctlstack->doneglabel);
694: putif (mkexpr(OPLT, t, ctlstack->domax),
695: ctlstack->dobodylabel);
696: }
697: else
698: {
699: int op;
700: op = (ctlstack->dostepsign == POSSTEP ? OPGT : OPLT);
701: if (optimflag)
702: optbuff (SKIFN, mkexpr(op,t,ctlstack->domax),
703: ctlstack->dobodylabel,0);
704: else
705: putif (mkexpr(op, t, ctlstack->domax),
706: ctlstack->dobodylabel);
707: }
708: if (optimflag)
709: optbuff (SKLABEL,0,ctlstack->endlabel,0);
710: else
711: putlabel (ctlstack->endlabel);
712:
713: if (ap = memversion(np))
714: {
715: if (optimflag)
716: optbuff (SKEQ,mkexpr(OPASSIGN,ap, rv),0,0);
717: else
718: puteq (ap, rv);
719: }
720: else
721: frexpr(rv);
722: for (i = 0; i < 4; i++)
723: ctlstack->ctlabels[i] = 0;
724: if (!optimflag)
725: deregister(ctlstack->donamep);
726: ctlstack->donamep->vdovar = NO;
727: if (optimflag)
728: doslot->nullslot = optbuff (SKNULL,0,0,0);
729: }
730:
731: popctl();
732: poplab();
733:
734: dorange = 0;
735: for (q = ctlstack; q >= ctls; --q)
736: if (q->ctltype == CTLDO)
737: {
738: dorange = q->dolabel;
739: break;
740: }
741: }
742: }
743:
744:
745: exassign(vname, labelval)
746: Namep vname;
747: struct Labelblock *labelval;
748: {
749: Addrp p;
750: expptr mkaddcon();
751:
752: p = mkplace(vname);
753: #if SZADDR > SZSHORT
754: if( p->vtype == TYSHORT )
755: err("insufficient precision in ASSIGN variable");
756: else
757: #endif
758: if( ! ONEOF(p->vtype, MSKINT|MSKADDR) )
759: err("noninteger assign variable");
760: else
761: {
762: if (optimflag)
763: optbuff (SKASSIGN, p, labelval->labelno, 0);
764: else
765: puteq (p, intrconv(p->vtype, mkaddcon(labelval->labelno)));
766: }
767: }
768:
769:
770:
771: exarif(expr, neglab, zerlab, poslab)
772: expptr expr;
773: struct Labelblock *neglab, *zerlab, *poslab;
774: {
775: register int lm, lz, lp;
776: struct Labelblock *labels[3];
777:
778: lm = neglab->labelno;
779: lz = zerlab->labelno;
780: lp = poslab->labelno;
781: expr = fixtype(expr);
782:
783: if( ! ONEOF(expr->headblock.vtype, MSKINT|MSKREAL) )
784: {
785: err("invalid type of arithmetic if expression");
786: frexpr(expr);
787: }
788: else
789: {
790: if(lm == lz)
791: exar2(OPLE, expr, lm, lp);
792: else if(lm == lp)
793: exar2(OPNE, expr, lm, lz);
794: else if(lz == lp)
795: exar2(OPGE, expr, lz, lm);
796: else
797: if (optimflag)
798: {
799: labels[0] = neglab;
800: labels[1] = zerlab;
801: labels[2] = poslab;
802: optbuff (SKARIF, expr, 0, labels);
803: }
804: else
805: prarif(expr, lm, lz, lp);
806: }
807: }
808:
809:
810:
811: LOCAL exar2 (op, e, l1, l2)
812: int op;
813: expptr e;
814: int l1,l2;
815: {
816: if (optimflag)
817: {
818: optbuff (SKIFN, mkexpr(op, e, ICON(0)), l2, 0);
819: optbuff (SKGOTO, 0, l1, 0);
820: }
821: else
822: {
823: putif (mkexpr(op, e, ICON(0)), l2);
824: putgoto (l1);
825: }
826: }
827:
828:
829: exreturn(p)
830: register expptr p;
831: {
832: if(procclass != CLPROC)
833: warn("RETURN statement in main or block data");
834: if(p && (proctype!=TYSUBR || procclass!=CLPROC) )
835: {
836: err("alternate return in nonsubroutine");
837: p = 0;
838: }
839:
840: if(p)
841: if (optimflag)
842: optbuff (SKRETURN, p, retlabel, 0);
843: else
844: {
845: putforce (TYINT, p);
846: putgoto (retlabel);
847: }
848: else
849: if (optimflag)
850: optbuff (SKRETURN, p,
851: (proctype==TYSUBR ? ret0label : retlabel), 0);
852: else
853: putgoto (proctype==TYSUBR ? ret0label : retlabel);
854: }
855:
856:
857:
858: exasgoto(labvar)
859: struct Hashentry *labvar;
860: {
861: register Addrp p;
862:
863: p = mkplace(labvar);
864: if( ! ISINT(p->vtype) )
865: err("assigned goto variable must be integer");
866: else
867: if (optimflag)
868: optbuff (SKASGOTO, p, 0, 0);
869: else
870: putbranch (p);
871: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.