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