2 * Copyright © 2016 Keith Packard <keithp@keithp.com>
4 * This program is free software; you can redistribute it and/or modify
5 * it under the terms of the GNU General Public License as published by
6 * the Free Software Foundation, either version 2 of the License, or
7 * (at your option) any later version.
9 * This program is distributed in the hope that it will be useful, but
10 * WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12 * General Public License for more details.
21 static struct ao_lisp_builtin *
22 ao_lisp_make_builtin(enum ao_lisp_builtin_id func, int args) {
23 struct ao_lisp_builtin *b = ao_lisp_alloc(sizeof (struct ao_lisp_builtin));
25 b->type = AO_LISP_BUILTIN;
34 enum ao_lisp_builtin_id func;
37 #define AO_LISP_BUILTIN_CONSTS
38 #include "ao_lisp_builtin.h"
40 #define N_FUNC (sizeof funcs / sizeof funcs[0])
42 struct ao_lisp_frame *globals;
47 struct ao_lisp_atom *a;
49 for (a = ao_lisp_atoms; a; a = ao_lisp_poly_atom(a->next))
50 if (((uint8_t *) a->name - ao_lisp_const) == offset)
51 return strlen(a->name);
55 #define AO_FEC_CRC_INIT 0xffff
57 static inline uint16_t
58 ao_fec_crc_byte(uint8_t byte, uint16_t crc)
62 for (bit = 0; bit < 8; bit++) {
63 if (((crc & 0x8000) >> 8) ^ (byte & 0x80))
64 crc = (crc << 1) ^ 0x8005;
73 ao_fec_crc(const uint8_t *bytes, uint8_t len)
75 uint16_t crc = AO_FEC_CRC_INIT;
78 crc = ao_fec_crc_byte(*bytes++, crc);
82 struct ao_lisp_macro_stack {
83 struct ao_lisp_macro_stack *next;
87 struct ao_lisp_macro_stack *macro_stack;
90 ao_lisp_macro_push(ao_poly p)
92 struct ao_lisp_macro_stack *m = macro_stack;
99 m = malloc (sizeof (struct ao_lisp_macro_stack));
101 m->next = macro_stack;
107 ao_lisp_macro_pop(void)
109 struct ao_lisp_macro_stack *m = macro_stack;
111 macro_stack = m->next;
117 int macro_scan_depth;
122 for (i = 0; i < macro_scan_depth; i++)
125 #define MACRO_DEBUG(a) a
127 #define MACRO_DEBUG(a)
131 ao_has_macro(ao_poly p);
134 ao_macro_test_get(ao_poly atom)
136 ao_poly *ref = ao_lisp_atom_ref(atom);
143 ao_is_macro(ao_poly p)
145 struct ao_lisp_builtin *builtin;
146 struct ao_lisp_lambda *lambda;
149 MACRO_DEBUG(indent(); printf ("is macro "); ao_lisp_poly_write(p); printf("\n"); ++macro_scan_depth);
150 switch (ao_lisp_poly_type(p)) {
152 if (ao_lisp_macro_push(p))
155 if (ao_is_macro(ao_macro_test_get(p)))
163 ret = ao_has_macro(p);
165 case AO_LISP_BUILTIN:
166 builtin = ao_lisp_poly_builtin(p);
167 if ((builtin->args & AO_LISP_FUNC_MASK) == AO_LISP_FUNC_MACRO)
174 lambda = ao_lisp_poly_lambda(p);
175 if (lambda->args == AO_LISP_FUNC_MACRO)
178 ret = ao_has_macro(lambda->code);
184 MACRO_DEBUG(--macro_scan_depth; indent(); printf ("... "); ao_lisp_poly_write(ret); printf("\n"));
189 ao_has_macro(ao_poly p)
191 struct ao_lisp_cons *cons;
192 struct ao_lisp_lambda *lambda;
196 if (p == AO_LISP_NIL)
199 MACRO_DEBUG(indent(); printf("has macro "); ao_lisp_poly_write(p); printf("\n"); ++macro_scan_depth);
200 switch (ao_lisp_poly_type(p)) {
202 lambda = ao_lisp_poly_lambda(p);
203 p = ao_has_macro(lambda->code);
206 cons = ao_lisp_poly_cons(p);
207 if ((p = ao_is_macro(cons->car)))
212 while (list != AO_LISP_NIL && ao_lisp_poly_type(list) == AO_LISP_CONS) {
213 cons = ao_lisp_poly_cons(list);
214 m = ao_has_macro(cons->car);
227 MACRO_DEBUG(--macro_scan_depth; indent(); printf("... "); ao_lisp_poly_write(p); printf("\n"));
232 ao_lisp_read_eval_abort(void)
234 ao_poly in, out = AO_LISP_NIL;
237 if (in == _ao_lisp_atom_eof)
239 out = ao_lisp_eval(in);
240 if (ao_lisp_exception)
242 ao_lisp_poly_write(out);
257 static const struct option options[] = {
258 { .name = "out", .has_arg = 1, .val = 'o' },
262 static void usage(char *program)
264 fprintf(stderr, "usage: %s [--out=<output>] [input]\n", program);
269 main(int argc, char **argv)
273 struct ao_lisp_atom *a;
274 struct ao_lisp_builtin *b;
276 char *out_name = NULL;
278 enum ao_lisp_builtin_id prev_func;
283 while ((c = getopt_long(argc, argv, "o:", options, NULL)) != -1) {
294 ao_lisp_frame_init();
296 /* Boolean values #f and #t */
300 prev_func = _builtin_last;
301 for (f = 0; f < (int) N_FUNC; f++) {
302 if (funcs[f].func != prev_func)
303 b = ao_lisp_make_builtin(funcs[f].func, funcs[f].args);
304 a = ao_lisp_atom_intern(funcs[f].name);
305 ao_lisp_atom_def(ao_lisp_atom_poly(a),
306 ao_lisp_builtin_poly(b));
309 /* end of file value */
310 a = ao_lisp_atom_intern("eof");
311 ao_lisp_atom_def(ao_lisp_atom_poly(a),
312 ao_lisp_atom_poly(a));
315 a = ao_lisp_atom_intern("else");
318 in = fopen(argv[optind], "r");
320 perror(argv[optind]);
324 if (!ao_lisp_read_eval_abort()) {
325 fprintf(stderr, "eval failed\n");
329 /* Reduce to referenced values */
330 ao_lisp_collect(AO_LISP_COLLECT_FULL);
332 for (f = 0; f < ao_lisp_frame_global->num; f++) {
333 struct ao_lisp_frame_vals *vals = ao_lisp_poly_frame_vals(ao_lisp_frame_global->vals);
334 val = ao_has_macro(vals->vals[f].val);
335 if (val != AO_LISP_NIL) {
336 printf("error: function %s contains unresolved macro: ",
337 ao_lisp_poly_atom(vals->vals[f].atom)->name);
338 ao_lisp_poly_write(val);
345 out = fopen(out_name, "w");
352 fprintf(out, "/* Generated file, do not edit */\n\n");
354 fprintf(out, "#define AO_LISP_POOL_CONST %d\n", ao_lisp_top);
355 fprintf(out, "extern const uint8_t ao_lisp_const[AO_LISP_POOL_CONST] __attribute__((aligned(4)));\n");
356 fprintf(out, "#define ao_builtin_atoms 0x%04x\n", ao_lisp_atom_poly(ao_lisp_atoms));
357 fprintf(out, "#define ao_builtin_frame 0x%04x\n", ao_lisp_frame_poly(ao_lisp_frame_global));
358 fprintf(out, "#define ao_lisp_const_checksum ((uint16_t) 0x%04x)\n", ao_fec_crc(ao_lisp_const, ao_lisp_top));
360 fprintf(out, "#define _ao_lisp_bool_false 0x%04x\n", ao_lisp_bool_poly(ao_lisp_false));
361 fprintf(out, "#define _ao_lisp_bool_true 0x%04x\n", ao_lisp_bool_poly(ao_lisp_true));
363 for (a = ao_lisp_atoms; a; a = ao_lisp_poly_atom(a->next)) {
364 char *n = a->name, c;
365 fprintf(out, "#define _ao_lisp_atom_");
368 fprintf(out, "%c", c);
370 fprintf(out, "%02x", c);
372 fprintf(out, " 0x%04x\n", ao_lisp_atom_poly(a));
374 fprintf(out, "#ifdef AO_LISP_CONST_BITS\n");
375 fprintf(out, "const uint8_t ao_lisp_const[AO_LISP_POOL_CONST] __attribute((aligned(4))) = {");
376 for (o = 0; o < ao_lisp_top; o++) {
379 fprintf(out, "\n\t");
382 c = ao_lisp_const[o];
384 in_atom = is_atom(o);
386 fprintf(out, " '%c',", c);
389 fprintf(out, "0x%02x,", c);
392 fprintf(out, "\n};\n");
393 fprintf(out, "#endif /* AO_LISP_CONST_BITS */\n");