home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / f2c-93.04.28-src.tgz / tar.out / fsf / f2c / src / gram.dcl < prev    next >
Text File  |  1996-09-28  |  8KB  |  395 lines
  1. spec:      dcl
  2.     | common
  3.     | external
  4.     | intrinsic
  5.     | equivalence
  6.     | data
  7.     | implicit
  8.     | namelist
  9.     | SSAVE
  10.         { NO66("SAVE statement");
  11.           saveall = YES; }
  12.     | SSAVE savelist
  13.         { NO66("SAVE statement"); }
  14.     | SFORMAT
  15.         { fmtstmt(thislabel); setfmt(thislabel); }
  16.     | SPARAM in_dcl SLPAR paramlist SRPAR
  17.         { NO66("PARAMETER statement"); }
  18.     ;
  19.  
  20. dcl:      type opt_comma name in_dcl new_dcl dims lengspec
  21.         { settype($3, $1, $7);
  22.           if(ndim>0) setbound($3,ndim,dims);
  23.         }
  24.     | dcl SCOMMA name dims lengspec
  25.         { settype($3, $1, $5);
  26.           if(ndim>0) setbound($3,ndim,dims);
  27.         }
  28.     | dcl SSLASHD datainit vallist SSLASHD
  29.         { if (new_dcl == 2) {
  30.             err("attempt to give DATA in type-declaration");
  31.             new_dcl = 1;
  32.             }
  33.         }
  34.     ;
  35.  
  36. new_dcl:    { new_dcl = 2; }
  37.  
  38. type:      typespec lengspec
  39.         { varleng = $2; }
  40.     ;
  41.  
  42. typespec:  typename
  43.         { varleng = ($1<0 || ONEOF($1,M(TYLOGICAL)|M(TYLONG))
  44.                 ? 0 : typesize[$1]);
  45.           vartype = $1; }
  46.     ;
  47.  
  48. typename:    SINTEGER    { $$ = TYLONG; }
  49.     | SREAL        { $$ = tyreal; }
  50.     | SCOMPLEX    { ++complex_seen; $$ = tycomplex; }
  51.     | SDOUBLE    { $$ = TYDREAL; }
  52.     | SDCOMPLEX    { ++dcomplex_seen; NOEXT("DOUBLE COMPLEX statement"); $$ = TYDCOMPLEX; }
  53.     | SLOGICAL    { $$ = TYLOGICAL; }
  54.     | SCHARACTER    { NO66("CHARACTER statement"); $$ = TYCHAR; }
  55.     | SUNDEFINED    { $$ = TYUNKNOWN; }
  56.     | SDIMENSION    { $$ = TYUNKNOWN; }
  57.     | SAUTOMATIC    { NOEXT("AUTOMATIC statement"); $$ = - STGAUTO; }
  58.     | SSTATIC    { NOEXT("STATIC statement"); $$ = - STGBSS; }
  59.     ;
  60.  
  61. lengspec:
  62.         { $$ = varleng; }
  63.     | SSTAR intonlyon expr intonlyoff
  64.         {
  65.         expptr p;
  66.         p = $3;
  67.         NO66("length specification *n");
  68.         if( ! ISICON(p) || p->constblock.Const.ci <= 0 )
  69.             {
  70.             $$ = 0;
  71.             dclerr("length must be a positive integer constant",
  72.                 NPNULL);
  73.             }
  74.         else {
  75.             if (vartype == TYCHAR)
  76.                 $$ = p->constblock.Const.ci;
  77.             else switch((int)p->constblock.Const.ci) {
  78.                 case 1:    $$ = 1; break;
  79.                 case 2: $$ = typesize[TYSHORT];    break;
  80.                 case 4: $$ = typesize[TYLONG];    break;
  81.                 case 8: $$ = typesize[TYDREAL];    break;
  82.                 case 16: $$ = typesize[TYDCOMPLEX]; break;
  83.                 default:
  84.                     dclerr("invalid length",NPNULL);
  85.                     $$ = varleng;
  86.                 }
  87.             }
  88.         }
  89.     | SSTAR intonlyon SLPAR SSTAR SRPAR intonlyoff
  90.         { NO66("length specification *(*)"); $$ = -1; }
  91.     ;
  92.  
  93. common:      SCOMMON in_dcl var
  94.         { incomm( $$ = comblock("") , $3 ); }
  95.     | SCOMMON in_dcl comblock var
  96.         { $$ = $3;  incomm($3, $4); }
  97.     | common opt_comma comblock opt_comma var
  98.         { $$ = $3;  incomm($3, $5); }
  99.     | common SCOMMA var
  100.         { incomm($1, $3); }
  101.     ;
  102.  
  103. comblock:  SCONCAT
  104.         { $$ = comblock(""); }
  105.     | SSLASH SNAME SSLASH
  106.         { $$ = comblock(token); }
  107.     ;
  108.  
  109. external: SEXTERNAL in_dcl name
  110.         { setext($3); }
  111.     | external SCOMMA name
  112.         { setext($3); }
  113.     ;
  114.  
  115. intrinsic:  SINTRINSIC in_dcl name
  116.         { NO66("INTRINSIC statement"); setintr($3); }
  117.     | intrinsic SCOMMA name
  118.         { setintr($3); }
  119.     ;
  120.  
  121. equivalence:  SEQUIV in_dcl equivset
  122.     | equivalence SCOMMA equivset
  123.     ;
  124.  
  125. equivset:  SLPAR equivlist SRPAR
  126.         {
  127.         struct Equivblock *p;
  128.         if(nequiv >= maxequiv)
  129.             many("equivalences", 'q', maxequiv);
  130.         p  =  & eqvclass[nequiv++];
  131.         p->eqvinit = NO;
  132.         p->eqvbottom = 0;
  133.         p->eqvtop = 0;
  134.         p->equivs = $2;
  135.         }
  136.     ;
  137.  
  138. equivlist:  lhs
  139.         { $$=ALLOC(Eqvchain);
  140.           $$->eqvitem.eqvlhs = (struct Primblock *)$1;
  141.         }
  142.     | equivlist SCOMMA lhs
  143.         { $$=ALLOC(Eqvchain);
  144.           $$->eqvitem.eqvlhs = (struct Primblock *) $3;
  145.           $$->eqvnextp = $1;
  146.         }
  147.     ;
  148.  
  149. data:      SDATA in_data datalist
  150.     | data opt_comma datalist
  151.     ;
  152.  
  153. in_data:
  154.         { if(parstate == OUTSIDE)
  155.             {
  156.             newproc();
  157.             startproc(ESNULL, CLMAIN);
  158.             }
  159.           if(parstate < INDATA)
  160.             {
  161.             enddcl();
  162.             parstate = INDATA;
  163.             datagripe = 1;
  164.             }
  165.         }
  166.     ;
  167.  
  168. datalist:  datainit datavarlist SSLASH datapop vallist SSLASH
  169.         { ftnint junk;
  170.           if(nextdata(&junk) != NULL)
  171.             err("too few initializers");
  172.           frdata($2);
  173.           frrpl();
  174.         }
  175.     ;
  176.  
  177. datainit: /* nothing */ { frchain(&datastack); curdtp = 0; }
  178.  
  179. datapop: /* nothing */ { pop_datastack(); }
  180.  
  181. vallist:  { toomanyinit = NO; }  val
  182.     | vallist SCOMMA val
  183.     ;
  184.  
  185. val:      value
  186.         { dataval(ENULL, $1); }
  187.     | simple SSTAR value
  188.         { dataval($1, $3); }
  189.     ;
  190.  
  191. value:      simple
  192.     | addop simple
  193.         { if( $1==OPMINUS && ISCONST($2) )
  194.             consnegop((Constp)$2);
  195.           $$ = $2;
  196.         }
  197.     | complex_const
  198.     ;
  199.  
  200. savelist: saveitem
  201.     | savelist SCOMMA saveitem
  202.     ;
  203.  
  204. saveitem: name
  205.         { int k;
  206.           $1->vsave = YES;
  207.           k = $1->vstg;
  208.         if( ! ONEOF(k, M(STGUNKNOWN)|M(STGBSS)|M(STGINIT)) )
  209.             dclerr("can only save static variables", $1);
  210.         }
  211.     | comblock
  212.     ;
  213.  
  214. paramlist:  paramitem
  215.     | paramlist SCOMMA paramitem
  216.     ;
  217.  
  218. paramitem:  name SEQUALS expr
  219.         { if($1->vclass == CLUNKNOWN)
  220.             make_param((struct Paramblock *)$1, $3);
  221.           else dclerr("cannot make into parameter", $1);
  222.         }
  223.     ;
  224.  
  225. var:      name dims
  226.         { if(ndim>0) setbound($1, ndim, dims); }
  227.     ;
  228.  
  229. datavar:      lhs
  230.         { Namep np;
  231.           np = ( (struct Primblock *) $1) -> namep;
  232.           vardcl(np);
  233.           if(np->vstg == STGCOMMON)
  234.             extsymtab[np->vardesc.varno].extinit = YES;
  235.           else if(np->vstg==STGEQUIV)
  236.             eqvclass[np->vardesc.varno].eqvinit = YES;
  237.           else if(np->vstg!=STGINIT && np->vstg!=STGBSS)
  238.             dclerr("inconsistent storage classes", np);
  239.           $$ = mkchain((char *)$1, CHNULL);
  240.         }
  241.     | SLPAR datavarlist SCOMMA dospec SRPAR
  242.         { chainp p; struct Impldoblock *q;
  243.         pop_datastack();
  244.         q = ALLOC(Impldoblock);
  245.         q->tag = TIMPLDO;
  246.         (q->varnp = (Namep) ($4->datap))->vimpldovar = 1;
  247.         p = $4->nextp;
  248.         if(p)  { q->implb = (expptr)(p->datap); p = p->nextp; }
  249.         if(p)  { q->impub = (expptr)(p->datap); p = p->nextp; }
  250.         if(p)  { q->impstep = (expptr)(p->datap); }
  251.         frchain( & ($4) );
  252.         $$ = mkchain((char *)q, CHNULL);
  253.         q->datalist = hookup($2, $$);
  254.         }
  255.     ;
  256.  
  257. datavarlist: datavar
  258.         { if (!datastack)
  259.             curdtp = 0;
  260.           datastack = mkchain((char *)curdtp, datastack);
  261.           curdtp = $1; curdtelt = 0;
  262.           }
  263.     | datavarlist SCOMMA datavar
  264.         { $$ = hookup($1, $3); }
  265.     ;
  266.  
  267. dims:
  268.         { ndim = 0; }
  269.     | SLPAR dimlist SRPAR
  270.     ;
  271.  
  272. dimlist:   { ndim = 0; }   dim
  273.     | dimlist SCOMMA dim
  274.     ;
  275.  
  276. dim:      ubound
  277.         {
  278.           if(ndim == maxdim)
  279.             err("too many dimensions");
  280.           else if(ndim < maxdim)
  281.             { dims[ndim].lb = 0;
  282.               dims[ndim].ub = $1;
  283.             }
  284.           ++ndim;
  285.         }
  286.     | expr SCOLON ubound
  287.         {
  288.           if(ndim == maxdim)
  289.             err("too many dimensions");
  290.           else if(ndim < maxdim)
  291.             { dims[ndim].lb = $1;
  292.               dims[ndim].ub = $3;
  293.             }
  294.           ++ndim;
  295.         }
  296.     ;
  297.  
  298. ubound:      SSTAR
  299.         { $$ = 0; }
  300.     | expr
  301.     ;
  302.  
  303. labellist: label
  304.         { nstars = 1; labarray[0] = $1; }
  305.     | labellist SCOMMA label
  306.         { if(nstars < maxlablist)  labarray[nstars++] = $3; }
  307.     ;
  308.  
  309. label:      SICON
  310.         { $$ = execlab( convci(toklen, token) ); }
  311.     ;
  312.  
  313. implicit:  SIMPLICIT in_dcl implist
  314.         { NO66("IMPLICIT statement"); }
  315.     | implicit SCOMMA implist
  316.     ;
  317.  
  318. implist:  imptype SLPAR letgroups SRPAR
  319.     | imptype
  320.         { if (vartype != TYUNKNOWN)
  321.             dclerr("-- expected letter range",NPNULL);
  322.           setimpl(vartype, varleng, 'a', 'z'); }
  323.     ;
  324.  
  325. imptype:   { needkwd = 1; } type
  326.         /* { vartype = $2; } */
  327.     ;
  328.  
  329. letgroups: letgroup
  330.     | letgroups SCOMMA letgroup
  331.     ;
  332.  
  333. letgroup:  letter
  334.         { setimpl(vartype, varleng, $1, $1); }
  335.     | letter SMINUS letter
  336.         { setimpl(vartype, varleng, $1, $3); }
  337.     ;
  338.  
  339. letter:  SNAME
  340.         { if(toklen!=1 || token[0]<'a' || token[0]>'z')
  341.             {
  342.             dclerr("implicit item must be single letter", NPNULL);
  343.             $$ = 0;
  344.             }
  345.           else $$ = token[0];
  346.         }
  347.     ;
  348.  
  349. namelist:    SNAMELIST
  350.     | namelist namelistentry
  351.     ;
  352.  
  353. namelistentry:  SSLASH name SSLASH namelistlist
  354.         {
  355.         if($2->vclass == CLUNKNOWN)
  356.             {
  357.             $2->vclass = CLNAMELIST;
  358.             $2->vtype = TYINT;
  359.             $2->vstg = STGBSS;
  360.             $2->varxptr.namelist = $4;
  361.             $2->vardesc.varno = ++lastvarno;
  362.             }
  363.         else dclerr("cannot be a namelist name", $2);
  364.         }
  365.     ;
  366.  
  367. namelistlist:  name
  368.         { $$ = mkchain((char *)$1, CHNULL); }
  369.     | namelistlist SCOMMA name
  370.         { $$ = hookup($1, mkchain((char *)$3, CHNULL)); }
  371.     ;
  372.  
  373. in_dcl:
  374.         { switch(parstate)
  375.             {
  376.             case OUTSIDE:    newproc();
  377.                     startproc(ESNULL, CLMAIN);
  378.             case INSIDE:    parstate = INDCL;
  379.             case INDCL:    break;
  380.  
  381.             case INDATA:
  382.                 if (datagripe) {
  383.                     errstr(
  384.                 "Statement order error: declaration after DATA",
  385.                         CNULL);
  386.                     datagripe = 0;
  387.                     }
  388.                 break;
  389.  
  390.             default:
  391.                 dclerr("declaration among executables", NPNULL);
  392.             }
  393.         }
  394.     ;
  395.