BSD 4 release

[unix-history] / usr / src / cmd / f77 / gram.dcl

diff --git a/usr/src/cmd/f77/gram.dcl b/usr/src/cmd/f77/gram.dcl
index 4a911fb..a44f28f 100644 (file)
--- a/usr/src/cmd/f77/gram.dcl
+++ b/usr/src/cmd/f77/gram.dcl
@@ -5,20 +5,24 @@ spec:   dcl
        | equivalence
        | data
        | implicit
        | equivalence
        | data
        | implicit

+       | namelist

        | SSAVE
        | SSAVE

-               { saveall = YES; }
+               { NO66("SAVE statement");
+                 saveall = YES; }

        | SSAVE savelist
        | SSAVE savelist

+               { NO66("SAVE statement"); }

        | SFORMAT
                { fmtstmt(thislabel); setfmt(thislabel); }
        | SPARAM in_dcl SLPAR paramlist SRPAR
        | SFORMAT
                { fmtstmt(thislabel); setfmt(thislabel); }
        | SPARAM in_dcl SLPAR paramlist SRPAR

+               { NO66("PARAMETER statement"); }

        ;
 
        ;
 

-dcl:     type name in_dcl lengspec dims
-               { settype($2, $1, $4);
-                 if(ndim>0) setbound($2,ndim,dims);
+dcl:     type opt_comma name in_dcl dims lengspec
+               { settype($3, $1, $6);
+                 if(ndim>0) setbound($3,ndim,dims);

                }
                }

-       | dcl SCOMMA name lengspec dims
-               { settype($3, $1, $4);
+       | dcl SCOMMA name dims lengspec
+               { settype($3, $1, $5);

                  if(ndim>0) setbound($3,ndim,dims);
                }
        ;
                  if(ndim>0) setbound($3,ndim,dims);
                }
        ;


@@ -35,32 +39,36 @@ typename:    SINTEGER       { $$ = TYLONG; }
        | SREAL         { $$ = TYREAL; }
        | SCOMPLEX      { $$ = TYCOMPLEX; }
        | SDOUBLE       { $$ = TYDREAL; }
        | SREAL         { $$ = TYREAL; }
        | SCOMPLEX      { $$ = TYCOMPLEX; }
        | SDOUBLE       { $$ = TYDREAL; }

-       | SDCOMPLEX     { $$ = TYDCOMPLEX; }
+       | SDCOMPLEX     { NOEXT("DOUBLE COMPLEX statement"); $$ = TYDCOMPLEX; }

        | SLOGICAL      { $$ = TYLOGICAL; }
        | SLOGICAL      { $$ = TYLOGICAL; }

-       | SCHARACTER    { $$ = TYCHAR; }
+       | SCHARACTER    { NO66("CHARACTER statement"); $$ = TYCHAR; }

        | SUNDEFINED    { $$ = TYUNKNOWN; }
        | SDIMENSION    { $$ = TYUNKNOWN; }
        | SUNDEFINED    { $$ = TYUNKNOWN; }
        | SDIMENSION    { $$ = TYUNKNOWN; }

-       | SAUTOMATIC    { $$ = - STGAUTO; }
-       | SSTATIC       { $$ = - STGBSS; }
+       | SAUTOMATIC    { NOEXT("AUTOMATIC statement"); $$ = - STGAUTO; }
+       | SSTATIC       { NOEXT("STATIC statement"); $$ = - STGBSS; }

        ;
 
 lengspec:
                { $$ = varleng; }
        ;
 
 lengspec:
                { $$ = varleng; }

-       | SSTAR expr
+       | SSTAR intonlyon expr intonlyoff

                {
                {

-                 if( ! ISICON($2) )
+               expptr p;
+               p = $3;
+               NO66("length specification *n");
+               if( ! ISICON(p) || p->constblock.const.ci<0 )

                        {
                        $$ = 0;
                        {
                        $$ = 0;

-                       dclerr("length must be an integer constant", 0);
+                       dclerr("length must be a positive integer constant",
+                               PNULL);

                        }
                        }

-                 else $$ = $2->const.ci;
+               else $$ = p->constblock.const.ci;

                }
                }

