![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to rlex.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv8dc / cmd / ratfor|
Return to rlex.c CVS log | Up to [Research Unix] / researchv8dc / cmd / ratfor |
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.