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