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