[unix-history] / usr / src / old / ratfor / r1.c

Original BTL Ratfor System for 4.2
/*-
 * %sccs.include.proprietary.c%
 */

#ifndef lint
static char sccsid[] = "@(#)r1.c	1.4 (Berkeley) %G%";
#endif /* not lint */

#include "r.h"

#define	wasbreak	brkused[brkptr]==1 || brkused[brkptr]==3
#define	wasnext	brkused[brkptr]==2 || brkused[brkptr]==3

int	transfer	= 0;	/* 1 if just finished retrun, break, next */

char	fcname[10];
char	scrat[500];

int	brkptr	= -1;
int	brkstk[10];	/* break label */
int	typestk[10];	/* type of loop construct */
int	brkused[10];	/* loop contains BREAK or NEXT */

int	forptr	= 0;
char	*forstk[10];

repcode() {
	transfer = 0;
	outcont(0);
	putcom("repeat");
	yyval = genlab(3);
	indent++;
	outcont(yyval);
	brkstk[++brkptr] = yyval+1;
	typestk[brkptr] = REPEAT;
	brkused[brkptr] = 0;
}

untils(p1,un) int p1,un; {
	outnum(p1+1);
	outtab();
	if (un > 0) {
		outcode("if(.not.");
		balpar();
		outcode(")");
	}
	transfer = 0;
	outgoto(p1);
	indent--;
	if (wasbreak)
		outcont(p1+2);
	brkptr--;
}

ifcode() {
	transfer = 0;
	outtab();
	outcode("if(.not.");
	balpar();
	outcode(")");
	outgoto(yyval=genlab(2));
	indent++;
}

elsecode(p1) {
	outgoto(p1+1);
	indent--;
	putcom("else");
	indent++;
	outcont(p1);
}

whilecode() {
	transfer = 0;
	outcont(0);
	putcom("while");
	brkstk[++brkptr] = yyval = genlab(2);
	typestk[brkptr] = WHILE;
	brkused[brkptr] = 0;
	outnum(yyval);
	outtab();
	outcode("if(.not.");
	balpar();
	outcode(")");
	outgoto(yyval+1);
	indent++;
}

whilestat(p1) int p1; {
	outgoto(p1);
	indent--;
	putcom("endwhile");
	outcont(p1+1);
	brkptr--;
}

balpar() {
	register c, lpar;
	while ((c=gtok(scrat)) == ' ' || c == '\t')
		;
	if (c != '(') {
		error("missing left paren");
		return;
	}
	outcode(scrat);
	lpar = 1;
	do {
		c = gtok(scrat);
		if (c==';' || c=='{' || c=='}' || c==EOF) {
			pbstr(scrat);
			break;
		}
		if (c=='(')
			lpar++;
		else if (c==')')
			lpar--;
		else if (c == '\n') {
			while ((c = gtok(scrat)) == ' ' || c=='\t' || c=='\n')
				;
			pbstr(scrat);
			continue;
		}
		else if (c == '=' && scrat[1] == '\0')
			error("assigment inside conditional");
		outcode(scrat);
	} while (lpar > 0);
	if (lpar != 0)
		error("missing parenthesis");
}

int	labval	= 23000;

genlab(n){
	labval += n;
	return(labval-n);
}

gokcode(p1) {
	transfer = 0;
	outtab();
	outcode(p1);
	eatup();
	outdon();
}

eatup() {
	int t, lpar;
	char temp[100];
	lpar = 0;
	do {
		if ((t = gtok(scrat)) == ';' || t == '\n')
			break;
		if (t == '{' || t == '}' || t == EOF) {
			pbstr(scrat);
			break;
		}
		if (t == ',' || t == '+' || t == '-' || t == '*' || t == '('
		  || t == '&' || t == '|' || t == '=') {
			while (gtok(temp) == '\n')
				;
			pbstr(temp);
		}
		if (t == '(')
			lpar++;
		else if (t==')') {
			lpar--;
			if (lpar < 0) {
				error("missing left paren");
				return(1);
			}
		}
		outcode(scrat);
	} while (lpar >= 0);
	if (lpar > 0) {
		error("missing right paren");
		return(1);
	}
	return(0);
}

