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