|
|
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.