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 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 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 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 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 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 203 LOCAL popctl() 204 { 205 if( ctlstack-- < ctls ) 206 fatal("control stack empty"); 207 --blklevel; 208 } 209 210 211 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 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 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 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 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 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 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 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 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 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