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