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