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