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) 06/07/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 30exec: 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 51logif: SLOGIF end_spec SLPAR expr SRPAR 52 { exif($4); } 53 ; 54 55dospec: 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 66iffable: 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 97assignlabel: SICON 98 { $$ = mklabel( convci(toklen, token) ); } 99 ; 100 101let: 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 115goto: 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 142opt_comma: 143 | SCOMMA 144 ; 145 146call: SCALL end_spec name 147 { nstars = 0; $$ = $3; } 148 ; 149 150callarglist: 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 161callarg: expr 162 | SSTAR label 163 { if(nstars<MAXLABLIST) labarray[nstars++] = $2; $$ = 0; } 164 ; 165 166stop: SPAUSE 167 { $$ = 0; } 168 | SSTOP 169 { $$ = 1; } 170 ; 171 172exprlist: expr 173 { $$ = mkchain($1, CHNULL); } 174 | exprlist SCOMMA expr 175 { $$ = hookup($1, mkchain($3,CHNULL) ); } 176 ; 177 178end_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 194intonlyon: 195 { intonly = YES; } 196 ; 197 198intonlyoff: 199 { intonly = NO; } 200 ; 201