xref: /original-bsd/old/ratfor/rio.c (revision c3e32dec)
1 /*-
2  * %sccs.include.proprietary.c%
3  */
4 
5 #ifndef lint
6 static char sccsid[] = "@(#)rio.c	8.1 (Berkeley) 06/06/93";
7 #endif /* not lint */
8 
9 
10 #include "r.h"
11 char	ibuf[BUFSIZ];
12 char	*ip = ibuf;
13 
14 char	type[] = {
15 	0,	CRAP,	CRAP,	CRAP,	CRAP,	CRAP,	CRAP,	CRAP,
16 	CRAP,	'\t',	'\n',	CRAP,	CRAP,	CRAP,	CRAP,	CRAP,
17 	CRAP,	CRAP,	CRAP,	CRAP,	CRAP,	CRAP,	CRAP,	CRAP,
18 	CRAP,	CRAP,	CRAP,	CRAP,	CRAP,	CRAP,	CRAP,	CRAP,
19 	' ',	'!',	'"',	'#',	'$',	'%',	'&',	'\'',
20 	'(',	')',	'*',	'+',	',',	'-',	'.',	'/',
21 	DIG,	DIG,	DIG,	DIG,	DIG,	DIG,	DIG,	DIG,
22 	DIG,	DIG,	':',	';',	'<',	'=',	'>',	'?',
23 	'@',	LET,	LET,	LET,	LET,	LET,	LET,	LET,
24 	LET,	LET,	LET,	LET,	LET,	LET,	LET,	LET,
25 	LET,	LET,	LET,	LET,	LET,	LET,	LET,	LET,
26 	LET,	LET,	LET,	'[',	'\\',	']',	'^',	'_',
27 	'`',	LET,	LET,	LET,	LET,	LET,	LET,	LET,
28 	LET,	LET,	LET,	LET,	LET,	LET,	LET,	LET,
29 	LET,	LET,	LET,	LET,	LET,	LET,	LET,	LET,
30 	LET,	LET,	LET,	'{',	'|',	'}',	'~',	0,
31 };
32 
33 gtok(s) char *s; {	/* get token into s */
34 	register c, t;
35 	register char *p;
36 	struct nlist *q;
37 
38 	for(;;) {
39 		p = s;
40 		*p++ = c = getchr();
41 		switch(t = type[c]) {
42 		case 0:
43 			if (infptr > 0) {
44 				fclose(infile[infptr]);
45 				infptr--;
46 				continue;
47 			}
48 			if (svargc > 1) {
49 				svargc--;
50 				svargv++;
51 				if (infile[infptr] != stdin)
52 					fclose(infile[infptr]);
53 				if( (infile[infptr] = fopen(*svargv,"r")) == NULL )
54 					cant(*svargv);
55 				linect[infptr] = 0;
56 				curfile[infptr] = *svargv;
57 				continue;
58 			}
59 			return(EOF);	/* real eof */
60 		case ' ':
61 		case '\t':
62 			while ((c = getchr()) == ' ' || c == '\t')
63 				;	/* skip others */
64 			if (c == COMMENT || c == '_') {
65 				putbak(c);
66 				continue;
67 			}
68 			if (c != '\n') {
69 				putbak(c);
70 				*p = '\0';
71 				return(' ');
72 			} else {
73 				*s = '\n';
74 				*(s+1) = '\0';
75 				return(*s);
76 			}
77 		case '_':
78 			while ((c = getchr()) == ' ' || c == '\t')
79 				;
80 			if (c == COMMENT) {
81 				putbak(c);
82 				gtok(s);	/* recursive */
83 			}
84 			else if (c != '\n')
85 				putbak(c);
86 			continue;
87 		case LET:
88 		case DIG:
89 			while ((t=type[*p = getchr()]) == LET || t == DIG)
90 				p++;
91 			putbak(*p);
92 			*p = '\0';
93 			if ((q = lookup(s))->name != NULL && q->ydef == 0) {	/* found but not keyword */
94 				if (q->def != fcnloc) {	/* not "function" */
95 					pbstr(q->def);
96 					continue;
97 				}
98 				getfname();	/* recursive gtok */
99 			}
100 			for (p=s; *p; p++)
101 				if (*p>='A' && *p<='Z')
102 					*p += 'a' - 'A';
103 			for (p=s; *p; p++)
104 				if (*p < '0' || *p > '9')
105 					return(LET);
106 			return(DIG);
107 		case '[':
108 			*p = '\0';
109 			return('{');
110 		case ']':
111 			*p = '\0';
112 			return('}');
113 		case '$':
114 		case '\\':
115 			if ((*p = getchr()) == '(' || *p == ')') {
116 				putbak(*p=='(' ? '{' : '}');
117 				continue;
118 			}
119 			if (*p == '"' || *p == '\'')
120 				p++;
121 			else
122 				putbak(*p);
123 			*p = '\0';
124 			return('$');
125 		case COMMENT:
126 			comment[comptr++] = 'c';
127 			while ((comment[comptr++] = getchr()) != '\n')
128 				;
129 			flushcom();
130 			*s = '\n';
131 			*(s+1) = '\0';
132 			return(*s);
133 		case '"':
134 		case '\'':
135 			for (; (*p = getchr()) != c; p++) {
136 				if (*p == '\\')
137 					*++p = getchr();
138 				if (*p == '\n') {
139 					error("missing quote");
140 					putbak('\n');
141 					break;
142 				}
143 			}
144 			*p++ = c;
145 			*p = '\0';
146 			return(QUOTE);
147 		case '%':
148 			while ((*p = getchr()) != '\n')
149 				p++;
150 			putbak(*p);
151 			*p = '\0';
152 			return('%');
153 		case '>': case '<': case '=': case '!': case '^':
154 			return(peek(p, '='));
155 		case '&':
156 			return(peek(p, '&'));
157 		case '|':
158 			return(peek(p, '|'));
159 		case CRAP:
160 			continue;
161 		default:
162 			*p = '\0';
163 			return(*s);
164 		}
165 	}
166 }
167 
168 gnbtok(s) char *s; {
169 	register c;
170 	while ((c = gtok(s)) == ' ' || c == '\t')
171 		;
172 	return(c);
173 }
174 
175 getfname() {
176 	while (gtok(fcname) == ' ')
177 		;
178 	pbstr(fcname);
179 	putbak(' ');
180 }
181 
182 peek(p, c1) char *p, c1; {
183 	register c;
184 	c = *(p-1);
185 	if ((*p = getchr()) == c1)
186 		p++;
187 	else
188 		putbak(*p);
189 	*p = '\0';
190 	return(c);
191 }
192 
193 pbstr(str)
194 register char *str;
195 {
196 	register char *p;
197 
198 	p = str;
199 	while (*p++);
200 	--p;
201 	if (ip >= &ibuf[BUFSIZ]) {
202 		error("pushback overflow");
203 		exit(1);
204 	}
205 	while (p > str)
206 		putbak(*--p);
207 }
208 
209 getchr() {
210 	register c;
211 
212 	if (ip > ibuf)
213 		return(*--ip);
214 	c = getc(infile[infptr]);
215 	if (c == '\n')
216 		linect[infptr]++;
217 	if (c == EOF)
218 		return(0);
219 	return(c);
220 }
221