-       | SSTAR SLPAR SSTAR SRPAR
-               { $$ = 0; }
+       | SSTAR intonlyon SLPAR SSTAR SRPAR intonlyoff
+               { NO66("length specification *(*)"); $$ = -1; }

        ;
 
 common:          SCOMMON in_dcl var
        ;
 
 common:          SCOMMON in_dcl var

-               { incomm( $$ = comblock(0, 0) , $3 ); }
+               { incomm( $$ = comblock(0, CNULL) , $3 ); }

        | SCOMMON in_dcl comblock var
                { $$ = $3;  incomm($3, $4); }
        | common opt_comma comblock opt_comma var
        | SCOMMON in_dcl comblock var
                { $$ = $3;  incomm($3, $4); }
        | common opt_comma comblock opt_comma var


@@ -70,7 +78,7 @@ common:         SCOMMON in_dcl var
        ;
 
 comblock:  SCONCAT
        ;
 
 comblock:  SCONCAT

-               { $$ = comblock(0, 0); }
+               { $$ = comblock(0, CNULL); }

        | SSLASH SNAME SSLASH
                { $$ = comblock(toklen, token); }
        ;
        | SSLASH SNAME SSLASH
                { $$ = comblock(toklen, token); }
        ;


@@ -82,7 +90,7 @@ external: SEXTERNAL in_dcl name
        ;
 
 intrinsic:  SINTRINSIC in_dcl name
        ;
 
 intrinsic:  SINTRINSIC in_dcl name

-               { setintr($3); }
+               { NO66("INTRINSIC statement"); setintr($3); }

        | intrinsic SCOMMA name
                { setintr($3); }
        ;
        | intrinsic SCOMMA name
                { setintr($3); }
        ;


