|
|
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.