1: spec:     dcl
   2:     | common
   3:     | external
   4:     | intrinsic
   5:     | equivalence
   6:     | data
   7:     | implicit
   8:     | SSAVE
   9:         { saveall = YES; }
  10:     | SSAVE savelist
  11:     | SFORMAT
  12:         { fmtstmt(thislabel); setfmt(thislabel); }
  13:     | SPARAM in_dcl SLPAR paramlist SRPAR
  14:     ;
  15: 
  16: dcl:      type name in_dcl lengspec dims
  17:         { settype($2, $1, $4);
  18:           if(ndim>0) setbound($2,ndim,dims);
  19:         }
  20:     | dcl SCOMMA name lengspec dims
  21:         { settype($3, $1, $4);
  22:           if(ndim>0) setbound($3,ndim,dims);
  23:         }
  24:     ;
  25: 
  26: type:     typespec lengspec
  27:         { varleng = $2; }
  28:     ;
  29: 
  30: typespec:  typename
  31:         { varleng = ($1<0 || $1==TYLONG ? 0 : typesize[$1]); }
  32:     ;
  33: 
  34: typename:    SINTEGER   { $$ = TYLONG; }
  35:     | SREAL     { $$ = TYREAL; }
  36:     | SCOMPLEX  { $$ = TYCOMPLEX; }
  37:     | SDOUBLE   { $$ = TYDREAL; }
  38:     | SDCOMPLEX { $$ = TYDCOMPLEX; }
  39:     | SLOGICAL  { $$ = TYLOGICAL; }
  40:     | SCHARACTER    { $$ = TYCHAR; }
  41:     | SUNDEFINED    { $$ = TYUNKNOWN; }
  42:     | SDIMENSION    { $$ = TYUNKNOWN; }
  43:     | SAUTOMATIC    { $$ = - STGAUTO; }
  44:     | SSTATIC   { $$ = - STGBSS; }
  45:     ;
  46: 
  47: lengspec:
  48:         { $$ = varleng; }
  49:     | SSTAR intonlyon expr intonlyoff
  50:         {
  51:           if( ! ISICON($3) )
  52:             {
  53:             $$ = 0;
  54:             error("length must be an integer constant", 0, 0, DCLERR);
  55:             }
  56:           else $$ = $3->const.ci;
  57:         }
  58:     | SSTAR intonlyon SLPAR SSTAR SRPAR intonlyoff
  59:         { $$ = 0; }
  60:     ;
  61: 
  62: common:   SCOMMON in_dcl var
  63:         { incomm( $$ = comblock(0, 0) , $3 ); }
  64:     | SCOMMON in_dcl comblock var
  65:         { $$ = $3;  incomm($3, $4); }
  66:     | common opt_comma comblock opt_comma var
  67:         { $$ = $3;  incomm($3, $5); }
  68:     | common SCOMMA var
  69:         { incomm($1, $3); }
  70:     ;
  71: 
  72: comblock:  SCONCAT
  73:         { $$ = comblock(0, 0); }
  74:     | SSLASH SNAME SSLASH
  75:         { $$ = comblock(toklen, token); }
  76:     ;
  77: 
  78: external: SEXTERNAL in_dcl name
  79:         { setext($3); }
  80:     | external SCOMMA name
  81:         { setext($3); }
  82:     ;
  83: 
  84: intrinsic:  SINTRINSIC in_dcl name
  85:         { setintr($3); }
  86:     | intrinsic SCOMMA name
  87:         { setintr($3); }
  88:     ;
  89: 
  90: equivalence:  SEQUIV in_dcl equivset
  91:     | equivalence SCOMMA equivset
  92:     ;
  93: 
  94: equivset:  SLPAR equivlist SRPAR
  95:         {
  96:         struct equivblock *p;
  97:         if(nequiv >= MAXEQUIV)
  98:             error("too many equivalences",0,0,FATAL);
  99:         p  =  & eqvclass[nequiv++];
 100:         p->eqvinit = 0;
 101:         p->eqvbottom = 0;
 102:         p->eqvtop = 0;
 103:         p->equivs = $2;
 104:         }
 105:     ;
 106: 
 107: equivlist:  lhs
 108:         { $$ = ALLOC(eqvchain); $$->eqvitem = $1; }
 109:     | equivlist SCOMMA lhs
 110:         { $$ = ALLOC(eqvchain); $$->eqvitem = $3; $$->nextp = $1; }
 111:     ;
 112: 
 113: data:     SDATA in_data datalist
 114:     | data opt_comma datalist
 115:     ;
 116: 
 117: in_data:
 118:         { if(parstate == OUTSIDE)
 119:             {
 120:             newproc();
 121:             startproc(0, CLMAIN);
 122:             }
 123:           if(parstate < INDATA)
 124:             {
 125:             enddcl();
 126:             parstate = INDATA;
 127:             }
 128:         }
 129:     ;
 130: 
 131: datalist:  datavarlist SSLASH vallist SSLASH
 132:         { ftnint junk;
 133:           if(nextdata(&junk,&junk) != NULL)
 134:             {
 135:             error("too few initializers",0,0,ERR);
 136:             curdtp = NULL;
 137:             }
 138:           frdata($1);
 139:           frrpl();
 140:         }
 141:     ;
 142: 
 143: vallist:  { toomanyinit = NO; }  val
 144:     | vallist SCOMMA val
 145:     ;
 146: 
 147: val:      value
 148:         { dataval(NULL, $1); }
 149:     | simple SSTAR value
 150:         { dataval($1, $3); }
 151:     ;
 152: 
 153: value:    simple
 154:     | addop simple
 155:         { if( $1==OPMINUS && ISCONST($2) )
 156:             consnegop($2);
 157:           $$ = $2;
 158:         }
 159:     | complex_const
 160:     | bit_const
 161:     ;
 162: 
 163: savelist: saveitem
 164:     | savelist SCOMMA saveitem
 165:     ;
 166: 
 167: saveitem: name
 168:         { int k;
 169:           $1->vsave = 1;
 170:           k = $1->vstg;
 171:         if( ! ONEOF(k, M(STGUNKNOWN)|M(STGBSS)|M(STGINIT)) )
 172:             error("can only save static variables", $1, 0, DCLERR);
 173:         }
 174:     | comblock
 175:         { $1->extsave = 1; }
 176:     ;
 177: 
 178: paramlist:  paramitem
 179:     | paramlist SCOMMA paramitem
 180:     ;
 181: 
 182: paramitem:  name SEQUALS expr
 183:         { if($1->vclass == CLUNKNOWN)
 184:             { $1->vclass = CLPARAM;
 185:               $1->paramval = $3;
 186:             }
 187:           else error("cannot make %s parameter", $1, 0, DCLERR);
 188:         }
 189:     ;
 190: 
 191: var:      name dims
 192:         { if(ndim>0) setbound($1, ndim, dims); }
 193:     ;
 194: 
 195: datavar:      lhs
 196:         { ptr np;
 197:           vardcl(np = $1->namep);
 198:           if(np->vstg == STGBSS)
 199:             np->vstg = STGINIT;
 200:           else if(np->vstg == STGCOMMON)
 201:             extsymtab[np->vardesc.varno].extinit = YES;
 202:           else if(np->vstg==STGEQUIV)
 203:             eqvclass[np->vardesc.varno].eqvinit = YES;
 204:           else if(np->vstg != STGINIT)
 205:             error("inconsistent storage classes", np, 0, DCLERR);
 206:           $$ = mkchain($1, 0);
 207:         }
 208:     | SLPAR datavarlist SCOMMA dospec SRPAR
 209:         { chainp p; struct impldoblock *q;
 210:         q = ALLOC(impldoblock);
 211:         q->tag = TIMPLDO;
 212:         q->varnp = $4->datap;
 213:         p = $4->nextp;
 214:         if(p)  { q->implb = p->datap; p = p->nextp; }
 215:         if(p)  { q->impub = p->datap; p = p->nextp; }
 216:         if(p)  { q->impstep = p->datap; p = p->nextp; }
 217:         frchain( & ($4) );
 218:         $$ = mkchain(q, 0);
 219:         q->datalist = hookup($2, $$);
 220:         }
 221:     ;
 222: 
 223: datavarlist: datavar
 224:         { curdtp = $1; curdtelt = 0; }
 225:     | datavarlist SCOMMA datavar
 226:         { $$ = hookup($1, $3); }
 227:     ;
 228: 
 229: dims:
 230:         { ndim = 0; }
 231:     | SLPAR dimlist SRPAR
 232:     ;
 233: 
 234: dimlist:   { ndim = 0; }   dim
 235:     | dimlist SCOMMA dim
 236:     ;
 237: 
 238: dim:      ubound
 239:         { dims[ndim].lb = 0;
 240:           dims[ndim].ub = $1;
 241:           ++ndim;
 242:         }
 243:     | expr SCOLON ubound
 244:         { dims[ndim].lb = $1;
 245:           dims[ndim].ub = $3;
 246:           ++ndim;
 247:         }
 248:     ;
 249: 
 250: ubound:   SSTAR
 251:         { $$ = 0; }
 252:     | expr
 253:     ;
 254: 
 255: labellist: label
 256:         { nstars = 1; labarray[0] = $1; }
 257:     | labellist SCOMMA label
 258:         { if(nstars < MAXLABLIST)  labarray[nstars++] = $3; }
 259:     ;
 260: 
 261: label:    labelval
 262:         { if($1->labinacc)
 263:             error("illegal branch to inner block, statement %s",
 264:                 convic( (ftnint) ($1->stateno) ),0,WARN1);
 265:           else if($1->labdefined == NO)
 266:             $1->blklevel = blklevel;
 267:           $1->labused = YES;
 268:         }
 269:     ;
 270: 
 271: labelval:   SICON
 272:         { $$ = mklabel( convci(toklen, token) ); }
 273:     ;
 274: 
 275: implicit:  SIMPLICIT in_dcl implist
 276:     | implicit SCOMMA implist
 277:     ;
 278: 
 279: implist:  imptype SLPAR letgroups SRPAR
 280:     ;
 281: 
 282: imptype:   { needkwd = 1; } type
 283:         { vartype = $2; }
 284:     ;
 285: 
 286: letgroups: letgroup
 287:     | letgroups SCOMMA letgroup
 288:     ;
 289: 
 290: letgroup:  letter
 291:         { setimpl(vartype, varleng, $1, $1); }
 292:     | letter SMINUS letter
 293:         { setimpl(vartype, varleng, $1, $3); }
 294:     ;
 295: 
 296: letter:  SNAME
 297:         { if(toklen!=1 || token[0]<'a' || token[0]>'z')
 298:             {
 299:             error("implicit item must be single letter", 0, 0, DCLERR);
 300:             $$ = 0;
 301:             }
 302:           else $$ = token[0];
 303:         }
 304:     ;
 305: 
 306: in_dcl:
 307:         { switch(parstate)
 308:             {
 309:             case OUTSIDE:   newproc();
 310:                     startproc(0, CLMAIN);
 311:             case INSIDE:    parstate = INDCL;
 312:             case INDCL: break;
 313: 
 314:             default:
 315:                 error("declaration among executables", 0, 0, DCLERR);
 316:             }
 317:         }
 318:     ;
Last modified: 1994-01-04
Generated: 2016-12-26
Generated by src2html V0.67
page hit count: 2436
Valid CSS Valid XHTML 1.0 Strict