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