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