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