Commit | Line | Data |
---|---|---|
e2eab781 KM |
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.head 5.1 (Berkeley) %G% | |
7 | */ | |
8 | ||
9 | /* | |
10 | * gram.head | |
11 | * | |
12 | * First part of the f77 grammar, f77 compiler pass 1. | |
13 | * | |
14 | * University of Utah CS Dept modification history: | |
15 | * | |
16 | * $Log: gram.head,v $ | |
17 | * Revision 3.2 84/11/06 17:40:52 donn | |
18 | * Fixed bug with redundant labels causing errors when they appear on (e.g.) | |
19 | * PROGRAM statements. | |
20 | * | |
21 | * Revision 3.1 84/10/13 00:22:16 donn | |
22 | * Merged Jerry Berkman's version into mine. | |
23 | * | |
24 | * Revision 2.2 84/08/04 21:13:02 donn | |
25 | * Moved some code out of gram.head into gram.exec in accordance with | |
26 | * Jerry Berkman's fixes to make ASSIGNs work right. | |
27 | * | |
28 | * Revision 2.1 84/07/19 12:03:20 donn | |
29 | * Changed comment headers for UofU. | |
30 | * | |
31 | * Revision 1.2 84/03/23 22:43:06 donn | |
32 | * The subroutine argument temporary fixes from Bob Corbett didn't take into | |
33 | * account the fact that the code generator collects all the assignments to | |
34 | * temporaries at the start of a statement -- hence the temporaries need to | |
35 | * be initialized once per statement instead of once per call. | |
36 | * | |
37 | */ | |
38 | ||
39 | %{ | |
40 | # include "defs.h" | |
41 | # include "data.h" | |
42 | ||
43 | #ifdef SDB | |
44 | # include <a.out.h> | |
45 | ||
46 | # ifndef N_SO | |
47 | # include <stab.h> | |
48 | # endif | |
49 | #endif | |
50 | ||
51 | static int equivlisterr; | |
52 | static int do_name_err; | |
53 | static int nstars; | |
54 | static int ndim; | |
55 | static int vartype; | |
56 | static ftnint varleng; | |
57 | static struct { expptr lb, ub; } dims[MAXDIM+1]; | |
58 | static struct Labelblock *labarray[MAXLABLIST]; | |
59 | static int lastwasbranch = NO; | |
60 | static int thiswasbranch = NO; | |
61 | extern ftnint yystno; | |
62 | extern flag intonly; | |
63 | ||
64 | ftnint convci(); | |
65 | double convcd(); | |
66 | expptr mklogcon(), mkaddcon(), mkrealcon(), mkstrcon(), mkbitcon(); | |
67 | expptr mkcxcon(); | |
68 | struct Listblock *mklist(); | |
69 | struct Listblock *mklist(); | |
70 | struct Impldoblock *mkiodo(); | |
71 | struct Extsym *comblock(); | |
72 | ||
73 | %} | |
74 | ||
75 | /* Specify precedences and associativities. */ | |
76 | ||
77 | %union { | |
78 | int ival; | |
79 | char *charpval; | |
80 | chainp chval; | |
81 | tagptr tagval; | |
82 | expptr expval; | |
83 | struct Labelblock *labval; | |
84 | struct Nameblock *namval; | |
85 | struct Eqvchain *eqvval; | |
86 | struct Extsym *extval; | |
87 | union Vexpr *vexpval; | |
88 | struct ValList *drvals; | |
89 | struct Vlist *dvals; | |
90 | union Delt *deltp; | |
91 | struct Rpair *rpairp; | |
92 | struct Elist *elistp; | |
93 | } | |
94 | ||
95 | %left SCOMMA | |
96 | %nonassoc SCOLON | |
97 | %right SEQUALS | |
98 | %left SEQV SNEQV | |
99 | %left SOR | |
100 | %left SAND | |
101 | %left SNOT | |
102 | %nonassoc SLT SGT SLE SGE SEQ SNE | |
103 | %left SCONCAT | |
104 | %left SPLUS SMINUS | |
105 | %left SSTAR SSLASH | |
106 | %right SPOWER | |
107 | ||
108 | %start program | |
109 | %type <labval> thislabel label assignlabel | |
110 | %type <tagval> other inelt | |
111 | %type <ival> lengspec type typespec typename dcl letter addop relop stop nameeq | |
112 | %type <charpval> filename | |
113 | %type <chval> namelistlist funarglist funargs dospec | |
114 | %type <chval> callarglist arglist args exprlist inlist outlist out2 substring | |
115 | %type <namval> name arg call var entryname progname | |
116 | %type <expval> lhs expr uexpr opt_expr fexpr unpar_fexpr | |
117 | %type <expval> ubound callarg complex_const simple_const | |
118 | %type <extval> common comblock | |
119 | %type <eqvval> equivlist | |
120 | %type <expval> datavalue real_const unsignedreal bit_const | |
121 | %type <vexpval> unsignedint int_const | |
122 | %type <vexpval> dataname | |
123 | %type <vexpval> iconprimary iconfactor iconterm iconexpr opticonexpr | |
124 | %type <drvals> datarval datarvals | |
125 | %type <dvals> iconexprlist datasubs | |
126 | %type <deltp> dataelt dataimplieddo datalval | |
127 | %type <rpairp> datarange | |
128 | %type <elistp> dlist datalvals | |
129 | ||
130 | %% | |
131 | ||
132 | program: | |
133 | | program stat SEOS | |
134 | ; | |
135 | ||
136 | stat: thislabel entry | |
137 | { lastwasbranch = NO; } | |
138 | | thislabel spec | |
139 | | thislabel exec | |
140 | { if($1 && ($1->labelno==dorange)) | |
141 | enddo($1->labelno); | |
142 | if(lastwasbranch && thislabel==NULL) | |
143 | warn("statement cannot be reached"); | |
144 | lastwasbranch = thiswasbranch; | |
145 | thiswasbranch = NO; | |
146 | if($1) | |
147 | { | |
148 | if($1->labtype == LABFORMAT) | |
149 | err("label already that of a format"); | |
150 | else | |
151 | $1->labtype = LABEXEC; | |
152 | } | |
153 | if(!optimflag) | |
154 | { | |
155 | argtemplist = hookup(argtemplist, activearglist); | |
156 | activearglist = CHNULL; | |
157 | } | |
158 | } | |
159 | | thislabel SINCLUDE filename | |
160 | { doinclude( $3 ); } | |
161 | | thislabel SEND end_spec | |
162 | { lastwasbranch = NO; endproc(); } | |
163 | | thislabel SUNKNOWN | |
164 | { execerr("unclassifiable statement", CNULL); flline(); }; | |
165 | | error | |
166 | { flline(); needkwd = NO; inioctl = NO; | |
167 | yyerrok; yyclearin; } | |
168 | ; | |
169 | ||
170 | thislabel: SLABEL | |
171 | { | |
172 | #ifdef SDB | |
173 | if( sdbflag ) | |
174 | { | |
175 | linenostab(lineno); | |
176 | } | |
177 | #endif | |
178 | ||
179 | if(yystno != 0) | |
180 | { | |
181 | $$ = thislabel = mklabel(yystno); | |
182 | if(thislabel->labdefined) | |
183 | execerr("label %s already defined", | |
184 | convic(thislabel->stateno) ); | |
185 | else { | |
186 | if(thislabel->blklevel!=0 && thislabel->blklevel<blklevel | |
187 | && thislabel->labtype!=LABFORMAT) | |
188 | warn1("there is a branch to label %s from outside block", | |
189 | convic( (ftnint) (thislabel->stateno) ) ); | |
190 | thislabel->blklevel = blklevel; | |
191 | thislabel->labdefined = YES; | |
192 | } | |
193 | } | |
194 | else $$ = thislabel = NULL; | |
195 | } | |
196 | ; | |
197 | ||
198 | entry: SPROGRAM new_proc progname | |
199 | {startproc($3, CLMAIN); } | |
200 | | SBLOCK new_proc progname | |
201 | { if($3) NO66("named BLOCKDATA"); | |
202 | startproc($3, CLBLOCK); } | |
203 | | SSUBROUTINE new_proc entryname arglist | |
204 | { entrypt(CLPROC, TYSUBR, (ftnint) 0, $3, $4); } | |
205 | | SFUNCTION new_proc entryname arglist | |
206 | { entrypt(CLPROC, TYUNKNOWN, (ftnint) 0, $3, $4); } | |
207 | | type SFUNCTION new_proc entryname arglist | |
208 | { entrypt(CLPROC, $1, varleng, $4, $5); } | |
209 | | SENTRY entryname arglist | |
210 | { if(parstate==OUTSIDE || procclass==CLMAIN | |
211 | || procclass==CLBLOCK) | |
212 | execerr("misplaced entry statement", CNULL); | |
213 | entrypt(CLENTRY, 0, (ftnint) 0, $2, $3); | |
214 | } | |
215 | ; | |
216 | ||
217 | new_proc: | |
218 | { newproc(); } | |
219 | ; | |
220 | ||
221 | entryname: name | |
222 | ; | |
223 | ||
224 | name: SNAME | |
225 | { $$ = mkname(toklen, token); } | |
226 | ; | |
227 | ||
228 | progname: { $$ = NULL; } | |
229 | | entryname | |
230 | ; | |
231 | ||
232 | arglist: | |
233 | { $$ = 0; } | |
234 | | SLPAR SRPAR | |
235 | { NO66(" () argument list"); | |
236 | $$ = 0; } | |
237 | | SLPAR args SRPAR | |
238 | {$$ = $2; } | |
239 | ; | |
240 | ||
241 | args: arg | |
242 | { $$ = ($1 ? mkchain($1,CHNULL) : CHNULL ); } | |
243 | | args SCOMMA arg | |
244 | { if($3) $1 = $$ = hookup($1, mkchain($3,CHNULL)); } | |
245 | ; | |
246 | ||
247 | arg: name | |
248 | { if(($1->vstg!=STGUNKNOWN && $1->vstg!=STGARG) | |
249 | || ($1->vclass == CLPARAM) ) { | |
250 | dclerr("name declared as argument after use", $1); | |
251 | $$ = NULL; | |
252 | } else | |
253 | $1->vstg = STGARG; | |
254 | } | |
255 | | SSTAR | |
256 | { NO66("altenate return argument"); | |
257 | $$ = 0; substars = YES; } | |
258 | ; | |
259 | ||
260 | ||
261 | ||
262 | filename: SHOLLERITH | |
263 | { | |
264 | char *s; | |
265 | s = copyn(toklen+1, token); | |
266 | s[toklen] = '\0'; | |
267 | $$ = s; | |
268 | } | |
269 | ; |