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