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