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