4.3BSD - /usr/src/usr.bin/f77/src/f77pass1/gram.dcl

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