|
|
1.1 root 1: %{
2: #include "defs"
3: ptr bgnexec(), addexec(), bgnproc(), mkvar(), mkcomm(), mkstruct(), mkarrow();
4: ptr mkiost(), mkioitem(), mkiogroup(), mkformat();
5: ptr funcinv(), extrfield(), typexpr(), strucelt(), mkfield();
6: ptr esizeof(), elenof(), mkilab();
7: ptr ifthen(), doloop();
8: struct varblock *subscript();
9: %}
10:
11: %start graal
12: %union { int ival; ptr pval; char *cval; }
13:
14: %left COLON
15: %left COMMA
16: %right ASGNOP /* = +- -= ... */
17: %right REPOP /* $ */
18: %left OR /* | || */
19: %left AND /* & && */
20: %left NOT
21: %nonassoc RELOP /* LT GT LE GE EQ NE */
22: %left ADDOP /* + - */
23: %left MULTOP /* * / */
24: %right POWER /* ** ^ */
25: %left ARROW QUALOP /* -> . */
26:
27: %type <pval> dcl stat exec stats proc args arg varname comname structname
28: %type <pval> dcl1 dcls1 dcl dcls specs equivlist attrs attr comclass
29: %type <pval> dim dimbound bounds bound ubound vars varlist var
30: %type <pval> specarray spec deftype Struct
31: %type <pval> expr lhs parexprs iostat sizeof lengthof lhs1 lhsname exprlist
32: %type <pval> beginexec control until lablist parlablist compgotoindex
33: %type <pval> do exprnull fortest iostat iounit iolist ioitem iobrace
34: %type <pval> format
35: %type <ival> stype sclass prec logcon logval brk blocktype letter iokwd label
36: %token <pval> CONST OPTNAME COMNAME STRUCTNAME NAME ESCAPE
37: %token <ival> RELOP ASGNOP OR AND NOT ADDOP MULTOP POWER DOUBLEADDOP
38: %token <ival> LETTER TRUE FALSE
39:
40: %{
41: extern int prevv;
42: extern YYSTYPE prevl;
43: ptr p;
44: ptr procattrs;
45: int i,n;
46: static int imptype;
47: static int ininit =NO;
48:
49: %}
50:
51: %%
52:
53:
54: graal:
55: { graal = PARSEOF; }
56: | option endchunk
57: { graal = PARSOPT; }
58: | dcl endchunk
59: { graal = PARSDCL; doinits($1); frchain( & $1); }
60: | procst EOS stats end
61: { endproc(); graal = PARSPROC; }
62: | define endchunk
63: { graal = PARSDEF; }
64: | exec endchunk
65: { graal = PARSERR; }
66: | error
67: { graal = PARSERR;
68: errmess("Syntax error", "", "");
69: }
70: ;
71:
72: endchunk: EOS { eofneed = 1; }
73:
74: stat: dcl EOS
75: { if(!dclsect)
76: warn("declaration amid executables");
77: $$ = bgnexec();
78: TEST fprintf(diagfile,"stat: dcl\n");
79: doinits($1); frchain( & $1); }
80: | exec EOS
81: { if(dclsect && ((struct headbits *)$1)->tag!=TSTFUNCT)
82: dclsect = 0;
83: TEST fprintf(diagfile, "stat: exec\n"); }
84: | define EOS
85: { $$ = bgnexec(); }
86: | error EOS
87: { yyerrok;
88: errmess("Syntax error", "", "");
89: $$ = bgnexec();
90: }
91: ;
92:
93: stats:
94: { $$ = bgnexec(); }
95: | stats { ((struct execblock *)thisexec)->copylab = 1; } stat
96: { $$ = addexec(); ((struct execblock *)thisexec)->copylab = 0; }
97: ;
98:
99: procst: oproc
100: { procname = 0; thisargs = 0;
101: if(procclass == 0) procclass = PRMAIN;
102: goto proctype;
103: }
104: | oproc procname
105: { thisargs = 0; goto proctype; }
106: | oproc procname LPAR RPAR
107: { thisargs = 0; goto proctype; }
108: | oproc procname LPAR args RPAR
109: { thisargs = $4;
110: proctype:
111: if(procattrs)
112: if(procname == 0)
113: dclerr("attributes on unnamed procedure", "");
114: else {
115: attvars(procattrs, mkchain(procname,CHNULL));
116: procclass = PRFUNCT;
117: }
118: fprintf(diagfile, "Procedure %s:\n", procnm() );
119: if(verbose)
120: fprintf(diagfile, " Pass 1\n");
121: }
122: ;
123:
124: procname: NAME
125: { procname = mkvar($1);
126: extname(procname);
127: }
128: ;
129:
130: oproc: proc
131: { procattrs = 0; }
132: | attrs proc
133: { procattrs = $1;
134: if(procclass == 0) procclass = PRFUNCT;
135: }
136: ;
137:
138: proc: PROCEDURE
139: { $$ = bgnproc(); procclass = 0; }
140: | BLOCKDATA
141: { $$ = bgnproc(); procclass = PRBLOCK; }
142: ;
143:
144: args: arg
145: { $$ = (int *)mkchain($1,CHNULL); }
146: | args COMMA arg
147: { hookup($1, mkchain($3,CHNULL) ); }
148: ;
149:
150: arg: varname
151: { if(((struct iostblock /*|| struct exprblock|| struct varblock */ *)$1)->vclass == CLUNDEFINED)
152: ((struct iostblock /*|| struct exprblock|| struct varblock */ *)$1)->vclass = CLARG;
153: else dclerr("argument already used", ((struct stentry *)((struct defblock /*|| struct labelblock|| struct varblock|| struct keyblock|| struct typeblock */ *)$1)->sthead)->namep);
154: }
155: ;
156:
157: option: optson optionnames { optneed = 0; }
158: ;
159:
160: optson: OPTION
161: { if(blklevel > 0)
162: {
163: execerr("Option statement inside procedure", "");
164: execerr("procedure %s terminated prematurely", procnm());
165: endproc();
166: }
167: optneed = 1;
168: }
169: ;
170:
171: optionnames:
172: | optionnames optelt
173: | optionnames optelt COMMA
174: ;
175:
176: optelt: OPTNAME
177: { setopt($1,CNULL); cfree($1); }
178: | OPTNAME ASGNOP OPTNAME
179: { setopt($1,$3); cfree($1); cfree($3); }
180: | OPTNAME ASGNOP CONST
181: { setopt($1,((struct iostblock /*|| struct exprblock */ *)$3)->leftp); cfree($1); cfree($3); }
182: ;
183:
184:
185: define: DEFINE { defneed = 1; }
186: ;
187:
188: end: END
189: { if(((struct headbits *)thisctl)->subtype != STPROC)
190: execerr("control stack not empty upon END", "");
191: exnull();
192: popctl();
193: }
194: ;
195:
196: contnu:
197: { igeol=1; /* continue past newlines */ }
198: ;
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.