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;
37 struct builtin_func funcs[] = {
38 { .name = "eval", .args = AO_LISP_FUNC_F_LAMBDA, .func = builtin_eval },
39 { .name = "read", .args = AO_LISP_FUNC_F_LAMBDA, .func = builtin_read },
40 { .name = "lambda", .args = AO_LISP_FUNC_NLAMBDA, .func = builtin_lambda },
41 { .name = "lexpr", .args = AO_LISP_FUNC_NLAMBDA, .func = builtin_lexpr },
42 { .name = "nlambda", .args = AO_LISP_FUNC_NLAMBDA, .func = builtin_nlambda },
43 { .name = "macro", .args = AO_LISP_FUNC_NLAMBDA, .func = builtin_macro },
44 { .name = "car", .args = AO_LISP_FUNC_F_LAMBDA, .func = builtin_car },
45 { .name = "cdr", .args = AO_LISP_FUNC_F_LAMBDA, .func = builtin_cdr },
46 { .name = "cons", .args = AO_LISP_FUNC_F_LAMBDA, .func = builtin_cons },
47 { .name = "last", .args = AO_LISP_FUNC_F_LAMBDA, .func = builtin_last },
48 { .name = "length", .args = AO_LISP_FUNC_F_LAMBDA, .func = builtin_length },
49 { .name = "quote", .args = AO_LISP_FUNC_NLAMBDA, .func = builtin_quote },
50 { .name = "set", .args = AO_LISP_FUNC_F_LAMBDA, .func = builtin_set },
51 { .name = "setq", .args = AO_LISP_FUNC_MACRO, .func = builtin_setq },
52 { .name = "cond", .args = AO_LISP_FUNC_NLAMBDA, .func = builtin_cond },
53 { .name = "progn", .args = AO_LISP_FUNC_NLAMBDA, .func = builtin_progn },
54 { .name = "while", .args = AO_LISP_FUNC_NLAMBDA, .func = builtin_while },
55 { .name = "print", .args = AO_LISP_FUNC_F_LEXPR, .func = builtin_print },
56 { .name = "patom", .args = AO_LISP_FUNC_F_LEXPR, .func = builtin_patom },
57 { .name = "+", .args = AO_LISP_FUNC_F_LEXPR, .func = builtin_plus },
58 { .name = "-", .args = AO_LISP_FUNC_F_LEXPR, .func = builtin_minus },
59 { .name = "*", .args = AO_LISP_FUNC_F_LEXPR, .func = builtin_times },
60 { .name = "/", .args = AO_LISP_FUNC_F_LEXPR, .func = builtin_divide },
61 { .name = "%", .args = AO_LISP_FUNC_F_LEXPR, .func = builtin_mod },
62 { .name = "=", .args = AO_LISP_FUNC_F_LEXPR, .func = builtin_equal },
63 { .name = "<", .args = AO_LISP_FUNC_F_LEXPR, .func = builtin_less },
64 { .name = ">", .args = AO_LISP_FUNC_F_LEXPR, .func = builtin_greater },
65 { .name = "<=", .args = AO_LISP_FUNC_F_LEXPR, .func = builtin_less_equal },
66 { .name = ">=", .args = AO_LISP_FUNC_F_LEXPR, .func = builtin_greater_equal },
67 { .name = "pack", .args = AO_LISP_FUNC_F_LAMBDA, .func = builtin_pack },
68 { .name = "unpack", .args = AO_LISP_FUNC_F_LAMBDA, .func = builtin_unpack },
69 { .name = "flush", .args = AO_LISP_FUNC_F_LAMBDA, .func = builtin_flush },
70 { .name = "delay", .args = AO_LISP_FUNC_F_LAMBDA, .func = builtin_delay },
71 { .name = "led", .args = AO_LISP_FUNC_F_LEXPR, .func = builtin_led },
72 { .name = "save", .args = AO_LISP_FUNC_F_LAMBDA, .func = builtin_save },
73 { .name = "restore", .args = AO_LISP_FUNC_F_LAMBDA, .func = builtin_restore },
74 { .name = "call/cc", .args = AO_LISP_FUNC_F_LAMBDA, .func = builtin_call_cc },
77 #define N_FUNC (sizeof funcs / sizeof funcs[0])
79 struct ao_lisp_frame *globals;
84 struct ao_lisp_atom *a;
86 for (a = ao_lisp_atoms; a; a = ao_lisp_poly_atom(a->next))
87 if (((uint8_t *) a->name - ao_lisp_const) == offset)
88 return strlen(a->name);
92 #define AO_FEC_CRC_INIT 0xffff
94 static inline uint16_t
95 ao_fec_crc_byte(uint8_t byte, uint16_t crc)
99 for (bit = 0; bit < 8; bit++) {
100 if (((crc & 0x8000) >> 8) ^ (byte & 0x80))
101 crc = (crc << 1) ^ 0x8005;
110 ao_fec_crc(const uint8_t *bytes, uint8_t len)
112 uint16_t crc = AO_FEC_CRC_INIT;
115 crc = ao_fec_crc_byte(*bytes++, crc);
119 struct ao_lisp_macro_stack {
120 struct ao_lisp_macro_stack *next;
124 struct ao_lisp_macro_stack *macro_stack;
127 ao_lisp_macro_push(ao_poly p)
129 struct ao_lisp_macro_stack *m = macro_stack;
136 m = malloc (sizeof (struct ao_lisp_macro_stack));
138 m->next = macro_stack;
144 ao_lisp_macro_pop(void)
146 struct ao_lisp_macro_stack *m = macro_stack;
148 macro_stack = m->next;
154 int macro_scan_depth;
159 for (i = 0; i < macro_scan_depth; i++)
162 #define MACRO_DEBUG(a) a
164 #define MACRO_DEBUG(a)
168 ao_has_macro(ao_poly p);
171 ao_macro_test_get(ao_poly atom)
173 ao_poly *ref = ao_lisp_atom_ref(ao_lisp_frame_global, atom);
180 ao_is_macro(ao_poly p)
182 struct ao_lisp_builtin *builtin;
183 struct ao_lisp_lambda *lambda;
186 MACRO_DEBUG(indent(); printf ("is macro "); ao_lisp_poly_print(p); printf("\n"); ++macro_scan_depth);
187 switch (ao_lisp_poly_type(p)) {
189 if (ao_lisp_macro_push(p))
192 if (ao_is_macro(ao_macro_test_get(p)))
200 ret = ao_has_macro(p);
202 case AO_LISP_BUILTIN:
203 builtin = ao_lisp_poly_builtin(p);
204 if ((builtin->args & AO_LISP_FUNC_MASK) == AO_LISP_FUNC_MACRO)
211 lambda = ao_lisp_poly_lambda(p);
212 if (lambda->args == AO_LISP_FUNC_MACRO)
215 ret = ao_has_macro(lambda->code);
221 MACRO_DEBUG(--macro_scan_depth; indent(); printf ("... "); ao_lisp_poly_print(ret); printf("\n"));
226 ao_has_macro(ao_poly p)
228 struct ao_lisp_cons *cons;
229 struct ao_lisp_lambda *lambda;
232 if (p == AO_LISP_NIL)
235 MACRO_DEBUG(indent(); printf("has macro "); ao_lisp_poly_print(p); printf("\n"); ++macro_scan_depth);
236 switch (ao_lisp_poly_type(p)) {
238 lambda = ao_lisp_poly_lambda(p);
239 p = ao_has_macro(lambda->code);
242 cons = ao_lisp_poly_cons(p);
243 if ((p = ao_is_macro(cons->car)))
246 cons = ao_lisp_poly_cons(cons->cdr);
249 m = ao_has_macro(cons->car);
254 cons = ao_lisp_poly_cons(cons->cdr);
262 MACRO_DEBUG(--macro_scan_depth; indent(); printf("... "); ao_lisp_poly_print(p); printf("\n"));
267 ao_lisp_read_eval_abort(void)
269 ao_poly in, out = AO_LISP_NIL;
272 if (in == _ao_lisp_atom_eof)
274 out = ao_lisp_eval(in);
275 if (ao_lisp_exception)
277 ao_lisp_poly_print(out);
292 static const struct option options[] = {
293 { .name = "out", .has_arg = 1, .val = 'o' },
297 static void usage(char *program)
299 fprintf(stderr, "usage: %s [--out=<output>] [input]\n", program);
304 main(int argc, char **argv)
308 struct ao_lisp_atom *a;
309 struct ao_lisp_builtin *b;
311 char *out_name = NULL;
317 while ((c = getopt_long(argc, argv, "o:", options, NULL)) != -1) {
328 for (f = 0; f < (int) N_FUNC; f++) {
329 b = ao_lisp_make_builtin(funcs[f].func, funcs[f].args);
330 a = ao_lisp_atom_intern(funcs[f].name);
331 ao_lisp_atom_set(ao_lisp_atom_poly(a),
332 ao_lisp_builtin_poly(b));
335 /* boolean constants */
336 ao_lisp_atom_set(ao_lisp_atom_poly(ao_lisp_atom_intern("nil")),
338 a = ao_lisp_atom_intern("t");
339 ao_lisp_atom_set(ao_lisp_atom_poly(a),
340 ao_lisp_atom_poly(a));
342 /* end of file value */
343 a = ao_lisp_atom_intern("eof");
344 ao_lisp_atom_set(ao_lisp_atom_poly(a),
345 ao_lisp_atom_poly(a));
348 in = fopen(argv[optind], "r");
350 perror(argv[optind]);
354 if (!ao_lisp_read_eval_abort()) {
355 fprintf(stderr, "eval failed\n");
359 /* Reduce to referenced values */
360 ao_lisp_collect(AO_LISP_COLLECT_FULL);
362 for (f = 0; f < ao_lisp_frame_global->num; f++) {
363 val = ao_has_macro(ao_lisp_frame_global->vals[f].val);
364 if (val != AO_LISP_NIL) {
365 printf("error: function %s contains unresolved macro: ",
366 ao_lisp_poly_atom(ao_lisp_frame_global->vals[f].atom)->name);
367 ao_lisp_poly_print(val);
374 out = fopen(out_name, "w");
381 fprintf(out, "/* Generated file, do not edit */\n\n");
383 fprintf(out, "#define AO_LISP_POOL_CONST %d\n", ao_lisp_top);
384 fprintf(out, "extern const uint8_t ao_lisp_const[AO_LISP_POOL_CONST] __attribute__((aligned(4)));\n");
385 fprintf(out, "#define ao_builtin_atoms 0x%04x\n", ao_lisp_atom_poly(ao_lisp_atoms));
386 fprintf(out, "#define ao_builtin_frame 0x%04x\n", ao_lisp_frame_poly(ao_lisp_frame_global));
387 fprintf(out, "#define ao_lisp_const_checksum ((uint16_t) 0x%04x)\n", ao_fec_crc(ao_lisp_const, ao_lisp_top));
390 for (a = ao_lisp_atoms; a; a = ao_lisp_poly_atom(a->next)) {
391 char *n = a->name, c;
392 fprintf(out, "#define _ao_lisp_atom_");
395 fprintf(out, "%c", c);
397 fprintf(out, "%02x", c);
399 fprintf(out, " 0x%04x\n", ao_lisp_atom_poly(a));
401 fprintf(out, "#ifdef AO_LISP_CONST_BITS\n");
402 fprintf(out, "const uint8_t ao_lisp_const[AO_LISP_POOL_CONST] __attribute((aligned(4))) = {");
403 for (o = 0; o < ao_lisp_top; o++) {
406 fprintf(out, "\n\t");
409 c = ao_lisp_const[o];
411 in_atom = is_atom(o);
413 fprintf(out, " '%c',", c);
416 fprintf(out, "0x%02x,", c);
419 fprintf(out, "\n};\n");
420 fprintf(out, "#endif /* AO_LISP_CONST_BITS */\n");