![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to gram.head CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / usr.bin / f77 / src / f77pass1|
Return to gram.head CVS log | Up to [CSRG BSD Unix] / 43BSD / usr.bin / f77 / src / f77pass1 |
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.head 5.1 (Berkeley) 6/7/85
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: ;
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.