Return to lex.c CVS log

Up to [CSRG BSD Unix] / 3BSD / cmd / f77

Annotation of 3BSD/cmd/f77/lex.c, revision 1.1

1.1     ! root        1: #include "defs"
        !             2: #include "tokdefs"
        !             3: 
        !             4: # define BLANK ' '
        !             5: # define MYQUOTE (2)
        !             6: # define SEOF 0
        !             7: 
        !             8: /* card types */
        !             9: 
        !            10: # define STEOF 1
        !            11: # define STINITIAL 2
        !            12: # define STCONTINUE 3
        !            13: 
        !            14: /* lex states */
        !            15: 
        !            16: #define NEWSTMT        1
        !            17: #define FIRSTTOKEN     2
        !            18: #define OTHERTOKEN     3
        !            19: #define RETEOS 4
        !            20: 
        !            21: 
        !            22: LOCAL int stkey;
        !            23: ftnint yystno;
        !            24: LOCAL long int stno;
        !            25: LOCAL long int nxtstno;
        !            26: LOCAL int parlev;
        !            27: LOCAL int expcom;
        !            28: LOCAL int expeql;
        !            29: LOCAL char *nextch;
        !            30: LOCAL char *lastch;
        !            31: LOCAL char *nextcd     = NULL;
        !            32: LOCAL char *endcd;
        !            33: LOCAL int prevlin;
        !            34: LOCAL int thislin;
        !            35: LOCAL int code;
        !            36: LOCAL int lexstate     = NEWSTMT;
        !            37: LOCAL char s[1390];
        !            38: LOCAL char *send       = s+20*66;
        !            39: LOCAL int nincl        = 0;
        !            40: 
        !            41: struct Inclfile
        !            42:        {
        !            43:        struct Inclfile *inclnext;
        !            44:        FILEP inclfp;
        !            45:        char *inclname;
        !            46:        int incllno;
        !            47:        char *incllinp;
        !            48:        int incllen;
        !            49:        int inclcode;
        !            50:        ftnint inclstno;
        !            51:        } ;
        !            52: 
        !            53: LOCAL struct Inclfile *inclp   =  NULL;
        !            54: LOCAL struct Keylist { char *keyname; int keyval; char notinf66; } ;
        !            55: LOCAL struct Punctlist { char punchar; int punval; };
        !            56: LOCAL struct Fmtlist { char fmtchar; int fmtval; };
        !            57: LOCAL struct Dotlist { char *dotname; int dotval; };
        !            58: LOCAL struct Keylist *keystart[26], *keyend[26];
        !            59: 
        !            60: 
        !            61: 
        !            62: 
        !            63: inilex(name)
        !            64: char *name;
        !            65: {
        !            66: nincl = 0;
        !            67: inclp = NULL;
        !            68: doinclude(name);
        !            69: lexstate = NEWSTMT;
        !            70: return(NO);
        !            71: }
        !            72: 
        !            73: 
        !            74: 
        !            75: /* throw away the rest of the current line */
        !            76: flline()
        !            77: {
        !            78: lexstate = RETEOS;
        !            79: }
        !            80: 
        !            81: 
        !            82: 
        !            83: char *lexline(n)
        !            84: ftnint *n;
        !            85: {
        !            86: *n = (lastch - nextch) + 1;
        !            87: return(nextch);
        !            88: }
        !            89: 
        !            90: 
        !            91: 
        !            92: 
        !            93: 
        !            94: doinclude(name)
        !            95: char *name;
        !            96: {
        !            97: FILEP fp;
        !            98: struct Inclfile *t;
        !            99: 
        !           100: if(inclp)
        !           101:        {
        !           102:        inclp->incllno = thislin;
        !           103:        inclp->inclcode = code;
        !           104:        inclp->inclstno = nxtstno;
        !           105:        if(nextcd)
        !           106:                inclp->incllinp = copyn(inclp->incllen = endcd-nextcd , nextcd);
        !           107:        else
        !           108:                inclp->incllinp = 0;
        !           109:        }
        !           110: nextcd = NULL;
        !           111: 
        !           112: if(++nincl >= MAXINCLUDE)
        !           113:        fatal("includes nested too deep");
        !           114: if(name[0] == '\0')
        !           115:        fp = stdin;
        !           116: else
        !           117:        fp = fopen(name, "r");
        !           118: if( fp )
        !           119:        {
        !           120:        t = inclp;
        !           121:        inclp = ALLOC(Inclfile);
        !           122:        inclp->inclnext = t;
        !           123:        prevlin = thislin = 0;
        !           124:        infname = inclp->inclname = name;
        !           125:        infile = inclp->inclfp = fp;
        !           126:        }
        !           127: else
        !           128:        {
        !           129:        fprintf(diagfile, "Cannot open file %s", name);
        !           130:        done(1);
        !           131:        }
        !           132: }
        !           133: 
        !           134: 
        !           135: 
        !           136: 
        !           137: LOCAL popinclude()
        !           138: {
        !           139: struct Inclfile *t;
        !           140: register char *p;
        !           141: register int k;
        !           142: 
        !           143: if(infile != stdin)
        !           144:        clf(&infile);
        !           145: free(infname);
        !           146: 
        !           147: --nincl;
        !           148: t = inclp->inclnext;
        !           149: free(inclp);
        !           150: inclp = t;
        !           151: if(inclp == NULL)
        !           152:        return(NO);
        !           153: 
        !           154: infile = inclp->inclfp;
        !           155: infname = inclp->inclname;
        !           156: prevlin = thislin = inclp->incllno;
        !           157: code = inclp->inclcode;
        !           158: stno = nxtstno = inclp->inclstno;
        !           159: if(inclp->incllinp)
        !           160:        {
        !           161:        endcd = nextcd = s;
        !           162:        k = inclp->incllen;
        !           163:        p = inclp->incllinp;
        !           164:        while(--k >= 0)
        !           165:                *endcd++ = *p++;
        !           166:        free(inclp->incllinp);
        !           167:        }
        !           168: else
        !           169:        nextcd = NULL;
        !           170: return(YES);
        !           171: }
        !           172: 
        !           173: 
        !           174: 
        !           175: 
        !           176: yylex()
        !           177: {
        !           178: static int  tokno;
        !           179: 
        !           180:        switch(lexstate)
        !           181:        {
        !           182: case NEWSTMT : /* need a new statement */
        !           183:        if(getcds() == STEOF)
        !           184:                return(SEOF);
        !           185:        crunch();
        !           186:        tokno = 0;
        !           187:        lexstate = FIRSTTOKEN;
        !           188:        yystno = stno;
        !           189:        stno = nxtstno;
        !           190:        toklen = 0;
        !           191:        return(SLABEL);
        !           192: 
        !           193: first:
        !           194: case FIRSTTOKEN :      /* first step on a statement */
        !           195:        analyz();
        !           196:        lexstate = OTHERTOKEN;
        !           197:        tokno = 1;
        !           198:        return(stkey);
        !           199: 
        !           200: case OTHERTOKEN :      /* return next token */
        !           201:        if(nextch > lastch)
        !           202:                goto reteos;
        !           203:        ++tokno;
        !           204:        if((stkey==SLOGIF || stkey==SELSEIF) && parlev==0 && tokno>3) goto first;
        !           205:        if(stkey==SASSIGN && tokno==3 && nextch<lastch &&
        !           206:                nextch[0]=='t' && nextch[1]=='o')
        !           207:                        {
        !           208:                        nextch+=2;
        !           209:                        return(STO);
        !           210:                        }
        !           211:        return(gettok());
        !           212: 
        !           213: reteos:
        !           214: case RETEOS:
        !           215:        lexstate = NEWSTMT;
        !           216:        return(SEOS);
        !           217:        }
        !           218: fatali("impossible lexstate %d", lexstate);
        !           219: /* NOTREACHED */
        !           220: }
        !           221: 
        !           222: LOCAL getcds()
        !           223: {
        !           224: register char *p, *q;
        !           225: 
        !           226: top:
        !           227:        if(nextcd == NULL)
        !           228:                {
        !           229:                code = getcd( nextcd = s );
        !           230:                stno = nxtstno;
        !           231:                prevlin = thislin;
        !           232:                }
        !           233:        if(code == STEOF)
        !           234:                if( popinclude() )
        !           235:                        goto top;
        !           236:                else
        !           237:                        return(STEOF);
        !           238: 
        !           239:        if(code == STCONTINUE)
        !           240:                {
        !           241:                lineno = thislin;
        !           242:                err("illegal continuation card ignored");
        !           243:                nextcd = NULL;
        !           244:                goto top;
        !           245:                }
        !           246: 
        !           247:        if(nextcd > s)
        !           248:                {
        !           249:                q = nextcd;
        !           250:                p = s;
        !           251:                while(q < endcd)
        !           252:                        *p++ = *q++;
        !           253:                endcd = p;
        !           254:                }
        !           255:        for(nextcd = endcd ;
        !           256:                nextcd+66<=send && (code = getcd(nextcd))==STCONTINUE ;
        !           257:                nextcd = endcd )
        !           258:                        ;
        !           259:        nextch = s;
        !           260:        lastch = nextcd - 1;
        !           261:        if(nextcd >= send)
        !           262:                nextcd = NULL;
        !           263:        lineno = prevlin;
        !           264:        prevlin = thislin;
        !           265:        return(STINITIAL);
        !           266: }
        !           267: 
        !           268: LOCAL getcd(b)
        !           269: register char *b;
        !           270: {
        !           271: register int c;
        !           272: register char *p, *bend;
        !           273: int speclin;
        !           274: static char a[6];
        !           275: static char *aend      = a+6;
        !           276: 
        !           277: top:
        !           278:        endcd = b;
        !           279:        bend = b+66;
        !           280:        speclin = NO;
        !           281: 
        !           282:        if( (c = getc(infile)) == '&')
        !           283:                {
        !           284:                a[0] = BLANK;
        !           285:                a[5] = 'x';
        !           286:                speclin = YES;
        !           287:                bend = send;
        !           288:                }
        !           289:        else if(c=='c' || c=='C' || c=='*')
        !           290:                {
        !           291:                while( (c = getc(infile)) != '\n')
        !           292:                        if(c == EOF)
        !           293:                                return(STEOF);
        !           294:                ++thislin;
        !           295:                goto top;
        !           296:                }
        !           297: 
        !           298:        else if(c != EOF)
        !           299:                {
        !           300:                /* a tab in columns 1-6 skips to column 7 */
        !           301:                ungetc(c, infile);
        !           302:                for(p=a; p<aend && (c=getc(infile)) != '\n' && c!=EOF; )
        !           303:                        if(c == '\t')
        !           304:                                {
        !           305:                                while(p < aend)
        !           306:                                        *p++ = BLANK;
        !           307:                                speclin = YES;
        !           308:                                bend = send;
        !           309:                                }
        !           310:                        else
        !           311:                                *p++ = c;
        !           312:                }
        !           313:        if(c == EOF)
        !           314:                return(STEOF);
        !           315:        if(c == '\n')
        !           316:                {
        !           317:                while(p < aend)
        !           318:                        *p++ = BLANK;
        !           319:                if( ! speclin )
        !           320:                        while(endcd < bend)
        !           321:                                *endcd++ = BLANK;
        !           322:                }
        !           323:        else    {       /* read body of line */
        !           324:                while( endcd<bend && (c=getc(infile)) != '\n' && c!=EOF )
        !           325:                        *endcd++ = c;
        !           326:                if(c == EOF)
        !           327:                        return(STEOF);
        !           328:                if(c != '\n')
        !           329:                        {
        !           330:                        while( (c=getc(infile)) != '\n')
        !           331:                                if(c == EOF)
        !           332:                                        return(STEOF);
        !           333:                        }
        !           334: 
        !           335:                if( ! speclin )
        !           336:                        while(endcd < bend)
        !           337:                                *endcd++ = BLANK;
        !           338:                }
        !           339:        ++thislin;
        !           340:        if( !isspace(a[5]) && a[5]!='0')
        !           341:                return(STCONTINUE);
        !           342:        for(p=a; p<aend; ++p)
        !           343:                if( !isspace(*p) ) goto initline;
        !           344:        for(p = b ; p<endcd ; ++p)
        !           345:                if( !isspace(*p) ) goto initline;
        !           346:        goto top;
        !           347: 
        !           348: initline:
        !           349:        nxtstno = 0;
        !           350:        for(p = a ; p<a+5 ; ++p)
        !           351:                if( !isspace(*p) )
        !           352:                        if(isdigit(*p))
        !           353:                                nxtstno = 10*nxtstno + (*p - '0');
        !           354:                        else    {
        !           355:                                lineno = thislin;
        !           356:                                err("nondigit in statement number field");
        !           357:                                nxtstno = 0;
        !           358:                                break;
        !           359:                                }
        !           360:        return(STINITIAL);
        !           361: }
        !           362: 
        !           363: LOCAL crunch()
        !           364: {
        !           365: register char *i, *j, *j0, *j1, *prvstr;
        !           366: int ten, nh, quote;
        !           367: 
        !           368: /* i is the next input character to be looked at
        !           369: j is the next output character */
        !           370: parlev = 0;
        !           371: expcom = 0;    /* exposed ','s */
        !           372: expeql = 0;    /* exposed equal signs */
        !           373: j = s;
        !           374: prvstr = s;
        !           375: for(i=s ; i<=lastch ; ++i)
        !           376:        {
        !           377:        if(isspace(*i) )
        !           378:                continue;
        !           379:        if(*i=='\'' ||  *i=='"')
        !           380:                {
        !           381:                quote = *i;
        !           382:                *j = MYQUOTE; /* special marker */
        !           383:                for(;;)
        !           384:                        {
        !           385:                        if(++i > lastch)
        !           386:                                {
        !           387:                                err("unbalanced quotes; closing quote supplied");
        !           388:                                break;
        !           389:                                }
        !           390:                        if(*i == quote)
        !           391:                                if(i<lastch && i[1]==quote) ++i;
        !           392:                                else break;
        !           393:                        else if(*i=='\\' && i<lastch)
        !           394:                                switch(*++i)
        !           395:                                        {
        !           396:                                        case 't':
        !           397:                                                *i = '\t'; break;
        !           398:                                        case 'b':
        !           399:                                                *i = '\b'; break;
        !           400:                                        case 'n':
        !           401:                                                *i = '\n'; break;
        !           402:                                        case 'f':
        !           403:                                                *i = '\f'; break;
        !           404:                                        case 'v':
        !           405:                                                *i = '\v'; break;
        !           406:                                        case '0':
        !           407:                                                *i = '\0'; break;
        !           408:                                        default:
        !           409:                                                break;
        !           410:                                        }
        !           411:                        *++j = *i;
        !           412:                        }
        !           413:                j[1] = MYQUOTE;
        !           414:                j += 2;
        !           415:                prvstr = j;
        !           416:                }
        !           417:        else if( (*i=='h' || *i=='H')  && j>prvstr)     /* test for Hollerith strings */
        !           418:                {
        !           419:                if( ! isdigit(j[-1])) goto copychar;
        !           420:                nh = j[-1] - '0';
        !           421:                ten = 10;
        !           422:                j1 = prvstr - 1;
        !           423:                if (j1<j-5) j1=j-5;
        !           424:                for(j0=j-2 ; j0>j1; -- j0)
        !           425:                        {
        !           426:                        if( ! isdigit(*j0 ) ) break;
        !           427:                        nh += ten * (*j0-'0');
        !           428:                        ten*=10;
        !           429:                        }
        !           430:                if(j0 <= j1) goto copychar;
        !           431: /* a hollerith must be preceded by a punctuation mark.
        !           432:    '*' is possible only as repetition factor in a data statement
        !           433:    not, in particular, in character*2h
        !           434: */
        !           435: 
        !           436:                if( !(*j0=='*'&&s[0]=='d') && *j0!='/' && *j0!='(' &&
        !           437:                        *j0!=',' && *j0!='=' && *j0!='.')
        !           438:                                goto copychar;
        !           439:                if(i+nh > lastch)
        !           440:                        {
        !           441:                        erri("%dH too big", nh);
        !           442:                        nh = lastch - i;
        !           443:                        }
        !           444:                j0[1] = MYQUOTE; /* special marker */
        !           445:                j = j0 + 1;
        !           446:                while(nh-- > 0)
        !           447:                        {
        !           448:                        if(*++i == '\\')
        !           449:                                switch(*++i)
        !           450:                                        {
        !           451:                                        case 't':
        !           452:                                                *i = '\t'; break;
        !           453:                                        case 'b':
        !           454:                                                *i = '\b'; break;
        !           455:                                        case 'n':
        !           456:                                                *i = '\n'; break;
        !           457:                                        case 'f':
        !           458:                                                *i = '\f'; break;
        !           459:                                        case '0':
        !           460:                                                *i = '\0'; break;
        !           461:                                        default:
        !           462:                                                break;
        !           463:                                        }
        !           464:                        *++j = *i;
        !           465:                        }
        !           466:                j[1] = MYQUOTE;
        !           467:                j+=2;
        !           468:                prvstr = j;
        !           469:                }
        !           470:        else    {
        !           471:                if(*i == '(') ++parlev;
        !           472:                else if(*i == ')') --parlev;
        !           473:                else if(parlev == 0)
        !           474:                        if(*i == '=') expeql = 1;
        !           475:                        else if(*i == ',') expcom = 1;
        !           476: copychar:              /*not a string or space -- copy, shifting case if necessary */
        !           477:                if(shiftcase && isupper(*i))
        !           478:                        *j++ = tolower(*i);
        !           479:                else    *j++ = *i;
        !           480:                }
        !           481:        }
        !           482: lastch = j - 1;
        !           483: nextch = s;
        !           484: }
        !           485: 
        !           486: LOCAL analyz()
        !           487: {
        !           488: register char *i;
        !           489: 
        !           490:        if(parlev != 0)
        !           491:                {
        !           492:                err("unbalanced parentheses, statement skipped");
        !           493:                stkey = SUNKNOWN;
        !           494:                return;
        !           495:                }
        !           496:        if(nextch+2<=lastch && nextch[0]=='i' && nextch[1]=='f' && nextch[2]=='(')
        !           497:                {
        !           498: /* assignment or if statement -- look at character after balancing paren */
        !           499:                parlev = 1;
        !           500:                for(i=nextch+3 ; i<=lastch; ++i)
        !           501:                        if(*i == (MYQUOTE))
        !           502:                                {
        !           503:                                while(*++i != MYQUOTE)
        !           504:                                        ;
        !           505:                                }
        !           506:                        else if(*i == '(')
        !           507:                                ++parlev;
        !           508:                        else if(*i == ')')
        !           509:                                {
        !           510:                                if(--parlev == 0)
        !           511:                                        break;
        !           512:                                }
        !           513:                if(i >= lastch)
        !           514:                        stkey = SLOGIF;
        !           515:                else if(i[1] == '=')
        !           516:                        stkey = SLET;
        !           517:                else if( isdigit(i[1]) )
        !           518:                        stkey = SARITHIF;
        !           519:                else    stkey = SLOGIF;
        !           520:                if(stkey != SLET)
        !           521:                        nextch += 2;
        !           522:                }
        !           523:        else if(expeql) /* may be an assignment */
        !           524:                {
        !           525:                if(expcom && nextch<lastch &&
        !           526:                        nextch[0]=='d' && nextch[1]=='o')
        !           527:                                {
        !           528:                                stkey = SDO;
        !           529:                                nextch += 2;
        !           530:                                }
        !           531:                else    stkey = SLET;
        !           532:                }
        !           533: /* otherwise search for keyword */
        !           534:        else    {
        !           535:                stkey = getkwd();
        !           536:                if(stkey==SGOTO && lastch>=nextch)
        !           537:                        if(nextch[0]=='(')
        !           538:                                stkey = SCOMPGOTO;
        !           539:                        else if(isalpha(nextch[0]))
        !           540:                                stkey = SASGOTO;
        !           541:                }
        !           542:        parlev = 0;
        !           543: }
        !           544: 
        !           545: 
        !           546: 
        !           547: LOCAL getkwd()
        !           548: {
        !           549: register char *i, *j;
        !           550: register struct Keylist *pk, *pend;
        !           551: int k;
        !           552: 
        !           553: if(! isalpha(nextch[0]) )
        !           554:        return(SUNKNOWN);
        !           555: k = nextch[0] - 'a';
        !           556: if(pk = keystart[k])
        !           557:        for(pend = keyend[k] ; pk<=pend ; ++pk )
        !           558:                {
        !           559:                i = pk->keyname;
        !           560:                j = nextch;
        !           561:                while(*++i==*++j && *i!='\0')
        !           562:                        ;
        !           563:                if(*i=='\0' && j<=lastch+1)
        !           564:                        {
        !           565:                        nextch = j;
        !           566:                        if(no66flag && pk->notinf66)
        !           567:                                errstr("Not a Fortran 66 keyword: %s",
        !           568:                                        pk->keyname);
        !           569:                        return(pk->keyval);
        !           570:                        }
        !           571:                }
        !           572: return(SUNKNOWN);
        !           573: }
        !           574: 
        !           575: 
        !           576: 
        !           577: initkey()
        !           578: {
        !           579: extern struct Keylist keys[];
        !           580: register struct Keylist *p;
        !           581: register int i,j;
        !           582: 
        !           583: for(i = 0 ; i<26 ; ++i)
        !           584:        keystart[i] = NULL;
        !           585: 
        !           586: for(p = keys ; p->keyname ; ++p)
        !           587:        {
        !           588:        j = p->keyname[0] - 'a';
        !           589:        if(keystart[j] == NULL)
        !           590:                keystart[j] = p;
        !           591:        keyend[j] = p;
        !           592:        }
        !           593: }
        !           594: 
        !           595: LOCAL gettok()
        !           596: {
        !           597: int havdot, havexp, havdbl;
        !           598: int radix;
        !           599: extern struct Punctlist puncts[];
        !           600: struct Punctlist *pp;
        !           601: extern struct Fmtlist fmts[];
        !           602: extern struct Dotlist dots[];
        !           603: struct Dotlist *pd;
        !           604: 
        !           605: char *i, *j, *n1, *p;
        !           606: 
        !           607:        if(*nextch == (MYQUOTE))
        !           608:                {
        !           609:                ++nextch;
        !           610:                p = token;
        !           611:                while(*nextch != MYQUOTE)
        !           612:                        *p++ = *nextch++;
        !           613:                ++nextch;
        !           614:                toklen = p - token;
        !           615:                *p = '\0';
        !           616:                return (SHOLLERITH);
        !           617:                }
        !           618: /*
        !           619:        if(stkey == SFORMAT)
        !           620:                {
        !           621:                for(pf = fmts; pf->fmtchar; ++pf)
        !           622:                        {
        !           623:                        if(*nextch == pf->fmtchar)
        !           624:                                {
        !           625:                                ++nextch;
        !           626:                                if(pf->fmtval == SLPAR)
        !           627:                                        ++parlev;
        !           628:                                else if(pf->fmtval == SRPAR)
        !           629:                                        --parlev;
        !           630:                                return(pf->fmtval);
        !           631:                                }
        !           632:                        }
        !           633:                if( isdigit(*nextch) )
        !           634:                        {
        !           635:                        p = token;
        !           636:                        *p++ = *nextch++;
        !           637:                        while(nextch<=lastch && isdigit(*nextch) )
        !           638:                                *p++ = *nextch++;
        !           639:                        toklen = p - token;
        !           640:                        *p = '\0';
        !           641:                        if(nextch<=lastch && *nextch=='p')
        !           642:                                {
        !           643:                                ++nextch;
        !           644:                                return(SSCALE);
        !           645:                                }
        !           646:                        else    return(SICON);
        !           647:                        }
        !           648:                if( isalpha(*nextch) )
        !           649:                        {
        !           650:                        p = token;
        !           651:                        *p++ = *nextch++;
        !           652:                        while(nextch<=lastch &&
        !           653:                                (*nextch=='.' || isdigit(*nextch) || isalpha(*nextch) ))
        !           654:                                        *p++ = *nextch++;
        !           655:                        toklen = p - token;
        !           656:                        *p = '\0';
        !           657:                        return(SFIELD);
        !           658:                        }
        !           659:                goto badchar;
        !           660:                }
        !           661: /* Not a format statement */
        !           662: 
        !           663: if(needkwd)
        !           664:        {
        !           665:        needkwd = 0;
        !           666:        return( getkwd() );
        !           667:        }
        !           668: 
        !           669:        for(pp=puncts; pp->punchar; ++pp)
        !           670:                if(*nextch == pp->punchar)
        !           671:                        {
        !           672:                        if( (*nextch=='*' || *nextch=='/') &&
        !           673:                                nextch<lastch && nextch[1]==nextch[0])
        !           674:                                        {
        !           675:                                        if(*nextch == '*')
        !           676:                                                yylval = SPOWER;
        !           677:                                        else    yylval = SCONCAT;
        !           678:                                        nextch+=2;
        !           679:                                        }
        !           680:                        else    {yylval=pp->punval;
        !           681:                                        if(yylval==SLPAR)
        !           682:                                                ++parlev;
        !           683:                                        else if(yylval==SRPAR)
        !           684:                                                --parlev;
        !           685:                                        ++nextch;
        !           686:                                }
        !           687:                        return(yylval);
        !           688:                        }
        !           689:        if(*nextch == '.')
        !           690:                if(nextch >= lastch) goto badchar;
        !           691:                else if(isdigit(nextch[1])) goto numconst;
        !           692:                else    {
        !           693:                        for(pd=dots ; (j=pd->dotname) ; ++pd)
        !           694:                                {
        !           695:                                for(i=nextch+1 ; i<=lastch ; ++i)
        !           696:                                        if(*i != *j) break;
        !           697:                                        else if(*i != '.') ++j;
        !           698:                                        else    {
        !           699:                                                nextch = i+1;
        !           700:                                                return(pd->dotval);
        !           701:                                                }
        !           702:                                }
        !           703:                        goto badchar;
        !           704:                        }
        !           705:        if( isalpha(*nextch) )
        !           706:                {
        !           707:                p = token;
        !           708:                *p++ = *nextch++;
        !           709:                while(nextch<=lastch)
        !           710:                        if( isalpha(*nextch) || isdigit(*nextch) )
        !           711:                                *p++ = *nextch++;
        !           712:                        else break;
        !           713:                toklen = p - token;
        !           714:                *p = '\0';
        !           715:                if(inioctl && nextch<=lastch && *nextch=='=')
        !           716:                        {
        !           717:                        ++nextch;
        !           718:                        return(SNAMEEQ);
        !           719:                        }
        !           720:                if(toklen>=8 && eqn(8, token, "function") &&
        !           721:                        nextch<lastch && *nextch=='(')
        !           722:                                {
        !           723:                                nextch -= (toklen - 8);
        !           724:                                return(SFUNCTION);
        !           725:                                }
        !           726:                if(toklen > VL)
        !           727:                        {
        !           728:                        char buff[30];
        !           729:                        sprintf(buff, "name %s too long, truncated to %d",
        !           730:                                token, VL);
        !           731:                        err(buff);
        !           732:                        toklen = VL;
        !           733:                        token[6] = '\0';
        !           734:                        }
        !           735:                if(toklen==1 && *nextch==MYQUOTE)
        !           736:                        {
        !           737:                        switch(token[0])
        !           738:                                {
        !           739:                                case 'z':  case 'Z':
        !           740:                                case 'x':  case 'X':
        !           741:                                        radix = 16; break;
        !           742:                                case 'o':  case 'O':
        !           743:                                        radix = 8; break;
        !           744:                                case 'b':  case 'B':
        !           745:                                        radix = 2; break;
        !           746:                                default:
        !           747:                                        err("bad bit identifier");
        !           748:                                        return(SNAME);
        !           749:                                }
        !           750:                        ++nextch;
        !           751:                        for(p = token ; *nextch!=MYQUOTE ; )
        !           752:                                if( hextoi(*p++ = *nextch++) >= radix)
        !           753:                                        {
        !           754:                                        err("invalid binary character");
        !           755:                                        break;
        !           756:                                        }
        !           757:                        ++nextch;
        !           758:                        toklen = p - token;
        !           759:                        return( radix==16 ? SHEXCON : (radix==8 ? SOCTCON : SBITCON) );
        !           760:                        }
        !           761:                return(SNAME);
        !           762:                }
        !           763:        if( ! isdigit(*nextch) ) goto badchar;
        !           764: numconst:
        !           765:        havdot = NO;
        !           766:        havexp = NO;
        !           767:        havdbl = NO;
        !           768:        for(n1 = nextch ; nextch<=lastch ; ++nextch)
        !           769:                {
        !           770:                if(*nextch == '.')
        !           771:                        if(havdot) break;
        !           772:                        else if(nextch+2<=lastch && isalpha(nextch[1])
        !           773:                                && isalpha(nextch[2]))
        !           774:                                        break;
        !           775:                        else    havdot = YES;
        !           776:                else if(*nextch=='d' || *nextch=='e')
        !           777:                        {
        !           778:                        p = nextch;
        !           779:                        havexp = YES;
        !           780:                        if(*nextch == 'd')
        !           781:                                havdbl = YES;
        !           782:                        if(nextch<lastch)
        !           783:                                if(nextch[1]=='+' || nextch[1]=='-')
        !           784:                                        ++nextch;
        !           785:                        if( ! isdigit(*++nextch) )
        !           786:                                {
        !           787:                                nextch = p;
        !           788:                                havdbl = havexp = NO;
        !           789:                                break;
        !           790:                                }
        !           791:                        for(++nextch ;
        !           792:                                nextch<=lastch && isdigit(*nextch);
        !           793:                                ++nextch);
        !           794:                        break;
        !           795:                        }
        !           796:                else if( ! isdigit(*nextch) )
        !           797:                        break;
        !           798:                }
        !           799:        p = token;
        !           800:        i = n1;
        !           801:        while(i < nextch)
        !           802:                *p++ = *i++;
        !           803:        toklen = p - token;
        !           804:        *p = '\0';
        !           805:        if(havdbl) return(SDCON);
        !           806:        if(havdot || havexp) return(SRCON);
        !           807:        return(SICON);
        !           808: badchar:
        !           809:        s[0] = *nextch++;
        !           810:        return(SUNKNOWN);
        !           811: }
        !           812: 
        !           813: /* KEYWORD AND SPECIAL CHARACTER TABLES
        !           814: */
        !           815: 
        !           816: struct Punctlist puncts[ ] =
        !           817:        {
        !           818:        '(', SLPAR,
        !           819:        ')', SRPAR,
        !           820:        '=', SEQUALS,
        !           821:        ',', SCOMMA,
        !           822:        '+', SPLUS,
        !           823:        '-', SMINUS,
        !           824:        '*', SSTAR,
        !           825:        '/', SSLASH,
        !           826:        '$', SCURRENCY,
        !           827:        ':', SCOLON,
        !           828:        0, 0 } ;
        !           829: 
        !           830: /*
        !           831: LOCAL struct Fmtlist  fmts[ ] =
        !           832:        {
        !           833:        '(', SLPAR,
        !           834:        ')', SRPAR,
        !           835:        '/', SSLASH,
        !           836:        ',', SCOMMA,
        !           837:        '-', SMINUS,
        !           838:        ':', SCOLON,
        !           839:        0, 0 } ;
        !           840: */
        !           841: 
        !           842: LOCAL struct Dotlist  dots[ ] =
        !           843:        {
        !           844:        "and.", SAND, 
        !           845:        "or.", SOR, 
        !           846:        "not.", SNOT, 
        !           847:        "true.", STRUE, 
        !           848:        "false.", SFALSE, 
        !           849:        "eq.", SEQ, 
        !           850:        "ne.", SNE, 
        !           851:        "lt.", SLT, 
        !           852:        "le.", SLE, 
        !           853:        "gt.", SGT, 
        !           854:        "ge.", SGE, 
        !           855:        "neqv.", SNEQV, 
        !           856:        "eqv.", SEQV, 
        !           857:        0, 0 } ;
        !           858: 
        !           859: LOCAL struct Keylist  keys[ ] =
        !           860:        {
        !           861:                { "assign",  SASSIGN  },
        !           862:                { "automatic",  SAUTOMATIC, YES  },
        !           863:                { "backspace",  SBACKSPACE  },
        !           864:                { "blockdata",  SBLOCK  },
        !           865:                { "call",  SCALL  },
        !           866:                { "character",  SCHARACTER, YES  },
        !           867:                { "close",  SCLOSE, YES  },
        !           868:                { "common",  SCOMMON  },
        !           869:                { "complex",  SCOMPLEX  },
        !           870:                { "continue",  SCONTINUE  },
        !           871:                { "data",  SDATA  },
        !           872:                { "dimension",  SDIMENSION  },
        !           873:                { "doubleprecision",  SDOUBLE  },
        !           874:                { "doublecomplex", SDCOMPLEX, YES  },
        !           875:                { "elseif",  SELSEIF, YES  },
        !           876:                { "else",  SELSE, YES  },
        !           877:                { "endfile",  SENDFILE  },
        !           878:                { "endif",  SENDIF, YES  },
        !           879:                { "end",  SEND  },
        !           880:                { "entry",  SENTRY, YES  },
        !           881:                { "equivalence",  SEQUIV  },
        !           882:                { "external",  SEXTERNAL  },
        !           883:                { "format",  SFORMAT  },
        !           884:                { "function",  SFUNCTION  },
        !           885:                { "goto",  SGOTO  },
        !           886:                { "implicit",  SIMPLICIT, YES  },
        !           887:                { "include",  SINCLUDE, YES  },
        !           888:                { "inquire",  SINQUIRE, YES  },
        !           889:                { "intrinsic",  SINTRINSIC, YES  },
        !           890:                { "integer",  SINTEGER  },
        !           891:                { "logical",  SLOGICAL  },
        !           892:                { "none", SUNDEFINED, YES },
        !           893:                { "open",  SOPEN, YES  },
        !           894:                { "parameter",  SPARAM, YES  },
        !           895:                { "pause",  SPAUSE  },
        !           896:                { "print",  SPRINT  },
        !           897:                { "program",  SPROGRAM, YES  },
        !           898:                { "punch",  SPUNCH, YES  },
        !           899:                { "read",  SREAD  },
        !           900:                { "real",  SREAL  },
        !           901:                { "return",  SRETURN  },
        !           902:                { "rewind",  SREWIND  },
        !           903:                { "save",  SSAVE, YES  },
        !           904:                { "static",  SSTATIC, YES  },
        !           905:                { "stop",  SSTOP  },
        !           906:                { "subroutine",  SSUBROUTINE  },
        !           907:                { "then",  STHEN, YES  },
        !           908:                { "undefined", SUNDEFINED, YES  },
        !           909:                { "write",  SWRITE  },
        !           910:                        { 0, 0 }
        !           911:        };

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