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) 01/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 47spec: 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 69dcl: 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 79type: typespec lengspec 80 { varleng = $2; } 81 ; 82 83typespec: typename 84 { varleng = ($1<0 || $1==TYLONG ? 0 : typesize[$1]); 85 vartype = $1; 86 } 87 ; 88 89typename: 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 102lengspec: 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 135common: 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 145comblock: SCONCAT 146 { $$ = comblock(0, CNULL); } 147 | SSLASH SNAME SSLASH 148 { $$ = comblock(toklen, token); } 149 ; 150 151external: SEXTERNAL in_dcl name 152 { setext($3); } 153 | external SCOMMA name 154 { setext($3); } 155 ; 156 157intrinsic: SINTRINSIC in_dcl name 158 { NO66("INTRINSIC statement"); setintr($3); } 159 | intrinsic SCOMMA name 160 { setintr($3); } 161 ; 162 163equivalence: SEQUIV in_dcl equivset 164 | equivalence SCOMMA equivset 165 ; 166 167equivset: 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 184equivlist: 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 205savelist: saveitem 206 | savelist SCOMMA saveitem 207 ; 208 209saveitem: 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 221paramlist: paramitem 222 | paramlist SCOMMA paramitem 223 ; 224 225paramitem: name SEQUALS expr 226 { paramset( $1, $3 ); } 227 ; 228 229in_param: inside 230 { if(parstate > INDCL) 231 dclerr("parameter statement out of order", PNULL); 232 } 233 ; 234 235var: name dims 236 { if(ndim>0) setbound($1, ndim, dims); } 237 ; 238 239 240dims: 241 { ndim = 0; } 242 | SLPAR dimlist SRPAR 243 ; 244 245dimlist: { ndim = 0; } dim 246 | dimlist SCOMMA dim 247 ; 248 249dim: 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 269ubound: SSTAR 270 { $$ = 0; } 271 | expr 272 ; 273 274labellist: label 275 { nstars = 1; labarray[0] = $1; } 276 | labellist SCOMMA label 277 { if(nstars < MAXLABLIST) labarray[nstars++] = $3; } 278 ; 279 280label: SICON 281 { $$ = execlab( convci(toklen, token) ); } 282 ; 283 284implicit: SIMPLICIT in_implicit implist 285 { NO66("IMPLICIT statement"); } 286 | implicit SCOMMA implist 287 ; 288 289implist: imptype SLPAR letgroups SRPAR 290 ; 291 292imptype: { needkwd = 1; } type 293 { vartype = $2; } 294 ; 295 296in_implicit: inside 297 { if(parstate >= INDCL) 298 dclerr("implicit statement out of order", PNULL); 299 } 300 ; 301 302letgroups: letgroup 303 | letgroups SCOMMA letgroup 304 ; 305 306letgroup: letter 307 { setimpl(vartype, varleng, $1, $1); } 308 | letter SMINUS letter 309 { setimpl(vartype, varleng, $1, $3); } 310 ; 311 312letter: 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 322namelist: SNAMELIST 323 | namelist namelistentry 324 ; 325 326namelistentry: 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 340namelistlist: name 341 { $$ = mkchain($1, CHNULL); } 342 | namelistlist SCOMMA name 343 { $$ = hookup($1, mkchain($3, CHNULL)); } 344 ; 345 346inside: 347 { if(parstate < INSIDE) 348 { 349 newproc(); 350 startproc(PNULL, CLMAIN); 351 parstate = INSIDE; 352 } 353 } 354 ; 355 356in_dcl: inside 357 { if(parstate < INDCL) 358 parstate = INDCL; 359 if(parstate > INDCL) 360 dclerr("declaration among executables", PNULL); 361 } 362 ; 363 364data: data1 365 { 366 if (overlapflag == YES) 367 warn("overlapping initializations"); 368 } 369 370data1: SDATA in_data datapair 371 | data1 opt_comma datapair 372 ; 373 374in_data: inside 375 { if(parstate < INDATA) 376 { 377 enddcl(); 378 parstate = INDATA; 379 } 380 overlapflag = NO; 381 } 382 ; 383 384datapair: datalvals SSLASH datarvals SSLASH 385 { savedata($1, $3); } 386 ; 387 388datalvals: datalval 389 { $$ = preplval(NULL, $1); } 390 | datalvals SCOMMA datalval 391 { $$ = preplval($1, $3); } 392 ; 393 394datarvals: datarval 395 | datarvals SCOMMA datarval 396 { 397 $3->next = $1; 398 $$ = $3; 399 } 400 ; 401 402datalval: 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 413dataname: SNAME { $$ = mkdname(toklen, token); } 414 ; 415 416datasubs: SLPAR iconexprlist SRPAR 417 { $$ = revvlist($2); } 418 ; 419 420datarange: SLPAR opticonexpr SCOLON opticonexpr SRPAR 421 { $$ = mkdrange($2, $4); } 422 ; 423 424iconexprlist: iconexpr 425 { 426 $$ = prepvexpr(NULL, $1); 427 } 428 | iconexprlist SCOMMA iconexpr 429 { 430 $$ = prepvexpr($1, $3); 431 } 432 ; 433 434opticonexpr: { $$ = NULL; } 435 | iconexpr { $$ = $1; } 436 ; 437 438dataimplieddo: SLPAR dlist SCOMMA dataname SEQUALS iconexprlist SRPAR 439 { $$ = mkdatado($2, $4, $6); } 440 ; 441 442dlist: dataelt 443 { $$ = preplval(NULL, $1); } 444 | dlist SCOMMA dataelt 445 { $$ = preplval($1, $3); } 446 ; 447 448dataelt: 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 457datarval: 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 475datavalue: 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 495int_const: unsignedint 496 | SPLUS unsignedint 497 { $$ = $2; } 498 | SMINUS unsignedint 499 { 500 $$ = negival($2); 501 frvexpr($2); 502 } 503 504 ; 505 506unsignedint: SICON { $$ = evicon(toklen, token); } 507 ; 508 509real_const: unsignedreal 510 | SPLUS unsignedreal 511 { $$ = $2; } 512 | SMINUS unsignedreal 513 { 514 consnegop($2); 515 $$ = $2; 516 } 517 ; 518 519unsignedreal: SRCON { $$ = mkrealcon(TYREAL, convcd(toklen, token)); } 520 | SDCON { $$ = mkrealcon(TYDREAL, convcd(toklen, token)); } 521 ; 522 523bit_const: SHEXCON { $$ = mkbitcon(4, toklen, token); } 524 | SOCTCON { $$ = mkbitcon(3, toklen, token); } 525 | SBITCON { $$ = mkbitcon(1, toklen, token); } 526 ; 527 528iconexpr: 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 539iconterm: iconfactor 540 | iconterm SSTAR iconfactor 541 { $$ = mkdexpr(OPSTAR, $1, $3); } 542 | iconterm SSLASH iconfactor 543 { $$ = mkdexpr(OPSLASH, $1, $3); } 544 ; 545 546iconfactor: iconprimary 547 | iconprimary SPOWER iconfactor 548 { $$ = mkdexpr(OPPOWER, $1, $3); } 549 ; 550 551iconprimary: SICON 552 { $$ = evicon(toklen, token); } 553 | dataname 554 | SLPAR iconexpr SRPAR 555 { $$ = $2; } 556 ; 557