Return to gram.dcl CVS log

Up to [CSRG BSD Unix] / 42BSD / usr.bin / f77 / src / f77pass1

Annotation of 42BSD/usr.bin/f77/src/f77pass1/gram.dcl, revision 1.1

1.1     ! root        1: spec:    dcl
        !             2:        | common
        !             3:        | external
        !             4:        | intrinsic
        !             5:        | equivalence
        !             6:        | implicit
        !             7:        | data
        !             8:        | namelist
        !             9:        | SSAVE
        !            10:                { NO66("SAVE statement");
        !            11:                  saveall = YES; }
        !            12:        | SSAVE savelist
        !            13:                { NO66("SAVE statement"); }
        !            14:        | SFORMAT
        !            15:                {
        !            16:                if (parstate < INDCL)
        !            17:                        parstate = INDCL;
        !            18:                fmtstmt(thislabel);
        !            19:                setfmt(thislabel);
        !            20:                }
        !            21:        | SPARAM in_dcl SLPAR paramlist SRPAR
        !            22:                { NO66("PARAMETER statement"); }
        !            23:        ;
        !            24: 
        !            25: dcl:     type opt_comma name in_dcl dims lengspec
        !            26:                { settype($3, $1, $6);
        !            27:                  if(ndim>0) setbound($3,ndim,dims);
        !            28:                }
        !            29:        | dcl SCOMMA name dims lengspec
        !            30:                { settype($3, $1, $5);
        !            31:                  if(ndim>0) setbound($3,ndim,dims);
        !            32:                }
        !            33:        ;
        !            34: 
        !            35: type:    typespec lengspec
        !            36:                { varleng = $2; }
        !            37:        ;
        !            38: 
        !            39: typespec:  typename
        !            40:                { varleng = ($1<0 || $1==TYLONG ? 0 : typesize[$1]); }
        !            41:        ;
        !            42: 
        !            43: typename:    SINTEGER  { $$ = TYLONG; }
        !            44:        | SREAL         { $$ = TYREAL; }
        !            45:        | SCOMPLEX      { $$ = TYCOMPLEX; }
        !            46:        | SDOUBLE       { $$ = TYDREAL; }
        !            47:        | SDCOMPLEX     { NOEXT("DOUBLE COMPLEX statement"); $$ = TYDCOMPLEX; }
        !            48:        | SLOGICAL      { $$ = TYLOGICAL; }
        !            49:        | SCHARACTER    { NO66("CHARACTER statement"); $$ = TYCHAR; }
        !            50:        | SUNDEFINED    { $$ = TYUNKNOWN; }
        !            51:        | SDIMENSION    { $$ = TYUNKNOWN; }
        !            52:        | SAUTOMATIC    { NOEXT("AUTOMATIC statement"); $$ = - STGAUTO; }
        !            53:        | SSTATIC       { NOEXT("STATIC statement"); $$ = - STGBSS; }
        !            54:        ;
        !            55: 
        !            56: lengspec:
        !            57:                { $$ = varleng; }
        !            58:        | SSTAR intonlyon expr intonlyoff
        !            59:                {
        !            60:                expptr p;
        !            61:                p = $3;
        !            62:                NO66("length specification *n");
        !            63:                if( ! ISICON(p) || p->constblock.const.ci<0 )
        !            64:                        {
        !            65:                        $$ = 0;
        !            66:                        dclerr("length must be a positive integer constant",
        !            67:                                PNULL);
        !            68:                        }
        !            69:                else $$ = p->constblock.const.ci;
        !            70:                }
        !            71:        | SSTAR intonlyon SLPAR SSTAR SRPAR intonlyoff
        !            72:                { NO66("length specification *(*)"); $$ = -1; }
        !            73:        ;
        !            74: 
        !            75: common:          SCOMMON in_dcl var
        !            76:                { incomm( $$ = comblock(0, CNULL) , $3 ); }
        !            77:        | SCOMMON in_dcl comblock var
        !            78:                { $$ = $3;  incomm($3, $4); }
        !            79:        | common opt_comma comblock opt_comma var
        !            80:                { $$ = $3;  incomm($3, $5); }
        !            81:        | common SCOMMA var
        !            82:                { incomm($1, $3); }
        !            83:        ;
        !            84: 
        !            85: comblock:  SCONCAT
        !            86:                { $$ = comblock(0, CNULL); }
        !            87:        | SSLASH SNAME SSLASH
        !            88:                { $$ = comblock(toklen, token); }
        !            89:        ;
        !            90: 
        !            91: external: SEXTERNAL in_dcl name
        !            92:                { setext($3); }
        !            93:        | external SCOMMA name
        !            94:                { setext($3); }
        !            95:        ;
        !            96: 
        !            97: intrinsic:  SINTRINSIC in_dcl name
        !            98:                { NO66("INTRINSIC statement"); setintr($3); }
        !            99:        | intrinsic SCOMMA name
        !           100:                { setintr($3); }
        !           101:        ;
        !           102: 
        !           103: equivalence:  SEQUIV in_dcl equivset
        !           104:        | equivalence SCOMMA equivset
        !           105:        ;
        !           106: 
        !           107: equivset:  SLPAR equivlist SRPAR
        !           108:                {
        !           109:                struct Equivblock *p;
        !           110:                if(nequiv >= maxequiv)
        !           111:                        many("equivalences", 'q');
        !           112:                p  =  & eqvclass[nequiv++];
        !           113:                p->eqvinit = NO;
        !           114:                p->eqvbottom = 0;
        !           115:                p->eqvtop = 0;
        !           116:                p->equivs = $2;
        !           117:                p->init = NO;
        !           118:                p->initoffset = 0;
        !           119:                }
        !           120:        ;
        !           121: 
        !           122: equivlist:  lhs
        !           123:                { $$=ALLOC(Eqvchain);
        !           124:                  $$->eqvitem.eqvlhs = (struct Primblock *)$1;
        !           125:                }
        !           126:        | equivlist SCOMMA lhs
        !           127:                { $$=ALLOC(Eqvchain);
        !           128:                  $$->eqvitem.eqvlhs = (struct Primblock *) $3;
        !           129:                  $$->eqvnextp = $1;
        !           130:                }
        !           131:        ;
        !           132: 
        !           133: 
        !           134: savelist: saveitem
        !           135:        | savelist SCOMMA saveitem
        !           136:        ;
        !           137: 
        !           138: saveitem: name
        !           139:                { int k;
        !           140:                  $1->vsave = YES;
        !           141:                  k = $1->vstg;
        !           142:                if( ! ONEOF(k, M(STGUNKNOWN)|M(STGBSS)|M(STGINIT)) )
        !           143:                        dclerr("can only save static variables", $1);
        !           144:                }
        !           145:        | comblock
        !           146:                { $1->extsave = 1; }
        !           147:        ;
        !           148: 
        !           149: paramlist:  paramitem
        !           150:        | paramlist SCOMMA paramitem
        !           151:        ;
        !           152: 
        !           153: paramitem:  name SEQUALS expr
        !           154:                {
        !           155:                  if ($1->vclass == CLUNKNOWN)
        !           156:                    $1->vclass = CLPARAM;
        !           157:                  else
        !           158:                    dclerr("%s redefined", $1);
        !           159: 
        !           160:                  if ($1->vclass == CLPARAM)
        !           161:                    {
        !           162:                      if (!ISCONST($3))
        !           163:                        $3 = fixtype($3);
        !           164: 
        !           165:                      if ($1->vtype == TYUNKNOWN)
        !           166:                        {
        !           167:                          char c;
        !           168: 
        !           169:                          c = $1->varname[0];
        !           170:                          if (c >= 'A' && c <= 'Z')
        !           171:                            c = c - 'A';
        !           172:                          else
        !           173:                            c = c - 'a';
        !           174:                          $1->vtype = impltype[c];
        !           175:                          $1->vleng = ICON(implleng[c]);
        !           176:                        }
        !           177:                      if ($1->vtype == TYUNKNOWN)
        !           178:                        { 
        !           179:                          warn1("type undefined for %s",
        !           180:                                varstr(VL, $1->varname));
        !           181:                          ((struct Paramblock *) ($1))->paramval = $3;
        !           182:                        }
        !           183:                      else
        !           184:                        {
        !           185:                          extern int badvalue;
        !           186:                          extern expptr constconv();
        !           187:                          int type;
        !           188:                          ftnint len;
        !           189: 
        !           190:                          type = $1->vtype;
        !           191:                          if (type == TYCHAR)
        !           192:                            {
        !           193:                              if ($1->vleng != NULL)
        !           194:                                len = $1->vleng->constblock.const.ci;
        !           195:                              else if (ISCONST($3) &&
        !           196:                                        $3->constblock.vtype == TYCHAR)
        !           197:                                len = $3->constblock.vleng->
        !           198:                                        constblock.const.ci;
        !           199:                              else
        !           200:                                len = 1;
        !           201:                            }
        !           202:                          badvalue = 0;
        !           203:                          if (ISCONST($3))
        !           204:                            {
        !           205:                              ((struct Paramblock *) ($1))->paramval =
        !           206:                                convconst($1->vtype, len, $3);
        !           207:                              if (type == TYLOGICAL)
        !           208:                                ((struct Paramblock *) ($1))->paramval->
        !           209:                                  headblock.vtype = TYLOGICAL;
        !           210:                              frexpr((tagptr) $3);
        !           211:                            }
        !           212:                          else
        !           213:                            {
        !           214:                              warn1("%s set to a nonconstant",
        !           215:                                    varstr(VL, $1->varname));
        !           216:                              ((struct Paramblock *) ($1))->paramval = $3;
        !           217:                            }
        !           218:                        }
        !           219:                    }
        !           220:                }
        !           221:        ;
        !           222: 
        !           223: var:     name dims
        !           224:                { if(ndim>0) setbound($1, ndim, dims); }
        !           225:        ;
        !           226: 
        !           227: 
        !           228: dims:
        !           229:                { ndim = 0; }
        !           230:        | SLPAR dimlist SRPAR
        !           231:        ;
        !           232: 
        !           233: dimlist:   { ndim = 0; }   dim
        !           234:        | dimlist SCOMMA dim
        !           235:        ;
        !           236: 
        !           237: dim:     ubound
        !           238:                { if(ndim == maxdim)
        !           239:                        err("too many dimensions");
        !           240:                  else if(ndim < maxdim)
        !           241:                        { dims[ndim].lb = 0;
        !           242:                          dims[ndim].ub = $1;
        !           243:                        }
        !           244:                  ++ndim;
        !           245:                }
        !           246:        | expr SCOLON ubound
        !           247:                { if(ndim == maxdim)
        !           248:                        err("too many dimensions");
        !           249:                  else if(ndim < maxdim)
        !           250:                        { dims[ndim].lb = $1;
        !           251:                          dims[ndim].ub = $3;
        !           252:                        }
        !           253:                  ++ndim;
        !           254:                }
        !           255:        ;
        !           256: 
        !           257: ubound:          SSTAR
        !           258:                { $$ = 0; }
        !           259:        | expr
        !           260:        ;
        !           261: 
        !           262: labellist: label
        !           263:                { nstars = 1; labarray[0] = $1; }
        !           264:        | labellist SCOMMA label
        !           265:                { if(nstars < MAXLABLIST)  labarray[nstars++] = $3; }
        !           266:        ;
        !           267: 
        !           268: label:   SICON
        !           269:                { $$ = execlab( convci(toklen, token) ); }
        !           270:        ;
        !           271: 
        !           272: implicit:  SIMPLICIT in_dcl implist
        !           273:                { NO66("IMPLICIT statement"); }
        !           274:        | implicit SCOMMA implist
        !           275:        ;
        !           276: 
        !           277: implist:  imptype SLPAR letgroups SRPAR
        !           278:        ;
        !           279: 
        !           280: imptype:   { needkwd = 1; } type
        !           281:                { vartype = $2; }
        !           282:        ;
        !           283: 
        !           284: letgroups: letgroup
        !           285:        | letgroups SCOMMA letgroup
        !           286:        ;
        !           287: 
        !           288: letgroup:  letter
        !           289:                { setimpl(vartype, varleng, $1, $1); }
        !           290:        | letter SMINUS letter
        !           291:                { setimpl(vartype, varleng, $1, $3); }
        !           292:        ;
        !           293: 
        !           294: letter:  SNAME
        !           295:                { if(toklen!=1 || token[0]<'a' || token[0]>'z')
        !           296:                        {
        !           297:                        dclerr("implicit item must be single letter", PNULL);
        !           298:                        $$ = 0;
        !           299:                        }
        !           300:                  else $$ = token[0];
        !           301:                }
        !           302:        ;
        !           303: 
        !           304: namelist:      SNAMELIST
        !           305:        | namelist namelistentry
        !           306:        ;
        !           307: 
        !           308: namelistentry:  SSLASH name SSLASH namelistlist
        !           309:                {
        !           310:                if($2->vclass == CLUNKNOWN)
        !           311:                        {
        !           312:                        $2->vclass = CLNAMELIST;
        !           313:                        $2->vtype = TYINT;
        !           314:                        $2->vstg = STGINIT;
        !           315:                        $2->varxptr.namelist = $4;
        !           316:                        $2->vardesc.varno = ++lastvarno;
        !           317:                        }
        !           318:                else dclerr("cannot be a namelist name", $2);
        !           319:                }
        !           320:        ;
        !           321: 
        !           322: namelistlist:  name
        !           323:                { $$ = mkchain($1, CHNULL); }
        !           324:        | namelistlist SCOMMA name
        !           325:                { $$ = hookup($1, mkchain($3, CHNULL)); }
        !           326:        ;
        !           327: 
        !           328: in_dcl:
        !           329:                { switch(parstate)      
        !           330:                        {
        !           331:                        case OUTSIDE:   newproc();
        !           332:                                        startproc(PNULL, CLMAIN);
        !           333:                        case INSIDE:    parstate = INDCL;
        !           334:                        case INDCL:     break;
        !           335: 
        !           336:                        default:
        !           337:                                dclerr("declaration among executables", PNULL);
        !           338:                        }
        !           339:                }
        !           340:        ;
        !           341: 
        !           342: data:  data1
        !           343:        {
        !           344:          if (overlapflag == YES)
        !           345:            warn("overlapping initializations");
        !           346:        }
        !           347: 
        !           348: data1: SDATA in_data datapair
        !           349:     |  data1 opt_comma datapair
        !           350:     ;
        !           351: 
        !           352: in_data:
        !           353:                { if(parstate == OUTSIDE)
        !           354:                        {
        !           355:                        newproc();
        !           356:                        startproc(PNULL, CLMAIN);
        !           357:                        }
        !           358:                  if(parstate < INDATA)
        !           359:                        {
        !           360:                        enddcl();
        !           361:                        parstate = INDATA;
        !           362:                        }
        !           363:                  overlapflag = NO;
        !           364:                }
        !           365:        ;
        !           366: 
        !           367: datapair:      datalvals SSLASH datarvals SSLASH
        !           368:                        { savedata($1, $3); }
        !           369:        ;
        !           370: 
        !           371: datalvals:     datalval
        !           372:                { $$ = preplval(NULL, $1); }
        !           373:         |      datalvals SCOMMA datalval
        !           374:                { $$ = preplval($1, $3); }
        !           375:         ;
        !           376: 
        !           377: datarvals:     datarval
        !           378:         |      datarvals SCOMMA datarval
        !           379:                        {
        !           380:                          $3->next = $1;
        !           381:                          $$ = $3;
        !           382:                        }
        !           383:         ;
        !           384: 
        !           385: datalval:      dataname
        !           386:                        { $$ = mkdlval($1, NULL, NULL); }
        !           387:        |       dataname datasubs
        !           388:                        { $$ = mkdlval($1, $2, NULL); }
        !           389:        |       dataname datarange
        !           390:                        { $$ = mkdlval($1, NULL, $2); }
        !           391:        |       dataname datasubs datarange
        !           392:                        { $$ = mkdlval($1, $2, $3); }
        !           393:        |       dataimplieddo
        !           394:        ;
        !           395: 
        !           396: dataname:      SNAME { $$ = mkdname(toklen, token); }
        !           397:        ;
        !           398: 
        !           399: datasubs:      SLPAR iconexprlist SRPAR
        !           400:                        { $$ = revvlist($2); }
        !           401:        ;
        !           402: 
        !           403: datarange:     SLPAR opticonexpr SCOLON opticonexpr SRPAR
        !           404:                        { $$ = mkdrange($2, $4); }
        !           405:         ;
        !           406: 
        !           407: iconexprlist:  iconexpr
        !           408:                        {
        !           409:                          $$ = prepvexpr(NULL, $1);
        !           410:                        }
        !           411:            |   iconexprlist SCOMMA iconexpr
        !           412:                        {
        !           413:                          $$ = prepvexpr($1, $3);
        !           414:                        }
        !           415:            ;
        !           416: 
        !           417: opticonexpr:                   { $$ = NULL; }
        !           418:           |    iconexpr        { $$ = $1; }
        !           419:           ;
        !           420: 
        !           421: dataimplieddo: SLPAR dlist SCOMMA dataname SEQUALS iconexprlist SRPAR
        !           422:                { $$ = mkdatado($2, $4, $6); }
        !           423:             ;
        !           424: 
        !           425: dlist: dataelt
        !           426:        { $$ = preplval(NULL, $1); }
        !           427:      | dlist SCOMMA dataelt
        !           428:        { $$ = preplval($1, $3); }
        !           429:      ;
        !           430: 
        !           431: dataelt:       dataname datasubs
        !           432:                { $$ = mkdlval($1, $2, NULL); }
        !           433:        |       dataname datarange
        !           434:                { $$ = mkdlval($1, NULL, $2); }
        !           435:        |       dataname datasubs datarange
        !           436:                { $$ = mkdlval($1, $2, $3); }
        !           437:        |       dataimplieddo
        !           438:        ;
        !           439: 
        !           440: datarval:      datavalue
        !           441:                        {
        !           442:                          static dvalue one = { DVALUE, NORMAL, 1 };
        !           443: 
        !           444:                          $$ = mkdrval(&one, $1);
        !           445:                        }
        !           446:        |       dataname SSTAR datavalue
        !           447:                        {
        !           448:                          $$ = mkdrval($1, $3);
        !           449:                          frvexpr($1);
        !           450:                        }
        !           451:        |       unsignedint SSTAR datavalue
        !           452:                        {
        !           453:                          $$ = mkdrval($1, $3);
        !           454:                          frvexpr($1);
        !           455:                        }
        !           456:        ;
        !           457: 
        !           458: datavalue:     dataname
        !           459:                        {
        !           460:                          $$ = evparam($1);
        !           461:                          free((char *) $1);
        !           462:                        }
        !           463:         |      int_const
        !           464:                        {
        !           465:                          $$ = ivaltoicon($1);
        !           466:                          frvexpr($1);
        !           467:                        }
        !           468: 
        !           469:         |      real_const
        !           470:         |      complex_const
        !           471:         |      STRUE           { $$ = mklogcon(1); }
        !           472:         |      SFALSE          { $$ = mklogcon(0); }
        !           473:         |      SHOLLERITH      { $$ = mkstrcon(toklen, token); }
        !           474:         |      SSTRING         { $$ = mkstrcon(toklen, token); }
        !           475:         |      bit_const
        !           476:         ;
        !           477: 
        !           478: int_const:     unsignedint
        !           479:         |      SPLUS unsignedint
        !           480:                        { $$ = $2; }
        !           481:         |      SMINUS unsignedint
        !           482:                        {
        !           483:                          $$ = negival($2);
        !           484:                          frvexpr($2);
        !           485:                        }
        !           486:                                
        !           487:         ;
        !           488: 
        !           489: unsignedint:   SICON { $$ = evicon(toklen, token); }
        !           490:           ;
        !           491: 
        !           492: real_const:    unsignedreal
        !           493:          |     SPLUS unsignedreal
        !           494:                        { $$ = $2; }
        !           495:          |     SMINUS unsignedreal
        !           496:                        {
        !           497:                          consnegop($2);
        !           498:                          $$ = $2;
        !           499:                        }
        !           500:          ;
        !           501: 
        !           502: unsignedreal:  SRCON { $$ = mkrealcon(TYREAL, convcd(toklen, token)); }
        !           503:            |   SDCON { $$ = mkrealcon(TYDREAL, convcd(toklen, token)); }
        !           504:            ;
        !           505: 
        !           506: bit_const:     SHEXCON { $$ = mkbitcon(4, toklen, token); }
        !           507:         |      SOCTCON { $$ = mkbitcon(3, toklen, token); }
        !           508:         |      SBITCON { $$ = mkbitcon(1, toklen, token); }
        !           509:         ;
        !           510: 
        !           511: iconexpr:      iconterm
        !           512:        |       SPLUS iconterm
        !           513:                        { $$ = $2; }
        !           514:        |       SMINUS iconterm
        !           515:                        { $$ = mkdexpr(OPNEG, NULL, $2); }
        !           516:        |       iconexpr SPLUS iconterm
        !           517:                        { $$ = mkdexpr(OPPLUS, $1, $3); }
        !           518:        |       iconexpr SMINUS iconterm
        !           519:                        { $$ = mkdexpr(OPMINUS, $1, $3); }
        !           520:        ;
        !           521: 
        !           522: iconterm:      iconfactor
        !           523:        |       iconterm SSTAR iconfactor
        !           524:                        { $$ = mkdexpr(OPSTAR, $1, $3); }
        !           525:        |       iconterm SSLASH iconfactor
        !           526:                        { $$ = mkdexpr(OPSLASH, $1, $3); }
        !           527:        ;
        !           528: 
        !           529: iconfactor:    iconprimary
        !           530:          |     iconprimary SPOWER iconfactor
        !           531:                        { $$ = mkdexpr(OPPOWER, $1, $3); }
        !           532:          ;
        !           533: 
        !           534: iconprimary:   SICON
        !           535:                        { $$ = evicon(toklen, token); }
        !           536:           |    dataname
        !           537:           |    SLPAR iconexpr SRPAR
        !           538:                        { $$ = $2; }
        !           539:           ;

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