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

unix.superglobalmegacorp.com

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