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