![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to gram.dcl CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 3BSD / cmd / f77|
Return to gram.dcl CVS log | Up to [CSRG BSD Unix] / 3BSD / cmd / f77 |
1.1 root 1: spec: dcl
2: | common
3: | external
4: | intrinsic
5: | equivalence
6: | data
7: | implicit
8: | SSAVE
9: { NO66("SAVE statement");
10: saveall = YES; }
11: | SSAVE savelist
12: { NO66("SAVE statement"); }
13: | SFORMAT
14: { fmtstmt(thislabel); setfmt(thislabel); }
15: | SPARAM in_dcl SLPAR paramlist SRPAR
16: { NO66("PARAMETER statement"); }
17: ;
18:
19: dcl: type opt_comma name in_dcl dims lengspec
20: { settype($3, $1, $6);
21: if(ndim>0) setbound($3,ndim,dims);
22: }
23: | dcl SCOMMA name dims lengspec
24: { settype($3, $1, $5);
25: if(ndim>0) setbound($3,ndim,dims);
26: }
27: ;
28:
29: type: typespec lengspec
30: { varleng = $2; }
31: ;
32:
33: typespec: typename
34: { varleng = ($1<0 || $1==TYLONG ? 0 : typesize[$1]); }
35: ;
36:
37: typename: SINTEGER { $$ = TYLONG; }
38: | SREAL { $$ = TYREAL; }
39: | SCOMPLEX { $$ = TYCOMPLEX; }
40: | SDOUBLE { $$ = TYDREAL; }
41: | SDCOMPLEX { NOEXT("DOUBLE COMPLEX statement"); $$ = TYDCOMPLEX; }
42: | SLOGICAL { $$ = TYLOGICAL; }
43: | SCHARACTER { NO66("CHARACTER statement"); $$ = TYCHAR; }
44: | SUNDEFINED { $$ = TYUNKNOWN; }
45: | SDIMENSION { $$ = TYUNKNOWN; }
46: | SAUTOMATIC { NOEXT("AUTOMATIC statement"); $$ = - STGAUTO; }
47: | SSTATIC { NOEXT("STATIC statement"); $$ = - STGBSS; }
48: ;
49:
50: lengspec:
51: { $$ = varleng; }
52: | SSTAR expr
53: {
54: NO66("length specification *n");
55: if( ! ISICON($2) )
56: {
57: $$ = 0;
58: dclerr("length must be an integer constant", 0);
59: }
60: else $$ = $2->const.ci;
61: }
62: | SSTAR SLPAR SSTAR SRPAR
63: { NO66("length specification *(*)"); $$ = 0; }
64: ;
65:
66: common: SCOMMON in_dcl var
67: { incomm( $$ = comblock(0, 0) , $3 ); }
68: | SCOMMON in_dcl comblock var
69: { $$ = $3; incomm($3, $4); }
70: | common opt_comma comblock opt_comma var
71: { $$ = $3; incomm($3, $5); }
72: | common SCOMMA var
73: { incomm($1, $3); }
74: ;
75:
76: comblock: SCONCAT
77: { $$ = comblock(0, 0); }
78: | SSLASH SNAME SSLASH
79: { $$ = comblock(toklen, token); }
80: ;
81:
82: external: SEXTERNAL in_dcl name
83: { setext($3); }
84: | external SCOMMA name
85: { setext($3); }
86: ;
87:
88: intrinsic: SINTRINSIC in_dcl name
89: { NO66("INTRINSIC statement"); setintr($3); }
90: | intrinsic SCOMMA name
91: { setintr($3); }
92: ;
93:
94: equivalence: SEQUIV in_dcl equivset
95: | equivalence SCOMMA equivset
96: ;
97:
98: equivset: SLPAR equivlist SRPAR
99: {
100: struct Equivblock *p;
101: if(nequiv >= MAXEQUIV)
102: many("equivalences", 'q');
103: p = & eqvclass[nequiv++];
104: p->eqvinit = 0;
105: p->eqvbottom = 0;
106: p->eqvtop = 0;
107: p->equivs = $2;
108: }
109: ;
110:
111: equivlist: lhs
112: { $$ = ALLOC(Eqvchain); $$->eqvitem = $1; }
113: | equivlist SCOMMA lhs
114: { $$ = ALLOC(Eqvchain); $$->eqvitem = $3; $$->nextp = $1; }
115: ;
116:
117: data: SDATA in_data datalist
118: | data opt_comma datalist
119: ;
120:
121: in_data:
122: { if(parstate == OUTSIDE)
123: {
124: newproc();
125: startproc(0, CLMAIN);
126: }
127: if(parstate < INDATA)
128: {
129: enddcl();
130: parstate = INDATA;
131: }
132: }
133: ;
134:
135: datalist: datavarlist SSLASH vallist SSLASH
136: { ftnint junk;
137: if(nextdata(&junk,&junk) != NULL)
138: {
139: err("too few initializers");
140: curdtp = NULL;
141: }
142: frdata($1);
143: frrpl();
144: }
145: ;
146:
147: vallist: { toomanyinit = NO; } val
148: | vallist SCOMMA val
149: ;
150:
151: val: value
152: { dataval(NULL, $1); }
153: | simple SSTAR value
154: { dataval($1, $3); }
155: ;
156:
157: value: simple
158: | addop simple
159: { if( $1==OPMINUS && ISCONST($2) )
160: consnegop($2);
161: $$ = $2;
162: }
163: | complex_const
164: | bit_const
165: ;
166:
167: savelist: saveitem
168: | savelist SCOMMA saveitem
169: ;
170:
171: saveitem: name
172: { int k;
173: $1->vsave = 1;
174: k = $1->vstg;
175: if( ! ONEOF(k, M(STGUNKNOWN)|M(STGBSS)|M(STGINIT)) )
176: dclerr("can only save static variables", $1);
177: }
178: | comblock
179: { $1->extsave = 1; }
180: ;
181:
182: paramlist: paramitem
183: | paramlist SCOMMA paramitem
184: ;
185:
186: paramitem: name SEQUALS expr
187: { if($1->vclass == CLUNKNOWN)
188: { $1->vclass = CLPARAM;
189: $1->paramval = $3;
190: }
191: else dclerr("cannot make %s parameter", $1);
192: }
193: ;
194:
195: var: name dims
196: { if(ndim>0) setbounds($1, ndim, dims); }
197: ;
198:
199: datavar: lhs
200: { ptr np;
201: vardcl(np = $1->namep);
202: if(np->vstg == STGBSS)
203: np->vstg = STGINIT;
204: else if(np->vstg == STGCOMMON)
205: extsymtab[np->vardesc.varno].extinit = YES;
206: else if(np->vstg==STGEQUIV)
207: eqvclass[np->vardesc.varno].eqvinit = YES;
208: else if(np->vstg != STGINIT)
209: dclerr("inconsistent storage classes", np);
210: $$ = mkchain($1, 0);
211: }
212: | SLPAR datavarlist SCOMMA dospec SRPAR
213: { chainp p; struct Impldoblock *q;
214: q = ALLOC(Impldoblock);
215: q->tag = TIMPLDO;
216: q->varnp = $4->datap;
217: p = $4->nextp;
218: if(p) { q->implb = p->datap; p = p->nextp; }
219: if(p) { q->impub = p->datap; p = p->nextp; }
220: if(p) { q->impstep = p->datap; p = p->nextp; }
221: frchain( & ($4) );
222: $$ = mkchain(q, 0);
223: q->datalist = hookup($2, $$);
224: }
225: ;
226:
227: datavarlist: datavar
228: { curdtp = $1; curdtelt = 0; }
229: | datavarlist SCOMMA datavar
230: { $$ = hookup($1, $3); }
231: ;
232:
233: dims:
234: { ndim = 0; }
235: | SLPAR dimlist SRPAR
236: ;
237:
238: dimlist: { ndim = 0; } dim
239: | dimlist SCOMMA dim
240: ;
241:
242: dim: ubound
243: { if(ndim == maxdim)
244: err("too many dimensions");
245: else if(ndim < maxdim)
246: { dims[ndim].lb = 0;
247: dims[ndim].ub = $1;
248: }
249: ++ndim;
250: }
251: | expr SCOLON ubound
252: { if(ndim == maxdim)
253: err("too many dimensions");
254: else if(ndim < maxdim)
255: { dims[ndim].lb = $1;
256: dims[ndim].ub = $3;
257: }
258: ++ndim;
259: }
260: ;
261:
262: ubound: SSTAR
263: { $$ = 0; }
264: | expr
265: ;
266:
267: labellist: label
268: { nstars = 1; labarray[0] = $1; }
269: | labellist SCOMMA label
270: { if(nstars < MAXLABLIST) labarray[nstars++] = $3; }
271: ;
272:
273: label: labelval
274: {
275: if($1 == 0)
276: execerr("illegal label", 0);
277: else {
278: if($1->labinacc)
279: warn1("illegal branch to inner block, statement %s",
280: convic( (ftnint) ($1->stateno) ));
281: else if($1->labdefined == NO)
282: $1->blklevel = blklevel;
283: $1->labused = YES;
284: if($1->labtype == LABFORMAT)
285: err("may not branch to a format");
286: else
287: $1->labtype = LABEXEC;
288: }
289: }
290: ;
291:
292: labelval: SICON
293: { $$ = mklabel( convci(toklen, token) ); }
294: ;
295:
296: implicit: SIMPLICIT in_dcl implist
297: { NO66("IMPLICIT statement"); }
298: | implicit SCOMMA implist
299: ;
300:
301: implist: imptype SLPAR letgroups SRPAR
302: ;
303:
304: imptype: { needkwd = 1; } type
305: { vartype = $2; }
306: ;
307:
308: letgroups: letgroup
309: | letgroups SCOMMA letgroup
310: ;
311:
312: letgroup: letter
313: { setimpl(vartype, varleng, $1, $1); }
314: | letter SMINUS letter
315: { setimpl(vartype, varleng, $1, $3); }
316: ;
317:
318: letter: SNAME
319: { if(toklen!=1 || token[0]<'a' || token[0]>'z')
320: {
321: dclerr("implicit item must be single letter", 0);
322: $$ = 0;
323: }
324: else $$ = token[0];
325: }
326: ;
327:
328: in_dcl:
329: { switch(parstate)
330: {
331: case OUTSIDE: newproc();
332: startproc(0, CLMAIN);
333: case INSIDE: parstate = INDCL;
334: case INDCL: break;
335:
336: default:
337: dclerr("declaration among executables", 0);
338: }
339: }
340: ;
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.