@@ -93,11 +101,11 @@ equivalence:  SEQUIV in_dcl equivset
 
 equivset:  SLPAR equivlist SRPAR
                {
 
 equivset:  SLPAR equivlist SRPAR
                {

-               struct equivblock *p;
-               if(nequiv >= MAXEQUIV)
-                       fatal("too many equivalences");
+               struct Equivblock *p;
+               if(nequiv >= maxequiv)
+                       many("equivalences", 'q');

                p  =  & eqvclass[nequiv++];
                p  =  & eqvclass[nequiv++];

-               p->eqvinit = 0;
+               p->eqvinit = NO;

                p->eqvbottom = 0;
                p->eqvtop = 0;
                p->equivs = $2;
                p->eqvbottom = 0;
                p->eqvtop = 0;
                p->equivs = $2;


@@ -105,9 +113,14 @@ equivset:  SLPAR equivlist SRPAR
        ;
 
 equivlist:  lhs
        ;
 
 equivlist:  lhs

-               { $$ = ALLOC(eqvchain); $$->eqvitem = $1; }
+               { $$=ALLOC(Eqvchain);
+                 $$->eqvitem.eqvlhs = (struct Primblock *)$1;
+               }

        | equivlist SCOMMA lhs
        | equivlist SCOMMA lhs

-               { $$ = ALLOC(eqvchain); $$->eqvitem = $3; $$->nextp = $1; }
+               { $$=ALLOC(Eqvchain);
+                 $$->eqvitem.eqvlhs = (struct Primblock *) $3;
+                 $$->eqvnextp = $1;
+               }

        ;
 
 data:    SDATA in_data datalist
        ;
 
 data:    SDATA in_data datalist


@@ -118,7 +131,7 @@ in_data:
                { if(parstate == OUTSIDE)
                        {
                        newproc();
                { if(parstate == OUTSIDE)
                        {
                        newproc();

-                       startproc(0, CLMAIN);
+                       startproc(PNULL, CLMAIN);

                        }
                  if(parstate < INDATA)
                        {
                        }
                  if(parstate < INDATA)
                        {


@@ -145,7 +158,7 @@ vallist:  { toomanyinit = NO; }  val
        ;
 
 val:     value
        ;
 
 val:     value

-               { dataval(NULL, $1); }
+               { dataval(PNULL, $1); }

        | simple SSTAR value
                { dataval($1, $3); }
        ;
        | simple SSTAR value
                { dataval($1, $3); }
        ;


@@ -166,7 +179,7 @@ savelist: saveitem
 
 saveitem: name
                { int k;
 
 saveitem: name
                { int k;

-                 $1->vsave = 1;
+                 $1->vsave = YES;

                  k = $1->vstg;
                if( ! ONEOF(k, M(STGUNKNOWN)|M(STGBSS)|M(STGINIT)) )
                        dclerr("can only save static variables", $1);
                  k = $1->vstg;
                if( ! ONEOF(k, M(STGUNKNOWN)|M(STGBSS)|M(STGINIT)) )
                        dclerr("can only save static variables", $1);


@@ -182,40 +195,39 @@ paramlist:  paramitem
 paramitem:  name SEQUALS expr
                { if($1->vclass == CLUNKNOWN)
                        { $1->vclass = CLPARAM;
 paramitem:  name SEQUALS expr
                { if($1->vclass == CLUNKNOWN)
                        { $1->vclass = CLPARAM;

-                         $1->paramval = $3;
+                         ( (struct Paramblock *) ($1) )->paramval = $3;

                        }
                  else dclerr("cannot make %s parameter", $1);
                }
        ;
 
 var:     name dims
                        }
                  else dclerr("cannot make %s parameter", $1);
                }
        ;
 
 var:     name dims

-               { if(ndim>0) setbounds($1, ndim, dims); }
+               { if(ndim>0) setbound($1, ndim, dims); }

        ;
 
 datavar:         lhs
        ;
 
 datavar:         lhs

-               { ptr np;
-                 vardcl(np = $1->namep);
-                 if(np->vstg == STGBSS)
-                       np->vstg = STGINIT;
-                 else if(np->vstg == STGCOMMON)
+               { Namep np;
+                 np = ( (struct Primblock *) $1) -> namep;
+                 vardcl(np);
+                 if(np->vstg == STGCOMMON)

                        extsymtab[np->vardesc.varno].extinit = YES;
                  else if(np->vstg==STGEQUIV)
                        eqvclass[np->vardesc.varno].eqvinit = YES;
                        extsymtab[np->vardesc.varno].extinit = YES;
                  else if(np->vstg==STGEQUIV)
                        eqvclass[np->vardesc.varno].eqvinit = YES;

-                 else if(np->vstg != STGINIT)
+                 else if(np->vstg!=STGINIT && np->vstg!=STGBSS)

                        dclerr("inconsistent storage classes", np);
                        dclerr("inconsistent storage classes", np);

-                 $$ = mkchain($1, 0);
+                 $$ = mkchain($1, CHNULL);

                }
        | SLPAR datavarlist SCOMMA dospec SRPAR
                }
        | SLPAR datavarlist SCOMMA dospec SRPAR

-               { chainp p; struct impldoblock *q;
-               q = ALLOC(impldoblock);
+               { chainp p; struct Impldoblock *q;
+               q = ALLOC(Impldoblock);

                q->tag = TIMPLDO;
                q->tag = TIMPLDO;

-               q->varnp = $4->datap;
+               q->varnp = (Namep) ($4->datap);

                p = $4->nextp;
                p = $4->nextp;

-               if(p)  { q->implb = p->datap; p = p->nextp; }
-               if(p)  { q->impub = p->datap; p = p->nextp; }
-               if(p)  { q->impstep = p->datap; p = p->nextp; }
+               if(p)  { q->implb = (expptr)(p->datap); p = p->nextp; }
+               if(p)  { q->impub = (expptr)(p->datap); p = p->nextp; }
+               if(p)  { q->impstep = (expptr)(p->datap); p = p->nextp; }

                frchain( & ($4) );
                frchain( & ($4) );

-               $$ = mkchain(q, 0);
+               $$ = mkchain(q, CHNULL);

                q->datalist = hookup($2, $$);
                }
        ;
                q->datalist = hookup($2, $$);
                }
        ;


@@ -236,13 +248,21 @@ dimlist:   { ndim = 0; }   dim
        ;
 
 dim:     ubound
        ;
 
 dim:     ubound

-               { dims[ndim].lb = 0;
-                 dims[ndim].ub = $1;
+               { if(ndim == maxdim)
+                       err("too many dimensions");
+                 else if(ndim < maxdim)
+                       { dims[ndim].lb = 0;
+                         dims[ndim].ub = $1;
+                       }

                  ++ndim;
                }
        | expr SCOLON ubound
                  ++ndim;
                }
        | expr SCOLON ubound

-               { dims[ndim].lb = $1;
-                 dims[ndim].ub = $3;
+               { if(ndim == maxdim)
+                       err("too many dimensions");
+                 else if(ndim < maxdim)
+                       { dims[ndim].lb = $1;
+                         dims[ndim].ub = $3;
+                       }

                  ++ndim;
                }
        ;
                  ++ndim;
                }
        ;


@@ -258,21 +278,12 @@ labellist: label
                { if(nstars < MAXLABLIST)  labarray[nstars++] = $3; }
        ;
 
                { if(nstars < MAXLABLIST)  labarray[nstars++] = $3; }
        ;
 

-label:   labelval
-               { if($1->labinacc)
-                       warn1("illegal branch to inner block, statement %s",
-                               convic( (ftnint) ($1->stateno) ));
-                 else if($1->labdefined == NO)
-                       $1->blklevel = blklevel;
-                 $1->labused = YES;
-               }
-       ;
-
-labelval:   SICON
-               { $$ = mklabel( convci(toklen, token) ); }
+label:   SICON
+               { $$ = execlab( convci(toklen, token) ); }

        ;
 
 implicit:  SIMPLICIT in_dcl implist
        ;
 
 implicit:  SIMPLICIT in_dcl implist

+               { NO66("IMPLICIT statement"); }

        | implicit SCOMMA implist
        ;
 
        | implicit SCOMMA implist
        ;
 


@@ -296,23 +307,47 @@ letgroup:  letter
 letter:  SNAME
                { if(toklen!=1 || token[0]<'a' || token[0]>'z')
                        {
 letter:  SNAME
                { if(toklen!=1 || token[0]<'a' || token[0]>'z')
                        {

-                       dclerr("implicit item must be single letter", 0);
+                       dclerr("implicit item must be single letter", PNULL);

                        $$ = 0;
                        }
                  else $$ = token[0];
                }
        ;
 
                        $$ = 0;
                        }
                  else $$ = token[0];
                }
        ;
 

+namelist:      SNAMELIST
+       | namelist namelistentry
+       ;
+
+namelistentry:  SSLASH name SSLASH namelistlist
+               {
+               if($2->vclass == CLUNKNOWN)
+                       {
+                       $2->vclass = CLNAMELIST;
+                       $2->vtype = TYINT;
+                       $2->vstg = STGINIT;
+                       $2->varxptr.namelist = $4;
+                       $2->vardesc.varno = ++lastvarno;
+                       }
+               else dclerr("cannot be a namelist name", $2);
+               }
+       ;
+
+namelistlist:  name
+               { $$ = mkchain($1, CHNULL); }
+       | namelistlist SCOMMA name
+               { $$ = hookup($1, mkchain($3, CHNULL)); }
+       ;
+

 in_dcl:
                { switch(parstate)      
                        {
                        case OUTSIDE:   newproc();
 in_dcl:
                { switch(parstate)      
                        {
                        case OUTSIDE:   newproc();

-                                       startproc(0, CLMAIN);
+                                       startproc(PNULL, CLMAIN);

                        case INSIDE:    parstate = INDCL;
                        case INDCL:     break;
 
                        default:
                        case INSIDE:    parstate = INDCL;
                        case INDCL:     break;
 
                        default:

-                               dclerr("declaration among executables", 0);
+                               dclerr("declaration among executables", PNULL);

                        }
                }
        ;
                        }
                }
        ;