UNIX 7th Ed. - /usr/src/cmd/f77/lex.c

   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 };

Defined functions

Defined variables

Defined struct's

Defined macros