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