# 2.11BSD#431 - /usr/src/usr.bin/f77/lex.c

##### Functions

    analyz            X
    crunch            X
    doinclude         X
    flline            X
    getcd             X
    getcds            X
    getkwd            X
    gettok            X
    inilex            X
    initkey           X
    lexline           X
    popinclude        X
    yylex             X

##### Variables

    code              X
    dots              X
    endcd             X
    expcom            X
    expeql            X
    inclp             X
    intonly           X
    keyend            X
    keys              X
    keystart          X
    lastch            X
    lexstate          X
    nextcd            X
    nextch            X
    nincl             X
    nxtstno           X
    parlev            X
    prevlin           X
    puncts            X
    s                 X
    send              X
    stkey             X
    stno              X
    thislin           X
    yystno            X

##### Macros

    BLANK             X
    FIRSTTOKEN        X
    MYQUOTE           X
    NEWSTMT           X
    OTHERTOKEN        X
    RETEOS            X
    SEOF              X
    STCONTINUE        X
    STEOF             X
    STINITIAL         X

##### struct's

    dotlist           X
    fmtlist           X
    inclfile          X
    keylist           X
    punctlist         X

       1: #include "defs"
       2: #include "string_defs"
       3: #include "tokdefs"
       4:
       5: # define BLANK  ' '
       6: # define MYQUOTE (2)
       7: # define SEOF 0
       8:
       9: /* card types */
      10:
      11: # define STEOF 1
      12: # define STINITIAL 2
      13: # define STCONTINUE 3
      14:
      15: /* lex states */
      16:
      17: #define NEWSTMT 1
      18: #define FIRSTTOKEN  2
      19: #define OTHERTOKEN  3
      20: #define RETEOS  4
      21:
      22:
      23: LOCAL int stkey;
      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; } ;
      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: ftnint *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:
     102: if(inclp)
     103:     {
     104:     inclp->incllno = thislin;
     105:     inclp->inclcode = code;
     106:     inclp->inclstno = nxtstno;
     107:     if(nextcd)
     108:         inclp->incllinp = copyn(inclp->incllen = endcd-nextcd , nextcd);
     109:     else
     110:         inclp->incllinp = 0;
     111:     }
     112: nextcd = NULL;
     113:
     114: if(++nincl >= MAXINCLUDES)
     115:     error("includes nested too deep",0,0,FATAL);
     116: if(name[0] == '\0')
     117:     fp = stdin;
     118: else
     119:     fp = fopen(name, "r");
     120: if( fp )
     121:     {
     122:     t = inclp;
     123:     inclp = ALLOC(inclfile);
     124:     inclp->inclnext = t;
     125:     prevlin = thislin = 0;
     126:     infname = inclp->inclname = name;
     127:     infile = inclp->inclfp = fp;
     128:     }
     129: else
     130:     {
     131:     fprintf(diagfile, "Cannot open file %s", name);
     132:     done(1);
     133:     }
     134: }
     135:
     136:
     137:
     138:
     139: LOCAL popinclude()
     140: {
     141: struct inclfile *t;
     142: register char *p;
     143: register int k;
     144:
     145: if(infile != stdin)
     146:     clf(&infile);
     147: free(infname);
     148:
     149: --nincl;
     150: t = inclp->inclnext;
     151: free(inclp);
     152: inclp = t;
     153: if(inclp == NULL)
     154:     return(NO);
     155:
     156: infile = inclp->inclfp;
     157: infname = inclp->inclname;
     158: prevlin = thislin = inclp->incllno;
     159: code = inclp->inclcode;
     160: stno = nxtstno = inclp->inclstno;
     161: if(inclp->incllinp)
     162:     {
     163:     endcd = nextcd = s;
     164:     k = inclp->incllen;
     165:     p = inclp->incllinp;
     166:     while(--k >= 0)
     167:         *endcd++ = *p++;
     168:     free(inclp->incllinp);
     169:     }
     170: else
     171:     nextcd = NULL;
     172: return(YES);
     173: }
     174:
     175:
     176:
     177:
     178: yylex()
     179: {
     180: static int  tokno;
     181:
     182:     switch(lexstate)
     183:     {
     184: case NEWSTMT :  /* need a new statement */
     185:     if(getcds() == STEOF)
     186:         return(SEOF);
     187:     crunch();
     188:     tokno = 0;
     189:     lexstate = FIRSTTOKEN;
     190:     yystno = stno;
     191:     stno = nxtstno;
     192:     toklen = 0;
     193:     return(SLABEL);
     194:
     195: first:
     196: case FIRSTTOKEN :   /* first step on a statement */
     197:     analyz();
     198:     lexstate = OTHERTOKEN;
     199:     tokno = 1;
     200:     return(stkey);
     201:
     202: case OTHERTOKEN :   /* return next token */
     203:     if(nextch > lastch)
     204:         goto reteos;
     205:     ++tokno;
     206:     if((stkey==SLOGIF || stkey==SELSEIF) && parlev==0 && tokno>3) goto first;
     207:     if(stkey==SASSIGN && tokno==3 && nextch<lastch &&
     208:         nextch[0]=='t' && nextch[1]=='o')
     209:             {
     210:             nextch+=2;
     211:             return(STO);
     212:             }
     213:     return(gettok());
     214:
     215: reteos:
     216: case RETEOS:
     217:     lexstate = NEWSTMT;
     218:     return(SEOS);
     219:     }
     220: error("impossible lexstate %d", lexstate,0,FATAL1);
     221: /* NOTREACHED */
     222: }
     223:
     224: LOCAL getcds()
     225: {
     226: register char *p, *q;
     227:
     228: top:
     229:     if(nextcd == NULL)
     230:         {
     231:         code = getcd( nextcd = s );
     232:         stno = nxtstno;
     233:         prevlin = thislin;
     234:         }
     235:     if(code == STEOF)
     236:         if( popinclude() )
     237:             goto top;
     238:         else
     239:             return(STEOF);
     240:
     241:     if(code == STCONTINUE)
     242:         {
     243:         lineno = thislin;
     244:         error("illegal continuation card ignored",0,0,ERR);
     245:         nextcd = NULL;
     246:         goto top;
     247:         }
     248:
     249:     if(nextcd > s)
     250:         {
     251:         q = nextcd;
     252:         p = s;
     253:         while(q < endcd)
     254:             *p++ = *q++;
     255:         endcd = p;
     256:         }
     257:     for(nextcd = endcd ;
     258:         nextcd+66<=send && (code = getcd(nextcd))==STCONTINUE ;
     259:         nextcd = endcd )
     260:             ;
     261:     nextch = s;
     262:     lastch = nextcd - 1;
     263:     if(nextcd >= send)
     264:         nextcd = NULL;
     265:     lineno = prevlin;
     266:     prevlin = thislin;
     267:     return(STINITIAL);
     268: }
     269:
     270: LOCAL getcd(b)
     271: register char *b;
     272: {
     273: register int c;
     274: register char *p, *bend;
     275: int speclin;
     276: static char a[6];
     277: static char *aend   = a+6;
     278:
     279: top:
     280:     endcd = b;
     281:     bend = b+66;
     282:     speclin = NO;
     283:
     284:     if( (c = getc(infile)) == '&')
     285:         {
     286:         a[0] = BLANK;
     287:         a[5] = 'x';
     288:         speclin = YES;
     289:         bend = send;
     290:         }
     291:     else if(c=='c' || c=='C' || c=='*')
     292:         {
     293:         while( (c = getc(infile)) != '\n')
     294:             if(c == EOF)
     295:                 return(STEOF);
     296:         ++thislin;
     297:         goto top;
     298:         }
     299:
     300:     else if(c != EOF)
     301:         {
     302:         /* a tab in columns 1-6 skips to column 7 */
     303:         ungetc(c, infile);
     304:         for(p=a; p<aend && (c=getc(infile)) != '\n' && c!=EOF; )
     305:             if(c == '\t')
     306:                 {
     307:                 while(p < aend)
     308:                     *p++ = BLANK;
     309:                 speclin = YES;
     310:                 bend = send;
     311:                 }
     312:             else
     313:                 *p++ = c;
     314:         }
     315:     if(c == EOF)
     316:         return(STEOF);
     317:     if(c == '\n')
     318:         {
     319:         while(p < aend)
     320:             *p++ = BLANK;
     321:         if( ! speclin )
     322:             while(endcd < bend)
     323:                 *endcd++ = BLANK;
     324:         }
     325:     else    {   /* read body of line */
     326:         while( endcd<bend && (c=getc(infile)) != '\n' && c!=EOF )
     327:             *endcd++ = c;
     328:         if(c == EOF)
     329:             return(STEOF);
     330:         if(c != '\n')
     331:             {
     332:             while( (c=getc(infile)) != '\n')
     333:                 if(c == EOF)
     334:                     return(STEOF);
     335:             }
     336:
     337:         if( ! speclin )
     338:             while(endcd < bend)
     339:                 *endcd++ = BLANK;
     340:         }
     341:     ++thislin;
     342:     if( !isspace(a[5]) && a[5]!='0')
     343:         return(STCONTINUE);
     344:     for(p=a; p<aend; ++p)
     345:         if( !isspace(*p) ) goto initline;
     346:     for(p = b ; p<endcd ; ++p)
     347:         if( !isspace(*p) ) goto initline;
     348:     goto top;
     349:
     350: initline:
     351:     nxtstno = 0;
     352:     for(p = a ; p<a+5 ; ++p)
     353:         if( !isspace(*p) )
     354:             if(isdigit(*p))
     355:                 nxtstno = 10*nxtstno + (*p - '0');
     356:             else    {
     357:                 lineno = thislin;
     358:                 error("nondigit in statement number field",0,0,ERR);
     359:                 nxtstno = 0;
     360:                 break;
     361:                 }
     362:     return(STINITIAL);
     363: }
     364:
     365: LOCAL crunch()
     366: {
     367: register char *i, *j, *j0, *j1, *prvstr;
     368: int ten, nh, quote;
     369:
     370: /* i is the next input character to be looked at
     371: j is the next output character */
     372: parlev = 0;
     373: expcom = 0; /* exposed ','s */
     374: expeql = 0; /* exposed equal signs */
     375: j = s;
     376: prvstr = s;
     377: for(i=s ; i<=lastch ; ++i)
     378:     {
     379:     if(isspace(*i) )
     380:         continue;
     381:     if(*i=='\'' ||  *i=='"')
     382:         {
     383:         quote = *i;
     384:         *j = MYQUOTE; /* special marker */
     385:         for(;;)
     386:             {
     387:             if(++i > lastch)
     388:                 {
     389:                 error("unbalanced quotes; closing quote supplied",0,0,ERR);
     390:                 break;
     391:                 }
     392:             if(*i == quote)
     393:                 if(i<lastch && i[1]==quote) ++i;
     394:                 else break;
     395:             else if(*i=='\\' && i<lastch)
     396:                 switch(*++i)
     397:                     {
     398:                     case 't':
     399:                         *i = '\t'; break;
     400:                     case 'b':
     401:                         *i = '\b'; break;
     402:                     case 'n':
     403:                         *i = '\n'; break;
     404:                     case 'f':
     405:                         *i = '\f'; 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:             error("%dH too big", nh,0,ERR1);
     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:         error("unbalanced parentheses, statement skipped",0,0,ERR);
     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:             return(pk->keyval);
     567:             }
     568:         }
     569: return(SUNKNOWN);
     570: }
     571:
     572:
     573:
     574: initkey()
     575: {
     576: extern struct keylist keys[];
     577: register struct keylist *p;
     578: register int i,j;
     579:
     580: for(i = 0 ; i<26 ; ++i)
     581:     keystart[i] = NULL;
     582:
     583: for(p = keys ; p->keyname ; ++p)
     584:     {
     585:     j = p->keyname[0] - 'a';
     586:     if(keystart[j] == NULL)
     587:         keystart[j] = p;
     588:     keyend[j] = p;
     589:     }
     590: }
     591:
     592: LOCAL gettok()
     593: {
     594: int havdot, havexp, havdbl;
     595: int radix;
     596: extern struct punctlist puncts[];
     597: struct punctlist *pp;
     598: extern struct fmtlist fmts[];
     599: extern struct dotlist dots[];
     600: struct dotlist *pd;
     601:
     602: char *i, *j, *n1, *p;
     603:
     604:     if(*nextch == (MYQUOTE))
     605:         {
     606:         ++nextch;
     607:         p = token;
     608:         while(*nextch != MYQUOTE)
     609:             *p++ = *nextch++;
     610:         ++nextch;
     611:         toklen = p - token;
     612:         *p = '\0';
     613:         return (SHOLLERITH);
     614:         }
     615: /*
     616: 	if(stkey == SFORMAT)
     617: 		{
     618: 		for(pf = fmts; pf->fmtchar; ++pf)
     619: 			{
     620: 			if(*nextch == pf->fmtchar)
     621: 				{
     622: 				++nextch;
     623: 				if(pf->fmtval == SLPAR)
     624: 					++parlev;
     625: 				else if(pf->fmtval == SRPAR)
     626: 					--parlev;
     627: 				return(pf->fmtval);
     628: 				}
     629: 			}
     630: 		if( isdigit(*nextch) )
     631: 			{
     632: 			p = token;
     633: 			*p++ = *nextch++;
     634: 			while(nextch<=lastch && isdigit(*nextch) )
     635: 				*p++ = *nextch++;
     636: 			toklen = p - token;
     637: 			*p = '\0';
     638: 			if(nextch<=lastch && *nextch=='p')
     639: 				{
     640: 				++nextch;
     641: 				return(SSCALE);
     642: 				}
     643: 			else	return(SICON);
     644: 			}
     645: 		if( isalpha(*nextch) )
     646: 			{
     647: 			p = token;
     648: 			*p++ = *nextch++;
     649: 			while(nextch<=lastch &&
     650: 				(*nextch=='.' || isdigit(*nextch) || isalpha(*nextch) ))
     651: 					*p++ = *nextch++;
     652: 			toklen = p - token;
     653: 			*p = '\0';
     654: 			return(SFIELD);
     655: 			}
     656: 		goto badchar;
     657: 		}
     658: /* Not a format statement */
     659:
     660: if(needkwd)
     661:     {
     662:     needkwd = 0;
     663:     return( getkwd() );
     664:     }
     665:
     666:     for(pp=puncts; pp->punchar; ++pp)
     667:         if(*nextch == pp->punchar)
     668:             {
     669:             if( (*nextch=='*' || *nextch=='/') &&
     670:                 nextch<lastch && nextch[1]==nextch[0])
     671:                     {
     672:                     if(*nextch == '*')
     673:                         yylval = SPOWER;
     674:                     else    yylval = SCONCAT;
     675:                     nextch+=2;
     676:                     }
     677:             else    {yylval=pp->punval;
     678:                     if(yylval==SLPAR)
     679:                         ++parlev;
     680:                     else if(yylval==SRPAR)
     681:                         --parlev;
     682:                     ++nextch;
     683:                 }
     684:             return(yylval);
     685:             }
     686:     if(*nextch == '.')
     687:         if(nextch >= lastch) goto badchar;
     688:         else if(isdigit(nextch[1])) goto numconst;
     689:         else    {
     690:             for(pd=dots ; (j=pd->dotname) ; ++pd)
     691:                 {
     692:                 for(i=nextch+1 ; i<=lastch ; ++i)
     693:                     if(*i != *j) break;
     694:                     else if(*i != '.') ++j;
     695:                     else    {
     696:                         nextch = i+1;
     697:                         return(pd->dotval);
     698:                         }
     699:                 }
     700:             goto badchar;
     701:             }
     702:     if( isalpha(*nextch) )
     703:         {
     704:         p = token;
     705:         *p++ = *nextch++;
     706:         while(nextch<=lastch)
     707:             if( isalpha(*nextch) || isdigit(*nextch) )
     708:                 *p++ = *nextch++;
     709:             else break;
     710:         toklen = p - token;
     711:         *p = '\0';
     712:         if(inioctl && nextch<=lastch && *nextch=='=')
     713:             {
     714:             ++nextch;
     715:             return(SNAMEEQ);
     716:             }
     717:         if(toklen>=8 && eqn(8, token, "function") &&
     718:             nextch<lastch && *nextch=='(')
     719:                 {
     720:                 nextch -= (toklen - 8);
     721:                 return(SFUNCTION);
     722:                 }
     723:         if(toklen > VL)
     724:             {
     725:             error("name %s too long, truncated to %d", token, VL,ERR2);
     726:             toklen = VL;
     727:             token[6] = '\0';
     728:             }
     729:         if(toklen==1 && *nextch==MYQUOTE)
     730:             {
     731:             switch(token[0])
     732:                 {
     733:                 case 'z':  case 'Z':
     734:                 case 'x':  case 'X':
     735:                     radix = 16; break;
     736:                 case 'o':  case 'O':
     737:                     radix = 8; break;
     738:                 case 'b':  case 'B':
     739:                     radix = 2; break;
     740:                 default:
     741:                     error("bad bit identifier",0,0,ERR);
     742:                     return(SNAME);
     743:                 }
     744:             ++nextch;
     745:             for(p = token ; *nextch!=MYQUOTE ; )
     746:                 if( hextoi(*p++ = *nextch++) >= radix)
     747:                     {
     748:                     error("invalid binary character",0,0,ERR);
     749:                     break;
     750:                     }
     751:             ++nextch;
     752:             toklen = p - token;
     753:             return( radix==16 ? SHEXCON : (radix==8 ? SOCTCON : SBITCON) );
     754:             }
     755:         return(SNAME);
     756:         }
     757:     if( ! isdigit(*nextch) ) goto badchar;
     758: numconst:
     759:     havdot = NO;
     760:     havexp = NO;
     761:     havdbl = NO;
     762:     for(n1 = nextch ; nextch<=lastch ; ++nextch)
     763:         {
     764:         if(*nextch == '.')
     765:             if(havdot) break;
     766:             else if(nextch+2<=lastch && isalpha(nextch[1])
     767:                 && isalpha(nextch[2]))
     768:                     break;
     769:             else    havdot = YES;
     770:         else if(!intonly && (*nextch=='d' || *nextch=='e'))
     771:             {
     772:             p = nextch;
     773:             havexp = YES;
     774:             if(*nextch == 'd')
     775:                 havdbl = YES;
     776:             if(nextch<lastch)
     777:                 if(nextch[1]=='+' || nextch[1]=='-')
     778:                     ++nextch;
     779:             if( ! isdigit(*++nextch) )
     780:                 {
     781:                 nextch = p;
     782:                 havdbl = havexp = NO;
     783:                 break;
     784:                 }
     785:             for(++nextch ;
     786:                 nextch<=lastch && isdigit(*nextch);
     787:                 ++nextch);
     788:             break;
     789:             }
     790:         else if( ! isdigit(*nextch) )
     791:             break;
     792:         }
     793:     p = token;
     794:     i = n1;
     795:     while(i < nextch)
     796:         *p++ = *i++;
     797:     toklen = p - token;
     798:     *p = '\0';
     799:     if(havdbl) return(SDCON);
     800:     if(havdot || havexp) return(SRCON);
     801:     return(SICON);
     802: badchar:
     803:     s[0] = *nextch++;
     804:     return(SUNKNOWN);
     805: }
     806:
     807: /* KEYWORD AND SPECIAL CHARACTER TABLES
     808: */
     809:
     810: struct punctlist puncts[ ] =
     811:     {
     812:     '(', SLPAR,
     813:     ')', SRPAR,
     814:     '=', SEQUALS,
     815:     ',', SCOMMA,
     816:     '+', SPLUS,
     817:     '-', SMINUS,
     818:     '*', SSTAR,
     819:     '/', SSLASH,
     820:     '$', SCURRENCY,
     821:     ':', SCOLON,
     822:     0, 0 } ;
     823:
     824: /*
     825: LOCAL struct fmtlist  fmts[ ] =
     826: 	{
     827: 	'(', SLPAR,
     828: 	')', SRPAR,
     829: 	'/', SSLASH,
     830: 	',', SCOMMA,
     831: 	'-', SMINUS,
     832: 	':', SCOLON,
     833: 	0, 0 } ;
     834: */
     835:
     836: LOCAL struct dotlist  dots[ ] =
     837:     {
     838:     "and.", SAND,
     839:     "or.", SOR,
     840:     "not.", SNOT,
     841:     "true.", STRUE,
     842:     "false.", SFALSE,
     843:     "eq.", SEQ,
     844:     "ne.", SNE,
     845:     "lt.", SLT,
     846:     "le.", SLE,
     847:     "gt.", SGT,
     848:     "ge.", SGE,
     849:     "neqv.", SNEQV,
     850:     "eqv.", SEQV,
     851:     0, 0 } ;
     852:
     853: LOCAL struct keylist  keys[ ] =
     854:     {
     855:     "assign",  SASSIGN,
     856:     "automatic",  SAUTOMATIC,
     857:     "backspace",  SBACKSPACE,
     858:     "blockdata",  SBLOCK,
     859:     "call",  SCALL,
     860:     "character",  SCHARACTER,
     861:     "close",  SCLOSE,
     862:     "common",  SCOMMON,
     863:     "complex",  SCOMPLEX,
     864:     "continue",  SCONTINUE,
     865:     "data",  SDATA,
     866:     "dimension",  SDIMENSION,
     867:     "doubleprecision",  SDOUBLE,
     868:     "doublecomplex", SDCOMPLEX,
     869:     "elseif",  SELSEIF,
     870:     "else",  SELSE,
     871:     "endfile",  SENDFILE,
     872:     "endif",  SENDIF,
     873:     "end",  SEND,
     874:     "entry",  SENTRY,
     875:     "equivalence",  SEQUIV,
     876:     "external",  SEXTERNAL,
     877:     "format",  SFORMAT,
     878:     "function",  SFUNCTION,
     879:     "goto",  SGOTO,
     880:     "implicit",  SIMPLICIT,
     881:     "include",  SINCLUDE,
     882:     "inquire",  SINQUIRE,
     883:     "intrinsic",  SINTRINSIC,
     884:     "integer",  SINTEGER,
     885:     "logical",  SLOGICAL,
     886:     "open",  SOPEN,
     887:     "parameter",  SPARAM,
     888:     "pause",  SPAUSE,
     889:     "print",  SPRINT,
     890:     "program",  SPROGRAM,
     891:     "punch",  SPUNCH,
     892:     "read",  SREAD,
     893:     "real",  SREAL,
     894:     "return",  SRETURN,
     895:     "rewind",  SREWIND,
     896:     "save",  SSAVE,
     897:     "static",  SSTATIC,
     898:     "stop",  SSTOP,
     899:     "subroutine",  SSUBROUTINE,
     900:     "then",  STHEN,
     901:     "undefined", SUNDEFINED,
     902:     "write",  SWRITE,
     903:     "decode",  SDECODE,
     904:     "encode",  SENCODE,
     905:     0, 0 };

#### Defined functions

analyz defined in line 486; used 1 times

- in line 197

crunch defined in line 365; used 1 times

- in line 187

doinclude defined in line 96; used 2 times

- in line 70
- in /usr/src/usr.bin/f77/gram.head line 67

flline defined in line 78; used 3 times

- in /usr/src/usr.bin/f77/gram.head line 71-73(2)
- in /usr/src/usr.bin/f77/io.c line 211

getcd defined in line 270; used 2 times

- in line 231, 258

getcds defined in line 224; used 1 times

- in line 185

getkwd defined in line 547; used 2 times

- in line 535, 663

gettok defined in line 592; used 1 times

- in line 213

inilex defined in line 65; used 1 times

- in /usr/src/usr.bin/f77/main.c line 102

initkey defined in line 574; used 1 times

- in /usr/src/usr.bin/f77/main.c line 101

lexline defined in line 85; used 2 times

- in /usr/src/usr.bin/f77/io.c line 205-207(2)

popinclude defined in line 139; used 1 times

- in line 236

yylex defined in line 178; never used

#### Defined variables

code defined in line 37; used 6 times

- in line 105, 159, 231-235(2), 241, 258

dots defined in line 836; used 2 times

- in line 599, 690

endcd defined in line 34; used 15 times

- in line 108, 163-167(2), 253-259(4), 280, 322-327(4), 338-339(2), 346

expcom defined in line 29; used 3 times

- in line 373, 475, 525

expeql defined in line 30; used 3 times

- in line 374, 474, 523

inclp defined in line 55; used 26 times

- in line 69, 102-110(7), 122-127(5), 150-168(13)

intonly defined in line 25; used 1 times

- in line 770

keyend defined in line 60; used 2 times

- in line 557, 588

keys defined in line 853; used 2 times

- in line 576, 583

keystart defined in line 60; used 4 times

- in line 556, 581-587(3)

lastch defined in line 32; used 27 times

- in line 88, 203-207(2), 262, 377, 387, 393-395(2), 439-442(2), 482, 496-500(2), 513, 525, 536, 563, 670, 687-692(2), 706, 712, 718, 762-766(2), 776, 786

lexstate defined in line 38; used 7 times

- in line 71, 80, 182, 189, 198, 217-220(2)

nextcd defined in line 33; used 18 times

- in line 107-112(4), 163, 171, 229-231(2), 245-251(3), 257-264(7)

nextch defined in line 31; used 87 times

- in line 88-89(2), 203-210(5), 261, 483, 496-500(5), 521-529(5), 536-539(3), 553-565(4), 604-610(5), 667-675(8), 682-696(6), 702-720(12), 729, 744-751(4), 757-795(24), 803

nincl defined in line 41; used 3 times

- in line 68, 114, 149

nxtstno defined in line 27; used 8 times

- in line 106, 160, 191, 232, 351-359(4)

parlev defined in line 28; used 12 times

- in line 206, 372, 471-473(3), 490, 499, 507-510(2), 542, 679-681(2)

prevlin defined in line 35; used 5 times

- in line 125, 158, 233, 265-266(2)

puncts defined in line 810; used 2 times

- in line 596, 666

s defined in line 39; used 12 times

- in line 40, 163, 231, 249-252(2), 261, 375-377(3), 436, 483, 803

send defined in line 40; used 4 times

- in line 258-263(2), 289, 310

stkey defined in line 23; used 16 times

- in line 200, 206-207(3), 493, 514-520(5), 528-540(6)

stno defined in line 26; used 4 times

- in line 160, 190-191(2), 232

thislin defined in line 36; used 9 times

- in line 104, 125, 158, 233, 243, 266, 296, 341, 357

yystno defined in line 24; used 1 times

- in line 190

#### Defined struct's

dotlist defined in line 59; used 6 times

- in line 599-600(4), 836(2)

fmtlist defined in line 58; used 2 times

- in line 598(2)

inclfile defined in line 43; used 8 times

- in line 45(2), 55(2), 100(2), 141(2)

keylist defined in line 56; used 10 times

- in line 60(2), 550(2), 576-577(4), 853(2)

punctlist defined in line 57; used 6 times

- in line 596-597(4), 810(2)

#### Defined macros

BLANK defined in line 5; used 5 times

- in line 286, 308, 320-323(2), 339

FIRSTTOKEN defined in line 18; used 1 times

- in line 189

MYQUOTE defined in line 6; used 10 times

- in line 384, 413, 444, 466, 501-503(2), 604-608(2), 729, 745

NEWSTMT defined in line 17; used 3 times

- in line 38, 71, 217

OTHERTOKEN defined in line 19; used 1 times

- in line 198

RETEOS defined in line 20; used 1 times

- in line 80

SEOF defined in line 7; used 1 times

- in line 186

STCONTINUE defined in line 13; used 3 times

- in line 241, 258, 343

STEOF defined in line 11; used 7 times

- in line 185, 235-239(2), 295, 316, 329-334(2)

STINITIAL defined in line 12; used 2 times

- in line 267, 362

Last modified: 1987-02-17 Generated: 2016-12-26 | Generated by src2html V0.67 page hit count: 2028 |