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