![[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] / 42BSD / usr.bin / f77 / src / f77pass1|
Return to gram.dcl CVS log | Up to [CSRG BSD Unix] / 42BSD / usr.bin / f77 / src / f77pass1 |
1.1 root 1: spec: dcl
2: | common
3: | external
4: | intrinsic
5: | equivalence
6: | implicit
7: | data
8: | namelist
9: | SSAVE
10: { NO66("SAVE statement");
11: saveall = YES; }
12: | SSAVE savelist
13: { NO66("SAVE statement"); }
14: | SFORMAT
15: {
16: if (parstate < INDCL)
17: parstate = INDCL;
18: fmtstmt(thislabel);
19: setfmt(thislabel);
20: }
21: | SPARAM in_dcl SLPAR paramlist SRPAR
22: { NO66("PARAMETER statement"); }
23: ;
24:
25: dcl: type opt_comma name in_dcl dims lengspec
26: { settype($3, $1, $6);
27: if(ndim>0) setbound($3,ndim,dims);
28: }
29: | dcl SCOMMA name dims lengspec
30: { settype($3, $1, $5);
31: if(ndim>0) setbound($3,ndim,dims);
32: }
33: ;
34:
35: type: typespec lengspec
36: { varleng = $2; }
37: ;
38:
39: typespec: typename
40: { varleng = ($1<0 || $1==TYLONG ? 0 : typesize[$1]); }
41: ;
42:
43: typename: SINTEGER { $$ = TYLONG; }
44: | SREAL { $$ = TYREAL; }
45: | SCOMPLEX { $$ = TYCOMPLEX; }
46: | SDOUBLE { $$ = TYDREAL; }
47: | SDCOMPLEX { NOEXT("DOUBLE COMPLEX statement"); $$ = TYDCOMPLEX; }
48: | SLOGICAL { $$ = TYLOGICAL; }
49: | SCHARACTER { NO66("CHARACTER statement"); $$ = TYCHAR; }
50: | SUNDEFINED { $$ = TYUNKNOWN; }
51: | SDIMENSION { $$ = TYUNKNOWN; }
52: | SAUTOMATIC { NOEXT("AUTOMATIC statement"); $$ = - STGAUTO; }
53: | SSTATIC { NOEXT("STATIC statement"); $$ = - STGBSS; }
54: ;
55:
56: lengspec:
57: { $$ = varleng; }
58: | SSTAR intonlyon expr intonlyoff
59: {
60: expptr p;
61: p = $3;
62: NO66("length specification *n");
63: if( ! ISICON(p) || p->constblock.const.ci<0 )
64: {
65: $$ = 0;
66: dclerr("length must be a positive integer constant",
67: PNULL);
68: }
69: else $$ = p->constblock.const.ci;
70: }
71: | SSTAR intonlyon SLPAR SSTAR SRPAR intonlyoff
72: { NO66("length specification *(*)"); $$ = -1; }
73: ;
74:
75: common: SCOMMON in_dcl var
76: { incomm( $$ = comblock(0, CNULL) , $3 ); }
77: | SCOMMON in_dcl comblock var
78: { $$ = $3; incomm($3, $4); }
79: | common opt_comma comblock opt_comma var
80: { $$ = $3; incomm($3, $5); }
81: | common SCOMMA var
82: { incomm($1, $3); }
83: ;
84:
85: comblock: SCONCAT
86: { $$ = comblock(0, CNULL); }
87: | SSLASH SNAME SSLASH
88: { $$ = comblock(toklen, token); }
89: ;
90:
91: external: SEXTERNAL in_dcl name
92: { setext($3); }
93: | external SCOMMA name
94: { setext($3); }
95: ;
96:
97: intrinsic: SINTRINSIC in_dcl name
98: { NO66("INTRINSIC statement"); setintr($3); }
99: | intrinsic SCOMMA name
100: { setintr($3); }
101: ;
102:
103: equivalence: SEQUIV in_dcl equivset
104: | equivalence SCOMMA equivset
105: ;
106:
107: equivset: SLPAR equivlist SRPAR
108: {
109: struct Equivblock *p;
110: if(nequiv >= maxequiv)
111: many("equivalences", 'q');
112: p = & eqvclass[nequiv++];
113: p->eqvinit = NO;
114: p->eqvbottom = 0;
115: p->eqvtop = 0;
116: p->equivs = $2;
117: p->init = NO;
118: p->initoffset = 0;
119: }
120: ;
121:
122: equivlist: lhs
123: { $$=ALLOC(Eqvchain);
124: $$->eqvitem.eqvlhs = (struct Primblock *)$1;
125: }
126: | equivlist SCOMMA lhs
127: { $$=ALLOC(Eqvchain);
128: $$->eqvitem.eqvlhs = (struct Primblock *) $3;
129: $$->eqvnextp = $1;
130: }
131: ;
132:
133:
134: savelist: saveitem
135: | savelist SCOMMA saveitem
136: ;
137:
138: saveitem: name
139: { int k;
140: $1->vsave = YES;
141: k = $1->vstg;
142: if( ! ONEOF(k, M(STGUNKNOWN)|M(STGBSS)|M(STGINIT)) )
143: dclerr("can only save static variables", $1);
144: }
145: | comblock
146: { $1->extsave = 1; }
147: ;
148:
149: paramlist: paramitem
150: | paramlist SCOMMA paramitem
151: ;
152:
153: paramitem: name SEQUALS expr
154: {
155: if ($1->vclass == CLUNKNOWN)
156: $1->vclass = CLPARAM;
157: else
158: dclerr("%s redefined", $1);
159:
160: if ($1->vclass == CLPARAM)
161: {
162: if (!ISCONST($3))
163: $3 = fixtype($3);
164:
165: if ($1->vtype == TYUNKNOWN)
166: {
167: char c;
168:
169: c = $1->varname[0];
170: if (c >= 'A' && c <= 'Z')
171: c = c - 'A';
172: else
173: c = c - 'a';
174: $1->vtype = impltype[c];
175: $1->vleng = ICON(implleng[c]);
176: }
177: if ($1->vtype == TYUNKNOWN)
178: {
179: warn1("type undefined for %s",
180: varstr(VL, $1->varname));
181: ((struct Paramblock *) ($1))->paramval = $3;
182: }
183: else
184: {
185: extern int badvalue;
186: extern expptr constconv();
187: int type;
188: ftnint len;
189:
190: type = $1->vtype;
191: if (type == TYCHAR)
192: {
193: if ($1->vleng != NULL)
194: len = $1->vleng->constblock.const.ci;
195: else if (ISCONST($3) &&
196: $3->constblock.vtype == TYCHAR)
197: len = $3->constblock.vleng->
198: constblock.const.ci;
199: else
200: len = 1;
201: }
202: badvalue = 0;
203: if (ISCONST($3))
204: {
205: ((struct Paramblock *) ($1))->paramval =
206: convconst($1->vtype, len, $3);
207: if (type == TYLOGICAL)
208: ((struct Paramblock *) ($1))->paramval->
209: headblock.vtype = TYLOGICAL;
210: frexpr((tagptr) $3);
211: }
212: else
213: {
214: warn1("%s set to a nonconstant",
215: varstr(VL, $1->varname));
216: ((struct Paramblock *) ($1))->paramval = $3;
217: }
218: }
219: }
220: }
221: ;
222:
223: var: name dims
224: { if(ndim>0) setbound($1, ndim, dims); }
225: ;
226:
227:
228: dims:
229: { ndim = 0; }
230: | SLPAR dimlist SRPAR
231: ;
232:
233: dimlist: { ndim = 0; } dim
234: | dimlist SCOMMA dim
235: ;
236:
237: dim: ubound
238: { if(ndim == maxdim)
239: err("too many dimensions");
240: else if(ndim < maxdim)
241: { dims[ndim].lb = 0;
242: dims[ndim].ub = $1;
243: }
244: ++ndim;
245: }
246: | expr SCOLON ubound
247: { if(ndim == maxdim)
248: err("too many dimensions");
249: else if(ndim < maxdim)
250: { dims[ndim].lb = $1;
251: dims[ndim].ub = $3;
252: }
253: ++ndim;
254: }
255: ;
256:
257: ubound: SSTAR
258: { $$ = 0; }
259: | expr
260: ;
261:
262: labellist: label
263: { nstars = 1; labarray[0] = $1; }
264: | labellist SCOMMA label
265: { if(nstars < MAXLABLIST) labarray[nstars++] = $3; }
266: ;
267:
268: label: SICON
269: { $$ = execlab( convci(toklen, token) ); }
270: ;
271:
272: implicit: SIMPLICIT in_dcl implist
273: { NO66("IMPLICIT statement"); }
274: | implicit SCOMMA implist
275: ;
276:
277: implist: imptype SLPAR letgroups SRPAR
278: ;
279:
280: imptype: { needkwd = 1; } type
281: { vartype = $2; }
282: ;
283:
284: letgroups: letgroup
285: | letgroups SCOMMA letgroup
286: ;
287:
288: letgroup: letter
289: { setimpl(vartype, varleng, $1, $1); }
290: | letter SMINUS letter
291: { setimpl(vartype, varleng, $1, $3); }
292: ;
293:
294: letter: SNAME
295: { if(toklen!=1 || token[0]<'a' || token[0]>'z')
296: {
297: dclerr("implicit item must be single letter", PNULL);
298: $$ = 0;
299: }
300: else $$ = token[0];
301: }
302: ;
303:
304: namelist: SNAMELIST
305: | namelist namelistentry
306: ;
307:
308: namelistentry: SSLASH name SSLASH namelistlist
309: {
310: if($2->vclass == CLUNKNOWN)
311: {
312: $2->vclass = CLNAMELIST;
313: $2->vtype = TYINT;
314: $2->vstg = STGINIT;
315: $2->varxptr.namelist = $4;
316: $2->vardesc.varno = ++lastvarno;
317: }
318: else dclerr("cannot be a namelist name", $2);
319: }
320: ;
321:
322: namelistlist: name
323: { $$ = mkchain($1, CHNULL); }
324: | namelistlist SCOMMA name
325: { $$ = hookup($1, mkchain($3, CHNULL)); }
326: ;
327:
328: in_dcl:
329: { switch(parstate)
330: {
331: case OUTSIDE: newproc();
332: startproc(PNULL, CLMAIN);
333: case INSIDE: parstate = INDCL;
334: case INDCL: break;
335:
336: default:
337: dclerr("declaration among executables", PNULL);
338: }
339: }
340: ;
341:
342: data: data1
343: {
344: if (overlapflag == YES)
345: warn("overlapping initializations");
346: }
347:
348: data1: SDATA in_data datapair
349: | data1 opt_comma datapair
350: ;
351:
352: in_data:
353: { if(parstate == OUTSIDE)
354: {
355: newproc();
356: startproc(PNULL, CLMAIN);
357: }
358: if(parstate < INDATA)
359: {
360: enddcl();
361: parstate = INDATA;
362: }
363: overlapflag = NO;
364: }
365: ;
366:
367: datapair: datalvals SSLASH datarvals SSLASH
368: { savedata($1, $3); }
369: ;
370:
371: datalvals: datalval
372: { $$ = preplval(NULL, $1); }
373: | datalvals SCOMMA datalval
374: { $$ = preplval($1, $3); }
375: ;
376:
377: datarvals: datarval
378: | datarvals SCOMMA datarval
379: {
380: $3->next = $1;
381: $$ = $3;
382: }
383: ;
384:
385: datalval: dataname
386: { $$ = mkdlval($1, NULL, NULL); }
387: | dataname datasubs
388: { $$ = mkdlval($1, $2, NULL); }
389: | dataname datarange
390: { $$ = mkdlval($1, NULL, $2); }
391: | dataname datasubs datarange
392: { $$ = mkdlval($1, $2, $3); }
393: | dataimplieddo
394: ;
395:
396: dataname: SNAME { $$ = mkdname(toklen, token); }
397: ;
398:
399: datasubs: SLPAR iconexprlist SRPAR
400: { $$ = revvlist($2); }
401: ;
402:
403: datarange: SLPAR opticonexpr SCOLON opticonexpr SRPAR
404: { $$ = mkdrange($2, $4); }
405: ;
406:
407: iconexprlist: iconexpr
408: {
409: $$ = prepvexpr(NULL, $1);
410: }
411: | iconexprlist SCOMMA iconexpr
412: {
413: $$ = prepvexpr($1, $3);
414: }
415: ;
416:
417: opticonexpr: { $$ = NULL; }
418: | iconexpr { $$ = $1; }
419: ;
420:
421: dataimplieddo: SLPAR dlist SCOMMA dataname SEQUALS iconexprlist SRPAR
422: { $$ = mkdatado($2, $4, $6); }
423: ;
424:
425: dlist: dataelt
426: { $$ = preplval(NULL, $1); }
427: | dlist SCOMMA dataelt
428: { $$ = preplval($1, $3); }
429: ;
430:
431: dataelt: dataname datasubs
432: { $$ = mkdlval($1, $2, NULL); }
433: | dataname datarange
434: { $$ = mkdlval($1, NULL, $2); }
435: | dataname datasubs datarange
436: { $$ = mkdlval($1, $2, $3); }
437: | dataimplieddo
438: ;
439:
440: datarval: datavalue
441: {
442: static dvalue one = { DVALUE, NORMAL, 1 };
443:
444: $$ = mkdrval(&one, $1);
445: }
446: | dataname SSTAR datavalue
447: {
448: $$ = mkdrval($1, $3);
449: frvexpr($1);
450: }
451: | unsignedint SSTAR datavalue
452: {
453: $$ = mkdrval($1, $3);
454: frvexpr($1);
455: }
456: ;
457:
458: datavalue: dataname
459: {
460: $$ = evparam($1);
461: free((char *) $1);
462: }
463: | int_const
464: {
465: $$ = ivaltoicon($1);
466: frvexpr($1);
467: }
468:
469: | real_const
470: | complex_const
471: | STRUE { $$ = mklogcon(1); }
472: | SFALSE { $$ = mklogcon(0); }
473: | SHOLLERITH { $$ = mkstrcon(toklen, token); }
474: | SSTRING { $$ = mkstrcon(toklen, token); }
475: | bit_const
476: ;
477:
478: int_const: unsignedint
479: | SPLUS unsignedint
480: { $$ = $2; }
481: | SMINUS unsignedint
482: {
483: $$ = negival($2);
484: frvexpr($2);
485: }
486:
487: ;
488:
489: unsignedint: SICON { $$ = evicon(toklen, token); }
490: ;
491:
492: real_const: unsignedreal
493: | SPLUS unsignedreal
494: { $$ = $2; }
495: | SMINUS unsignedreal
496: {
497: consnegop($2);
498: $$ = $2;
499: }
500: ;
501:
502: unsignedreal: SRCON { $$ = mkrealcon(TYREAL, convcd(toklen, token)); }
503: | SDCON { $$ = mkrealcon(TYDREAL, convcd(toklen, token)); }
504: ;
505:
506: bit_const: SHEXCON { $$ = mkbitcon(4, toklen, token); }
507: | SOCTCON { $$ = mkbitcon(3, toklen, token); }
508: | SBITCON { $$ = mkbitcon(1, toklen, token); }
509: ;
510:
511: iconexpr: iconterm
512: | SPLUS iconterm
513: { $$ = $2; }
514: | SMINUS iconterm
515: { $$ = mkdexpr(OPNEG, NULL, $2); }
516: | iconexpr SPLUS iconterm
517: { $$ = mkdexpr(OPPLUS, $1, $3); }
518: | iconexpr SMINUS iconterm
519: { $$ = mkdexpr(OPMINUS, $1, $3); }
520: ;
521:
522: iconterm: iconfactor
523: | iconterm SSTAR iconfactor
524: { $$ = mkdexpr(OPSTAR, $1, $3); }
525: | iconterm SSLASH iconfactor
526: { $$ = mkdexpr(OPSLASH, $1, $3); }
527: ;
528:
529: iconfactor: iconprimary
530: | iconprimary SPOWER iconfactor
531: { $$ = mkdexpr(OPPOWER, $1, $3); }
532: ;
533:
534: iconprimary: SICON
535: { $$ = evicon(toklen, token); }
536: | dataname
537: | SLPAR iconexpr SRPAR
538: { $$ = $2; }
539: ;
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.