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