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