Commit | Line | Data |
---|---|---|
24b05658 BJ |
1 | /* Copyright (c) 1979 Regents of the University of California */ |
2 | /* | |
3 | * pi - Pascal interpreter code translator | |
4 | * | |
5 | * Charles Haley, Bill Joy UCB | |
6 | * Version 1.1 February 1978 | |
7 | * | |
8 | * | |
9 | * pxp - Pascal execution profiler | |
10 | * | |
11 | * Bill Joy UCB | |
12 | * Version 1.1 February 1978 | |
13 | */ | |
14 | ||
15 | #include "0.h" | |
16 | #include "yy.h" | |
17 | ||
18 | #ifdef PXP | |
19 | int yytokcnt; | |
20 | #endif | |
21 | ||
22 | /* | |
23 | * Readch returns the next | |
24 | * character from the current | |
25 | * input line or -1 on end-of-file. | |
26 | * It also maintains yycol for use in | |
27 | * printing error messages. | |
28 | */ | |
29 | readch() | |
30 | { | |
31 | register i, c; | |
32 | ||
33 | if (*bufp == '\n' && bufp >= charbuf) { | |
34 | #ifdef PXP | |
35 | yytokcnt = 0; | |
36 | #endif | |
37 | if (getline() < 0) | |
38 | return (-1); | |
39 | } | |
40 | c = *++bufp; | |
41 | if (c == '\t') | |
42 | yycol = ((yycol + 8) & ~7); | |
43 | else | |
44 | yycol++; | |
45 | return (c); | |
46 | } | |
47 | \f | |
48 | /* | |
49 | * Definitions of the structures used for the | |
50 | * include facility. The variable "ibp" points | |
51 | * to the getc buffer of the current input file. | |
52 | * There are "inclev + 1" current include files, | |
53 | * and information in saved in the incs stack | |
54 | * whenever a new level of include nesting occurs. | |
55 | * | |
56 | * Ibp in the incs structure saves the pointer | |
57 | * to the previous levels input buffer; | |
58 | * filename saves the previous file name; | |
59 | * Printed saves whether the previous file name | |
60 | * had been printed before this nesting occurred; | |
61 | * and yyline is the line we were on on the previous file. | |
62 | */ | |
63 | ||
64 | #define MAXINC 10 | |
65 | ||
66 | struct inc { | |
67 | FILE *ibp; | |
68 | char *filename; | |
69 | int Printed; | |
70 | int yyline; | |
71 | int yyLinpt; | |
72 | } incs[MAXINC]; | |
73 | ||
74 | extern char printed; | |
75 | ||
76 | int inclev = -1; | |
77 | ||
78 | #ifdef PXP | |
79 | /* | |
80 | * These initializations survive only if | |
81 | * pxp is asked to pretty print one file. | |
82 | * Otherwise they are destroyed by the initial | |
83 | * call to getline. | |
84 | */ | |
85 | char charbuf[CBSIZE] = " program x(output);\n"; | |
86 | int yycol = 8; | |
87 | char *bufp = charbuf; | |
88 | ||
89 | #endif | |
90 | /* | |
91 | * YyLinpt is the seek pointer to the beginning of the | |
92 | * next line in the file. | |
93 | */ | |
94 | int yyLinpt; | |
95 | \f | |
96 | /* | |
97 | * Getline places the next line | |
98 | * from the input stream in the | |
99 | * line buffer, returning -1 at YEOF. | |
100 | */ | |
101 | getline() | |
102 | { | |
103 | register char *cp; | |
104 | register CHAR c; | |
105 | #ifdef PXP | |
106 | static char ateof; | |
107 | #endif | |
108 | register FILE *ib; | |
109 | int i; | |
110 | ||
111 | if (opt('l') && yyprtd == 0) | |
112 | yyoutline(); | |
113 | yyprtd = 0; | |
114 | top: | |
115 | yylinpt = yyLinpt; | |
116 | yyline++; | |
117 | yyseqid++; | |
118 | cp = charbuf; | |
119 | ib = ibp; | |
120 | i = sizeof charbuf - 1; | |
121 | for (;;) { | |
122 | c = getc(ib); | |
123 | if (c == EOF) { | |
124 | if (uninclud()) | |
125 | goto top; | |
126 | #ifdef PXP | |
127 | if (ateof == 0 && bracket) { | |
128 | strcpy(charbuf, "begin end.\n"); | |
129 | ateof = 1; | |
130 | goto out; | |
131 | } | |
132 | #endif | |
133 | bufp = "\n"; | |
134 | yyline--; | |
135 | yyseqid--; | |
136 | yyprtd = 1; | |
137 | return (-1); | |
138 | } | |
139 | *cp++ = c; | |
140 | if (c == '\n') | |
141 | break; | |
142 | if (--i == 0) { | |
143 | line = yyline; | |
144 | error("Input line too long - QUIT"); | |
145 | pexit(DIED); | |
146 | } | |
147 | } | |
148 | *cp = 0; | |
149 | yyLinpt = yylinpt + cp - charbuf; | |
150 | if (includ()) | |
151 | goto top; | |
152 | #ifdef PXP | |
153 | if (cp == &charbuf[1]) | |
154 | commnl(); | |
155 | else if (cp == &charbuf[2]) | |
156 | switch (charbuf[0]) { | |
157 | case ' ': | |
158 | commnlbl(); | |
159 | break; | |
160 | case '\f': | |
161 | commform(); | |
162 | } | |
163 | #endif | |
164 | if (opt('u')) | |
165 | setuflg(); | |
166 | out: | |
167 | bufp = charbuf - 1; | |
168 | yycol = 8; | |
169 | return (1); | |
170 | } | |
171 | \f | |
172 | /* | |
173 | * Check an input line to see if it is a "#include" pseudo-statement. | |
174 | * We allow arbitrary blanks in the line and the file name | |
175 | * may be delimited by either 's or "s. A single semicolon | |
176 | * may be placed after the name, but nothing else is allowed | |
177 | */ | |
178 | includ() | |
179 | { | |
180 | register char *cp, *dp; | |
181 | char ch; | |
182 | register struct inc *ip; | |
183 | ||
184 | cp = charbuf; | |
185 | if (*cp++ != '#') | |
186 | return (0); | |
187 | cp = skipbl(cp); | |
188 | for (dp = "include"; *dp; dp++) | |
189 | if (*dp != *cp++) | |
190 | return (0); | |
191 | line = yyline; | |
192 | cp = skipbl(cp); | |
193 | ch = *cp++; | |
194 | if (ch != '\'' && ch != '"') { | |
195 | /* | |
196 | * This should be a yerror flagging the place | |
197 | * but its not worth figuring out the column. | |
198 | */ | |
199 | line = yyline; | |
200 | error("Include syntax error - expected ' or \" not found - QUIT"); | |
201 | pexit(DIED); | |
202 | } | |
203 | for (dp = cp; *dp != ch; dp++) | |
204 | if (*dp == 0) { | |
205 | line = yyline; | |
206 | error("Missing closing %c for include file name - QUIT", ch); | |
207 | pexit(DIED); | |
208 | } | |
209 | *dp++ = 0; | |
210 | /* | |
211 | if (*dp == ';') | |
212 | dp++; | |
213 | dp = skipbl(dp); | |
214 | if (*dp != '\n') { | |
215 | line = yyline; | |
216 | error("Garbage after filename in include"); | |
217 | pexit(DIED); | |
218 | } | |
219 | */ | |
220 | if (!dotted(cp, 'i')) { | |
221 | line = yyline; | |
222 | error("Include filename must end in .i"); | |
223 | } | |
224 | #ifdef PXP | |
225 | commincl(cp, ch); | |
226 | if (noinclude) | |
227 | return (1); | |
228 | #endif | |
229 | inclev++; | |
230 | if (inclev > MAXINC) { | |
231 | line = yyline; | |
232 | error("Absurdly deep include nesting - QUIT"); | |
233 | pexit(DIED); | |
234 | } | |
235 | ip = &incs[inclev]; | |
236 | ip->filename = filename; | |
237 | filename = savestr(cp); | |
238 | /* | |
239 | * left over from before stdio | |
240 | * | |
241 | * cp = malloc(518); | |
242 | * if (cp == -1) { | |
243 | * error("Ran out of memory (include)"); | |
244 | * pexit(DIED); | |
245 | * } | |
246 | * | |
247 | */ | |
248 | ip->ibp = ibp; | |
249 | if ( ( ibp = fopen(filename, "r" ) ) == NULL ) { | |
250 | perror(filename); | |
251 | pexit(DIED); | |
252 | } | |
253 | if (inpflist(filename)) { | |
254 | #ifdef PI | |
255 | opush('l'); | |
256 | #endif | |
257 | #ifdef PXP | |
258 | opush('z'); | |
259 | #endif | |
260 | } | |
261 | ip->Printed = printed; | |
262 | printed = 0; | |
263 | ip->yyline = yyline; | |
264 | yyline = 0; | |
265 | ip->yyLinpt = yyLinpt; | |
266 | yyLinpt = 0; | |
267 | /* | |
268 | * left over from before stdio | |
269 | * | |
270 | * ip->ibp = ibp; | |
271 | * ibp = cp; | |
272 | * | |
273 | */ | |
274 | return (1); | |
275 | } | |
276 | ||
277 | skipbl(ocp) | |
278 | char *ocp; | |
279 | { | |
280 | register char *cp; | |
281 | ||
282 | cp = ocp; | |
283 | while (*cp == ' ' || *cp == '\t') | |
284 | cp++; | |
285 | return (cp); | |
286 | } | |
287 | ||
288 | \f | |
289 | /* | |
290 | * At the end of an include, | |
291 | * close the file, free the input buffer, | |
292 | * and restore the environment before | |
293 | * the "push", including the value of | |
294 | * the z option for pxp and the l option for pi. | |
295 | */ | |
296 | uninclud() | |
297 | { | |
298 | register struct inc *ip; | |
299 | ||
300 | if (inclev < 0) | |
301 | return (0); | |
302 | /* | |
303 | * left over from before stdio: becomes fclose ( ibp ) | |
304 | * | |
305 | * close(ibp[0]); | |
306 | * free(ibp); | |
307 | * | |
308 | */ | |
309 | fclose ( ibp ); | |
310 | ip = &incs[inclev]; | |
311 | ibp = ip->ibp; | |
312 | yyline = ip->yyline; | |
313 | if (inpflist(filename)) { | |
314 | #ifdef PI | |
315 | opop('l'); | |
316 | #endif | |
317 | #ifdef PXP | |
318 | opop('z'); | |
319 | #endif | |
320 | } | |
321 | filename = ip->filename; | |
322 | yyLinpt = ip->yyLinpt; | |
323 | /* | |
324 | * If we printed out the nested name, | |
325 | * then we should print all covered names again. | |
326 | * If we didn't print out the nested name | |
327 | * we print the uncovered name only if it | |
328 | * has not been printed before (unstack). | |
329 | */ | |
330 | if (printed) { | |
331 | printed = 0; | |
332 | while (ip >= incs) { | |
333 | ip->Printed = 0; | |
334 | ip--; | |
335 | } | |
336 | } else | |
337 | printed = ip->Printed; | |
338 | inclev--; | |
339 | return (1); | |
340 | } |