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