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