Return to rlex.c CVS log

Up to [Research Unix] / researchv8dc / cmd / ratfor

Annotation of researchv8dc/cmd/ratfor/rlex.c, revision 1.1

1.1     ! root        1: # include "r.h"
        !             2: 
        !             3: char *keyword [] = {
        !             4:        "do",
        !             5:        "if",
        !             6:        "else",
        !             7:        "for",
        !             8:        "repeat",
        !             9:        "until",
        !            10:        "while",
        !            11:        "break",
        !            12:        "next",
        !            13:        "define",
        !            14:        "include",
        !            15:        "return",
        !            16:        "switch",
        !            17:        "case",
        !            18:        "default",
        !            19:        0};
        !            20: 
        !            21: int keytran[] = {
        !            22:        DO,
        !            23:        IF,
        !            24:        ELSE,
        !            25:        FOR,
        !            26:        REPEAT,
        !            27:        UNTIL,
        !            28:        WHILE,
        !            29:        BREAK,
        !            30:        NEXT,
        !            31:        DEFINE,
        !            32:        INCLUDE,
        !            33:        RETURN,
        !            34:        SWITCH,
        !            35:        CASE,
        !            36:        DEFAULT,
        !            37:        0};
        !            38: 
        !            39: char   *fcnloc;        /* spot for "function" */
        !            40: char   *FCN1loc;       /* spot for "FUNCTION"; kludge */
        !            41: 
        !            42: int    svargc;
        !            43: char   **svargv;
        !            44: char   *curfile[10]    = { "" };
        !            45: int    infptr  = 0;
        !            46: FILE   *outfil = { stdout };
        !            47: FILE   *infile[10]     = { stdin };
        !            48: int    linect[10];
        !            49: 
        !            50: int    contfld = CONTFLD;      /* place to put continuation char */
        !            51: int    printcom        = 0;    /* print comments if on */
        !            52: int    hollerith       = 0;    /* convert "..." to 27H... if on */
        !            53: int    uppercase       = 0;    /* produce output in upper case (except for "...") */
        !            54: 
        !            55: #ifndef unix
        !            56: #define OPTION(L)      (tolower(i) == tolower(L))
        !            57: #else
        !            58: #define OPTION(L)      (i == L)
        !            59: #endif
        !            60: #ifdef gcos
        !            61: #define BIT(n) (1 << 36 - 1 - n)
        !            62: #define FORTRAN        BIT(1)
        !            63: #define FDS    BIT(4)
        !            64: #define EXEC   BIT(5)
        !            65: #define FORM   BIT(14)
        !            66: #define LNO    BIT(15)
        !            67: #define BCD    BIT(16)
        !            68: #define OPTZ   BIT(17)
        !            69: int    compile = FORTRAN | FDS;
        !            70: #define GCOSOPT()      if (OPTION('O')) compile |= OPTZ; \
        !            71:                        else if (i == '6') compile |= FORM; \
        !            72:                        else if (OPTION('R')) compile = 0
        !            73: #else
        !            74: #define GCOSOPT()
        !            75: #define ffiler(S)      "can't open"
        !            76: #endif
        !            77: 
        !            78: main(argc,argv) int argc; char **argv; {
        !            79:        int i;
        !            80:        while(argc>1 && argv[1][0]=='-' && (i = argv[1][1]) != '\0') {
        !            81:                if (isdigit(i)) {
        !            82:                        contfld = i - '0';
        !            83:                        if (argv[1][2]!='\0')
        !            84:                                contchar = argv[1][2];
        !            85:                } else if (OPTION('C'))
        !            86:                        printcom++;
        !            87:                else if (OPTION('h'))
        !            88:                        hollerith++;
        !            89:                else if (OPTION('u') && (argv[1][2] == 'c' || argv[1][2] == 'C'))
        !            90:                        uppercase++;
        !            91:                GCOSOPT();
        !            92:                argc--;
        !            93:                argv++;
        !            94:        }
        !            95: 
        !            96: #ifdef gcos
        !            97:        if (!intss()) {
        !            98:                fputs("\t\t    Version 2.1 : read INFO/RATFOR (07/13/79)\n", stderr);
        !            99:                if (compile) {
        !           100:                        static char name[80] = "s*", opts[20] = "yw";
        !           101:                        char *opt = (char *)inquire(stdout, _OPTIONS);
        !           102:                        if (!strchr(opt, 't')) { /* if stdout is diverted */
        !           103:                                sprintf(name, "%s\"s*\"",  (char *)inquire(stdout, _FILENAME));
        !           104:                                strcpy(&opts[1], opt);
        !           105:                        }
        !           106:                        if (freopen(name, opts, stdout) == NULL)
        !           107:                                cant(name);
        !           108:                }
        !           109:        } else {
        !           110:                compile = 0;
        !           111:                if (argc < 2 && inquire(stdin, _TTY))
        !           112:                        freopen("*src", "rt", stdin);
        !           113:        }
        !           114: #endif
        !           115: 
        !           116:        svargc = argc;
        !           117:        svargv = argv;
        !           118:        if (svargc > 1)
        !           119:                putbak('\0');
        !           120:        for (i=0; keyword[i]; i++)
        !           121:                install(keyword[i], "", keytran[i]);
        !           122:        fcnloc = install("function", "", 0);
        !           123:        FCN1loc = install("FUNCTION", "", 0);
        !           124:        yyparse();
        !           125: #ifdef gcos
        !           126:        if (compile) {
        !           127:                if (errorflag) { /* abort */
        !           128:                        cretsw(EXEC);
        !           129:                } else { /* good: call forty */
        !           130:                        FILE *dstar; /* to intercept "gosys" action */
        !           131: 
        !           132:                        if ((dstar = fopen("d*", "wv")) == NULL)
        !           133:                                cant("d*");
        !           134:                        fputs("$\tforty\tascii", dstar);
        !           135:                        if (fopen("*1", "o") == NULL)
        !           136:                                cant("*1");
        !           137:                        fclose(stdout, "rl");
        !           138:                        cretsw(FORM | LNO | BCD);
        !           139:                        csetsw(compile);
        !           140:                        gosys("forty");
        !           141:                }
        !           142:        }
        !           143: #endif
        !           144:        exit(errorflag);
        !           145: }
        !           146: 
        !           147: cant(s) char *s; {
        !           148:        linect[infptr] = 0;
        !           149:        curfile[infptr] = s;
        !           150:        error(ffiler(""));
        !           151:        exit(1);
        !           152: }
        !           153: 
        !           154: inclstat() {
        !           155:        int c;
        !           156:        char *ps;
        !           157:        char fname[100];
        !           158:        while ((c = getchr()) == ' ' || c == '\t');
        !           159:        if (c == '(') {
        !           160:                for (ps=fname; (*ps=getchr()) != ')'; ps++);
        !           161:                *ps = '\0';
        !           162:        } else if (c == '"' || c == '\'') {
        !           163:                for (ps=fname; (*ps=getchr()) != c; ps++);
        !           164:                *ps = '\0';
        !           165:        } else {
        !           166:                putbak(c);
        !           167:                for (ps=fname; (*ps=getchr()) != ' ' &&*ps!='\t' && *ps!='\n' && *ps!=';'; ps++);
        !           168:                *ps = '\0';
        !           169:        }
        !           170:        if ((infile[++infptr] = fopen(fname,"r")) == NULL) {
        !           171:                cant(fname);
        !           172:                exit(1);
        !           173:        }
        !           174:        linect[infptr] = 0;
        !           175:        curfile[infptr] = fname;
        !           176: }
        !           177: 
        !           178: char   str[500];
        !           179: int    nstr;
        !           180: 
        !           181: yylex() {
        !           182:        int c, t;
        !           183:        for (;;) {
        !           184:                while ((c=gtok(str))==' ' || c=='\n' || c=='\t')
        !           185:                        ;
        !           186:                yylval = c;
        !           187:                if (c==';' || c=='{' || c=='}')
        !           188:                        return(c);
        !           189:                if (c==EOF)
        !           190:                        return(0);
        !           191:                yylval = (int) str;
        !           192:                if (c == DIG)
        !           193:                        return(DIGITS);
        !           194:                t = lookup(str)->ydef;
        !           195:                if (t==DEFINE)
        !           196:                        defstat();
        !           197:                else if (t==INCLUDE)
        !           198:                        inclstat();
        !           199:                else if (t > 0)
        !           200:                        return(t);
        !           201:                else
        !           202:                        return(GOK);
        !           203:        }
        !           204: }
        !           205: 
        !           206: int    dbg     = 0;
        !           207: 
        !           208: yyerror(p) char *p; {;}
        !           209: 
        !           210: 
        !           211: defstat() {
        !           212:        int c,i,val,t,nlp;
        !           213:        extern int nstr;
        !           214:        extern char str[];
        !           215:        while ((c=getchr())==' ' || c=='\t');
        !           216:        if (c == '(') {
        !           217:                t = '(';
        !           218:                while ((c=getchr())==' ' || c=='\t');
        !           219:                putbak(c);
        !           220:        }
        !           221:        else {
        !           222:                t = ' ';
        !           223:                putbak(c);
        !           224:        }
        !           225:        for (nstr=0; c=getchr(); nstr++) {
        !           226:                if (!isalpha(c) && !isdigit(c))
        !           227:                        break;
        !           228:                str[nstr] = c;
        !           229:        }
        !           230:        putbak(c);
        !           231:        str[nstr] = '\0';
        !           232:        if (c != ' ' && c != '\t' && c != '\n' && c != ',') {
        !           233:                error("illegal define statement");
        !           234:                return;
        !           235:        }
        !           236:        val = nstr+1;
        !           237:        if (t == ' ') {
        !           238:                while ((c=getchr())==' ' || c=='\t');
        !           239:                putbak(c);
        !           240:                for (i=val; (c=getchr())!='\n' && c!='#' && c!='\0'; i++)
        !           241:                        str[i] = c;
        !           242:                putbak(c);
        !           243:        } else {
        !           244:                while ((c=getchr())==' ' || c=='\t' || c==',' || c=='\n');
        !           245:                putbak(c);
        !           246:                nlp  = 0;
        !           247:                for (i=val; nlp>=0 && (c=str[i]=getchr()); i++)
        !           248:                        if (c == '(')
        !           249:                                nlp++;
        !           250:                        else if (c == ')')
        !           251:                                nlp--;
        !           252:                i--;
        !           253:        }
        !           254:        for ( ; i>0; i--)
        !           255:                if (str[i-1] != ' ' && str[i-1] != '\t')
        !           256:                        break;
        !           257:        str[i] = '\0';
        !           258:        install(str, &str[val], 0);
        !           259: }
        !           260: 

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.