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