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