forcode(){
	int lpar, t;
	char *ps, *qs;

	transfer = 0;
	outcont(0);
	putcom("for");
	yyval = genlab(3);
	brkstk[++brkptr] = yyval+1;
	typestk[brkptr] = FOR;
	brkused[brkptr] = 0;
	forstk[forptr++] = malloc(1);
	if ((t = gnbtok(scrat)) != '(') {
		error("missing left paren in FOR");
		pbstr(scrat);
		return;
	}
	if (gnbtok(scrat) != ';') {	/* real init clause */
		pbstr(scrat);
		outtab();
		if (eatup() > 0) {
			error("illegal FOR clause");
			return;
		}
		outdon();
	}
	if (gnbtok(scrat) == ';')	/* empty condition */
		outcont(yyval);
	else {	/* non-empty condition */
		pbstr(scrat);
		outnum(yyval);
		outtab();
		outcode("if(.not.(");
		for (lpar=0; lpar >= 0;) {
			if ((t = gnbtok(scrat)) == ';')
				break;
			if (t == '(')
				lpar++;
			else if (t == ')') {
				lpar--;
				if (lpar < 0) {
					error("missing left paren in FOR clause");
					return;
				}
			}
			if (t != '\n')
				outcode(scrat);
		}
		outcode("))");
		outgoto(yyval+2);
		if (lpar < 0)
			error("invalid FOR clause");
	}
	ps = scrat;
	for (lpar=0; lpar >= 0;) {
		if ((t = gtok(ps)) == '(')
			lpar++;
		else if (t == ')')
			lpar--;
		if (lpar >= 0 && t != '\n')
			while(*ps)
				ps++;
	}
	*ps = '\0';
	qs = forstk[forptr-1] = malloc((unsigned)(ps-scrat+1));
	ps = scrat;
	while (*qs++ = *ps++)
		;
	indent++;
}

forstat(p1) int p1; {
	char *bp, *q;
	bp = forstk[--forptr];
	if (wasnext) {
		outnum(p1+1);
		transfer = 0;
	}
	if (nonblank(bp)){
		outtab();
		outcode(bp);
		outdon();
	}
	outgoto(p1);
	indent--;
	putcom("endfor");
	outcont(p1+2);
	for (q=bp; *q++;);
	free(bp);
	brkptr--;
}

retcode() {
	register c;
	if ((c = gnbtok(scrat)) != '\n' && c != ';' && c != '}') {
		pbstr(scrat);
		outtab();
		outcode(fcname);
		outcode(" = ");
		eatup();
		outdon();
	}
	else if (c == '}')
		pbstr(scrat);
	outtab();
	outcode("return");
	outdon();
	transfer = 1;
}

docode() {
	transfer = 0;
	outtab();
	outcode("do ");
	yyval = genlab(2);
	brkstk[++brkptr] = yyval;
	typestk[brkptr] = DO;
	brkused[brkptr] = 0;
	outnum(yyval);
	eatup();
	outdon();
	indent++;
}

dostat(p1) int p1; {
	outcont(p1);
	indent--;
	if (wasbreak)
		outcont(p1+1);
	brkptr--;
}

#ifdef	gcos
#define	atoi(s)	(*s-'0')	/* crude!!! */
#endif

breakcode() {
	int level, t;

	level = 0;
	if ((t=gnbtok(scrat)) == DIG)
		level = atoi(scrat) - 1;
	else if (t != ';')
		pbstr(scrat);
	if (brkptr-level < 0)
		error("illegal BREAK");
	else {
		outgoto(brkstk[brkptr-level]+1);
		brkused[brkptr-level] |= 1;
	}
	transfer = 1;
}

nextcode() {
	int level, t;

	level = 0;
	if ((t=gnbtok(scrat)) == DIG)
		level = atoi(scrat) - 1;
	else if (t != ';')
		pbstr(scrat);
	if (brkptr-level < 0)
		error("illegal NEXT");
	else {
		outgoto(brkstk[brkptr-level]);
		brkused[brkptr-level] |= 2;
	}
	transfer = 1;
}

