Commit | Line | Data |
---|---|---|
45512a4d CC |
1 | Original BTL Ratfor System for 4.2 |
2 | /* @(#)rlex.c 1.1 (Berkeley) %G% */ | |
3 | # include "r.h" | |
4 | ||
5 | char *keyword [] = { | |
6 | "do", | |
7 | "if", | |
8 | "else", | |
9 | "for", | |
10 | "repeat", | |
11 | "until", | |
12 | "while", | |
13 | "break", | |
14 | "next", | |
15 | "define", | |
16 | "include", | |
17 | "return", | |
18 | "switch", | |
19 | "case", | |
20 | "default", | |
21 | 0}; | |
22 | ||
23 | int keytran[] = { | |
24 | DO, | |
25 | IF, | |
26 | ELSE, | |
27 | FOR, | |
28 | REPEAT, | |
29 | UNTIL, | |
30 | WHILE, | |
31 | BREAK, | |
32 | NEXT, | |
33 | DEFINE, | |
34 | INCLUDE, | |
35 | RETURN, | |
36 | SWITCH, | |
37 | CASE, | |
38 | DEFAULT, | |
39 | 0}; | |
40 | ||
41 | char *fcnloc; /* spot for "function" */ | |
42 | ||
43 | int svargc; | |
44 | char **svargv; | |
45 | char *curfile[10] = { "" }; | |
46 | int infptr = 0; | |
47 | FILE *outfil = { stdout }; | |
48 | FILE *infile[10] = { stdin }; | |
49 | int linect[10]; | |
50 | ||
51 | int contfld = CONTFLD; /* place to put continuation char */ | |
52 | int printcom = 0; /* print comments if on */ | |
53 | int hollerith = 0; /* convert "..." to 27H... if on */ | |
54 | ||
55 | #ifdef gcos | |
56 | char *ratfor "tssrat"; | |
57 | int bcdrat[2]; | |
58 | char *bwkmeter ". bwkmeter "; | |
59 | int bcdbwk[5]; | |
60 | #endif | |
61 | ||
62 | main(argc,argv) int argc; char **argv; { | |
63 | int i; | |
64 | while(argc>1 && argv[1][0]=='-') { | |
65 | if(argv[1][1]=='6') { | |
66 | contfld=6; | |
67 | if (argv[1][2]!='\0') | |
68 | contchar = argv[1][2]; | |
69 | } else if (argv[1][1] == 'C') | |
70 | printcom++; | |
71 | else if (argv[1][1] == 'h') | |
72 | hollerith++; | |
73 | argc--; | |
74 | argv++; | |
75 | } | |
76 | ||
77 | #ifdef gcos | |
78 | if (!intss()) { | |
79 | _fixup(); | |
80 | ratfor = "batrat"; | |
81 | } | |
82 | ascbcd(ratfor,bcdrat,6); | |
83 | ascbcd(bwkmeter,bcdbwk,24); | |
84 | acdata(bcdrat[0],1); | |
85 | acupdt(bcdbwk[0]); | |
86 | if (!intss()) { | |
87 | if ((infile[infptr]=fopen("s*", "r")) == NULL) | |
88 | cant("s*"); | |
89 | if ((outfil=fopen("*s", "w")) == NULL) | |
90 | cant("*s"); | |
91 | } | |
92 | #endif | |
93 | ||
94 | svargc = argc; | |
95 | svargv = argv; | |
96 | if (svargc > 1) | |
97 | putbak('\0'); | |
98 | for (i=0; keyword[i]; i++) | |
99 | install(keyword[i], "", keytran[i]); | |
100 | fcnloc = install("function", "", 0); | |
101 | yyparse(); | |
102 | #ifdef gcos | |
103 | if (!intss()) | |
104 | bexit(errorflag); | |
105 | #endif | |
106 | exit(errorflag); | |
107 | } | |
108 | ||
109 | #ifdef gcos | |
110 | bexit(status) { | |
111 | /* this is the batch version of exit for gcos tss */ | |
112 | FILE *inf, *outf; | |
113 | char c; | |
114 | ||
115 | fclose(stderr); /* make sure diagnostics get flushed */ | |
116 | if (status) /* abort */ | |
117 | _nogud(); | |
118 | ||
119 | /* good: copy output back to s*, call forty */ | |
120 | ||
121 | fclose(outfil,"r"); | |
122 | fclose(infile[0],"r"); | |
123 | inf = fopen("*s", "r"); | |
124 | outf = fopen("s*", "w"); | |
125 | while ((c=getc(inf)) != EOF) | |
126 | putc(c, outf); | |
127 | fclose(inf,"r"); | |
128 | fclose(outf,"r"); | |
129 | __imok(); | |
130 | } | |
131 | #endif | |
132 | ||
133 | cant(s) char *s; { | |
134 | linect[infptr] = 0; | |
135 | curfile[infptr] = s; | |
136 | error("can't open"); | |
137 | exit(1); | |
138 | } | |
139 | ||
140 | inclstat() { | |
141 | int c; | |
142 | char *ps; | |
143 | char fname[100]; | |
144 | while ((c = getchr()) == ' ' || c == '\t'); | |
145 | if (c == '(') { | |
146 | for (ps=fname; (*ps=getchr()) != ')'; ps++); | |
147 | *ps = '\0'; | |
148 | } else if (c == '"' || c == '\'') { | |
149 | for (ps=fname; (*ps=getchr()) != c; ps++); | |
150 | *ps = '\0'; | |
151 | } else { | |
152 | putbak(c); | |
153 | for (ps=fname; (*ps=getchr()) != ' ' &&*ps!='\t' && *ps!='\n' && *ps!=';'; ps++); | |
154 | *ps = '\0'; | |
155 | } | |
156 | if ((infile[++infptr] = fopen(fname,"r")) == NULL) { | |
157 | cant(fname); | |
158 | exit(1); | |
159 | } | |
160 | linect[infptr] = 0; | |
161 | curfile[infptr] = fname; | |
162 | } | |
163 | ||
164 | char str[500]; | |
165 | int nstr; | |
166 | ||
167 | yylex() { | |
168 | int c, t; | |
169 | for (;;) { | |
170 | while ((c=gtok(str))==' ' || c=='\n' || c=='\t') | |
171 | ; | |
172 | yylval = c; | |
173 | if (c==';' || c=='{' || c=='}') | |
174 | return(c); | |
175 | if (c==EOF) | |
176 | return(0); | |
177 | yylval = (int) str; | |
178 | if (c == DIG) | |
179 | return(DIGITS); | |
180 | t = lookup(str)->ydef; | |
181 | if (t==DEFINE) | |
182 | defstat(); | |
183 | else if (t==INCLUDE) | |
184 | inclstat(); | |
185 | else if (t > 0) | |
186 | return(t); | |
187 | else | |
188 | return(GOK); | |
189 | } | |
190 | } | |
191 | ||
192 | int dbg = 0; | |
193 | ||
194 | yyerror(p) char *p; {;} | |
195 | ||
196 | ||
197 | defstat() { | |
198 | int c,i,val,t,nlp; | |
199 | extern int nstr; | |
200 | extern char str[]; | |
201 | while ((c=getchr())==' ' || c=='\t'); | |
202 | if (c == '(') { | |
203 | t = '('; | |
204 | while ((c=getchr())==' ' || c=='\t'); | |
205 | putbak(c); | |
206 | } | |
207 | else { | |
208 | t = ' '; | |
209 | putbak(c); | |
210 | } | |
211 | for (nstr=0; c=getchr(); nstr++) { | |
212 | if (type[c] != LET && type[c] != DIG) | |
213 | break; | |
214 | str[nstr] = c; | |
215 | } | |
216 | putbak(c); | |
217 | str[nstr] = '\0'; | |
218 | if (c != ' ' && c != '\t' && c != '\n' && c != ',') { | |
219 | error("illegal define statement"); | |
220 | return; | |
221 | } | |
222 | val = nstr+1; | |
223 | if (t == ' ') { | |
224 | while ((c=getchr())==' ' || c=='\t'); | |
225 | putbak(c); | |
226 | for (i=val; (c=getchr())!='\n' && c!='#' && c!='\0'; i++) | |
227 | str[i] = c; | |
228 | putbak(c); | |
229 | } else { | |
230 | while ((c=getchr())==' ' || c=='\t' || c==',' || c=='\n'); | |
231 | putbak(c); | |
232 | nlp = 0; | |
233 | for (i=val; nlp>=0 && (c=str[i]=getchr()); i++) | |
234 | if (c == '(') | |
235 | nlp++; | |
236 | else if (c == ')') | |
237 | nlp--; | |
238 | i--; | |
239 | } | |
240 | for ( ; i>0; i--) | |
241 | if (str[i-1] != ' ' && str[i-1] != '\t') | |
242 | break; | |
243 | str[i] = '\0'; | |
244 | install(str, &str[val], 0); | |
245 | } | |
246 |