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