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