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