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