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