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