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: * @(#)gram.exec 5.2 (Berkeley) 1/7/86 7: */ 8: 9: /* 10: * gram.exec 11: * 12: * Grammar for executable statements, f77 compiler pass 1, 4.2 BSD. 13: * 14: * University of Utah CS Dept modification history: 15: * 16: * $Log: gram.exec,v $ 17: * Revision 5.2 85/12/18 20:17:38 donn 18: * Modified end_spec to insist on parser state INEXEC after seeing an 19: * executable statement. This allows us to limit statement functions to 20: * parser state INDATA. 21: * 22: * Revision 5.1 85/08/10 03:47:22 donn 23: * 4.3 alpha 24: * 25: * Revision 3.1 84/10/13 00:36:41 donn 26: * Installed Jerry Berkman's version; preserved comment header. 27: * 28: * Revision 1.3 84/08/06 18:38:43 donn 29: * Fixed a bug in Jerry Berkman's label fixes which caused the same label to 30: * be generated twice for some types of logical IF statements. 31: * 32: * Revision 1.2 84/08/04 21:09:57 donn 33: * Added fixes from Jerry Berkman to allow proper ASSIGNS from format 34: * statement numbers. 35: * 36: */ 37: 38: exec: iffable 39: | SDO end_spec intonlyon label intonlyoff opt_comma dospec 40: { 41: if( !do_name_err ) { 42: if($4->labdefined) 43: execerr("no backward DO loops", CNULL); 44: $4->blklevel = blklevel+1; 45: exdo($4->labelno, $7); 46: } 47: } 48: | logif iffable 49: { exendif(); thiswasbranch = NO; } 50: | logif STHEN 51: | SELSEIF end_spec SLPAR expr SRPAR STHEN 52: { exelif($4); lastwasbranch = NO; } 53: | SELSE end_spec 54: { exelse(); lastwasbranch = NO; } 55: | SENDIF end_spec 56: { exendif(); lastwasbranch = NO; } 57: ; 58: 59: logif: SLOGIF end_spec SLPAR expr SRPAR 60: { exif($4); } 61: ; 62: 63: dospec: name SEQUALS exprlist 64: { if( $1->vclass != CLPARAM ) { 65: $$ = mkchain($1, $3); 66: do_name_err = 0; 67: } else { 68: err("symbolic constant not allowed as DO variable"); 69: do_name_err = 1; 70: } 71: } 72: ; 73: 74: iffable: let lhs SEQUALS expr 75: { exequals($2, $4); } 76: | SASSIGN end_spec assignlabel STO name 77: { if( $5->vclass != CLPARAM ) { 78: exassign($5, $3); 79: } else { 80: err("can only assign to a variable"); 81: } 82: } 83: | SCONTINUE end_spec 84: | goto 85: | io 86: { inioctl = NO; } 87: | SARITHIF end_spec SLPAR expr SRPAR label SCOMMA label SCOMMA label 88: { exarif($4, $6, $8, $10); thiswasbranch = YES; } 89: | call 90: { excall($1, PNULL, 0, labarray); } 91: | call SLPAR SRPAR 92: { excall($1, PNULL, 0, labarray); } 93: | call SLPAR callarglist SRPAR 94: { if(nstars < MAXLABLIST) 95: excall($1, mklist($3), nstars, labarray); 96: else 97: err("too many alternate returns"); 98: } 99: | SRETURN end_spec opt_expr 100: { exreturn($3); thiswasbranch = YES; } 101: | stop end_spec opt_expr 102: { exstop($1, $3); thiswasbranch = $1; } 103: ; 104: 105: assignlabel: SICON 106: { $$ = mklabel( convci(toklen, token) ); } 107: ; 108: 109: let: SLET 110: { if(parstate == OUTSIDE) 111: { 112: newproc(); 113: startproc(PNULL, CLMAIN); 114: } 115: if( yystno != 0 && thislabel->labtype != LABFORMAT) 116: if (optimflag) 117: optbuff (SKLABEL, 0, thislabel->labelno, 1); 118: else 119: putlabel(thislabel->labelno); 120: } 121: ; 122: 123: goto: SGOTO end_spec label 124: { exgoto($3); thiswasbranch = YES; } 125: | SASGOTO end_spec name 126: { if( $3->vclass != CLPARAM ) { 127: exasgoto($3); thiswasbranch = YES; 128: } else { 129: err("must go to label or assigned variable"); 130: } 131: } 132: | SASGOTO end_spec name opt_comma SLPAR labellist SRPAR 133: { if( $3->vclass != CLPARAM ) { 134: exasgoto($3); thiswasbranch = YES; 135: } else { 136: err("must go to label or assigned variable"); 137: } 138: } 139: | SCOMPGOTO end_spec SLPAR labellist SRPAR opt_comma expr 140: { if(nstars < MAXLABLIST) 141: if (optimflag) 142: optbuff (SKCMGOTO, fixtype($7), nstars, labarray); 143: else 144: putcmgo (fixtype($7), nstars, labarray); 145: else 146: err("computed GOTO list too long"); 147: } 148: ; 149: 150: opt_comma: 151: | SCOMMA 152: ; 153: 154: call: SCALL end_spec name 155: { nstars = 0; $$ = $3; } 156: ; 157: 158: callarglist: callarg 159: { $$ = ($1 ? mkchain($1,CHNULL) : CHNULL); } 160: | callarglist SCOMMA callarg 161: { if($3) 162: if($1) $$ = hookup($1, mkchain($3,CHNULL)); 163: else $$ = mkchain($3,CHNULL); 164: else 165: $$ = $1; 166: } 167: ; 168: 169: callarg: expr 170: | SSTAR label 171: { if(nstars<MAXLABLIST) labarray[nstars++] = $2; $$ = 0; } 172: ; 173: 174: stop: SPAUSE 175: { $$ = 0; } 176: | SSTOP 177: { $$ = 1; } 178: ; 179: 180: exprlist: expr 181: { $$ = mkchain($1, CHNULL); } 182: | exprlist SCOMMA expr 183: { $$ = hookup($1, mkchain($3,CHNULL) ); } 184: ; 185: 186: end_spec: 187: { if(parstate == OUTSIDE) 188: { 189: newproc(); 190: startproc(PNULL, CLMAIN); 191: } 192: if(parstate < INDATA) enddcl(); 193: parstate = INEXEC; 194: if( yystno != 0 && thislabel->labtype != LABFORMAT) 195: if (optimflag) 196: optbuff (SKLABEL, 0, thislabel->labelno, 1); 197: else 198: putlabel(thislabel->labelno); 199: yystno = 0; 200: } 201: ; 202: 203: intonlyon: 204: { intonly = YES; } 205: ; 206: 207: intonlyoff: 208: { intonly = NO; } 209: ;