nonblank(s) char *s; {
	int c;
	while (c = *s++)
		if (c!=' ' && c!='\t' && c!='\n')
			return(1);
	return(0);
}

int	errorflag	= 0;

error(s1) char *s1; {
	if (errorflag == 0)
		fprintf(stderr, "ratfor:");
	fprintf(stderr, "error at line %d, file %s: ",linect[infptr],curfile[infptr]);
	fprintf(stderr, s1);
	fprintf(stderr, "\n");
	errorflag = 1;
}

errcode() {
	int c;
	if (errorflag == 0)
		fprintf(stderr, "******\n");
	fprintf(stderr, "*****F ratfor:");
	fprintf(stderr, "syntax error, line %d, file %s\n", linect[infptr], curfile[infptr]);
	while ((c=getchr())!=';' && c!='}' && c!='\n' && c!=EOF && c!='\0')
		;
	if (c == EOF || c == '\0')
		putbak(c);
	errorflag = 1;
}
Commit	Line	Data
52dfb15d	1	Original BTL Ratfor System for 4.2
6ae7c017 KB	2	/*-
	3	* %sccs.include.proprietary.c%
	4	*/
	5
476fcd16	6	#ifndef lint
6ae7c017 KB	7	static char sccsid[] = "@(#)r1.c 1.4 (Berkeley) %G%";
6ae7c017 KB	8	#endif /* not lint */
476fcd16	9
52dfb15d CC	10	#include "r.h"
	11
	12	#define wasbreak brkused[brkptr]==1 \|\| brkused[brkptr]==3
	13	#define wasnext brkused[brkptr]==2 \|\| brkused[brkptr]==3
	14
	15	int transfer = 0; /* 1 if just finished retrun, break, next */
	16
	17	char fcname[10];
	18	char scrat[500];
	19
	20	int brkptr = -1;
	21	int brkstk[10]; /* break label */
	22	int typestk[10]; /* type of loop construct */
	23	int brkused[10]; /* loop contains BREAK or NEXT */
	24
	25	int forptr = 0;
	26	char *forstk[10];
	27
	28	repcode() {
	29	transfer = 0;
	30	outcont(0);
	31	putcom("repeat");
	32	yyval = genlab(3);
	33	indent++;
	34	outcont(yyval);
	35	brkstk[++brkptr] = yyval+1;
	36	typestk[brkptr] = REPEAT;
	37	brkused[brkptr] = 0;
	38	}
	39
	40	untils(p1,un) int p1,un; {
	41	outnum(p1+1);
	42	outtab();
	43	if (un > 0) {
	44	outcode("if(.not.");
	45	balpar();
	46	outcode(")");
	47	}
	48	transfer = 0;
	49	outgoto(p1);
	50	indent--;
	51	if (wasbreak)
	52	outcont(p1+2);
	53	brkptr--;
	54	}
	55
	56	ifcode() {
	57	transfer = 0;
	58	outtab();
	59	outcode("if(.not.");
	60	balpar();
	61	outcode(")");
	62	outgoto(yyval=genlab(2));
	63	indent++;
	64	}
	65
	66	elsecode(p1) {
	67	outgoto(p1+1);
	68	indent--;
	69	putcom("else");
	70	indent++;
	71	outcont(p1);
	72	}
	73
