1 %option never-interactive
2
3 %top{
4 /* web2c-lexer.l -- lexical analysis for Tangle output. Public domain. */
5
6 #include "web2c.h"
7 #include "web2c-parser.h"
8 }
9
10 %{
11 /* Hack to make it possible to compile the generated code with C++
12 Required if you use flex. */
13 #ifdef __cplusplus
14 #define webinput yyinput
15 #else
16 #define webinput input
17 #endif
18
19 /* For some reason flex wants to do a system call, so we must lose our
20 definition of the Pascal read. */
21 #undef read
22
23 char conditional[20], negbuf[2], temp[20];
24 extern boolean doing_statements;
25
26
27 /* We only read one input file. This is the default definition, but
28 giving it ourselves avoids the need to find -lfl or -ll at link time.
29 This is a good thing, since libfl.a is often installed somewhere that
30 the linker doesn't search by default. */
31 static int
yywrap(void)32 yywrap (void)
33 {
34 return 1;
35 }
36 #define YY_SKIP_YYWRAP /* not that it matters */
37 %}
38 DIGIT [0-9]
39 ALPHA [a-zA-Z]
40 ALPHANUM ({DIGIT}|{ALPHA}|"_")
41 IDENTIFIER ({ALPHA}{ALPHANUM}*)
42 NUMBER ({DIGIT}+)
43 SIGN ("+"|"-")
44 SIGNED ({SIGN}?{NUMBER})
45 WHITE [ \n\t]+
46 REAL ({NUMBER}"."{NUMBER}("e"{SIGNED})?)|({NUMBER}"e"{SIGNED})
47 COMMENT (("{"[^}]*"}")|("(*"([^*]|"*"[^)])*"*)"))
48 W ({WHITE}|"packed ")+
49 WW ({WHITE}|{COMMENT}|"packed ")*
50 HHB0 ("hh"{WW}"."{WW}"b0")
51 HHB1 ("hh"{WW}"."{WW}"b1")
52
53 %%
54 {W} ;
55 "{" { while (webinput() != '}'); }
56
57 "#" {
58 register int c;
59 putc('#', out);
60 while ((c = webinput()) && c != ';')
61 putc(c, out);
62 putc('\n', out);
63 }
64
65 "ifdef(" {register int c;
66 register char *cp=conditional;
67 new_line();
68 while ((c = webinput()) != '\'')
69 ;
70 while ((c = webinput()) != '\'')
71 *cp++ = c;
72 *cp = '\0';
73 (void) webinput();
74 if (doing_statements) fputs("\t;\n", out);
75 fprintf(out, "#ifdef %s\n", conditional);
76 }
77
78 "endif(" {register int c;
79 new_line();
80 fputs("#endif /* ", out);
81 while ((c = webinput()) != '\'')
82 ;
83 while ((c = webinput()) != '\'')
84 (void) putc(c, out);
85 (void) webinput();
86 conditional[0] = '\0';
87 fputs(" */\n", out);
88 }
89
90 "ifndef(" {register int c;
91 register char *cp=conditional;
92 new_line();
93 while ((c = webinput()) != '\'')
94 ;
95 while ((c = webinput()) != '\'')
96 *cp++ = c;
97 *cp = '\0';
98 (void) webinput();
99 if (doing_statements) fputs("\t;\n", out);
100 fprintf(out, "#ifndef %s\n", conditional);
101 }
102
103 "endifn(" {register int c;
104 new_line();
105 fputs("#endif /* not ", out);
106 while ((c = webinput()) != '\'')
107 ;
108 while ((c = webinput()) != '\'')
109 putc(c, out);
110 (void) webinput();
111 conditional[0] = '\0';
112 fputs(" */\n", out);
113 }
114
115
116 "procedure "[a-z_]+";"[ \n\t]*"forward;" ;
117
118 "function "[(),:a-z_]+";"[ \n\t]*"forward;" ;
119
120 "@define" return last_tok=define_tok;
121 "@field" return last_tok=field_tok;
122 "and" return last_tok=and_tok;
123 "array" return last_tok=array_tok;
124 "begin" return last_tok=begin_tok;
125 "case" return last_tok=case_tok;
126 "const" return last_tok=const_tok;
127 "div" return last_tok=div_tok;
128 "break" return last_tok=break_tok;
129 "do" return last_tok=do_tok;
130 "downto" return last_tok=downto_tok;
131 "else" return last_tok=else_tok;
132 "end" return last_tok=end_tok;
133 "file" return last_tok=file_tok;
134 "for" return last_tok=for_tok;
135 "function" return last_tok=function_tok;
136 "goto" return last_tok=goto_tok;
137 "if" return last_tok=if_tok;
138 "label" return last_tok=label_tok;
139 "mod" return last_tok=mod_tok;
140 "noreturn" return last_tok=noreturn_tok;
141 "not" return last_tok=not_tok;
142 "of" return last_tok=of_tok;
143 "or" return last_tok=or_tok;
144 "procedure" return last_tok=procedure_tok;
145 "program" return last_tok=program_tok;
146 "record" return last_tok=record_tok;
147 "repeat" return last_tok=repeat_tok;
148 {HHB0} return last_tok=hhb0_tok;
149 {HHB1} return last_tok=hhb1_tok;
150 "then" return last_tok=then_tok;
151 "to" return last_tok=to_tok;
152 "type" return last_tok=type_tok;
153 "until" return last_tok=until_tok;
154 "var" return last_tok=var_tok;
155 "while" return last_tok=while_tok;
156 "others" return last_tok=others_tok;
157
158 {REAL} {
159 sprintf (temp, "%s%s", negbuf, yytext);
160 negbuf[0] = '\0';
161 return last_tok=r_num_tok;
162 }
163
164 {NUMBER} {
165 sprintf (temp, "%s%s", negbuf, yytext);
166 negbuf[0] = '\0';
167 return last_tok=i_num_tok;
168 }
169
170 ("'"([^']|"''")"'") return last_tok=single_char_tok;
171
172 ("'"([^']|"''")*"'") return last_tok=string_literal_tok;
173
174 "+" { if ((last_tok>=undef_id_tok &&
175 last_tok<=field_id_tok) ||
176 last_tok==i_num_tok ||
177 last_tok==r_num_tok ||
178 last_tok==')' ||
179 last_tok==']')
180 return last_tok='+';
181 else return last_tok=unary_plus_tok; }
182
183 "-" { if ((last_tok>=undef_id_tok &&
184 last_tok<=field_id_tok) ||
185 last_tok==i_num_tok ||
186 last_tok==r_num_tok ||
187 last_tok==')' ||
188 last_tok==']')
189 return last_tok='-';
190 else {
191 int c;
192 while ((c = webinput()) == ' ' || c == '\t')
193 ;
194 unput(c);
195 if (c < '0' || c > '9') {
196 return last_tok = unary_minus_tok;
197 }
198 negbuf[0] = '-';
199 }}
200
201 "*" return last_tok='*';
202 "/" return last_tok='/';
203 "=" return last_tok='=';
204 "<>" return last_tok=not_eq_tok;
205 "<" return last_tok='<';
206 ">" return last_tok='>';
207 "<=" return last_tok=less_eq_tok;
208 ">=" return last_tok=great_eq_tok;
209 "(" return last_tok='(';
210 ")" return last_tok=')';
211 "[" return last_tok='[';
212 "]" return last_tok=']';
213 ":=" return last_tok=assign_tok;
214 ".." return last_tok=two_dots_tok;
215 "." return last_tok='.';
216 "," return last_tok=',';
217 ";" return last_tok=';';
218 ":" return last_tok=':';
219 "^" return last_tok='^';
220
221 {IDENTIFIER} { strcpy (last_id, yytext);
222 l_s = search_table (last_id);
223 return
224 last_tok = (l_s == -1 ? undef_id_tok : sym_table[l_s].typ);
225 }
226
227
228 . { /* Any bizarre token will do. */
229 return last_tok = two_dots_tok; }
230 %%
231 /* Some helper routines. Defining these here means we don't have references
232 to yytext outside of this file. Which means we can omit one of the more
233 troublesome autoconf tests. */
234 void
235 get_string_literal (char *s)
236 {
237 int i, j;
238 j = 1;
239 s[0] = '"';
240 for (i=1; yytext[i-1] != 0; i++) {
241 if (yytext[i] == '\\' || yytext[i] == '"')
242 s[j++] = '\\';
243 else if (yytext[i] == '\'')
244 i++;
245 s[j++] = yytext[i];
246 }
247 s[j-1] = '"';
248 s[j] = 0;
249 }
250
251 void
252 get_single_char (char *s)
253 {
254 s[0]='\'';
255 if (yytext[1] == '\\' || yytext[1] == '\'') {
256 s[1] = '\\';
257 s[2] = yytext[1];
258 s[3] = '\'';
259 s[4] = 0;
260 } else {
261 s[1] = yytext[1];
262 s[2] = '\'';
263 s[3] = 0;
264 }
265 }
266
267 void
268 get_result_type (char *s)
269 {
270 strcpy(s, yytext);
271 }
272
273
274 /* Since a syntax error can never be recovered from, we exit here with
275 bad status. */
276
277 int
278 yyerror (const_string s)
279 {
280 /* This is so the convert script can delete the output file on error. */
281 puts ("@error@");
282 fflush (stdout);
283 fputs (s, stderr);
284 fprintf (stderr, ": Last token = %d (%c), ", last_tok, last_tok);
285 fprintf (stderr, "error buffer = `%s',\n\t", yytext);
286 fprintf (stderr, "last id = `%s' (", last_id);
287 ii = search_table (last_id);
288 if (ii == -1)
289 fputs ("not in symbol table", stderr);
290 else
291 switch (sym_table[ii].typ)
292 {
293 case undef_id_tok:
294 fputs ("undefined", stderr);
295 break;
296 case var_id_tok:
297 fputs ("variable", stderr);
298 break;
299 case const_id_tok:
300 fputs ("constant", stderr);
301 break;
302 case type_id_tok:
303 fputs ("type", stderr);
304 break;
305 case proc_id_tok:
306 fputs ("parameterless procedure", stderr);
307 break;
308 case proc_param_tok:
309 fputs ("procedure with parameters", stderr);
310 break;
311 case fun_id_tok:
312 fputs ("parameterless function", stderr);
313 break;
314 case fun_param_tok:
315 fputs ("function with parameters", stderr);
316 break;
317 default:
318 fputs ("unknown!", stderr);
319 break;
320 }
321 fputs (").\n", stderr);
322 exit (1);
323
324 /* Avoid silly warnings. */
325 return 0;
326 }
327