|
|
1.1 ! root 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: ;
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.