compilers/pcc/pcc-1.0.0/f77/fcom/gram.dcl

   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 dims lengspec
  17                 { settype($2, $1, $5);
  18                   if(ndim>0) setbound($2,ndim,dims);
  19                 }
  20         | dcl SCOMMA name dims lengspec
  21                 { settype($3, $1, $5);
  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 expr
  50                 {
  51                   if( ! ISICON($2) )
  52                         {
  53                         $$ = 0;
  54                         dclerr("length must be an integer constant", 0);
  55                         }
  56                   else $$ = $2->b_const.fconst.ci;
  57                 }
  58         | SSTAR SLPAR SSTAR SRPAR
  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 SFNAME 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                         fatal("too many equivalences");
  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); $$->eqvchain.eqvitem = $1; }
 109         | equivlist SCOMMA lhs
 110                 { $$ = ALLOC(eqvchain); $$->eqvchain.eqvitem = $3; $$->eqvchain.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                         err("too few initializers");
 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->b_name.vsave = 1;
 170                   k = $1->vstg;
 171                 if( ! ONEOF(k, M(STGUNKNOWN)|M(STGBSS)|M(STGINIT)) )
 172                         dclerr("can only save static variables", $1);
 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->b_param.paramval = $3;
 186                         }
 187                   else dclerr("cannot make %s parameter", $1);
 188                 }
 189         ;
 190
 191 var:      name dims
 192                 { if(ndim>0) setbound($1, ndim, dims); }
 193         ;
 194
 195 datavar:          lhs
 196                 { struct bigblock *np;
 197                   vardcl(np = $1->b_prim.namep);
 198                   if(np->vstg == STGBSS)
 199                         np->vstg = STGINIT;
 200                   else if(np->vstg == STGCOMMON)
 201                         extsymtab[np->b_name.vardesc.varno].extinit = YES;
 202                   else if(np->vstg==STGEQUIV)
 203                         eqvclass[np->b_name.vardesc.varno].eqvinit = YES;
 204                   else if(np->vstg != STGINIT)
 205                         dclerr("inconsistent storage classes", np);
 206                   $$ = mkchain($1, 0);
 207                 }
 208         | SLPAR datavarlist SCOMMA dospec SRPAR
 209                 { chainp p; struct bigblock *q;
 210                 q = BALLO();
 211                 q->tag = TIMPLDO;
 212                 q->b_impldo.varnp = $4->chain.datap;
 213                 p = $4->chain.nextp;
 214                 if(p)  { q->b_impldo.implb = p->chain.datap; p = p->chain.nextp; }
 215                 if(p)  { q->b_impldo.impub = p->chain.datap; p = p->chain.nextp; }
 216                 if(p)  { q->b_impldo.impstep = p->chain.datap; p = p->chain.nextp; }
 217                 frchain( & ($4) );
 218                 $$ = mkchain(q, 0);
 219                 q->b_impldo.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                 { labarray[nstars++] = $3; }
 259         ;
 260
 261 label:    labelval
 262                 { if($1->labinacc)
 263                         warn1("illegal branch to inner block, statement %s",
 264                                 convic( (ftnint) ($1->stateno) ));
 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:  SFNAME
 297                 { if(toklen!=1 || token[0]<'a' || token[0]>'z')
 298                         {
 299                         dclerr("implicit item must be single letter", 0);
 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                                 dclerr("declaration among executables", 0);
 316                         }
 317                 }
 318         ;