home *** CD-ROM | disk | FTP | other *** search
/ minnie.tuhs.org / unixen.tar / unixen / PDP-11 / Trees / V7 / usr / src / cmd / f77 / lex.c < prev    next >
Encoding:
C/C++ Source or Header  |  1979-05-05  |  15.3 KB  |  902 lines
  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; } ;
  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. fatal1("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 '0':
  405.                         *i = '\0'; break;
  406.                     default:
  407.                         break;
  408.                     }
  409.             *++j = *i;
  410.             }
  411.         j[1] = MYQUOTE;
  412.         j += 2;
  413.         prvstr = j;
  414.         }
  415.     else if( (*i=='h' || *i=='H')  && j>prvstr)    /* test for Hollerith strings */
  416.         {
  417.         if( ! isdigit(j[-1])) goto copychar;
  418.         nh = j[-1] - '0';
  419.         ten = 10;
  420.         j1 = prvstr - 1;
  421.         if (j1<j-5) j1=j-5;
  422.         for(j0=j-2 ; j0>j1; -- j0)
  423.             {
  424.             if( ! isdigit(*j0 ) ) break;
  425.             nh += ten * (*j0-'0');
  426.             ten*=10;
  427.             }
  428.         if(j0 <= j1) goto copychar;
  429. /* a hollerith must be preceded by a punctuation mark.
  430.    '*' is possible only as repetition factor in a data statement
  431.    not, in particular, in character*2h
  432. */
  433.  
  434.         if( !(*j0=='*'&&s[0]=='d') && *j0!='/' && *j0!='(' &&
  435.             *j0!=',' && *j0!='=' && *j0!='.')
  436.                 goto copychar;
  437.         if(i+nh > lastch)
  438.             {
  439.             err1("%dH too big", nh);
  440.             nh = lastch - i;
  441.             }
  442.         j0[1] = MYQUOTE; /* special marker */
  443.         j = j0 + 1;
  444.         while(nh-- > 0)
  445.             {
  446.             if(*++i == '\\')
  447.                 switch(*++i)
  448.                     {
  449.                     case 't':
  450.                         *i = '\t'; break;
  451.                     case 'b':
  452.                         *i = '\b'; break;
  453.                     case 'n':
  454.                         *i = '\n'; break;
  455.                     case 'f':
  456.                         *i = '\f'; break;
  457.                     case '0':
  458.                         *i = '\0'; break;
  459.                     default:
  460.                         break;
  461.                     }
  462.             *++j = *i;
  463.             }
  464.         j[1] = MYQUOTE;
  465.         j+=2;
  466.         prvstr = j;
  467.         }
  468.     else    {
  469.         if(*i == '(') ++parlev;
  470.         else if(*i == ')') --parlev;
  471.         else if(parlev == 0)
  472.             if(*i == '=') expeql = 1;
  473.             else if(*i == ',') expcom = 1;
  474. copychar:        /*not a string or space -- copy, shifting case if necessary */
  475.         if(shiftcase && isupper(*i))
  476.             *j++ = tolower(*i);
  477.         else    *j++ = *i;
  478.         }
  479.     }
  480. lastch = j - 1;
  481. nextch = s;
  482. }
  483.  
  484. LOCAL analyz()
  485. {
  486. register char *i;
  487.  
  488.     if(parlev != 0)
  489.         {
  490.         err("unbalanced parentheses, statement skipped");
  491.         stkey = SUNKNOWN;
  492.         return;
  493.         }
  494.     if(nextch+2<=lastch && nextch[0]=='i' && nextch[1]=='f' && nextch[2]=='(')
  495.         {
  496. /* assignment or if statement -- look at character after balancing paren */
  497.         parlev = 1;
  498.         for(i=nextch+3 ; i<=lastch; ++i)
  499.             if(*i == (MYQUOTE))
  500.                 {
  501.                 while(*++i != MYQUOTE)
  502.                     ;
  503.                 }
  504.             else if(*i == '(')
  505.                 ++parlev;
  506.             else if(*i == ')')
  507.                 {
  508.                 if(--parlev == 0)
  509.                     break;
  510.                 }
  511.         if(i >= lastch)
  512.             stkey = SLOGIF;
  513.         else if(i[1] == '=')
  514.             stkey = SLET;
  515.         else if( isdigit(i[1]) )
  516.             stkey = SARITHIF;
  517.         else    stkey = SLOGIF;
  518.         if(stkey != SLET)
  519.             nextch += 2;
  520.         }
  521.     else if(expeql) /* may be an assignment */
  522.         {
  523.         if(expcom && nextch<lastch &&
  524.             nextch[0]=='d' && nextch[1]=='o')
  525.                 {
  526.                 stkey = SDO;
  527.                 nextch += 2;
  528.                 }
  529.         else    stkey = SLET;
  530.         }
  531. /* otherwise search for keyword */
  532.     else    {
  533.         stkey = getkwd();
  534.         if(stkey==SGOTO && lastch>=nextch)
  535.             if(nextch[0]=='(')
  536.                 stkey = SCOMPGOTO;
  537.             else if(isalpha(nextch[0]))
  538.                 stkey = SASGOTO;
  539.         }
  540.     parlev = 0;
  541. }
  542.  
  543.  
  544.  
  545. LOCAL getkwd()
  546. {
  547. register char *i, *j;
  548. register struct keylist *pk, *pend;
  549. int k;
  550.  
  551. if(! isalpha(nextch[0]) )
  552.     return(SUNKNOWN);
  553. k = nextch[0] - 'a';
  554. if(pk = keystart[k])
  555.     for(pend = keyend[k] ; pk<=pend ; ++pk )
  556.         {
  557.         i = pk->keyname;
  558.         j = nextch;
  559.         while(*++i==*++j && *i!='\0')
  560.             ;
  561.         if(*i=='\0' && j<=lastch+1)
  562.             {
  563.             nextch = j;
  564.             return(pk->keyval);
  565.             }
  566.         }
  567. return(SUNKNOWN);
  568. }
  569.  
  570.  
  571.  
  572. initkey()
  573. {
  574. extern struct keylist keys[];
  575. register struct keylist *p;
  576. register int i,j;
  577.  
  578. for(i = 0 ; i<26 ; ++i)
  579.     keystart[i] = NULL;
  580.  
  581. for(p = keys ; p->keyname ; ++p)
  582.     {
  583.     j = p->keyname[0] - 'a';
  584.     if(keystart[j] == NULL)
  585.         keystart[j] = p;
  586.     keyend[j] = p;
  587.     }
  588. }
  589.  
  590. LOCAL gettok()
  591. {
  592. int havdot, havexp, havdbl;
  593. int radix;
  594. extern struct punctlist puncts[];
  595. struct punctlist *pp;
  596. extern struct fmtlist fmts[];
  597. extern struct dotlist dots[];
  598. struct dotlist *pd;
  599.  
  600. char *i, *j, *n1, *p;
  601.  
  602.     if(*nextch == (MYQUOTE))
  603.         {
  604.         ++nextch;
  605.         p = token;
  606.         while(*nextch != MYQUOTE)
  607.             *p++ = *nextch++;
  608.         ++nextch;
  609.         toklen = p - token;
  610.         *p = '\0';
  611.         return (SHOLLERITH);
  612.         }
  613. /*
  614.     if(stkey == SFORMAT)
  615.         {
  616.         for(pf = fmts; pf->fmtchar; ++pf)
  617.             {
  618.             if(*nextch == pf->fmtchar)
  619.                 {
  620.                 ++nextch;
  621.                 if(pf->fmtval == SLPAR)
  622.                     ++parlev;
  623.                 else if(pf->fmtval == SRPAR)
  624.                     --parlev;
  625.                 return(pf->fmtval);
  626.                 }
  627.             }
  628.         if( isdigit(*nextch) )
  629.             {
  630.             p = token;
  631.             *p++ = *nextch++;
  632.             while(nextch<=lastch && isdigit(*nextch) )
  633.                 *p++ = *nextch++;
  634.             toklen = p - token;
  635.             *p = '\0';
  636.             if(nextch<=lastch && *nextch=='p')
  637.                 {
  638.                 ++nextch;
  639.                 return(SSCALE);
  640.                 }
  641.             else    return(SICON);
  642.             }
  643.         if( isalpha(*nextch) )
  644.             {
  645.             p = token;
  646.             *p++ = *nextch++;
  647.             while(nextch<=lastch &&
  648.                 (*nextch=='.' || isdigit(*nextch) || isalpha(*nextch) ))
  649.                     *p++ = *nextch++;
  650.             toklen = p - token;
  651.             *p = '\0';
  652.             return(SFIELD);
  653.             }
  654.         goto badchar;
  655.         }
  656. /* Not a format statement */
  657.  
  658. if(needkwd)
  659.     {
  660.     needkwd = 0;
  661.     return( getkwd() );
  662.     }
  663.  
  664.     for(pp=puncts; pp->punchar; ++pp)
  665.         if(*nextch == pp->punchar)
  666.             {
  667.             if( (*nextch=='*' || *nextch=='/') &&
  668.                 nextch<lastch && nextch[1]==nextch[0])
  669.                     {
  670.                     if(*nextch == '*')
  671.                         yylval = SPOWER;
  672.                     else    yylval = SCONCAT;
  673.                     nextch+=2;
  674.                     }
  675.             else    {yylval=pp->punval;
  676.                     if(yylval==SLPAR)
  677.                         ++parlev;
  678.                     else if(yylval==SRPAR)
  679.                         --parlev;
  680.                     ++nextch;
  681.                 }
  682.             return(yylval);
  683.             }
  684.     if(*nextch == '.')
  685.         if(nextch >= lastch) goto badchar;
  686.         else if(isdigit(nextch[1])) goto numconst;
  687.         else    {
  688.             for(pd=dots ; (j=pd->dotname) ; ++pd)
  689.                 {
  690.                 for(i=nextch+1 ; i<=lastch ; ++i)
  691.                     if(*i != *j) break;
  692.                     else if(*i != '.') ++j;
  693.                     else    {
  694.                         nextch = i+1;
  695.                         return(pd->dotval);
  696.                         }
  697.                 }
  698.             goto badchar;
  699.             }
  700.     if( isalpha(*nextch) )
  701.         {
  702.         p = token;
  703.         *p++ = *nextch++;
  704.         while(nextch<=lastch)
  705.             if( isalpha(*nextch) || isdigit(*nextch) )
  706.                 *p++ = *nextch++;
  707.             else break;
  708.         toklen = p - token;
  709.         *p = '\0';
  710.         if(inioctl && nextch<=lastch && *nextch=='=')
  711.             {
  712.             ++nextch;
  713.             return(SNAMEEQ);
  714.             }
  715.         if(toklen>=8 && eqn(8, token, "function") &&
  716.             nextch<lastch && *nextch=='(')
  717.                 {
  718.                 nextch -= (toklen - 8);
  719.                 return(SFUNCTION);
  720.                 }
  721.         if(toklen > VL)
  722.             {
  723.             err2("name %s too long, truncated to %d", token, VL);
  724.             toklen = VL;
  725.             token[6] = '\0';
  726.             }
  727.         if(toklen==1 && *nextch==MYQUOTE)
  728.             {
  729.             switch(token[0])
  730.                 {
  731.                 case 'z':  case 'Z':
  732.                 case 'x':  case 'X':
  733.                     radix = 16; break;
  734.                 case 'o':  case 'O':
  735.                     radix = 8; break;
  736.                 case 'b':  case 'B':
  737.                     radix = 2; break;
  738.                 default:
  739.                     err("bad bit identifier");
  740.                     return(SNAME);
  741.                 }
  742.             ++nextch;
  743.             for(p = token ; *nextch!=MYQUOTE ; )
  744.                 if( hextoi(*p++ = *nextch++) >= radix)
  745.                     {
  746.                     err("invalid binary character");
  747.                     break;
  748.                     }
  749.             ++nextch;
  750.             toklen = p - token;
  751.             return( radix==16 ? SHEXCON : (radix==8 ? SOCTCON : SBITCON) );
  752.             }
  753.         return(SNAME);
  754.         }
  755.     if( ! isdigit(*nextch) ) goto badchar;
  756. numconst:
  757.     havdot = NO;
  758.     havexp = NO;
  759.     havdbl = NO;
  760.     for(n1 = nextch ; nextch<=lastch ; ++nextch)
  761.         {
  762.         if(*nextch == '.')
  763.             if(havdot) break;
  764.             else if(nextch+2<=lastch && isalpha(nextch[1])
  765.                 && isalpha(nextch[2]))
  766.                     break;
  767.             else    havdot = YES;
  768.         else if(*nextch=='d' || *nextch=='e')
  769.             {
  770.             p = nextch;
  771.             havexp = YES;
  772.             if(*nextch == 'd')
  773.                 havdbl = YES;
  774.             if(nextch<lastch)
  775.                 if(nextch[1]=='+' || nextch[1]=='-')
  776.                     ++nextch;
  777.             if( ! isdigit(*++nextch) )
  778.                 {
  779.                 nextch = p;
  780.                 havdbl = havexp = NO;
  781.                 break;
  782.                 }
  783.             for(++nextch ;
  784.                 nextch<=lastch && isdigit(*nextch);
  785.                 ++nextch);
  786.             break;
  787.             }
  788.         else if( ! isdigit(*nextch) )
  789.             break;
  790.         }
  791.     p = token;
  792.     i = n1;
  793.     while(i < nextch)
  794.         *p++ = *i++;
  795.     toklen = p - token;
  796.     *p = '\0';
  797.     if(havdbl) return(SDCON);
  798.     if(havdot || havexp) return(SRCON);
  799.     return(SICON);
  800. badchar:
  801.     s[0] = *nextch++;
  802.     return(SUNKNOWN);
  803. }
  804.  
  805. /* KEYWORD AND SPECIAL CHARACTER TABLES
  806. */
  807.  
  808. struct punctlist puncts[ ] =
  809.     {
  810.     '(', SLPAR,
  811.     ')', SRPAR,
  812.     '=', SEQUALS,
  813.     ',', SCOMMA,
  814.     '+', SPLUS,
  815.     '-', SMINUS,
  816.     '*', SSTAR,
  817.     '/', SSLASH,
  818.     '$', SCURRENCY,
  819.     ':', SCOLON,
  820.     0, 0 } ;
  821.  
  822. /*
  823. LOCAL struct fmtlist  fmts[ ] =
  824.     {
  825.     '(', SLPAR,
  826.     ')', SRPAR,
  827.     '/', SSLASH,
  828.     ',', SCOMMA,
  829.     '-', SMINUS,
  830.     ':', SCOLON,
  831.     0, 0 } ;
  832. */
  833.  
  834. LOCAL struct dotlist  dots[ ] =
  835.     {
  836.     "and.", SAND, 
  837.     "or.", SOR, 
  838.     "not.", SNOT, 
  839.     "true.", STRUE, 
  840.     "false.", SFALSE, 
  841.     "eq.", SEQ, 
  842.     "ne.", SNE, 
  843.     "lt.", SLT, 
  844.     "le.", SLE, 
  845.     "gt.", SGT, 
  846.     "ge.", SGE, 
  847.     "neqv.", SNEQV, 
  848.     "eqv.", SEQV, 
  849.     0, 0 } ;
  850.  
  851. LOCAL struct keylist  keys[ ] =
  852.     {
  853.     "assign",  SASSIGN,
  854.     "automatic",  SAUTOMATIC,
  855.     "backspace",  SBACKSPACE,
  856.     "blockdata",  SBLOCK,
  857.     "call",  SCALL,
  858.     "character",  SCHARACTER,
  859.     "close",  SCLOSE,
  860.     "common",  SCOMMON,
  861.     "complex",  SCOMPLEX,
  862.     "continue",  SCONTINUE,
  863.     "data",  SDATA,
  864.     "dimension",  SDIMENSION,
  865.     "doubleprecision",  SDOUBLE,
  866.     "doublecomplex", SDCOMPLEX,
  867.     "elseif",  SELSEIF,
  868.     "else",  SELSE,
  869.     "endfile",  SENDFILE,
  870.     "endif",  SENDIF,
  871.     "end",  SEND,
  872.     "entry",  SENTRY,
  873.     "equivalence",  SEQUIV,
  874.     "external",  SEXTERNAL,
  875.     "format",  SFORMAT,
  876.     "function",  SFUNCTION,
  877.     "goto",  SGOTO,
  878.     "implicit",  SIMPLICIT,
  879.     "include",  SINCLUDE,
  880.     "inquire",  SINQUIRE,
  881.     "intrinsic",  SINTRINSIC,
  882.     "integer",  SINTEGER,
  883.     "logical",  SLOGICAL,
  884.     "open",  SOPEN,
  885.     "parameter",  SPARAM,
  886.     "pause",  SPAUSE,
  887.     "print",  SPRINT,
  888.     "program",  SPROGRAM,
  889.     "punch",  SPUNCH,
  890.     "read",  SREAD,
  891.     "real",  SREAL,
  892.     "return",  SRETURN,
  893.     "rewind",  SREWIND,
  894.     "save",  SSAVE,
  895.     "static",  SSTATIC,
  896.     "stop",  SSTOP,
  897.     "subroutine",  SSUBROUTINE,
  898.     "then",  STHEN,
  899.     "undefined", SUNDEFINED,
  900.     "write",  SWRITE,
  901.     0, 0 };
  902.