fgen.l revision 1.41 1 1.1 eeh %{
2 1.41 wiz /* $NetBSD: fgen.l,v 1.41 2024/05/20 20:46:05 wiz Exp $ */
3 1.1 eeh /* FLEX input for FORTH input file scanner */
4 1.2 eeh /*
5 1.2 eeh * Copyright (c) 1998 Eduardo Horvath.
6 1.2 eeh * All rights reserved.
7 1.2 eeh *
8 1.2 eeh * Redistribution and use in source and binary forms, with or without
9 1.2 eeh * modification, are permitted provided that the following conditions
10 1.2 eeh * are met:
11 1.2 eeh * 1. Redistributions of source code must retain the above copyright
12 1.2 eeh * notice, this list of conditions and the following disclaimer.
13 1.2 eeh * 2. Redistributions in binary form must reproduce the above copyright
14 1.2 eeh * notice, this list of conditions and the following disclaimer in the
15 1.2 eeh * documentation and/or other materials provided with the distribution.
16 1.2 eeh *
17 1.2 eeh * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
18 1.2 eeh * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
19 1.2 eeh * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
20 1.2 eeh * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
21 1.2 eeh * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
22 1.2 eeh * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
23 1.2 eeh * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
24 1.2 eeh * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
25 1.2 eeh * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
26 1.2 eeh * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
27 1.2 eeh */
28 1.2 eeh /*
29 1.1 eeh Specifications are as follows:
30 1.1 eeh
31 1.1 eeh The function "yylex()" always returns a pointer to a structure:
32 1.1 eeh
33 1.1 eeh struct tok {
34 1.1 eeh int type;
35 1.1 eeh char *text;
36 1.1 eeh }
37 1.1 eeh #define TOKEN struct tok
38 1.1 eeh */
39 1.21 agc #include <sys/cdefs.h>
40 1.25 dmcmahil #ifdef HAVE_NBTOOL_CONFIG_H
41 1.25 dmcmahil #include "nbtool_config.h"
42 1.25 dmcmahil #endif
43 1.21 agc
44 1.22 lukem #if defined(__RCSID) && !defined(lint)
45 1.41 wiz __RCSID("$NetBSD: fgen.l,v 1.41 2024/05/20 20:46:05 wiz Exp $");
46 1.21 agc #endif
47 1.21 agc
48 1.1 eeh %}
49 1.8 tron
50 1.34 eeh %option yylineno
51 1.1 eeh
52 1.34 eeh hex [0-9A-Fa-f]
53 1.34 eeh hexdot [0-9A-Fa-f.]
54 1.1 eeh white [ \t\n\r\f]
55 1.1 eeh tail {white}
56 1.1 eeh
57 1.1 eeh %{
58 1.3 mrg #include <sys/types.h>
59 1.24 dmcmahil #include <arpa/inet.h>
60 1.3 mrg
61 1.3 mrg #include <assert.h>
62 1.7 tron #include <err.h>
63 1.1 eeh #include <errno.h>
64 1.3 mrg #include <fcntl.h>
65 1.6 mrg #include <stdarg.h>
66 1.1 eeh #include <stdio.h>
67 1.1 eeh #include <string.h>
68 1.2 eeh #include <unistd.h>
69 1.37 christos #include <util.h>
70 1.3 mrg
71 1.1 eeh #include "fgen.h"
72 1.35 joerg static TOKEN ltoken;
73 1.1 eeh
74 1.1 eeh /*
75 1.1 eeh * Global variables that control the parse state.
76 1.1 eeh */
77 1.1 eeh
78 1.35 joerg static struct fcode *dictionary = NULL;
79 1.35 joerg static struct macro *aliases = NULL;
80 1.35 joerg static int outf = 1; /* stdout */
81 1.35 joerg static int state = 0;
82 1.35 joerg static int nextfcode = 0x800;
83 1.35 joerg static int numbase = TOK_HEX;
84 1.35 joerg static long outpos;
85 1.35 joerg static char *outbuf = NULL;
86 1.35 joerg static char *outfile, *infile;
87 1.1 eeh #define BUFCLICK (1024*1024)
88 1.35 joerg static size_t outbufsiz = 0;
89 1.35 joerg static int offsetsize = 8;
90 1.35 joerg static int defining = 0;
91 1.35 joerg static int tokenizer = 0;
92 1.35 joerg static int need_end0 = 1;
93 1.1 eeh
94 1.1 eeh #define PSTKSIZ 1024
95 1.35 joerg static Cell parse_stack[PSTKSIZ];
96 1.35 joerg static int parse_stack_ptr = 0;
97 1.1 eeh
98 1.35 joerg static void token_err(int, const char *, const char *, const char *, ...)
99 1.35 joerg __printflike(4, 5) __dead;
100 1.35 joerg static YY_DECL;
101 1.2 eeh
102 1.35 joerg static int debug = 0;
103 1.1 eeh #define ASSERT if (debug) assert
104 1.37 christos #define STATE(y, x) do { if (debug) printf("%lx State %s: token `%s'\n", outpos, x, y); } while (0)
105 1.35 joerg static int mark_fload = 0;
106 1.3 mrg
107 1.1 eeh %}
108 1.1 eeh
109 1.33 christos %option nounput
110 1.33 christos
111 1.1 eeh %%
112 1.1 eeh
113 1.30 lukem 0 { ltoken.type = TOK_OTHER; ltoken.text = yytext; return <oken; }
114 1.1 eeh
115 1.30 lukem 1 { ltoken.type = TOK_OTHER; ltoken.text = yytext; return <oken; }
116 1.1 eeh
117 1.30 lukem 2 { ltoken.type = TOK_OTHER; ltoken.text = yytext; return <oken; }
118 1.1 eeh
119 1.30 lukem 3 { ltoken.type = TOK_OTHER; ltoken.text = yytext; return <oken; }
120 1.1 eeh
121 1.30 lukem -1 { ltoken.type = TOK_OTHER; ltoken.text = yytext; return <oken; }
122 1.19 eeh
123 1.30 lukem \. { ltoken.type = TOK_OTHER; ltoken.text = yytext; return <oken; }
124 1.1 eeh
125 1.1 eeh {white}* /* whitespace -- keep looping */ ;
126 1.1 eeh
127 1.1 eeh \\[^\n]*\n /* end of line comment -- keep looping */ { STATE(yytext, "EOL comment"); }
128 1.1 eeh
129 1.34 eeh -?{hex}{hexdot}* { ltoken.type = TOK_NUMBER; ltoken.text = yytext;
130 1.30 lukem return <oken; }
131 1.1 eeh
132 1.30 lukem \'.\' { ltoken.type = TOK_C_LIT; ltoken.text = yytext; return <oken; }
133 1.1 eeh
134 1.30 lukem \"{white}*(\\\"|[^"])*\" { ltoken.type = TOK_STRING_LIT; ltoken.text = yytext;
135 1.30 lukem return <oken; } /* String started by `"' or `."' */
136 1.1 eeh
137 1.30 lukem \.\({white}*(\\\"|[^)])*\) { ltoken.type = TOK_PSTRING; ltoken.text = yytext;
138 1.30 lukem return <oken; } /* String of type `.(.....)' */
139 1.1 eeh
140 1.30 lukem \.\"{white}*(\\\"|[^"])*\" { ltoken.type = TOK_PSTRING; ltoken.text = yytext;
141 1.30 lukem return <oken; }
142 1.1 eeh
143 1.34 eeh [aA][bB][oO][rR][tT]\"{white}*(\\\"|[^"])*\" { ltoken.type = TOK_ABORT_S;
144 1.34 eeh ltoken.text = yytext; return <oken; }
145 1.34 eeh
146 1.30 lukem "(" { ltoken.type = TOK_COMMENT; ltoken.text = yytext;
147 1.30 lukem return <oken; }
148 1.1 eeh
149 1.30 lukem ":" { ltoken.type = TOK_COLON; ltoken.text = yytext;
150 1.30 lukem return <oken; }
151 1.1 eeh
152 1.30 lukem ";" { ltoken.type = TOK_SEMICOLON; ltoken.text = yytext;
153 1.30 lukem return <oken; }
154 1.1 eeh
155 1.30 lukem \' { ltoken.type = TOK_TOKENIZE; ltoken.text = yytext;
156 1.30 lukem return <oken; }
157 1.1 eeh
158 1.30 lukem [aA][gG][aA][iI][nN] { ltoken.type = TOK_AGAIN; ltoken.text = yytext;
159 1.30 lukem return <oken; }
160 1.1 eeh
161 1.30 lukem [aA][lL][iI][aA][sS] { ltoken.type = TOK_ALIAS; ltoken.text = yytext;
162 1.30 lukem return <oken; }
163 1.1 eeh
164 1.30 lukem \[\'\] { ltoken.type = TOK_GETTOKEN; ltoken.text = yytext;
165 1.30 lukem return <oken; }
166 1.1 eeh
167 1.30 lukem [aA][sS][cC][iI][iI] { ltoken.type = TOK_ASCII; ltoken.text = yytext;
168 1.30 lukem return <oken; }
169 1.1 eeh
170 1.30 lukem [bB][eE][gG][iI][nN] { ltoken.type = TOK_BEGIN; ltoken.text = yytext;
171 1.30 lukem return <oken; }
172 1.1 eeh
173 1.30 lukem [bB][uU][fF][fF][eE][rR]: { ltoken.type = TOK_BUFFER; ltoken.text = yytext;
174 1.30 lukem return <oken; }
175 1.1 eeh
176 1.30 lukem [cC][aA][sS][eE] { ltoken.type = TOK_CASE; ltoken.text = yytext;
177 1.30 lukem return <oken; }
178 1.1 eeh
179 1.30 lukem [cC][oO][nN][sS][tT][aA][nN][tT] { ltoken.type = TOK_CONSTANT; ltoken.text = yytext;
180 1.30 lukem return <oken; }
181 1.1 eeh
182 1.30 lukem [cC][oO][nN][tT][rR][oO][lL] { ltoken.type = TOK_CONTROL; ltoken.text = yytext;
183 1.30 lukem return <oken; }
184 1.1 eeh
185 1.30 lukem [cC][rR][eE][aA][tT][eE] { ltoken.type = TOK_CREATE; ltoken.text = yytext;
186 1.30 lukem return <oken; }
187 1.1 eeh
188 1.30 lukem [dD]# { ltoken.type = TOK_DECIMAL; ltoken.text = yytext;
189 1.30 lukem return <oken; }
190 1.1 eeh
191 1.30 lukem [dD][eE][cC][iI][mM][aA][lL] { ltoken.type = TOK_DECIMAL; ltoken.text = yytext;
192 1.30 lukem return <oken; }
193 1.1 eeh
194 1.30 lukem [dD][eE][fF][eE][rR] { ltoken.type = TOK_DEFER; ltoken.text = yytext;
195 1.30 lukem return <oken; }
196 1.1 eeh
197 1.30 lukem \??[dD][oO] { ltoken.type = TOK_DO; ltoken.text = yytext;
198 1.30 lukem return <oken; }
199 1.1 eeh
200 1.30 lukem [eE][lL][sS][eE] { ltoken.type = TOK_ELSE; ltoken.text = yytext;
201 1.30 lukem return <oken; }
202 1.1 eeh
203 1.34 eeh [eE][nN][dD]0 { ltoken.type = TOK_END0; ltoken.text = yytext;
204 1.34 eeh return <oken; }
205 1.34 eeh
206 1.30 lukem [eE][nN][dD][cC][aA][sS][eE] { ltoken.type = TOK_ENDCASE; ltoken.text = yytext;
207 1.30 lukem return <oken; }
208 1.1 eeh
209 1.30 lukem [eE][nN][dD][oO][fF] { ltoken.type = TOK_ENDOF; ltoken.text = yytext;
210 1.30 lukem return <oken; }
211 1.1 eeh
212 1.30 lukem [eE][xX][tT][eE][rR][nN][aA][lL] { ltoken.type = TOK_EXTERNAL; ltoken.text = yytext;
213 1.30 lukem return <oken; }
214 1.1 eeh
215 1.34 eeh [fF][cC][oO][dD][eE]-[vV][eE][rR][sS][iI][oO][nN]2 {
216 1.34 eeh ltoken.type = TOK_FCODE_VERSION2; ltoken.text = yytext;
217 1.34 eeh return <oken; }
218 1.34 eeh
219 1.34 eeh [fF][cC][oO][dD][eE]-[eE][nN][dD] { ltoken.type = TOK_FCODE_END; ltoken.text = yytext;
220 1.34 eeh return <oken; }
221 1.34 eeh
222 1.30 lukem [fF][iI][eE][lL][dD] { ltoken.type = TOK_FIELD; ltoken.text = yytext;
223 1.30 lukem return <oken; }
224 1.1 eeh
225 1.30 lukem [hH]# { ltoken.type = TOK_HEX; ltoken.text = yytext;
226 1.30 lukem return <oken; }
227 1.1 eeh
228 1.30 lukem [hH][eE][aA][dD][eE][rR][lL][eE][sS][sS] { ltoken.type = TOK_HEADERLESS; ltoken.text = yytext;
229 1.30 lukem return <oken; }
230 1.1 eeh
231 1.30 lukem [hH][eE][aA][dD][eE][rR][sS] { ltoken.type = TOK_HEADERS; ltoken.text = yytext;
232 1.30 lukem return <oken; }
233 1.1 eeh
234 1.30 lukem [hH][eE][xX] { ltoken.type = TOK_HEX; ltoken.text = yytext;
235 1.30 lukem return <oken; }
236 1.1 eeh
237 1.30 lukem [iI][fF] { ltoken.type = TOK_IF; ltoken.text = yytext;
238 1.30 lukem return <oken; }
239 1.1 eeh
240 1.30 lukem \??[lL][eE][aA][vV][eE] { ltoken.type = TOK_LEAVE; ltoken.text = yytext;
241 1.30 lukem return <oken; }
242 1.1 eeh
243 1.30 lukem \+?[lL][oO][oO][pP] { ltoken.type = TOK_LOOP; ltoken.text = yytext;
244 1.30 lukem return <oken; }
245 1.1 eeh
246 1.30 lukem [oO]# { ltoken.type = TOK_OCTAL; ltoken.text = yytext;
247 1.30 lukem return <oken; }
248 1.1 eeh
249 1.30 lukem [oO][cC][tT][aA][lL] { ltoken.type = TOK_OCTAL; ltoken.text = yytext;
250 1.30 lukem return <oken; }
251 1.1 eeh
252 1.30 lukem [oO][fF] { ltoken.type = TOK_OF; ltoken.text = yytext;
253 1.30 lukem return <oken; }
254 1.1 eeh
255 1.34 eeh [oO][fF][fF][sS][eE][tT]16 { ltoken.type = TOK_OFFSET16; ltoken.text = yytext;
256 1.34 eeh return <oken; }
257 1.34 eeh
258 1.30 lukem [rR][eE][pP][eE][aA][tT] { ltoken.type = TOK_REPEAT; ltoken.text = yytext;
259 1.30 lukem return <oken; }
260 1.1 eeh
261 1.34 eeh [sS][tT][aA][rR][tT][0124] { ltoken.type = TOK_STARTX; ltoken.text = yytext;
262 1.34 eeh return <oken; }
263 1.34 eeh
264 1.30 lukem [tT][hH][eE][nN] { ltoken.type = TOK_THEN; ltoken.text = yytext;
265 1.30 lukem return <oken; }
266 1.1 eeh
267 1.30 lukem [tT][oO] { ltoken.type = TOK_TO; ltoken.text = yytext;
268 1.30 lukem return <oken; }
269 1.1 eeh
270 1.30 lukem [uU][nN][tT][iI][lL] { ltoken.type = TOK_UNTIL; ltoken.text = yytext;
271 1.30 lukem return <oken; }
272 1.1 eeh
273 1.30 lukem [vV][aA][lL][uU][eE] { ltoken.type = TOK_VALUE; ltoken.text = yytext;
274 1.30 lukem return <oken; }
275 1.1 eeh
276 1.30 lukem [vV][aA][rR][iI][aA][bB][lL][eE] { ltoken.type = TOK_VARIABLE; ltoken.text = yytext;
277 1.30 lukem return <oken; }
278 1.1 eeh
279 1.34 eeh [vV][eE][rR][sS][iI][oO][nN]1 { ltoken.type = TOK_VERSION1; ltoken.text = yytext;
280 1.30 lukem return <oken; }
281 1.1 eeh
282 1.34 eeh [wW][hH][iI][lL][eE] { ltoken.type = TOK_WHILE; ltoken.text = yytext;
283 1.30 lukem return <oken; }
284 1.1 eeh
285 1.30 lukem tokenizer\[ { ltoken.type = TOK_BEGTOK; ltoken.text = yytext;
286 1.30 lukem return <oken; }
287 1.1 eeh
288 1.30 lukem emit-byte { ltoken.type = TOK_EMIT_BYTE; ltoken.text = yytext;
289 1.30 lukem return <oken; }
290 1.1 eeh
291 1.30 lukem \]tokenizer { ltoken.type = TOK_ENDTOK; ltoken.text = yytext;
292 1.30 lukem return <oken; }
293 1.1 eeh
294 1.34 eeh [fF][lL][oO][aA][dD] { ltoken.type = TOK_FLOAD; ltoken.text = yytext;
295 1.30 lukem return <oken; }
296 1.1 eeh
297 1.1 eeh
298 1.30 lukem [^ \n\t\r\f]+ { ltoken.type = TOK_OTHER; ltoken.text = yytext;
299 1.30 lukem return <oken; }
300 1.1 eeh
301 1.1 eeh <<EOF>> { return NULL; }
302 1.1 eeh %%
303 1.1 eeh
304 1.1 eeh /* Function definitions */
305 1.35 joerg static void push(Cell);
306 1.35 joerg static Cell pop(void);
307 1.35 joerg static int depth(void);
308 1.35 joerg static int fadd(struct fcode *, struct fcode *);
309 1.35 joerg static struct fcode *flookup(struct fcode *, const char *);
310 1.35 joerg static int aadd(struct macro *, struct macro *);
311 1.35 joerg static struct macro *alookup(struct macro *, const char *);
312 1.35 joerg static void initdic(void);
313 1.37 christos __dead static void usage(void);
314 1.35 joerg static void tokenize(YY_BUFFER_STATE);
315 1.35 joerg static int emit(const char *);
316 1.35 joerg static int spit(long);
317 1.35 joerg static int offspit(long);
318 1.35 joerg static void sspit(const char *);
319 1.35 joerg static int apply_macros(YY_BUFFER_STATE, const char *);
320 1.35 joerg static Cell cvt(const char *, char **, int base);
321 1.1 eeh
322 1.1 eeh /*
323 1.1 eeh * Standard FCode names and numbers. Includes standard
324 1.1 eeh * tokenizer aliases.
325 1.1 eeh */
326 1.35 joerg static struct fcode fcodes[] = {
327 1.30 lukem { "end0", 0x0000, 0, NULL, NULL },
328 1.30 lukem { "b(lit)", 0x0010, 0, NULL, NULL },
329 1.30 lukem { "b(')", 0x0011, 0, NULL, NULL },
330 1.30 lukem { "b(\")", 0x0012, 0, NULL, NULL },
331 1.30 lukem { "bbranch", 0x0013, 0, NULL, NULL },
332 1.30 lukem { "b?branch", 0x0014, 0, NULL, NULL },
333 1.30 lukem { "b(loop)", 0x0015, 0, NULL, NULL },
334 1.30 lukem { "b(+loop)", 0x0016, 0, NULL, NULL },
335 1.30 lukem { "b(do)", 0x0017, 0, NULL, NULL },
336 1.30 lukem { "b(?do)", 0x0018, 0, NULL, NULL },
337 1.30 lukem { "i", 0x0019, 0, NULL, NULL },
338 1.30 lukem { "j", 0x001a, 0, NULL, NULL },
339 1.30 lukem { "b(leave)", 0x001b, 0, NULL, NULL },
340 1.30 lukem { "b(of)", 0x001c, 0, NULL, NULL },
341 1.30 lukem { "execute", 0x001d, 0, NULL, NULL },
342 1.30 lukem { "+", 0x001e, 0, NULL, NULL },
343 1.30 lukem { "-", 0x001f, 0, NULL, NULL },
344 1.30 lukem { "*", 0x0020, 0, NULL, NULL },
345 1.30 lukem { "/", 0x0021, 0, NULL, NULL },
346 1.30 lukem { "mod", 0x0022, 0, NULL, NULL },
347 1.30 lukem { "and", 0x0023, 0, NULL, NULL },
348 1.30 lukem { "or", 0x0024, 0, NULL, NULL },
349 1.30 lukem { "xor", 0x0025, 0, NULL, NULL },
350 1.30 lukem { "invert", 0x0026, 0, NULL, NULL },
351 1.30 lukem { "lshift", 0x0027, 0, NULL, NULL },
352 1.30 lukem { "rshift", 0x0028, 0, NULL, NULL },
353 1.30 lukem { ">>a", 0x0029, 0, NULL, NULL },
354 1.30 lukem { "/mod", 0x002a, 0, NULL, NULL },
355 1.30 lukem { "u/mod", 0x002b, 0, NULL, NULL },
356 1.30 lukem { "negate", 0x002c, 0, NULL, NULL },
357 1.30 lukem { "abs", 0x002d, 0, NULL, NULL },
358 1.30 lukem { "min", 0x002e, 0, NULL, NULL },
359 1.30 lukem { "max", 0x002f, 0, NULL, NULL },
360 1.30 lukem { ">r", 0x0030, 0, NULL, NULL },
361 1.30 lukem { "r>", 0x0031, 0, NULL, NULL },
362 1.30 lukem { "r@", 0x0032, 0, NULL, NULL },
363 1.30 lukem { "exit", 0x0033, 0, NULL, NULL },
364 1.30 lukem { "0=", 0x0034, 0, NULL, NULL },
365 1.30 lukem { "0<>", 0x0035, 0, NULL, NULL },
366 1.30 lukem { "0<", 0x0036, 0, NULL, NULL },
367 1.30 lukem { "0<=", 0x0037, 0, NULL, NULL },
368 1.30 lukem { "0>", 0x0038, 0, NULL, NULL },
369 1.30 lukem { "0>=", 0x0039, 0, NULL, NULL },
370 1.30 lukem { "<", 0x003a, 0, NULL, NULL },
371 1.30 lukem { ">", 0x003b, 0, NULL, NULL },
372 1.30 lukem { "=", 0x003c, 0, NULL, NULL },
373 1.30 lukem { "<>", 0x003d, 0, NULL, NULL },
374 1.30 lukem { "u>", 0x003e, 0, NULL, NULL },
375 1.30 lukem { "u<=", 0x003f, 0, NULL, NULL },
376 1.30 lukem { "u<", 0x0040, 0, NULL, NULL },
377 1.30 lukem { "u>=", 0x0041, 0, NULL, NULL },
378 1.30 lukem { ">=", 0x0042, 0, NULL, NULL },
379 1.30 lukem { "<=", 0x0043, 0, NULL, NULL },
380 1.30 lukem { "between", 0x0044, 0, NULL, NULL },
381 1.30 lukem { "within", 0x0045, 0, NULL, NULL },
382 1.30 lukem { "drop", 0x0046, 0, NULL, NULL },
383 1.30 lukem { "dup", 0x0047, 0, NULL, NULL },
384 1.30 lukem { "over", 0x0048, 0, NULL, NULL },
385 1.30 lukem { "swap", 0x0049, 0, NULL, NULL },
386 1.30 lukem { "rot", 0x004a, 0, NULL, NULL },
387 1.30 lukem { "-rot", 0x004b, 0, NULL, NULL },
388 1.30 lukem { "tuck", 0x004c, 0, NULL, NULL },
389 1.30 lukem { "nip", 0x004d, 0, NULL, NULL },
390 1.30 lukem { "pick", 0x004e, 0, NULL, NULL },
391 1.30 lukem { "roll", 0x004f, 0, NULL, NULL },
392 1.30 lukem { "?dup", 0x0050, 0, NULL, NULL },
393 1.30 lukem { "depth", 0x0051, 0, NULL, NULL },
394 1.30 lukem { "2drop", 0x0052, 0, NULL, NULL },
395 1.30 lukem { "2dup", 0x0053, 0, NULL, NULL },
396 1.30 lukem { "2over", 0x0054, 0, NULL, NULL },
397 1.30 lukem { "2swap", 0x0055, 0, NULL, NULL },
398 1.30 lukem { "2rot", 0x0056, 0, NULL, NULL },
399 1.30 lukem { "2/", 0x0057, 0, NULL, NULL },
400 1.30 lukem { "u2/", 0x0058, 0, NULL, NULL },
401 1.30 lukem { "2*", 0x0059, 0, NULL, NULL },
402 1.30 lukem { "/c", 0x005a, 0, NULL, NULL },
403 1.30 lukem { "/w", 0x005b, 0, NULL, NULL },
404 1.30 lukem { "/l", 0x005c, 0, NULL, NULL },
405 1.30 lukem { "/n", 0x005d, 0, NULL, NULL },
406 1.30 lukem { "ca+", 0x005e, 0, NULL, NULL },
407 1.30 lukem { "wa+", 0x005f, 0, NULL, NULL },
408 1.30 lukem { "la+", 0x0060, 0, NULL, NULL },
409 1.30 lukem { "na+", 0x0061, 0, NULL, NULL },
410 1.30 lukem { "char+", 0x0062, 0, NULL, NULL },
411 1.30 lukem { "wa1+", 0x0063, 0, NULL, NULL },
412 1.30 lukem { "la1+", 0x0064, 0, NULL, NULL },
413 1.30 lukem { "cell+", 0x0065, 0, NULL, NULL },
414 1.30 lukem { "chars", 0x0066, 0, NULL, NULL },
415 1.30 lukem { "/w*", 0x0067, 0, NULL, NULL },
416 1.30 lukem { "/l*", 0x0068, 0, NULL, NULL },
417 1.30 lukem { "cells", 0x0069, 0, NULL, NULL },
418 1.30 lukem { "on", 0x006a, 0, NULL, NULL },
419 1.30 lukem { "off", 0x006b, 0, NULL, NULL },
420 1.30 lukem { "+!", 0x006c, 0, NULL, NULL },
421 1.30 lukem { "@", 0x006d, 0, NULL, NULL },
422 1.30 lukem { "l@", 0x006e, 0, NULL, NULL },
423 1.30 lukem { "w@", 0x006f, 0, NULL, NULL },
424 1.30 lukem { "<w@", 0x0070, 0, NULL, NULL },
425 1.30 lukem { "c@", 0x0071, 0, NULL, NULL },
426 1.30 lukem { "!", 0x0072, 0, NULL, NULL },
427 1.30 lukem { "l!", 0x0073, 0, NULL, NULL },
428 1.30 lukem { "w!", 0x0074, 0, NULL, NULL },
429 1.30 lukem { "c!", 0x0075, 0, NULL, NULL },
430 1.30 lukem { "2@", 0x0076, 0, NULL, NULL },
431 1.30 lukem { "2!", 0x0077, 0, NULL, NULL },
432 1.30 lukem { "move", 0x0078, 0, NULL, NULL },
433 1.30 lukem { "fill", 0x0079, 0, NULL, NULL },
434 1.30 lukem { "comp", 0x007a, 0, NULL, NULL },
435 1.30 lukem { "noop", 0x007b, 0, NULL, NULL },
436 1.30 lukem { "lwsplit", 0x007c, 0, NULL, NULL },
437 1.30 lukem { "wjoin", 0x007d, 0, NULL, NULL },
438 1.30 lukem { "lbsplit", 0x007e, 0, NULL, NULL },
439 1.30 lukem { "bljoin", 0x007f, 0, NULL, NULL },
440 1.30 lukem { "wbflip", 0x0080, 0, NULL, NULL },
441 1.30 lukem { "upc", 0x0081, 0, NULL, NULL },
442 1.30 lukem { "lcc", 0x0082, 0, NULL, NULL },
443 1.30 lukem { "pack", 0x0083, 0, NULL, NULL },
444 1.30 lukem { "count", 0x0084, 0, NULL, NULL },
445 1.30 lukem { "body>", 0x0085, 0, NULL, NULL },
446 1.30 lukem { ">body", 0x0086, 0, NULL, NULL },
447 1.30 lukem { "fcode-revision", 0x0087, 0, NULL, NULL },
448 1.30 lukem { "span", 0x0088, 0, NULL, NULL },
449 1.30 lukem { "unloop", 0x0089, 0, NULL, NULL },
450 1.30 lukem { "expect", 0x008a, 0, NULL, NULL },
451 1.30 lukem { "alloc-mem", 0x008b, 0, NULL, NULL },
452 1.30 lukem { "free-mem", 0x008c, 0, NULL, NULL },
453 1.30 lukem { "key?", 0x008d, 0, NULL, NULL },
454 1.30 lukem { "key", 0x008e, 0, NULL, NULL },
455 1.30 lukem { "emit", 0x008f, 0, NULL, NULL },
456 1.30 lukem { "type", 0x0090, 0, NULL, NULL },
457 1.30 lukem { "(cr", 0x0091, 0, NULL, NULL },
458 1.30 lukem { "cr", 0x0092, 0, NULL, NULL },
459 1.30 lukem { "#out", 0x0093, 0, NULL, NULL },
460 1.30 lukem { "#line", 0x0094, 0, NULL, NULL },
461 1.30 lukem { "hold", 0x0095, 0, NULL, NULL },
462 1.30 lukem { "<#", 0x0096, 0, NULL, NULL },
463 1.30 lukem { "u#>", 0x0097, 0, NULL, NULL },
464 1.30 lukem { "sign", 0x0098, 0, NULL, NULL },
465 1.30 lukem { "u#", 0x0099, 0, NULL, NULL },
466 1.30 lukem { "u#s", 0x009a, 0, NULL, NULL },
467 1.30 lukem { "u.", 0x009b, 0, NULL, NULL },
468 1.30 lukem { "u.r", 0x009c, 0, NULL, NULL },
469 1.30 lukem { ".", 0x009d, 0, NULL, NULL },
470 1.30 lukem { ".r", 0x009e, 0, NULL, NULL },
471 1.30 lukem { ".s", 0x009f, 0, NULL, NULL },
472 1.30 lukem { "base", 0x00a0, 0, NULL, NULL },
473 1.30 lukem { "convert", 0x00a1, 0, NULL, NULL },
474 1.30 lukem { "$number", 0x00a2, 0, NULL, NULL },
475 1.30 lukem { "digit", 0x00a3, 0, NULL, NULL },
476 1.30 lukem { "-1", 0x00a4, 0, NULL, NULL },
477 1.30 lukem { "true", 0x00a4, 0, NULL, NULL },
478 1.30 lukem { "0", 0x00a5, 0, NULL, NULL },
479 1.30 lukem { "1", 0x00a6, 0, NULL, NULL },
480 1.30 lukem { "2", 0x00a7, 0, NULL, NULL },
481 1.30 lukem { "3", 0x00a8, 0, NULL, NULL },
482 1.30 lukem { "bl", 0x00a9, 0, NULL, NULL },
483 1.30 lukem { "bs", 0x00aa, 0, NULL, NULL },
484 1.30 lukem { "bell", 0x00ab, 0, NULL, NULL },
485 1.30 lukem { "bounds", 0x00ac, 0, NULL, NULL },
486 1.30 lukem { "here", 0x00ad, 0, NULL, NULL },
487 1.30 lukem { "aligned", 0x00ae, 0, NULL, NULL },
488 1.30 lukem { "wbsplit", 0x00af, 0, NULL, NULL },
489 1.30 lukem { "bwjoin", 0x00b0, 0, NULL, NULL },
490 1.30 lukem { "b(<mark)", 0x00b1, 0, NULL, NULL },
491 1.30 lukem { "b(>resolve)", 0x00b2, 0, NULL, NULL },
492 1.30 lukem { "set-token-table", 0x00b3, 0, NULL, NULL },
493 1.30 lukem { "set-table", 0x00b4, 0, NULL, NULL },
494 1.30 lukem { "new-token", 0x00b5, 0, NULL, NULL },
495 1.30 lukem { "named-token", 0x00b6, 0, NULL, NULL },
496 1.30 lukem { "b(:)", 0x00b7, 0, NULL, NULL },
497 1.30 lukem { "b(value)", 0x00b8, 0, NULL, NULL },
498 1.30 lukem { "b(variable)", 0x00b9, 0, NULL, NULL },
499 1.30 lukem { "b(constant)", 0x00ba, 0, NULL, NULL },
500 1.30 lukem { "b(create)", 0x00bb, 0, NULL, NULL },
501 1.30 lukem { "b(defer)", 0x00bc, 0, NULL, NULL },
502 1.30 lukem { "b(buffer:)", 0x00bd, 0, NULL, NULL },
503 1.30 lukem { "b(field)", 0x00be, 0, NULL, NULL },
504 1.30 lukem { "b(code)", 0x00bf, 0, NULL, NULL },
505 1.30 lukem { "instance", 0x00c0, 0, NULL, NULL },
506 1.30 lukem { "b(;)", 0x00c2, 0, NULL, NULL },
507 1.30 lukem { "b(to)", 0x00c3, 0, NULL, NULL },
508 1.30 lukem { "b(case)", 0x00c4, 0, NULL, NULL },
509 1.30 lukem { "b(endcase)", 0x00c5, 0, NULL, NULL },
510 1.30 lukem { "b(endof)", 0x00c6, 0, NULL, NULL },
511 1.30 lukem { "#", 0x00c7, 0, NULL, NULL },
512 1.30 lukem { "#s", 0x00c8, 0, NULL, NULL },
513 1.30 lukem { "#>", 0x00c9, 0, NULL, NULL },
514 1.30 lukem { "external-token", 0x00ca, 0, NULL, NULL },
515 1.30 lukem { "$find", 0x00cb, 0, NULL, NULL },
516 1.30 lukem { "offset16", 0x00cc, 0, NULL, NULL },
517 1.30 lukem { "evaluate", 0x00cd, 0, NULL, NULL },
518 1.30 lukem { "c,", 0x00d0, 0, NULL, NULL },
519 1.30 lukem { "w,", 0x00d1, 0, NULL, NULL },
520 1.30 lukem { "l,", 0x00d2, 0, NULL, NULL },
521 1.34 eeh { ",", 0x00d3, 0, NULL, NULL },
522 1.30 lukem { "um*", 0x00d4, 0, NULL, NULL },
523 1.30 lukem { "um/mod", 0x00d5, 0, NULL, NULL },
524 1.30 lukem { "d+", 0x00d8, 0, NULL, NULL },
525 1.30 lukem { "d-", 0x00d9, 0, NULL, NULL },
526 1.30 lukem { "get-token", 0x00da, 0, NULL, NULL },
527 1.30 lukem { "set-token", 0x00db, 0, NULL, NULL },
528 1.30 lukem { "state", 0x00dc, 0, NULL, NULL },
529 1.30 lukem { "compile,", 0x00dd, 0, NULL, NULL },
530 1.30 lukem { "behavior", 0x00de, 0, NULL, NULL },
531 1.30 lukem { "start0", 0x00f0, 0, NULL, NULL },
532 1.30 lukem { "start1", 0x00f1, 0, NULL, NULL },
533 1.30 lukem { "start2", 0x00f2, 0, NULL, NULL },
534 1.30 lukem { "start4", 0x00f3, 0, NULL, NULL },
535 1.30 lukem { "ferror", 0x00fc, 0, NULL, NULL },
536 1.30 lukem { "version1", 0x00fd, 0, NULL, NULL },
537 1.30 lukem { "4-byte-id", 0x00fe, 0, NULL, NULL },
538 1.30 lukem { "end1", 0x00ff, 0, NULL, NULL },
539 1.30 lukem { "dma-alloc", 0x0101, 0, NULL, NULL },
540 1.30 lukem { "my-address", 0x0102, 0, NULL, NULL },
541 1.30 lukem { "my-space", 0x0103, 0, NULL, NULL },
542 1.30 lukem { "memmap", 0x0104, 0, NULL, NULL },
543 1.30 lukem { "free-virtual", 0x0105, 0, NULL, NULL },
544 1.30 lukem { ">physical", 0x0106, 0, NULL, NULL },
545 1.30 lukem { "my-params", 0x010f, 0, NULL, NULL },
546 1.30 lukem { "property", 0x0110, 0, NULL, NULL },
547 1.30 lukem { "encode-int", 0x0111, 0, NULL, NULL },
548 1.30 lukem { "encode+", 0x0112, 0, NULL, NULL },
549 1.30 lukem { "encode-phys", 0x0113, 0, NULL, NULL },
550 1.30 lukem { "encode-string", 0x0114, 0, NULL, NULL },
551 1.30 lukem { "encode-bytes", 0x0115, 0, NULL, NULL },
552 1.30 lukem { "reg", 0x0116, 0, NULL, NULL },
553 1.30 lukem { "intr", 0x0117, 0, NULL, NULL },
554 1.30 lukem { "driver", 0x0118, 0, NULL, NULL },
555 1.30 lukem { "model", 0x0119, 0, NULL, NULL },
556 1.30 lukem { "device-type", 0x011a, 0, NULL, NULL },
557 1.30 lukem { "parse-2int", 0x011b, 0, NULL, NULL },
558 1.30 lukem { "is-install", 0x011c, 0, NULL, NULL },
559 1.30 lukem { "is-remove", 0x011d, 0, NULL, NULL },
560 1.30 lukem { "is-selftest", 0x011e, 0, NULL, NULL },
561 1.30 lukem { "new-device", 0x011f, 0, NULL, NULL },
562 1.30 lukem { "diagnostic-mode?", 0x0120, 0, NULL, NULL },
563 1.30 lukem { "display-status", 0x0121, 0, NULL, NULL },
564 1.30 lukem { "memory-test-suite", 0x0122, 0, NULL, NULL },
565 1.30 lukem { "group-code", 0x0123, 0, NULL, NULL },
566 1.30 lukem { "mask", 0x0124, 0, NULL, NULL },
567 1.30 lukem { "get-msecs", 0x0125, 0, NULL, NULL },
568 1.30 lukem { "ms", 0x0126, 0, NULL, NULL },
569 1.34 eeh { "finish-device", 0x0127, 0, NULL, NULL },
570 1.30 lukem { "decode-phys", 0x0128, 0, NULL, NULL },
571 1.30 lukem { "map-low", 0x0130, 0, NULL, NULL },
572 1.30 lukem { "sbus-intr>cpu", 0x0131, 0, NULL, NULL },
573 1.30 lukem { "#lines", 0x0150, 0, NULL, NULL },
574 1.30 lukem { "#columns", 0x0151, 0, NULL, NULL },
575 1.30 lukem { "line#", 0x0152, 0, NULL, NULL },
576 1.30 lukem { "column#", 0x0153, 0, NULL, NULL },
577 1.30 lukem { "inverse?", 0x0154, 0, NULL, NULL },
578 1.30 lukem { "inverse-screen?", 0x0155, 0, NULL, NULL },
579 1.30 lukem { "frame-buffer-busy?", 0x0156, 0, NULL, NULL },
580 1.30 lukem { "draw-character", 0x0157, 0, NULL, NULL },
581 1.30 lukem { "reset-screen", 0x0158, 0, NULL, NULL },
582 1.30 lukem { "toggle-cursor", 0x0159, 0, NULL, NULL },
583 1.30 lukem { "erase-screen", 0x015a, 0, NULL, NULL },
584 1.30 lukem { "blink-screen", 0x015b, 0, NULL, NULL },
585 1.30 lukem { "invert-screen", 0x015c, 0, NULL, NULL },
586 1.30 lukem { "insert-characters", 0x015d, 0, NULL, NULL },
587 1.30 lukem { "delete-characters", 0x015e, 0, NULL, NULL },
588 1.30 lukem { "insert-lines", 0x015f, 0, NULL, NULL },
589 1.30 lukem { "delete-lines", 0x0160, 0, NULL, NULL },
590 1.30 lukem { "draw-logo", 0x0161, 0, NULL, NULL },
591 1.30 lukem { "frame-buffer-addr", 0x0162, 0, NULL, NULL },
592 1.30 lukem { "screen-height", 0x0163, 0, NULL, NULL },
593 1.30 lukem { "screen-width", 0x0164, 0, NULL, NULL },
594 1.30 lukem { "window-top", 0x0165, 0, NULL, NULL },
595 1.30 lukem { "window-left", 0x0166, 0, NULL, NULL },
596 1.30 lukem { "default-font", 0x016a, 0, NULL, NULL },
597 1.30 lukem { "set-font", 0x016b, 0, NULL, NULL },
598 1.30 lukem { "char-height", 0x016c, 0, NULL, NULL },
599 1.30 lukem { "char-width", 0x016d, 0, NULL, NULL },
600 1.30 lukem { ">font", 0x016e, 0, NULL, NULL },
601 1.30 lukem { "fontbytes", 0x016f, 0, NULL, NULL },
602 1.30 lukem { "fb8-draw-character", 0x0180, 0, NULL, NULL },
603 1.30 lukem { "fb8-reset-screen", 0x0181, 0, NULL, NULL },
604 1.30 lukem { "fb8-toggle-cursor", 0x0182, 0, NULL, NULL },
605 1.30 lukem { "fb8-erase-screen", 0x0183, 0, NULL, NULL },
606 1.30 lukem { "fb8-blink-screen", 0x0184, 0, NULL, NULL },
607 1.30 lukem { "fb8-invert-screen", 0x0185, 0, NULL, NULL },
608 1.30 lukem { "fb8-insert-characters", 0x0186, 0, NULL, NULL },
609 1.30 lukem { "fb8-delete-characters", 0x0187, 0, NULL, NULL },
610 1.30 lukem { "fb8-inisert-lines", 0x0188, 0, NULL, NULL },
611 1.30 lukem { "fb8-delete-lines", 0x0189, 0, NULL, NULL },
612 1.30 lukem { "fb8-draw-logo", 0x018a, 0, NULL, NULL },
613 1.30 lukem { "fb8-install", 0x018b, 0, NULL, NULL },
614 1.30 lukem { "return-buffer", 0x01a0, 0, NULL, NULL },
615 1.30 lukem { "xmit-packet", 0x01a1, 0, NULL, NULL },
616 1.30 lukem { "poll-packet", 0x01a2, 0, NULL, NULL },
617 1.30 lukem { "mac-address", 0x01a4, 0, NULL, NULL },
618 1.30 lukem { "device-name", 0x0201, 0, NULL, NULL },
619 1.30 lukem { "my-args", 0x0202, 0, NULL, NULL },
620 1.30 lukem { "my-self", 0x0203, 0, NULL, NULL },
621 1.30 lukem { "find-package", 0x0204, 0, NULL, NULL },
622 1.30 lukem { "open-package", 0x0205, 0, NULL, NULL },
623 1.30 lukem { "close-package", 0x0206, 0, NULL, NULL },
624 1.30 lukem { "find-method", 0x0207, 0, NULL, NULL },
625 1.30 lukem { "call-package", 0x0208, 0, NULL, NULL },
626 1.30 lukem { "$call-parent", 0x0209, 0, NULL, NULL },
627 1.30 lukem { "my-parent", 0x020a, 0, NULL, NULL },
628 1.30 lukem { "ihandle>phandle", 0x020b, 0, NULL, NULL },
629 1.30 lukem { "my-unit", 0x020d, 0, NULL, NULL },
630 1.30 lukem { "$call-method", 0x020e, 0, NULL, NULL },
631 1.30 lukem { "$open-package", 0x020f, 0, NULL, NULL },
632 1.30 lukem { "processor-type", 0x0210, 0, NULL, NULL },
633 1.30 lukem { "firmware-version", 0x0211, 0, NULL, NULL },
634 1.30 lukem { "fcode-version", 0x0212, 0, NULL, NULL },
635 1.30 lukem { "alarm", 0x0213, 0, NULL, NULL },
636 1.30 lukem { "(is-user-word)", 0x0214, 0, NULL, NULL },
637 1.30 lukem { "suspend-fcode", 0x0215, 0, NULL, NULL },
638 1.30 lukem { "abort", 0x0216, 0, NULL, NULL },
639 1.30 lukem { "catch", 0x0217, 0, NULL, NULL },
640 1.30 lukem { "throw", 0x0218, 0, NULL, NULL },
641 1.30 lukem { "user-abort", 0x0219, 0, NULL, NULL },
642 1.30 lukem { "get-my-property", 0x021a, 0, NULL, NULL },
643 1.30 lukem { "decode-int", 0x021b, 0, NULL, NULL },
644 1.30 lukem { "decode-string", 0x021c, 0, NULL, NULL },
645 1.30 lukem { "get-inherited-property", 0x021d, 0, NULL, NULL },
646 1.30 lukem { "delete-property", 0x021e, 0, NULL, NULL },
647 1.30 lukem { "get-package-property", 0x021f, 0, NULL, NULL },
648 1.30 lukem { "cpeek", 0x0220, 0, NULL, NULL },
649 1.30 lukem { "wpeek", 0x0221, 0, NULL, NULL },
650 1.30 lukem { "lpeek", 0x0222, 0, NULL, NULL },
651 1.30 lukem { "cpoke", 0x0223, 0, NULL, NULL },
652 1.30 lukem { "wpoke", 0x0224, 0, NULL, NULL },
653 1.30 lukem { "lpoke", 0x0225, 0, NULL, NULL },
654 1.30 lukem { "lwflip", 0x0226, 0, NULL, NULL },
655 1.30 lukem { "lbflip", 0x0227, 0, NULL, NULL },
656 1.30 lukem { "lbflips", 0x0228, 0, NULL, NULL },
657 1.30 lukem { "adr-mask", 0x0229, 0, NULL, NULL },
658 1.30 lukem { "rb@", 0x0230, 0, NULL, NULL },
659 1.30 lukem { "rb!", 0x0231, 0, NULL, NULL },
660 1.30 lukem { "rw@", 0x0232, 0, NULL, NULL },
661 1.30 lukem { "rw!", 0x0233, 0, NULL, NULL },
662 1.30 lukem { "rl@", 0x0234, 0, NULL, NULL },
663 1.30 lukem { "rl!", 0x0235, 0, NULL, NULL },
664 1.30 lukem { "wbflips", 0x0236, 0, NULL, NULL },
665 1.30 lukem { "lwflips", 0x0237, 0, NULL, NULL },
666 1.30 lukem { "probe", 0x0238, 0, NULL, NULL },
667 1.30 lukem { "probe-virtual", 0x0239, 0, NULL, NULL },
668 1.30 lukem { "child", 0x023b, 0, NULL, NULL },
669 1.30 lukem { "peer", 0x023c, 0, NULL, NULL },
670 1.30 lukem { "next-property", 0x023d, 0, NULL, NULL },
671 1.30 lukem { "byte-load", 0x023e, 0, NULL, NULL },
672 1.30 lukem { "set-args", 0x023f, 0, NULL, NULL },
673 1.30 lukem { "left-parse-string", 0x0240, 0, NULL, NULL },
674 1.1 eeh /* 64-bit FCode extensions */
675 1.30 lukem { "bxjoin", 0x0241, 0, NULL, NULL },
676 1.30 lukem { "<l@", 0x0242, 0, NULL, NULL },
677 1.30 lukem { "lxjoin", 0x0243, 0, NULL, NULL },
678 1.30 lukem { "rx@", 0x022e, 0, NULL, NULL },
679 1.30 lukem { "rx!", 0x022f, 0, NULL, NULL },
680 1.30 lukem { "wxjoin", 0x0244, 0, NULL, NULL },
681 1.30 lukem { "x,", 0x0245, 0, NULL, NULL },
682 1.30 lukem { "x@", 0x0246, 0, NULL, NULL },
683 1.30 lukem { "x!", 0x0247, 0, NULL, NULL },
684 1.30 lukem { "/x", 0x0248, 0, NULL, NULL },
685 1.30 lukem { "/x*", 0x0249, 0, NULL, NULL },
686 1.30 lukem { "xa+", 0x024a, 0, NULL, NULL },
687 1.30 lukem { "xa1+", 0x024b, 0, NULL, NULL },
688 1.30 lukem { "xbflip", 0x024c, 0, NULL, NULL },
689 1.30 lukem { "xbflips", 0x024d, 0, NULL, NULL },
690 1.30 lukem { "xbsplit", 0x024e, 0, NULL, NULL },
691 1.30 lukem { "xlflip", 0x024f, 0, NULL, NULL },
692 1.30 lukem { "xlflips", 0x0250, 0, NULL, NULL },
693 1.30 lukem { "xlsplit", 0x0251, 0, NULL, NULL },
694 1.30 lukem { "xwflip", 0x0252, 0, NULL, NULL },
695 1.30 lukem { "xwflips", 0x0253, 0, NULL, NULL },
696 1.30 lukem { "xwsplit", 0x0254, 0, NULL, NULL },
697 1.30 lukem { NULL, 0, 0, NULL, NULL }
698 1.1 eeh };
699 1.1 eeh
700 1.1 eeh /*
701 1.1 eeh * Default macros -- can be overridden by colon definitions.
702 1.1 eeh */
703 1.35 joerg static struct macro macros[] = {
704 1.30 lukem { "eval", "evaluate", 0, NULL, NULL }, /* Build a more balanced tree */
705 1.30 lukem { "(.)", "dup abs <# u#s swap sign u#>", 0, NULL, NULL },
706 1.30 lukem { "<<", "lshift", 0, NULL, NULL },
707 1.30 lukem { ">>", "rshift", 0, NULL, NULL },
708 1.30 lukem { "?", "@ .", 0, NULL, NULL },
709 1.30 lukem { "1+", "1 +", 0, NULL, NULL },
710 1.30 lukem { "1-", "1 -", 0, NULL, NULL },
711 1.30 lukem { "2+", "2 +", 0, NULL, NULL },
712 1.30 lukem { "2-", "2 -", 0, NULL, NULL },
713 1.30 lukem { "abort\"", "-2 throw", 0, NULL, NULL },
714 1.30 lukem { "accept", "span @ -rot expect span @ swap span !", 0, NULL, NULL },
715 1.30 lukem { "allot", "0 max 0 ?do 0 c, loop", 0, NULL, NULL },
716 1.30 lukem { "blank", "bl fill", 0, NULL, NULL },
717 1.30 lukem { "/c*", "chars", 0, NULL, NULL },
718 1.30 lukem { "ca1+", "char+", 0, NULL, NULL },
719 1.34 eeh { "carret", "b(lit) 00 00 00 h# 0d", 0, NULL, NULL },
720 1.34 eeh { ".d", "base @ swap d# 0a base ! . base !", 0, NULL, NULL },
721 1.30 lukem { "decode-bytes", ">r over r@ + swap r@ - rot r>", 0, NULL, NULL },
722 1.30 lukem { "3drop", "drop 2drop", 0, NULL, NULL },
723 1.30 lukem { "3dup", "2 pick 2 pick 2 pick", 0, NULL, NULL },
724 1.30 lukem { "erase", "0 fill", 0, NULL, NULL },
725 1.30 lukem { "false", "0", 0, NULL, NULL },
726 1.34 eeh { ".h", "base @ swap d# 10 base ! . base !", 0, NULL, NULL },
727 1.34 eeh { "linefeed", "b(lit) 00 00 00 d# 0a", 0, NULL, NULL },
728 1.30 lukem { "/n*", "cells", 0, NULL, NULL },
729 1.30 lukem { "na1+", "cell+", 0, NULL, NULL },
730 1.30 lukem { "not", "invert", 0, NULL, NULL },
731 1.30 lukem { "s.", "(.) type space", 0, NULL, NULL },
732 1.30 lukem { "space", "bl emit", 0, NULL, NULL },
733 1.30 lukem { "spaces", "0 max 0 ?do space loop", 0, NULL, NULL },
734 1.30 lukem { "struct", "0", 0, NULL, NULL },
735 1.30 lukem { "true", "-1", 0, NULL, NULL },
736 1.30 lukem { "(u,)", "<# u#s u#>", 0, NULL, NULL },
737 1.30 lukem { NULL, NULL, 0, NULL, NULL }
738 1.1 eeh };
739 1.1 eeh
740 1.1 eeh /*
741 1.13 eeh * Utility functions.
742 1.13 eeh */
743 1.13 eeh
744 1.13 eeh /*
745 1.13 eeh * ASCII -> long int converter, eats `.'s
746 1.13 eeh */
747 1.13 eeh #define strtol(x, y, z) cvt(x, y, z)
748 1.35 joerg static Cell
749 1.30 lukem cvt(const char *s, char **e, int base)
750 1.13 eeh {
751 1.14 eeh Cell v = 0;
752 1.13 eeh int c, n = 0;
753 1.13 eeh
754 1.13 eeh c = *s;
755 1.13 eeh if (c == '-') { n = 1; s++; }
756 1.13 eeh
757 1.13 eeh for (c = *s; (c = *s); s++) {
758 1.13 eeh
759 1.13 eeh /* Ignore `.' */
760 1.13 eeh if (c == '.')
761 1.13 eeh continue;
762 1.13 eeh if (c >= '0' && c <= '9')
763 1.13 eeh c -= '0';
764 1.13 eeh else if (c >= 'a' && c <= 'f')
765 1.13 eeh c += 10 - 'a';
766 1.13 eeh else if (c >= 'A' && c <= 'F')
767 1.13 eeh c += 10 - 'A';
768 1.13 eeh if (c >= base)
769 1.13 eeh break;
770 1.13 eeh v *= base;
771 1.13 eeh v += c;
772 1.13 eeh }
773 1.13 eeh if (e)
774 1.30 lukem *e = __UNCONST(s);
775 1.13 eeh if (n)
776 1.13 eeh return (-v);
777 1.13 eeh return (v);
778 1.13 eeh }
779 1.13 eeh
780 1.13 eeh /*
781 1.1 eeh * Parser stack control functions.
782 1.1 eeh */
783 1.1 eeh
784 1.35 joerg static void
785 1.28 lukem push(Cell val)
786 1.1 eeh {
787 1.34 eeh if (debug > 1)
788 1.34 eeh printf("push %lx\n", (long)val);
789 1.1 eeh parse_stack[parse_stack_ptr++] = val;
790 1.37 christos if (parse_stack_ptr >= PSTKSIZ)
791 1.37 christos errx(EXIT_FAILURE, "Parse stack overflow");
792 1.1 eeh }
793 1.1 eeh
794 1.35 joerg static Cell
795 1.28 lukem pop(void)
796 1.1 eeh {
797 1.1 eeh ASSERT(parse_stack_ptr);
798 1.34 eeh if (debug > 1)
799 1.34 eeh printf("pop %lx\n", (long)parse_stack[parse_stack_ptr-1]);
800 1.1 eeh return parse_stack[--parse_stack_ptr];
801 1.1 eeh }
802 1.1 eeh
803 1.35 joerg static int
804 1.28 lukem depth(void)
805 1.4 eeh {
806 1.4 eeh return (parse_stack_ptr);
807 1.4 eeh }
808 1.4 eeh
809 1.1 eeh /*
810 1.1 eeh * Insert fcode into dictionary.
811 1.1 eeh */
812 1.35 joerg static int
813 1.28 lukem fadd(struct fcode *dict, struct fcode *new)
814 1.1 eeh {
815 1.1 eeh int res = strcmp(dict->name, new->name);
816 1.1 eeh
817 1.1 eeh new->type = FCODE;
818 1.1 eeh ASSERT(dict->type == FCODE);
819 1.34 eeh if (!res) {
820 1.34 eeh /*
821 1.34 eeh * Duplicate entry. Give the old name the new FCode
822 1.34 eeh * number.
823 1.34 eeh */
824 1.34 eeh dict->num = new->num;
825 1.34 eeh return (0);
826 1.34 eeh }
827 1.1 eeh if (res < 0) {
828 1.1 eeh if (dict->l)
829 1.2 eeh return fadd(dict->l, new);
830 1.1 eeh else {
831 1.34 eeh if (debug > 5)
832 1.37 christos printf("fadd: new FCode `%s' is %lx\n",
833 1.1 eeh new->name, new->num);
834 1.1 eeh new->l = new->r = NULL;
835 1.1 eeh dict->l = new;
836 1.1 eeh }
837 1.1 eeh } else {
838 1.1 eeh if (dict->r)
839 1.2 eeh return fadd(dict->r, new);
840 1.1 eeh else {
841 1.34 eeh if (debug > 5)
842 1.37 christos printf("fadd: new FCode `%s' is %lx\n",
843 1.1 eeh new->name, new->num);
844 1.1 eeh new->l = new->r = NULL;
845 1.1 eeh dict->r = new;
846 1.1 eeh }
847 1.1 eeh }
848 1.1 eeh return (1);
849 1.1 eeh }
850 1.1 eeh
851 1.1 eeh /*
852 1.1 eeh * Look for a code in the dictionary.
853 1.1 eeh */
854 1.35 joerg static struct fcode *
855 1.30 lukem flookup(struct fcode *dict, const char *str)
856 1.1 eeh {
857 1.1 eeh int res;
858 1.1 eeh if (!dict) return (dict);
859 1.1 eeh
860 1.1 eeh res = strcmp(dict->name, str);
861 1.1 eeh ASSERT(dict->type == FCODE);
862 1.34 eeh if (debug > 5)
863 1.37 christos printf("flookup: `%s' and `%s' %s match\n",
864 1.1 eeh str, dict->name, res?"don't":"do");
865 1.1 eeh if (!res) return (dict);
866 1.1 eeh if (res < 0)
867 1.1 eeh return (flookup(dict->l, str));
868 1.1 eeh else
869 1.1 eeh return (flookup(dict->r, str));
870 1.1 eeh
871 1.1 eeh }
872 1.1 eeh
873 1.1 eeh /*
874 1.1 eeh * Insert alias into macros.
875 1.1 eeh */
876 1.35 joerg static int
877 1.28 lukem aadd(struct macro *dict, struct macro *new)
878 1.1 eeh {
879 1.1 eeh int res = strcmp(dict->name, new->name);
880 1.1 eeh
881 1.1 eeh new->type = MACRO;
882 1.1 eeh ASSERT(dict->type == MACRO);
883 1.34 eeh if (!res) {
884 1.34 eeh /* Duplicate name. Replace the old macro */
885 1.34 eeh dict->equiv = new->equiv;
886 1.34 eeh /* We can't free the old equiv since it may be static data. */
887 1.34 eeh return (0);
888 1.34 eeh }
889 1.1 eeh if (res < 0) {
890 1.1 eeh if (dict->l)
891 1.2 eeh return aadd(dict->l, new);
892 1.1 eeh else {
893 1.1 eeh new->l = new->r = NULL;
894 1.1 eeh dict->l = new;
895 1.34 eeh if (debug > 5)
896 1.37 christos printf("aadd: new alias `%s' to `%s'\n",
897 1.1 eeh new->name, new->equiv);
898 1.1 eeh }
899 1.1 eeh } else {
900 1.1 eeh if (dict->r)
901 1.2 eeh return aadd(dict->r, new);
902 1.1 eeh else {
903 1.1 eeh new->l = new->r = NULL;
904 1.1 eeh dict->r = new;
905 1.34 eeh if (debug > 5)
906 1.37 christos printf("aadd: new alias `%s' to `%s'\n",
907 1.1 eeh new->name, new->equiv);
908 1.1 eeh }
909 1.1 eeh }
910 1.1 eeh return (1);
911 1.1 eeh }
912 1.1 eeh
913 1.1 eeh /*
914 1.1 eeh * Look for a macro in the aliases.
915 1.1 eeh */
916 1.35 joerg static struct macro *
917 1.30 lukem alookup(struct macro *dict, const char *str)
918 1.1 eeh {
919 1.1 eeh int res;
920 1.1 eeh if (!dict) return (dict);
921 1.1 eeh
922 1.1 eeh ASSERT(dict->type == MACRO);
923 1.1 eeh res = strcmp(dict->name, str);
924 1.1 eeh if (!res) return (dict);
925 1.1 eeh if (res < 0)
926 1.1 eeh return (alookup(dict->l, str));
927 1.1 eeh else
928 1.1 eeh return (alookup(dict->r, str));
929 1.1 eeh
930 1.1 eeh }
931 1.1 eeh
932 1.1 eeh /*
933 1.1 eeh * Bootstrap the dictionary and then install
934 1.1 eeh * all the standard FCodes.
935 1.1 eeh */
936 1.35 joerg static void
937 1.28 lukem initdic(void)
938 1.1 eeh {
939 1.1 eeh struct fcode *code = fcodes;
940 1.1 eeh struct macro *alias = macros;
941 1.1 eeh
942 1.1 eeh ASSERT(dictionary == NULL);
943 1.1 eeh code->l = code->r = NULL;
944 1.1 eeh dictionary = code;
945 1.1 eeh code->type = FCODE;
946 1.1 eeh
947 1.1 eeh while ((++code)->name) {
948 1.1 eeh if(!fadd(dictionary, code)) {
949 1.37 christos warnx("%s: duplicate dictionary entry `%s'", __func__,
950 1.37 christos code->name);
951 1.1 eeh }
952 1.1 eeh }
953 1.1 eeh
954 1.1 eeh ASSERT(aliases == NULL);
955 1.1 eeh aliases = alias;
956 1.1 eeh alias->l = alias->r = NULL;
957 1.1 eeh alias->type = MACRO;
958 1.1 eeh while ((++alias)->name) {
959 1.1 eeh if(!aadd(aliases, alias)) {
960 1.37 christos warnx("%s: duplicate macro entry `%s'", __func__,
961 1.37 christos alias->name);
962 1.1 eeh }
963 1.1 eeh }
964 1.1 eeh
965 1.1 eeh }
966 1.1 eeh
967 1.35 joerg static int
968 1.30 lukem apply_macros(YY_BUFFER_STATE yinput, const char *str)
969 1.1 eeh {
970 1.1 eeh struct macro *xform = alookup(aliases, str);
971 1.1 eeh
972 1.1 eeh if (xform) {
973 1.1 eeh YY_BUFFER_STATE newbuf;
974 1.1 eeh
975 1.34 eeh if (debug > 1)
976 1.34 eeh printf("Expanding %s to %s\n", str, xform->equiv);
977 1.34 eeh
978 1.1 eeh newbuf = yy_scan_string(xform->equiv);
979 1.1 eeh yy_switch_to_buffer(newbuf);
980 1.1 eeh tokenize(newbuf);
981 1.30 lukem yy_switch_to_buffer(yinput);
982 1.1 eeh yy_delete_buffer(newbuf);
983 1.1 eeh }
984 1.1 eeh return (xform != NULL);
985 1.1 eeh }
986 1.1 eeh
987 1.35 joerg static void
988 1.37 christos usage(void)
989 1.1 eeh {
990 1.41 wiz (void)fprintf(stderr, "usage: %s [-d level] [-o outfile] infile\n",
991 1.41 wiz getprogname());
992 1.37 christos exit(EXIT_FAILURE);
993 1.1 eeh }
994 1.1 eeh
995 1.1 eeh int
996 1.28 lukem main(int argc, char *argv[])
997 1.1 eeh {
998 1.36 christos int ch;
999 1.1 eeh FILE *inf;
1000 1.1 eeh struct fcode_header *fheader;
1001 1.1 eeh YY_BUFFER_STATE inbuf;
1002 1.30 lukem const char *hdrtype = "version1";
1003 1.1 eeh int i;
1004 1.1 eeh
1005 1.1 eeh outf = 1; /* stdout */
1006 1.1 eeh
1007 1.1 eeh while ((ch = getopt(argc, argv, "d:o:")) != -1)
1008 1.1 eeh switch(ch) {
1009 1.1 eeh case 'd':
1010 1.34 eeh mark_fload = 1;
1011 1.1 eeh debug = atol(optarg);
1012 1.1 eeh break;
1013 1.1 eeh case 'o':
1014 1.6 mrg outfile = optarg;
1015 1.1 eeh break;
1016 1.1 eeh default:
1017 1.37 christos usage();
1018 1.1 eeh }
1019 1.1 eeh argc -= optind;
1020 1.1 eeh argv += optind;
1021 1.1 eeh
1022 1.6 mrg if (argc != 1)
1023 1.37 christos usage();
1024 1.1 eeh
1025 1.6 mrg infile = argv[0];
1026 1.6 mrg
1027 1.1 eeh /*
1028 1.1 eeh * Initialization stuff.
1029 1.1 eeh */
1030 1.1 eeh initdic();
1031 1.1 eeh outbufsiz = BUFCLICK;
1032 1.37 christos fheader = emalloc(outbufsiz);
1033 1.37 christos outbuf = (void *)fheader;
1034 1.1 eeh outpos = 0;
1035 1.1 eeh emit(hdrtype);
1036 1.1 eeh outpos = sizeof(*fheader);
1037 1.1 eeh
1038 1.1 eeh /*
1039 1.1 eeh * Do it.
1040 1.1 eeh */
1041 1.6 mrg if ((inf = fopen(infile, "r")) == NULL)
1042 1.37 christos err(EXIT_FAILURE, "Cannot open `%s'", infile);
1043 1.1 eeh
1044 1.37 christos inbuf = yy_create_buffer(inf, YY_BUF_SIZE);
1045 1.1 eeh yy_switch_to_buffer(inbuf);
1046 1.3 mrg tokenize(inbuf);
1047 1.1 eeh yy_delete_buffer(inbuf);
1048 1.1 eeh fclose(inf);
1049 1.34 eeh if (need_end0) emit("end0");
1050 1.1 eeh
1051 1.1 eeh /* Now calculate length and checksum and stick them in the header */
1052 1.1 eeh fheader->format = 0x08;
1053 1.2 eeh fheader->length = htonl(outpos);
1054 1.1 eeh fheader->checksum = 0;
1055 1.1 eeh for (i = sizeof(*fheader); i<outpos; i++)
1056 1.34 eeh fheader->checksum += (unsigned char)outbuf[i];
1057 1.2 eeh fheader->checksum = htons(fheader->checksum);
1058 1.1 eeh
1059 1.17 bjh21 if ((outf = open(outfile, O_WRONLY|O_CREAT|O_TRUNC, 0666)) == -1)
1060 1.37 christos err(EXIT_FAILURE, "Cannot open `%s'", outfile);
1061 1.6 mrg
1062 1.1 eeh if (write(outf, outbuf, outpos) != outpos) {
1063 1.37 christos int serrno = errno;
1064 1.1 eeh close(outf);
1065 1.6 mrg unlink(outfile);
1066 1.37 christos errc(EXIT_FAILURE, serrno, "write error");
1067 1.1 eeh }
1068 1.1 eeh close(outf);
1069 1.37 christos return EXIT_SUCCESS;
1070 1.1 eeh };
1071 1.1 eeh
1072 1.1 eeh /*
1073 1.1 eeh * Tokenize one file. This is a separate function so it can
1074 1.40 andvar * be called recursively to parse multiple levels of include files.
1075 1.1 eeh */
1076 1.1 eeh
1077 1.35 joerg static void
1078 1.30 lukem tokenize(YY_BUFFER_STATE yinput)
1079 1.1 eeh {
1080 1.1 eeh FILE *inf;
1081 1.1 eeh YY_BUFFER_STATE inbuf;
1082 1.1 eeh TOKEN *token;
1083 1.30 lukem const char *last_token = "";
1084 1.1 eeh struct fcode *fcode;
1085 1.1 eeh int pos, off;
1086 1.1 eeh
1087 1.1 eeh while ((token = yylex()) != NULL) {
1088 1.1 eeh switch (token->type) {
1089 1.1 eeh case TOK_NUMBER:
1090 1.1 eeh STATE(token->text, "TOK_NUMBER");
1091 1.1 eeh {
1092 1.1 eeh char *end;
1093 1.1 eeh Cell value;
1094 1.1 eeh
1095 1.1 eeh if (tokenizer) {
1096 1.1 eeh push(strtol(token->text, &end, 16));
1097 1.1 eeh break;
1098 1.1 eeh }
1099 1.30 lukem value = strtol(token->text, &end, numbase);
1100 1.6 mrg if (*end != 0)
1101 1.6 mrg token_err(yylineno, infile, yytext,
1102 1.6 mrg "illegal number conversion");
1103 1.6 mrg
1104 1.1 eeh /*
1105 1.1 eeh * If this is a 64-bit value we need to store two literals
1106 1.1 eeh * and issue a `lxjoin' to combine them. But that's a future
1107 1.1 eeh * project.
1108 1.1 eeh */
1109 1.1 eeh emit("b(lit)");
1110 1.13 eeh spit((value>>24)&0x0ff);
1111 1.1 eeh spit((value>>16)&0x0ff);
1112 1.1 eeh spit((value>>8)&0x0ff);
1113 1.1 eeh spit(value&0x0ff);
1114 1.13 eeh if ((value>>32) != value && (value>>32) != 0 &&
1115 1.13 eeh (value>>32) != -1) {
1116 1.13 eeh emit("b(lit)");
1117 1.13 eeh spit((value>>56)&0x0ff);
1118 1.13 eeh spit((value>>48)&0x0ff);
1119 1.13 eeh spit((value>>40)&0x0ff);
1120 1.13 eeh spit((value>>32)&0x0ff);
1121 1.13 eeh emit("lxjoin");
1122 1.13 eeh }
1123 1.1 eeh }
1124 1.1 eeh break;
1125 1.1 eeh case TOK_C_LIT:
1126 1.1 eeh STATE(token->text, "TOK_C_LIT");
1127 1.1 eeh emit("b(lit)");
1128 1.1 eeh spit(0);
1129 1.1 eeh spit(0);
1130 1.1 eeh spit(0);
1131 1.1 eeh spit(token->text[1]);
1132 1.3 mrg break;
1133 1.1 eeh case TOK_STRING_LIT:
1134 1.1 eeh STATE(token->text, "TOK_STRING_LIT:");
1135 1.1 eeh {
1136 1.37 christos size_t len;
1137 1.1 eeh char *p = token->text;
1138 1.1 eeh
1139 1.1 eeh ++p; /* Skip the quote */
1140 1.1 eeh len = strlen(++p); /* Skip the 1st space */
1141 1.6 mrg
1142 1.6 mrg #define ERR_TOOLONG \
1143 1.37 christos token_err(yylineno, infile, yytext, "string length %zu too long", len)
1144 1.6 mrg
1145 1.6 mrg if (len > 255)
1146 1.6 mrg ERR_TOOLONG;
1147 1.6 mrg
1148 1.1 eeh if (p[len-1] == ')' ||
1149 1.1 eeh p[len-1] == '"') {
1150 1.1 eeh p[len-1] = 0;
1151 1.1 eeh }
1152 1.1 eeh emit("b(\")");
1153 1.1 eeh sspit(p);
1154 1.1 eeh }
1155 1.1 eeh break;
1156 1.1 eeh case TOK_PSTRING:
1157 1.1 eeh STATE(token->text, "TOK_PSTRING:");
1158 1.1 eeh {
1159 1.37 christos size_t len;
1160 1.1 eeh char *p = token->text;
1161 1.1 eeh
1162 1.1 eeh if (*p++ == '.') p++; /* Skip over delimiter */
1163 1.1 eeh p++; /* Skip over space/tab */
1164 1.1 eeh
1165 1.1 eeh len = strlen(p);
1166 1.6 mrg if (len > 255)
1167 1.6 mrg ERR_TOOLONG;
1168 1.6 mrg
1169 1.1 eeh if (p[len-1] == ')' ||
1170 1.1 eeh p[len-1] == '"') {
1171 1.1 eeh p[len-1] = 0;
1172 1.1 eeh }
1173 1.1 eeh emit("b(\")");
1174 1.1 eeh sspit(p);
1175 1.1 eeh emit("type");
1176 1.1 eeh }
1177 1.1 eeh break;
1178 1.34 eeh case TOK_ABORT_S:
1179 1.34 eeh STATE(token->text, "TOK_PSTRING:");
1180 1.34 eeh {
1181 1.37 christos size_t len;
1182 1.34 eeh Cell value = -2;
1183 1.34 eeh char *p = token->text;
1184 1.34 eeh
1185 1.34 eeh while (*p++ != ' '); /* Skip to the string */
1186 1.34 eeh
1187 1.34 eeh len = strlen(p);
1188 1.34 eeh if (len > 255)
1189 1.34 eeh ERR_TOOLONG;
1190 1.34 eeh
1191 1.34 eeh if (p[len-1] == '"') {
1192 1.34 eeh p[len-1] = 0;
1193 1.34 eeh }
1194 1.34 eeh emit("b?branch");
1195 1.34 eeh push(outpos);
1196 1.34 eeh offspit(0);
1197 1.34 eeh emit("b(\")");
1198 1.34 eeh sspit(p);
1199 1.34 eeh emit("type");
1200 1.34 eeh emit("cr");
1201 1.34 eeh emit("b(lit)");
1202 1.34 eeh spit((value>>24)&0x0ff);
1203 1.34 eeh spit((value>>16)&0x0ff);
1204 1.34 eeh spit((value>>8)&0x0ff);
1205 1.34 eeh spit(value&0x0ff);
1206 1.34 eeh emit("throw");
1207 1.34 eeh emit("b(>resolve)");
1208 1.34 eeh pos = outpos;
1209 1.34 eeh outpos = pop();
1210 1.34 eeh off = pos - outpos;
1211 1.34 eeh offspit(off);
1212 1.34 eeh outpos = pos;
1213 1.34 eeh }
1214 1.34 eeh break;
1215 1.34 eeh
1216 1.1 eeh case TOK_TOKENIZE:
1217 1.1 eeh STATE(token->text, "TOK_TOKENIZE");
1218 1.1 eeh /* The next pass should tokenize the FCODE number */
1219 1.1 eeh emit("b(')");
1220 1.1 eeh break;
1221 1.1 eeh case TOK_COMMENT:
1222 1.1 eeh STATE(token->text, "TOK_COMMENT:");
1223 1.34 eeh do {
1224 1.34 eeh off = input();
1225 1.34 eeh } while ((off != ')') && (off != '\n') &&
1226 1.34 eeh (off != EOF));
1227 1.1 eeh break;
1228 1.1 eeh case TOK_COLON:
1229 1.1 eeh STATE(token->text, "TOK_COLON:");
1230 1.1 eeh
1231 1.1 eeh token = yylex();
1232 1.6 mrg if (token == NULL)
1233 1.6 mrg token_err(yylineno, infile, yytext,
1234 1.6 mrg "EOF in colon definition");
1235 1.1 eeh
1236 1.1 eeh /* Add new code to dictionary */
1237 1.37 christos fcode = emalloc(sizeof(*fcode));
1238 1.1 eeh fcode->num = nextfcode++;
1239 1.37 christos fcode->name = estrdup(token->text);
1240 1.34 eeh if (!fadd(dictionary, fcode)) {
1241 1.34 eeh /* Duplicate definition. Free the memory. */
1242 1.34 eeh if (debug)
1243 1.37 christos printf("%s: duplicate FCode\n",
1244 1.34 eeh token->text);
1245 1.34 eeh free(__UNCONST(fcode->name));
1246 1.34 eeh free(fcode);
1247 1.34 eeh }
1248 1.6 mrg if (debug)
1249 1.37 christos printf("Adding %s to dictionary\n", token->text);
1250 1.1 eeh if (state == 0)
1251 1.1 eeh emit("new-token");
1252 1.1 eeh else {
1253 1.1 eeh if (state == TOK_EXTERNAL)
1254 1.1 eeh emit("external-token");
1255 1.1 eeh else
1256 1.1 eeh /* Here we have a choice of new-token or named-token */
1257 1.1 eeh emit("named-token");
1258 1.1 eeh sspit(token->text);
1259 1.1 eeh }
1260 1.1 eeh spit(fcode->num);
1261 1.1 eeh emit("b(:)");
1262 1.4 eeh last_token = fcode->name;
1263 1.1 eeh defining = 1;
1264 1.1 eeh break;
1265 1.1 eeh case TOK_SEMICOLON:
1266 1.1 eeh STATE(token->text, "TOK_SEMICOLON:");
1267 1.1 eeh emit("b(;)");
1268 1.1 eeh defining = 0;
1269 1.4 eeh if (depth()) {
1270 1.6 mrg token_err(yylineno, infile, NULL,
1271 1.6 mrg "Warning: stack depth %d at end of %s\n",
1272 1.6 mrg depth(), last_token);
1273 1.4 eeh }
1274 1.4 eeh last_token = "";
1275 1.1 eeh break;
1276 1.1 eeh
1277 1.1 eeh /* These are special */
1278 1.1 eeh case TOK_AGAIN:
1279 1.1 eeh STATE(token->text, "TOK_AGAIN");
1280 1.1 eeh emit("bbranch");
1281 1.1 eeh pos = pop();
1282 1.34 eeh pos = pos - outpos;
1283 1.34 eeh offspit(pos);
1284 1.1 eeh break;
1285 1.1 eeh case TOK_ALIAS:
1286 1.1 eeh STATE(token->text, "TOK_ALIAS");
1287 1.1 eeh {
1288 1.1 eeh struct macro *alias;
1289 1.1 eeh
1290 1.1 eeh token = yylex();
1291 1.1 eeh if (token == NULL) {
1292 1.37 christos warnx("EOF in alias definition");
1293 1.3 mrg return;
1294 1.1 eeh }
1295 1.1 eeh if (token->type != TOK_OTHER) {
1296 1.37 christos warnx("ENDCOMMENT aliasing weird token type %d",
1297 1.37 christos token->type);
1298 1.1 eeh }
1299 1.37 christos alias = emalloc(sizeof(*alias));
1300 1.37 christos alias->name = estrdup(token->text);
1301 1.1 eeh token = yylex();
1302 1.1 eeh if (token == NULL) {
1303 1.37 christos warnx("EOF in alias definition");
1304 1.37 christos free(__UNCONST(alias->name));
1305 1.37 christos free(alias);
1306 1.3 mrg return;
1307 1.1 eeh }
1308 1.37 christos alias->equiv = estrdup(token->text);
1309 1.1 eeh if (!aadd(aliases, alias)) {
1310 1.34 eeh free(__UNCONST(alias->name));
1311 1.34 eeh free(alias);
1312 1.1 eeh }
1313 1.1 eeh }
1314 1.1 eeh break;
1315 1.1 eeh case TOK_GETTOKEN:
1316 1.1 eeh STATE(token->text, "TOK_GETTOKEN");
1317 1.1 eeh /* This is caused by ['] */
1318 1.1 eeh emit("b(')");
1319 1.1 eeh token = yylex();
1320 1.1 eeh if (token == NULL) {
1321 1.37 christos warnx("EOF in [']");
1322 1.3 mrg return;
1323 1.1 eeh }
1324 1.37 christos if ((fcode = flookup(dictionary, token->text)) == NULL)
1325 1.37 christos errx(EXIT_FAILURE, "[']: %s not found",
1326 1.37 christos token->text);
1327 1.1 eeh spit(fcode->num);
1328 1.1 eeh break;
1329 1.1 eeh case TOK_ASCII:
1330 1.1 eeh STATE(token->text, "TOK_ASCII");
1331 1.1 eeh token = yylex();
1332 1.37 christos if (token == NULL)
1333 1.37 christos errx(EXIT_FAILURE, "EOF after \"ascii\"");
1334 1.1 eeh emit("b(lit)");
1335 1.1 eeh spit(0);
1336 1.1 eeh spit(0);
1337 1.1 eeh spit(0);
1338 1.1 eeh spit(token->text[0]);
1339 1.1 eeh break;
1340 1.1 eeh case TOK_BEGIN:
1341 1.1 eeh STATE(token->text, "TOK_BEGIN");
1342 1.1 eeh emit("b(<mark)");
1343 1.1 eeh push(outpos);
1344 1.1 eeh break;
1345 1.1 eeh case TOK_BUFFER:
1346 1.1 eeh STATE(token->text, "TOK_BUFFER");
1347 1.1 eeh
1348 1.1 eeh token = yylex();
1349 1.1 eeh if (token == NULL) {
1350 1.37 christos warnx("EOF in colon definition");
1351 1.3 mrg return;
1352 1.1 eeh }
1353 1.1 eeh
1354 1.1 eeh /* Add new code to dictionary */
1355 1.37 christos fcode = emalloc(sizeof(*fcode));
1356 1.1 eeh fcode->num = nextfcode++;
1357 1.37 christos fcode->name = estrdup(token->text);
1358 1.1 eeh fadd(dictionary, fcode);
1359 1.1 eeh
1360 1.1 eeh if (state == 0)
1361 1.1 eeh emit("new-token");
1362 1.1 eeh else {
1363 1.1 eeh if (state == TOK_EXTERNAL)
1364 1.1 eeh emit("external-token");
1365 1.1 eeh else
1366 1.1 eeh /* Here we have a choice of new-token or named-token */
1367 1.1 eeh emit("named-token");
1368 1.1 eeh sspit(token->text);
1369 1.1 eeh }
1370 1.1 eeh spit(fcode->num);
1371 1.1 eeh emit("b(buffer:)");
1372 1.1 eeh break;
1373 1.1 eeh case TOK_CASE:
1374 1.1 eeh STATE(token->text, "TOK_CASE");
1375 1.1 eeh emit("b(case)");
1376 1.1 eeh push(0);
1377 1.1 eeh break;
1378 1.1 eeh case TOK_CONSTANT:
1379 1.1 eeh STATE(token->text, "TOK_CONSTANT");
1380 1.1 eeh
1381 1.1 eeh token = yylex();
1382 1.1 eeh if (token == NULL) {
1383 1.37 christos warnx("EOF in constant definition");
1384 1.3 mrg return;
1385 1.1 eeh }
1386 1.1 eeh
1387 1.1 eeh /* Add new code to dictionary */
1388 1.37 christos fcode = emalloc(sizeof(*fcode));
1389 1.1 eeh fcode->num = nextfcode++;
1390 1.37 christos fcode->name = estrdup(token->text);
1391 1.1 eeh fadd(dictionary, fcode);
1392 1.1 eeh
1393 1.1 eeh if (state == 0)
1394 1.1 eeh emit("new-token");
1395 1.1 eeh else {
1396 1.1 eeh if (state == TOK_EXTERNAL)
1397 1.1 eeh emit("external-token");
1398 1.1 eeh else
1399 1.1 eeh /* Here we have a choice of new-token or named-token */
1400 1.1 eeh emit("named-token");
1401 1.1 eeh sspit(token->text);
1402 1.1 eeh }
1403 1.1 eeh spit(fcode->num);
1404 1.1 eeh emit("b(constant)");
1405 1.1 eeh break;
1406 1.1 eeh case TOK_CONTROL:
1407 1.1 eeh STATE(token->text, "TOK_CONTROL");
1408 1.1 eeh token = yylex();
1409 1.37 christos if (token == NULL)
1410 1.37 christos errx(EXIT_FAILURE, "EOF after \"ascii\"");
1411 1.1 eeh emit("b(lit)");
1412 1.1 eeh spit(0);
1413 1.1 eeh spit(0);
1414 1.1 eeh spit(0);
1415 1.1 eeh spit(token->text[0]&0x1f);
1416 1.1 eeh break;
1417 1.1 eeh case TOK_CREATE:
1418 1.1 eeh STATE(token->text, "TOK_CREATE");
1419 1.1 eeh /* Don't know what this does or if it's right */
1420 1.1 eeh token = yylex();
1421 1.1 eeh if (token == NULL) {
1422 1.37 christos warnx("EOF in create definition");
1423 1.3 mrg return;
1424 1.1 eeh }
1425 1.1 eeh
1426 1.1 eeh /* Add new code to dictionary */
1427 1.37 christos fcode = emalloc(sizeof(*fcode));
1428 1.1 eeh fcode->num = nextfcode++;
1429 1.37 christos fcode->name = estrdup(token->text);
1430 1.1 eeh fadd(dictionary, fcode);
1431 1.1 eeh
1432 1.1 eeh if (state == 0)
1433 1.1 eeh emit("new-token");
1434 1.1 eeh else {
1435 1.1 eeh if (state == TOK_EXTERNAL)
1436 1.1 eeh emit("external-token");
1437 1.1 eeh else
1438 1.1 eeh /* Here we have a choice of new-token or named-token */
1439 1.1 eeh emit("named-token");
1440 1.1 eeh sspit(token->text);
1441 1.1 eeh }
1442 1.1 eeh spit(fcode->num);
1443 1.1 eeh emit("b(create)");
1444 1.1 eeh break;
1445 1.1 eeh case TOK_DECIMAL:
1446 1.1 eeh STATE(token->text, "TOK_DECIMAL");
1447 1.1 eeh if (token->text[1] != '#') {
1448 1.1 eeh if (defining) {
1449 1.34 eeh emit("b(lit)");
1450 1.34 eeh spit(0);
1451 1.34 eeh spit(0);
1452 1.34 eeh spit(0);
1453 1.1 eeh spit(10);
1454 1.1 eeh emit("base");
1455 1.1 eeh emit("!");
1456 1.1 eeh } else
1457 1.30 lukem numbase = TOK_DECIMAL;
1458 1.1 eeh } else {
1459 1.1 eeh char *end;
1460 1.1 eeh Cell value;
1461 1.1 eeh
1462 1.1 eeh token = yylex();
1463 1.1 eeh if (token == NULL) {
1464 1.37 christos warnx("EOF after d#");
1465 1.3 mrg return;
1466 1.1 eeh }
1467 1.1 eeh if (token->type == TOK_OTHER) {
1468 1.1 eeh if (strcmp("-1", token->text) == 0) {
1469 1.1 eeh emit(token->text);
1470 1.1 eeh break;
1471 1.1 eeh }
1472 1.1 eeh }
1473 1.1 eeh value = strtol(token->text, &end, 10);
1474 1.6 mrg if (*end != 0)
1475 1.6 mrg token_err(yylineno, infile, NULL,
1476 1.6 mrg "Illegal number conversion: %s", token->text);
1477 1.6 mrg
1478 1.1 eeh /*
1479 1.1 eeh * If this is a 64-bit value we need to store two literals
1480 1.1 eeh * and issue a `lxjoin' to combine them. But that's a future
1481 1.1 eeh * project.
1482 1.1 eeh */
1483 1.1 eeh emit("b(lit)");
1484 1.13 eeh spit((value>>24)&0x0ff);
1485 1.1 eeh spit((value>>16)&0x0ff);
1486 1.1 eeh spit((value>>8)&0x0ff);
1487 1.1 eeh spit(value&0x0ff);
1488 1.15 eeh if ((value>>32) != value && (value>>32) != 0) {
1489 1.13 eeh emit("b(lit)");
1490 1.13 eeh spit((value>>56)&0x0ff);
1491 1.13 eeh spit((value>>48)&0x0ff);
1492 1.13 eeh spit((value>>40)&0x0ff);
1493 1.13 eeh spit((value>>32)&0x0ff);
1494 1.13 eeh emit("lxjoin");
1495 1.13 eeh }
1496 1.1 eeh }
1497 1.1 eeh break;
1498 1.1 eeh case TOK_DEFER:
1499 1.1 eeh STATE(token->text, "TOK_DEFER");
1500 1.1 eeh /* Don't know what this does or if it's right */
1501 1.1 eeh token = yylex();
1502 1.1 eeh if (token == NULL) {
1503 1.37 christos warnx("EOF in colon definition");
1504 1.3 mrg return;
1505 1.1 eeh }
1506 1.1 eeh
1507 1.1 eeh /* Add new code to dictionary */
1508 1.37 christos fcode = emalloc(sizeof(*fcode));
1509 1.1 eeh fcode->num = nextfcode++;
1510 1.37 christos fcode->name = estrdup(token->text);
1511 1.1 eeh fadd(dictionary, fcode);
1512 1.1 eeh
1513 1.1 eeh if (state == 0)
1514 1.1 eeh emit("new-token");
1515 1.1 eeh else {
1516 1.1 eeh if (state == TOK_EXTERNAL)
1517 1.1 eeh emit("external-token");
1518 1.1 eeh else
1519 1.1 eeh /* Here we have a choice of new-token or named-token */
1520 1.1 eeh emit("named-token");
1521 1.1 eeh sspit(token->text);
1522 1.1 eeh }
1523 1.1 eeh spit(fcode->num);
1524 1.1 eeh emit("b(defer)");
1525 1.1 eeh break;
1526 1.1 eeh case TOK_DO:
1527 1.1 eeh STATE(token->text, "TOK_DO");
1528 1.1 eeh /*
1529 1.1 eeh * From the 1275 spec. B is branch location, T is branch target.
1530 1.1 eeh *
1531 1.1 eeh * b(do) offset1 ... b(loop) offset2 ...
1532 1.1 eeh * b(do) offset1 ... b(+loop) offset2 ...
1533 1.1 eeh * b(?do) offset1 ... b(loop) offset2 ...
1534 1.1 eeh * b(?do) offset1 ... b(+loop) offset2 ...
1535 1.1 eeh * ^ ^
1536 1.1 eeh * B1 ^ ^ T1
1537 1.1 eeh * T2 B2
1538 1.1 eeh *
1539 1.1 eeh * How we do this is we generate the b(do) or b(?do), spit out a
1540 1.1 eeh * zero offset while remembering b1 and t2. Then we call tokenize()
1541 1.1 eeh * to generate the body. When tokenize() finds a b(loop) or b(+loop),
1542 1.1 eeh * it generates the FCode and returns, with outpos at b2. We then
1543 1.1 eeh * calculate the offsets, put them in the right slots and finishup.
1544 1.1 eeh */
1545 1.1 eeh
1546 1.1 eeh if (token->text[0] == '?')
1547 1.1 eeh emit("b(?do)");
1548 1.1 eeh else
1549 1.1 eeh emit("b(do)");
1550 1.1 eeh push(outpos);
1551 1.34 eeh offspit(0); /* Place holder for later */
1552 1.1 eeh push(outpos);
1553 1.1 eeh break;
1554 1.34 eeh case TOK_END0:
1555 1.34 eeh STATE(token->text, "TOK_END0");
1556 1.34 eeh emit("end0");
1557 1.34 eeh /* Remember we already generated end0 */
1558 1.34 eeh need_end0 = 0;
1559 1.34 eeh break;
1560 1.1 eeh case TOK_ELSE:
1561 1.1 eeh STATE(token->text, "TOK_ELSE");
1562 1.1 eeh /* Get where we need to patch */
1563 1.1 eeh off = pop();
1564 1.1 eeh emit("bbranch");
1565 1.1 eeh /* Save where we are now. */
1566 1.1 eeh push(outpos);
1567 1.34 eeh offspit(0); /* Place holder for later */
1568 1.1 eeh emit("b(>resolve)");
1569 1.1 eeh /* Rewind and patch the if branch */
1570 1.1 eeh pos = outpos;
1571 1.1 eeh outpos = off;
1572 1.1 eeh off = pos - off;
1573 1.34 eeh offspit(off); /* Place holder for later */
1574 1.1 eeh /* revert to the end */
1575 1.1 eeh outpos = pos;
1576 1.1 eeh break;
1577 1.1 eeh case TOK_ENDCASE:
1578 1.1 eeh STATE(token->text, "TOK_ENDCASE:");
1579 1.34 eeh emit("b(endcase)");
1580 1.1 eeh pos = outpos; /* Remember where we need to branch to */
1581 1.1 eeh
1582 1.1 eeh /* Thread our way backwards and install proper offsets */
1583 1.1 eeh off = pop();
1584 1.1 eeh while (off) {
1585 1.34 eeh int disp;
1586 1.34 eeh int next;
1587 1.1 eeh
1588 1.1 eeh /* Move to this offset */
1589 1.1 eeh outpos = off;
1590 1.1 eeh /* Load next offset to process */
1591 1.34 eeh disp = (signed char)(outbuf[outpos]);
1592 1.34 eeh if (offsetsize == 16) {
1593 1.34 eeh disp = (disp << 8) |
1594 1.34 eeh (unsigned char)outbuf[outpos+1];
1595 1.34 eeh }
1596 1.34 eeh next = outpos + disp;
1597 1.37 christos if (debug > -3)
1598 1.37 christos printf("Next endof: %x at %x\n",
1599 1.37 christos disp, next);
1600 1.1 eeh
1601 1.1 eeh /* process this offset */
1602 1.1 eeh off = pos - outpos;
1603 1.34 eeh offspit(off);
1604 1.34 eeh if ((off = disp))
1605 1.34 eeh off = next;
1606 1.1 eeh }
1607 1.1 eeh outpos = pos;
1608 1.1 eeh break;
1609 1.1 eeh case TOK_ENDOF:
1610 1.1 eeh STATE(token->text, "TOK_ENDOF");
1611 1.1 eeh off = pop();
1612 1.1 eeh emit("b(endof)");
1613 1.1 eeh /*
1614 1.1 eeh * Save back pointer in the offset field so we can traverse
1615 1.1 eeh * the linked list and patch it in the endcase.
1616 1.1 eeh */
1617 1.1 eeh pos = pop(); /* get position of prev link. */
1618 1.1 eeh push(outpos); /* save position of this link. */
1619 1.34 eeh if (pos)
1620 1.34 eeh /* save potision of prev link. */
1621 1.34 eeh offspit(pos - outpos);
1622 1.34 eeh else
1623 1.34 eeh /* This is the first statement */
1624 1.34 eeh offspit(0);
1625 1.1 eeh pos = outpos;
1626 1.1 eeh /* Now point the offset from b(of) here. */
1627 1.1 eeh outpos = off;
1628 1.34 eeh off = pos - off;
1629 1.34 eeh offspit(off);
1630 1.1 eeh /* Restore position */
1631 1.1 eeh outpos = pos;
1632 1.1 eeh break;
1633 1.1 eeh case TOK_EXTERNAL:
1634 1.1 eeh STATE(token->text, "TOK_EXTERNAL");
1635 1.1 eeh state = TOK_EXTERNAL;
1636 1.1 eeh break;
1637 1.34 eeh case TOK_FCODE_VERSION2:
1638 1.34 eeh /* This is actually a tokenizer directive. */
1639 1.34 eeh STATE(token->text, "TOK_FCODE_VERSION2");
1640 1.34 eeh offsetsize = 16;
1641 1.34 eeh pos = outpos;
1642 1.34 eeh outpos = 0;
1643 1.34 eeh emit("start1");
1644 1.34 eeh outpos = pos;
1645 1.34 eeh break;
1646 1.34 eeh case TOK_FCODE_END:
1647 1.34 eeh /*
1648 1.34 eeh * Another tokenizer directive.
1649 1.34 eeh *
1650 1.34 eeh * This should generate end0 and finish filling in
1651 1.34 eeh * the FCode header. But that's all done in main().
1652 1.34 eeh */
1653 1.34 eeh STATE(token->text, "TOK_FCODE_END");
1654 1.34 eeh return;
1655 1.1 eeh case TOK_FIELD:
1656 1.1 eeh STATE(token->text, "TOK_FIELD");
1657 1.1 eeh
1658 1.1 eeh token = yylex();
1659 1.1 eeh if (token == NULL) {
1660 1.37 christos warnx("EOF in field definition");
1661 1.3 mrg return;
1662 1.1 eeh }
1663 1.1 eeh
1664 1.1 eeh /* Add new code to dictionary */
1665 1.37 christos fcode = emalloc(sizeof(*fcode));
1666 1.1 eeh fcode->num = nextfcode++;
1667 1.37 christos fcode->name = estrdup(token->text);
1668 1.1 eeh fadd(dictionary, fcode);
1669 1.1 eeh
1670 1.1 eeh if (state == 0)
1671 1.1 eeh emit("new-token");
1672 1.1 eeh else {
1673 1.1 eeh if (state == TOK_EXTERNAL)
1674 1.1 eeh emit("external-token");
1675 1.1 eeh else
1676 1.1 eeh /* Here we have a choice of new-token or named-token */
1677 1.1 eeh emit("named-token");
1678 1.1 eeh sspit(token->text);
1679 1.1 eeh }
1680 1.1 eeh spit(fcode->num);
1681 1.1 eeh emit("b(field)");
1682 1.1 eeh break;
1683 1.1 eeh
1684 1.1 eeh case TOK_HEX:
1685 1.1 eeh STATE(token->text, "TOK_HEX");
1686 1.1 eeh if (token->text[1] != '#') {
1687 1.1 eeh if (defining) {
1688 1.34 eeh emit("b(lit)");
1689 1.34 eeh spit(0);
1690 1.34 eeh spit(0);
1691 1.34 eeh spit(0);
1692 1.1 eeh spit(16);
1693 1.1 eeh emit("base");
1694 1.1 eeh emit("!");
1695 1.1 eeh } else
1696 1.30 lukem numbase = TOK_HEX;
1697 1.1 eeh } else {
1698 1.1 eeh char *end;
1699 1.1 eeh Cell value;
1700 1.1 eeh
1701 1.1 eeh token = yylex();
1702 1.1 eeh if (token == NULL) {
1703 1.37 christos warnx("EOF after h#");
1704 1.3 mrg return;
1705 1.1 eeh }
1706 1.1 eeh value = strtol(token->text, &end, 16);
1707 1.37 christos if (*end != 0)
1708 1.37 christos errx(EXIT_FAILURE, "Illegal number"
1709 1.37 christos " conversion:%s:%d: %s\n",
1710 1.6 mrg infile, yylineno, yytext);
1711 1.1 eeh /*
1712 1.1 eeh * If this is a 64-bit value we need to store two literals
1713 1.1 eeh * and issue a `lxjoin' to combine them. But that's a future
1714 1.1 eeh * project.
1715 1.1 eeh */
1716 1.1 eeh emit("b(lit)");
1717 1.13 eeh spit((value>>24)&0x0ff);
1718 1.1 eeh spit((value>>16)&0x0ff);
1719 1.1 eeh spit((value>>8)&0x0ff);
1720 1.1 eeh spit(value&0x0ff);
1721 1.15 eeh if ((value>>32) != value && (value>>32) != 0) {
1722 1.13 eeh emit("b(lit)");
1723 1.13 eeh spit((value>>56)&0x0ff);
1724 1.13 eeh spit((value>>48)&0x0ff);
1725 1.13 eeh spit((value>>40)&0x0ff);
1726 1.13 eeh spit((value>>32)&0x0ff);
1727 1.13 eeh emit("lxjoin");
1728 1.13 eeh }
1729 1.1 eeh }
1730 1.1 eeh break;
1731 1.1 eeh case TOK_HEADERLESS:
1732 1.1 eeh STATE(token->text, "TOK_HEADERLESS");
1733 1.1 eeh state = 0;
1734 1.1 eeh break;
1735 1.1 eeh case TOK_HEADERS:
1736 1.1 eeh STATE(token->text, "TOK_HEADERS");
1737 1.1 eeh state = TOK_HEADERS;
1738 1.1 eeh break;
1739 1.1 eeh case TOK_IF:
1740 1.1 eeh STATE(token->text, "TOK_IF");
1741 1.1 eeh /*
1742 1.1 eeh * Similar to do but simpler since we only deal w/one branch.
1743 1.1 eeh */
1744 1.1 eeh emit("b?branch");
1745 1.1 eeh push(outpos);
1746 1.34 eeh offspit(0); /* Place holder for later */
1747 1.1 eeh break;
1748 1.1 eeh case TOK_LEAVE:
1749 1.1 eeh STATE(token->text, "TOK_LEAVE");
1750 1.1 eeh emit("b(leave)");
1751 1.1 eeh break;
1752 1.1 eeh case TOK_LOOP:
1753 1.1 eeh STATE(token->text, "TOK_LOOP");
1754 1.1 eeh
1755 1.1 eeh if (token->text[0] == '+')
1756 1.1 eeh emit("b(+loop)");
1757 1.1 eeh else
1758 1.1 eeh emit("b(loop)");
1759 1.1 eeh /* First do backwards branch of loop */
1760 1.1 eeh pos = pop();
1761 1.1 eeh off = pos - outpos;
1762 1.34 eeh offspit(off);
1763 1.1 eeh /* Now do forward branch of do */
1764 1.1 eeh pos = outpos;
1765 1.1 eeh outpos = pop();
1766 1.1 eeh off = pos - outpos;
1767 1.34 eeh spit(off);
1768 1.1 eeh /* Restore output position */
1769 1.1 eeh outpos = pos;
1770 1.1 eeh break;
1771 1.1 eeh case TOK_OCTAL:
1772 1.1 eeh STATE(token->text, "TOK_OCTAL");
1773 1.1 eeh if (token->text[1] != '#') {
1774 1.1 eeh if (defining) {
1775 1.1 eeh spit(16);
1776 1.1 eeh emit("base");
1777 1.1 eeh emit("!");
1778 1.1 eeh } else
1779 1.30 lukem numbase = TOK_OCTAL;
1780 1.1 eeh } else {
1781 1.1 eeh char *end;
1782 1.1 eeh Cell value;
1783 1.1 eeh
1784 1.1 eeh token = yylex();
1785 1.1 eeh if (token == NULL) {
1786 1.37 christos warnx("EOF after o#");
1787 1.3 mrg return;
1788 1.1 eeh }
1789 1.1 eeh value = strtol(token->text, &end, 8);
1790 1.1 eeh if (*end != 0) {
1791 1.37 christos errx(EXIT_FAILURE, "Illegal number"
1792 1.37 christos " conversion:%s:%d: %s\n",
1793 1.6 mrg infile, yylineno, yytext);
1794 1.1 eeh }
1795 1.1 eeh /*
1796 1.1 eeh * If this is a 64-bit value we need to store two literals
1797 1.1 eeh * and issue a `lxjoin' to combine them. But that's a future
1798 1.1 eeh * project.
1799 1.1 eeh */
1800 1.1 eeh emit("b(lit)");
1801 1.13 eeh spit((value>>24)&0x0ff);
1802 1.1 eeh spit((value>>16)&0x0ff);
1803 1.1 eeh spit((value>>8)&0x0ff);
1804 1.1 eeh spit(value&0x0ff);
1805 1.15 eeh if ((value>>32) != value && (value>>32) != 0) {
1806 1.13 eeh emit("b(lit)");
1807 1.13 eeh spit((value>>56)&0x0ff);
1808 1.13 eeh spit((value>>48)&0x0ff);
1809 1.13 eeh spit((value>>40)&0x0ff);
1810 1.13 eeh spit((value>>32)&0x0ff);
1811 1.13 eeh emit("lxjoin");
1812 1.13 eeh }
1813 1.1 eeh }
1814 1.1 eeh break;
1815 1.1 eeh case TOK_OF:
1816 1.1 eeh STATE(token->text, "TOK_OF");
1817 1.1 eeh /*
1818 1.1 eeh * Let's hope I get the semantics right.
1819 1.1 eeh *
1820 1.1 eeh * The `of' behaves almost the same as an
1821 1.1 eeh * `if'. The difference is that `endof'
1822 1.1 eeh * takes a branch offset to the associated
1823 1.1 eeh * `endcase'. Here we will generate a temporary
1824 1.1 eeh * offset of the `of' associated with the `endof'.
1825 1.1 eeh * Then in `endcase' we should be pointing just
1826 1.1 eeh * after the offset of the last `endof' so we
1827 1.1 eeh * calculate the offset and thread our way backwards
1828 1.1 eeh * searching for the previous `b(case)' or `b(endof)'.
1829 1.1 eeh */
1830 1.1 eeh emit("b(of)");
1831 1.1 eeh push(outpos);
1832 1.34 eeh offspit(0); /* Place holder for later */
1833 1.34 eeh break;
1834 1.34 eeh case TOK_OFFSET16:
1835 1.34 eeh STATE(token->text, "TOK_OFFSET16");
1836 1.34 eeh offsetsize = 16;
1837 1.34 eeh emit("offset16");
1838 1.1 eeh break;
1839 1.1 eeh case TOK_REPEAT:
1840 1.1 eeh STATE(token->text, "TOK_REPEAT");
1841 1.1 eeh emit("bbranch");
1842 1.1 eeh pos = pop();
1843 1.1 eeh off = pop();
1844 1.1 eeh /* First the offset for the branch back to the begin */
1845 1.1 eeh off -= outpos;
1846 1.34 eeh offspit(off);
1847 1.1 eeh emit("b(>resolve)");
1848 1.1 eeh /* Now point the offset of the while here. */
1849 1.1 eeh off = outpos;
1850 1.1 eeh outpos = pos;
1851 1.1 eeh pos = off - pos;
1852 1.34 eeh offspit(pos);
1853 1.1 eeh /* Return to the end of the output */
1854 1.1 eeh outpos = off;
1855 1.1 eeh break;
1856 1.34 eeh case TOK_STARTX:
1857 1.34 eeh /* Put a "startX" at addr 0. */
1858 1.34 eeh STATE(token->text, "TOK_FCODE_VERSION2");
1859 1.34 eeh offsetsize = 16;
1860 1.34 eeh pos = outpos;
1861 1.34 eeh outpos = 0;
1862 1.34 eeh emit(token->text);
1863 1.34 eeh outpos = pos;
1864 1.34 eeh break;
1865 1.1 eeh case TOK_THEN:
1866 1.1 eeh STATE(token->text, "TOK_THEN");
1867 1.1 eeh emit("b(>resolve)");
1868 1.1 eeh pos = outpos;
1869 1.1 eeh outpos = pop();
1870 1.1 eeh off = pos - outpos;
1871 1.34 eeh offspit(off);
1872 1.1 eeh outpos = pos;
1873 1.1 eeh break;
1874 1.1 eeh case TOK_TO:
1875 1.1 eeh STATE(token->text, "TOK_TO");
1876 1.1 eeh /* The next pass should tokenize the FCODE number */
1877 1.1 eeh emit("b(to)");
1878 1.1 eeh break;
1879 1.1 eeh case TOK_UNTIL:
1880 1.1 eeh STATE(token->text, "TOK_UNTIL");
1881 1.1 eeh emit("b?branch");
1882 1.1 eeh pos = pop();
1883 1.1 eeh pos -= outpos;
1884 1.34 eeh offspit(pos);
1885 1.30 lukem break;
1886 1.1 eeh case TOK_VALUE:
1887 1.1 eeh STATE(token->text, "TOK_VALUE");
1888 1.1 eeh
1889 1.1 eeh token = yylex();
1890 1.1 eeh if (token == NULL) {
1891 1.37 christos warnx("EOF in value definition");
1892 1.3 mrg return;
1893 1.1 eeh }
1894 1.1 eeh
1895 1.1 eeh /* Add new code to dictionary */
1896 1.37 christos fcode = emalloc(sizeof(*fcode));
1897 1.1 eeh fcode->num = nextfcode++;
1898 1.37 christos fcode->name = estrdup(token->text);
1899 1.1 eeh fadd(dictionary, fcode);
1900 1.1 eeh
1901 1.1 eeh if (state == 0)
1902 1.1 eeh emit("new-token");
1903 1.1 eeh else {
1904 1.1 eeh if (state == TOK_EXTERNAL)
1905 1.1 eeh emit("external-token");
1906 1.1 eeh else
1907 1.1 eeh /* Here we have a choice of new-token or named-token */
1908 1.1 eeh emit("named-token");
1909 1.1 eeh sspit(token->text);
1910 1.1 eeh }
1911 1.1 eeh spit(fcode->num);
1912 1.1 eeh emit("b(value)");
1913 1.1 eeh break;
1914 1.1 eeh case TOK_VARIABLE:
1915 1.1 eeh STATE(token->text, "TOK_VARIABLE");
1916 1.1 eeh
1917 1.1 eeh token = yylex();
1918 1.1 eeh if (token == NULL) {
1919 1.37 christos warnx("EOF in variable definition");
1920 1.3 mrg return;
1921 1.1 eeh }
1922 1.1 eeh
1923 1.1 eeh /* Add new code to dictionary */
1924 1.37 christos fcode = emalloc(sizeof(*fcode));
1925 1.1 eeh fcode->num = nextfcode++;
1926 1.37 christos fcode->name = estrdup(token->text);
1927 1.1 eeh fadd(dictionary, fcode);
1928 1.1 eeh
1929 1.1 eeh if (state == 0)
1930 1.1 eeh emit("new-token");
1931 1.1 eeh else {
1932 1.1 eeh if (state == TOK_EXTERNAL)
1933 1.1 eeh emit("external-token");
1934 1.1 eeh else
1935 1.1 eeh /* Here we have a choice of new-token or named-token */
1936 1.1 eeh emit("named-token");
1937 1.1 eeh sspit(token->text);
1938 1.1 eeh }
1939 1.1 eeh spit(fcode->num);
1940 1.1 eeh emit("b(variable)");
1941 1.1 eeh break;
1942 1.34 eeh case TOK_VERSION1:
1943 1.34 eeh /* This is actually a tokenizer directive. */
1944 1.34 eeh STATE(token->text, "TOK_FCODE_VERSION1");
1945 1.34 eeh offsetsize = 8;
1946 1.34 eeh pos = outpos;
1947 1.34 eeh outpos = 0;
1948 1.34 eeh emit("version1");
1949 1.34 eeh outpos = pos;
1950 1.34 eeh break;
1951 1.1 eeh case TOK_WHILE:
1952 1.1 eeh STATE(token->text, "TOK_WHILE");
1953 1.1 eeh emit("b?branch");
1954 1.1 eeh push(outpos);
1955 1.34 eeh offspit(0);
1956 1.1 eeh break;
1957 1.1 eeh
1958 1.1 eeh /* Tokenizer directives */
1959 1.1 eeh case TOK_BEGTOK:
1960 1.1 eeh STATE(token->text, "TOK_BEGTOK");
1961 1.1 eeh tokenizer = 1;
1962 1.1 eeh break;
1963 1.1 eeh case TOK_EMIT_BYTE:
1964 1.1 eeh STATE(token->text, "TOK_EMIT_BYTE");
1965 1.1 eeh spit(pop());
1966 1.1 eeh break;
1967 1.1 eeh case TOK_ENDTOK:
1968 1.1 eeh STATE(token->text, "TOK_ENDTOK");
1969 1.1 eeh tokenizer = 0;
1970 1.1 eeh break;
1971 1.1 eeh case TOK_FLOAD:
1972 1.6 mrg {
1973 1.6 mrg char *oldinfile = infile;
1974 1.6 mrg
1975 1.34 eeh STATE(token->text, "TOK_FLOAD");
1976 1.34 eeh /* Parse a different file for a while */
1977 1.34 eeh token = yylex();
1978 1.34 eeh if ((inf = fopen(token->text, "r")) == NULL) {
1979 1.37 christos warn("Cannot open `%s'", token->text);
1980 1.34 eeh break;
1981 1.34 eeh }
1982 1.37 christos infile = estrdup(token->text);
1983 1.34 eeh if (mark_fload) {
1984 1.34 eeh /*
1985 1.34 eeh * Insert commands to print out the
1986 1.34 eeh * filename into the instruction
1987 1.34 eeh * stream
1988 1.34 eeh */
1989 1.34 eeh emit("b(\")");
1990 1.34 eeh sspit("fload-ing ");
1991 1.34 eeh emit("type");
1992 1.34 eeh emit("b(\")");
1993 1.34 eeh sspit(infile);
1994 1.34 eeh emit("type");
1995 1.34 eeh emit("cr");
1996 1.34 eeh emit(".s");
1997 1.34 eeh }
1998 1.34 eeh inbuf = yy_create_buffer(inf, YY_BUF_SIZE);
1999 1.34 eeh yy_switch_to_buffer(inbuf);
2000 1.34 eeh
2001 1.34 eeh printf("======= fload file %s\n", infile);
2002 1.6 mrg tokenize(inbuf);
2003 1.34 eeh printf("======= done file %s\n", infile);
2004 1.34 eeh yy_switch_to_buffer(yinput);
2005 1.34 eeh yy_delete_buffer(inbuf);
2006 1.34 eeh fclose(inf);
2007 1.34 eeh if (mark_fload) {
2008 1.34 eeh /*
2009 1.34 eeh * Insert commands to print out the
2010 1.34 eeh * filename into the instruction
2011 1.34 eeh * stream
2012 1.34 eeh */
2013 1.34 eeh emit("b(\")");
2014 1.34 eeh sspit("fload-ed ");
2015 1.34 eeh emit("type");
2016 1.34 eeh emit("b(\")");
2017 1.34 eeh sspit(infile);
2018 1.34 eeh emit("type");
2019 1.34 eeh emit("cr");
2020 1.34 eeh emit(".s");
2021 1.34 eeh emit("cr");
2022 1.34 eeh }
2023 1.34 eeh free(infile);
2024 1.6 mrg infile = oldinfile;
2025 1.6 mrg }
2026 1.1 eeh break;
2027 1.1 eeh case TOK_OTHER:
2028 1.1 eeh STATE(token->text, "TOK_OTHER");
2029 1.30 lukem if (apply_macros(yinput, token->text))
2030 1.1 eeh break;
2031 1.1 eeh if (emit(token->text)) {
2032 1.1 eeh #if 0
2033 1.1 eeh /*
2034 1.1 eeh * Call an external command
2035 1.1 eeh *
2036 1.1 eeh * XXXXX assumes it will always find the command
2037 1.1 eeh */
2038 1.1 eeh sspit(token->text);
2039 1.1 eeh emit("$find");
2040 1.1 eeh emit("drop");
2041 1.1 eeh emit("execute");
2042 1.1 eeh #else
2043 1.34 eeh token_err(yylineno, infile, yytext,
2044 1.34 eeh "%s: undefined token `%s'\n",
2045 1.38 mrg __func__, token->text);
2046 1.1 eeh #endif
2047 1.1 eeh }
2048 1.1 eeh break;
2049 1.1 eeh default:
2050 1.16 thorpej /* Nothing */ ;
2051 1.1 eeh }
2052 1.1 eeh }
2053 1.3 mrg return;
2054 1.6 mrg }
2055 1.6 mrg
2056 1.6 mrg /*
2057 1.6 mrg * print a tokenizer error message
2058 1.6 mrg */
2059 1.35 joerg static void
2060 1.30 lukem token_err(int lineno, const char *file, const char *text, const char *fmt, ...)
2061 1.6 mrg {
2062 1.6 mrg va_list ap;
2063 1.6 mrg
2064 1.6 mrg va_start(ap, fmt);
2065 1.37 christos fprintf(stderr, "%s: ", getprogname());
2066 1.30 lukem if (file)
2067 1.37 christos (void)fprintf(stderr, "%s,%d: ", file, lineno);
2068 1.6 mrg if (fmt)
2069 1.6 mrg (void)vfprintf(stderr, fmt, ap);
2070 1.6 mrg fputc('\n', stderr);
2071 1.6 mrg if (text)
2072 1.6 mrg fprintf(stderr, "\t%s", text);
2073 1.6 mrg va_end(ap);
2074 1.37 christos exit(EXIT_FAILURE);
2075 1.1 eeh }
2076 1.1 eeh
2077 1.1 eeh /*
2078 1.1 eeh * Lookup fcode string in dictionary and spit it out.
2079 1.1 eeh *
2080 1.1 eeh * Fcode must be in dictionary. No alias conversion done.
2081 1.1 eeh */
2082 1.35 joerg static int
2083 1.30 lukem emit(const char *str)
2084 1.1 eeh {
2085 1.1 eeh struct fcode *code;
2086 1.37 christos if ((code = flookup(dictionary, str)))
2087 1.1 eeh spit(code->num);
2088 1.1 eeh if (debug > 1) {
2089 1.1 eeh if (code)
2090 1.37 christos printf("emitting `%s'\n", code->name);
2091 1.1 eeh else
2092 1.37 christos printf("emit: not found `%s'\n", str);
2093 1.1 eeh }
2094 1.1 eeh return (code == NULL);
2095 1.1 eeh }
2096 1.1 eeh
2097 1.1 eeh /*
2098 1.1 eeh * Spit out an integral value as a series of FCodes.
2099 1.1 eeh *
2100 1.1 eeh * It will spit out one zero byte or as many bytes as are
2101 1.1 eeh * non-zero.
2102 1.1 eeh */
2103 1.35 joerg static int
2104 1.28 lukem spit(long n)
2105 1.1 eeh {
2106 1.2 eeh int count = 1;
2107 1.1 eeh
2108 1.1 eeh if (n >> 8)
2109 1.2 eeh count += spit(n >> 8);
2110 1.30 lukem if ((size_t)outpos >= outbufsiz) {
2111 1.30 lukem while ((size_t)outpos >= outbufsiz) outbufsiz += BUFCLICK;
2112 1.37 christos outbuf = erealloc(outbuf, outbufsiz);
2113 1.1 eeh }
2114 1.34 eeh if (debug > 3) printf("%lx: spitting %2.2x\n", outpos, (unsigned char)n);
2115 1.1 eeh outbuf[outpos++] = n;
2116 1.2 eeh return (count);
2117 1.1 eeh }
2118 1.1 eeh
2119 1.1 eeh /*
2120 1.1 eeh * Spit out an FCode string.
2121 1.1 eeh */
2122 1.35 joerg static void
2123 1.30 lukem sspit(const char *s)
2124 1.1 eeh {
2125 1.1 eeh int len = strlen(s);
2126 1.1 eeh
2127 1.1 eeh if (len > 255) {
2128 1.37 christos warnx("string length %d too long", len);
2129 1.3 mrg return;
2130 1.1 eeh }
2131 1.34 eeh if (debug > 2)
2132 1.37 christos printf("sspit: len %d str `%s'\n", len, s);
2133 1.1 eeh spit(len);
2134 1.34 eeh while (len--)
2135 1.3 mrg spit(*s++);
2136 1.1 eeh }
2137 1.1 eeh
2138 1.34 eeh /*
2139 1.34 eeh * Spit out an offset. Offsets can be 8 or 16 bits.
2140 1.34 eeh * Bail if the value overflows. This is a little complicated since
2141 1.34 eeh * offsets can be negative numbers.
2142 1.34 eeh */
2143 1.35 joerg static int
2144 1.34 eeh offspit(long n)
2145 1.34 eeh {
2146 1.34 eeh
2147 1.34 eeh if (offsetsize == 16) {
2148 1.34 eeh volatile int16_t off16 = n;
2149 1.34 eeh
2150 1.34 eeh if (n != off16)
2151 1.34 eeh token_err(yylineno, infile, NULL,
2152 1.34 eeh "Offset16 offset overflow: %lx != %x\n",
2153 1.34 eeh n, off16);
2154 1.34 eeh spit((n>>8) & 0xff);
2155 1.34 eeh return spit(n & 0xff);
2156 1.34 eeh } else {
2157 1.34 eeh volatile int8_t off8 = n;
2158 1.34 eeh
2159 1.34 eeh if (n != off8)
2160 1.34 eeh token_err(yylineno, infile, NULL,
2161 1.34 eeh "Offset8 offset overflow: %lx != %x\n",
2162 1.34 eeh n, off8);
2163 1.34 eeh return spit(n & 0x0ffL);
2164 1.34 eeh }
2165 1.34 eeh }
2166 1.34 eeh
2167 1.1 eeh int
2168 1.28 lukem yywrap(void)
2169 1.3 mrg {
2170 1.1 eeh /* Always generate EOF */
2171 1.1 eeh return (1);
2172 1.1 eeh }
2173