Return to gram.dcl CVS log

Up to [Research Unix] / researchv10no / cmd / f2c

Annotation of researchv10no/cmd/f2c/gram.dcl, revision 1.1

1.1     ! root        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:        ;

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.