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