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