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