74	whilecode() {
75	transfer = 0;
76	outcont(0);
77	putcom("while");
78	brkstk[++brkptr] = yyval = genlab(2);
79	typestk[brkptr] = WHILE;
80	brkused[brkptr] = 0;
81	outnum(yyval);
82	outtab();
83	outcode("if(.not.");
84	balpar();
85	outcode(")");
86	outgoto(yyval+1);
87	indent++;
88	}
89
90	whilestat(p1) int p1; {
91	outgoto(p1);
92	indent--;
93	putcom("endwhile");
94	outcont(p1+1);
95	brkptr--;
96	}
97
98	balpar() {
99	register c, lpar;
100	while ((c=gtok(scrat)) == ' ' \|\| c == '\t')
101	;
102	if (c != '(') {
103	error("missing left paren");
104	return;
105	}
106	outcode(scrat);
107	lpar = 1;
108	do {
109	c = gtok(scrat);
110	if (c==';' \|\| c=='{' \|\| c=='}' \|\| c==EOF) {
111	pbstr(scrat);
112	break;
113	}
114	if (c=='(')
115	lpar++;
116	else if (c==')')
117	lpar--;
118	else if (c == '\n') {
119	while ((c = gtok(scrat)) == ' ' \|\| c=='\t' \|\| c=='\n')
120	;
121	pbstr(scrat);
122	continue;
123	}
124	else if (c == '=' && scrat[1] == '\0')
125	error("assigment inside conditional");
126	outcode(scrat);
127	} while (lpar > 0);
128	if (lpar != 0)
129	error("missing parenthesis");
130	}
131
132	int labval = 23000;
133
134	genlab(n){
135	labval += n;
136	return(labval-n);
137	}
138
139	gokcode(p1) {
140	transfer = 0;
141	outtab();
142	outcode(p1);
143	eatup();
144	outdon();
145	}
146
147	eatup() {
148	int t, lpar;
149	char temp[100];
150	lpar = 0;
151	do {
152	if ((t = gtok(scrat)) == ';' \|\| t == '\n')
153	break;
154	if (t == '{' \|\| t == '}' \|\| t == EOF) {
155	pbstr(scrat);
156	break;
157	}
158	if (t == ',' \|\| t == '+' \|\| t == '-' \|\| t == '*' \|\| t == '('
159	\|\| t == '&' \|\| t == '\|' \|\| t == '=') {
160	while (gtok(temp) == '\n')
161	;
162	pbstr(temp);
163	}
164	if (t == '(')
165	lpar++;
166	else if (t==')') {
167	lpar--;
168	if (lpar < 0) {
169	error("missing left paren");
170	return(1);
171	}
172	}
173	outcode(scrat);
174	} while (lpar >= 0);
175	if (lpar > 0) {
176	error("missing right paren");
177	return(1);
178	}
179	return(0);
180	}
181
182	forcode(){
183	int lpar, t;
184	char ps, qs;
185
186	transfer = 0;
187	outcont(0);
188	putcom("for");
189	yyval = genlab(3);
190	brkstk[++brkptr] = yyval+1;
191	typestk[brkptr] = FOR;
192	brkused[brkptr] = 0;
193	forstk[forptr++] = malloc(1);
194	if ((t = gnbtok(scrat)) != '(') {
195	error("missing left paren in FOR");
196	pbstr(scrat);
197	return;
198	}
199	if (gnbtok(scrat) != ';') { /* real init clause */
200	pbstr(scrat);
201	outtab();
202	if (eatup() > 0) {
203	error("illegal FOR clause");
204	return;
205	}
206	outdon();
207	}
208	if (gnbtok(scrat) == ';') /* empty condition */
209	outcont(yyval);
210	else { /* non-empty condition */
211	pbstr(scrat);
212	outnum(yyval);
213	outtab();
214	outcode("if(.not.(");
215	for (lpar=0; lpar >= 0;) {
216	if ((t = gnbtok(scrat)) == ';')
217	break;
218	if (t == '(')
219	lpar++;
220	else if (t == ')') {
221	lpar--;
222	if (lpar < 0) {
223	error("missing left paren in FOR clause");
224	return;
225	}
226	}
227	if (t != '\n')
228	outcode(scrat);
229	}
230	outcode("))");
231	outgoto(yyval+2);
232	if (lpar < 0)
233	error("invalid FOR clause");
234	}
235	ps = scrat;
236	for (lpar=0; lpar >= 0;) {
237	if ((t = gtok(ps)) == '(')
238	lpar++;
239	else if (t == ')')
240	lpar--;
241	if (lpar >= 0 && t != '\n')
242	while(*ps)
243	ps++;
244	}
245	*ps = '\0';
246	qs = forstk[forptr-1] = malloc((unsigned)(ps-scrat+1));
247	ps = scrat;
248	while (qs++ = ps++)
249	;
250	indent++;
251	}
252
253	forstat(p1) int p1; {
254	char bp, q;
255	bp = forstk[--forptr];
c5a49232	256	if (wasnext) {
52dfb15d	257	outnum(p1+1);
c5a49232 CC	258	transfer = 0;
c5a49232 CC	259	}
52dfb15d CC	260	if (nonblank(bp)){
	261	outtab();
	262	outcode(bp);
	263	outdon();
	264	}
	265	outgoto(p1);
	266	indent--;
	267	putcom("endfor");
	268	outcont(p1+2);
	269	for (q=bp; *q++;);
	270	free(bp);
	271	brkptr--;
	272	}
	273
	274	retcode() {
	275	register c;
	276	if ((c = gnbtok(scrat)) != '\n' && c != ';' && c != '}') {
	277	pbstr(scrat);
	278	outtab();
	279	outcode(fcname);
	280	outcode(" = ");
	281	eatup();
	282	outdon();
	283	}
	284	else if (c == '}')
	285	pbstr(scrat);
	286	outtab();
	287	outcode("return");
	288	outdon();
	289	transfer = 1;
	290	}
	291
	292	docode() {
	293	transfer = 0;
	294	outtab();
	295	outcode("do ");
	296	yyval = genlab(2);
	297	brkstk[++brkptr] = yyval;
	298	typestk[brkptr] = DO;
	299	brkused[brkptr] = 0;
	300	outnum(yyval);
	301	eatup();
	302	outdon();
	303	indent++;
	304	}
	305
	306	dostat(p1) int p1; {
	307	outcont(p1);
	308	indent--;
	309	if (wasbreak)
	310	outcont(p1+1);
	311	brkptr--;
	312	}
	313
	314	#ifdef gcos
	315	#define atoi(s) (s-'0') / crude!!! */
	316	#endif
	317
	318	breakcode() {
	319	int level, t;
	320
	321	level = 0;
	322	if ((t=gnbtok(scrat)) == DIG)
	323	level = atoi(scrat) - 1;
324	else if (t != ';')
325	pbstr(scrat);
326	if (brkptr-level < 0)
327	error("illegal BREAK");
328	else {
329	outgoto(brkstk[brkptr-level]+1);
330	brkused[brkptr-level] \|= 1;
331	}
332	transfer = 1;
333	}
334
335	nextcode() {
336	int level, t;
337
338	level = 0;
339	if ((t=gnbtok(scrat)) == DIG)
340	level = atoi(scrat) - 1;
341	else if (t != ';')
342	pbstr(scrat);
343	if (brkptr-level < 0)
344	error("illegal NEXT");
345	else {
346	outgoto(brkstk[brkptr-level]);
347	brkused[brkptr-level] \|= 2;
348	}
349	transfer = 1;
350	}
351
352	nonblank(s) char *s; {
353	int c;
354	while (c = *s++)
355	if (c!=' ' && c!='\t' && c!='\n')
356	return(1);
357	return(0);
358	}
359
360	int errorflag = 0;
361
362	error(s1) char *s1; {
363	if (errorflag == 0)
364	fprintf(stderr, "ratfor:");
365	fprintf(stderr, "error at line %d, file %s: ",linect[infptr],curfile[infptr]);
366	fprintf(stderr, s1);
367	fprintf(stderr, "\n");
368	errorflag = 1;
369	}
370
371	errcode() {
372	int c;
373	if (errorflag == 0)
374	fprintf(stderr, "******\n");
375	fprintf(stderr, "*****F ratfor:");
376	fprintf(stderr, "syntax error, line %d, file %s\n", linect[infptr], curfile[infptr]);
377	while ((c=getchr())!=';' && c!='}' && c!='\n' && c!=EOF && c!='\0')
378	;
379	if (c == EOF \|\| c == '\0')
380	putbak(c);
381	errorflag = 1;
382	}