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

Original BTL Ratfor System for 4.2
#ifndef lint
static char sccsid[] = "@(#)r1.c	1.3 (Berkeley) %G%";
#endif

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