![[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] / 40BSD / cmd / f77|
Return to gram.dcl CVS log | Up to [CSRG BSD Unix] / 40BSD / 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 { $$ = TYCOMPLEX; }
41: | SDOUBLE { $$ = TYDREAL; }
42: | SDCOMPLEX { 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');
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: datavarlist SSLASH vallist SSLASH
145: { ftnint junk;
146: if(nextdata(&junk,&junk) != NULL)
147: {
148: err("too few initializers");
149: curdtp = NULL;
150: }
151: frdata($1);
152: frrpl();
153: }
154: ;
155:
156: vallist: { toomanyinit = NO; } val
157: | vallist SCOMMA val
158: ;
159:
160: val: value
161: { dataval(PNULL, $1); }
162: | simple SSTAR value
163: { dataval($1, $3); }
164: ;
165:
166: value: simple
167: | addop simple
168: { if( $1==OPMINUS && ISCONST($2) )
169: consnegop($2);
170: $$ = $2;
171: }
172: | complex_const
173: | bit_const
174: ;
175:
176: savelist: saveitem
177: | savelist SCOMMA saveitem
178: ;
179:
180: saveitem: name
181: { int k;
182: $1->vsave = YES;
183: k = $1->vstg;
184: if( ! ONEOF(k, M(STGUNKNOWN)|M(STGBSS)|M(STGINIT)) )
185: dclerr("can only save static variables", $1);
186: }
187: | comblock
188: { $1->extsave = 1; }
189: ;
190:
191: paramlist: paramitem
192: | paramlist SCOMMA paramitem
193: ;
194:
195: paramitem: name SEQUALS expr
196: { if($1->vclass == CLUNKNOWN)
197: { $1->vclass = CLPARAM;
198: ( (struct Paramblock *) ($1) )->paramval = $3;
199: }
200: else dclerr("cannot make %s parameter", $1);
201: }
202: ;
203:
204: var: name dims
205: { if(ndim>0) setbound($1, ndim, dims); }
206: ;
207:
208: datavar: lhs
209: { Namep np;
210: np = ( (struct Primblock *) $1) -> namep;
211: vardcl(np);
212: if(np->vstg == STGCOMMON)
213: extsymtab[np->vardesc.varno].extinit = YES;
214: else if(np->vstg==STGEQUIV)
215: eqvclass[np->vardesc.varno].eqvinit = YES;
216: else if(np->vstg!=STGINIT && np->vstg!=STGBSS)
217: dclerr("inconsistent storage classes", np);
218: $$ = mkchain($1, CHNULL);
219: }
220: | SLPAR datavarlist SCOMMA dospec SRPAR
221: { chainp p; struct Impldoblock *q;
222: q = ALLOC(Impldoblock);
223: q->tag = TIMPLDO;
224: q->varnp = (Namep) ($4->datap);
225: p = $4->nextp;
226: if(p) { q->implb = (expptr)(p->datap); p = p->nextp; }
227: if(p) { q->impub = (expptr)(p->datap); p = p->nextp; }
228: if(p) { q->impstep = (expptr)(p->datap); p = p->nextp; }
229: frchain( & ($4) );
230: $$ = mkchain(q, CHNULL);
231: q->datalist = hookup($2, $$);
232: }
233: ;
234:
235: datavarlist: datavar
236: { curdtp = $1; curdtelt = 0; }
237: | datavarlist SCOMMA datavar
238: { $$ = hookup($1, $3); }
239: ;
240:
241: dims:
242: { ndim = 0; }
243: | SLPAR dimlist SRPAR
244: ;
245:
246: dimlist: { ndim = 0; } dim
247: | dimlist SCOMMA dim
248: ;
249:
250: dim: ubound
251: { if(ndim == maxdim)
252: err("too many dimensions");
253: else if(ndim < maxdim)
254: { dims[ndim].lb = 0;
255: dims[ndim].ub = $1;
256: }
257: ++ndim;
258: }
259: | expr SCOLON ubound
260: { if(ndim == maxdim)
261: err("too many dimensions");
262: else if(ndim < maxdim)
263: { dims[ndim].lb = $1;
264: dims[ndim].ub = $3;
265: }
266: ++ndim;
267: }
268: ;
269:
270: ubound: SSTAR
271: { $$ = 0; }
272: | expr
273: ;
274:
275: labellist: label
276: { nstars = 1; labarray[0] = $1; }
277: | labellist SCOMMA label
278: { if(nstars < MAXLABLIST) labarray[nstars++] = $3; }
279: ;
280:
281: label: SICON
282: { $$ = execlab( convci(toklen, token) ); }
283: ;
284:
285: implicit: SIMPLICIT in_dcl implist
286: { NO66("IMPLICIT statement"); }
287: | implicit SCOMMA implist
288: ;
289:
290: implist: imptype SLPAR letgroups SRPAR
291: ;
292:
293: imptype: { needkwd = 1; } type
294: { vartype = $2; }
295: ;
296:
297: letgroups: letgroup
298: | letgroups SCOMMA letgroup
299: ;
300:
301: letgroup: letter
302: { setimpl(vartype, varleng, $1, $1); }
303: | letter SMINUS letter
304: { setimpl(vartype, varleng, $1, $3); }
305: ;
306:
307: letter: SNAME
308: { if(toklen!=1 || token[0]<'a' || token[0]>'z')
309: {
310: dclerr("implicit item must be single letter", PNULL);
311: $$ = 0;
312: }
313: else $$ = token[0];
314: }
315: ;
316:
317: namelist: SNAMELIST
318: | namelist namelistentry
319: ;
320:
321: namelistentry: SSLASH name SSLASH namelistlist
322: {
323: if($2->vclass == CLUNKNOWN)
324: {
325: $2->vclass = CLNAMELIST;
326: $2->vtype = TYINT;
327: $2->vstg = STGINIT;
328: $2->varxptr.namelist = $4;
329: $2->vardesc.varno = ++lastvarno;
330: }
331: else dclerr("cannot be a namelist name", $2);
332: }
333: ;
334:
335: namelistlist: name
336: { $$ = mkchain($1, CHNULL); }
337: | namelistlist SCOMMA name
338: { $$ = hookup($1, mkchain($3, CHNULL)); }
339: ;
340:
341: in_dcl:
342: { switch(parstate)
343: {
344: case OUTSIDE: newproc();
345: startproc(PNULL, CLMAIN);
346: case INSIDE: parstate = INDCL;
347: case INDCL: break;
348:
349: default:
350: dclerr("declaration among executables", PNULL);
351: }
352: }
353: ;
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.