X-Git-Url: https://git.gag.com/?p=fw%2Faltos;a=blobdiff_plain;f=src%2Flisp%2Fao_lisp_make_const.c;h=0f243eb0731e8c5407ee0a2d74822a09b89c22fc;hp=6f852f9d9a1f15d6c1f148f53c10334c189595de;hb=daa06c8dedc6dc1cf21936ee2769d9d25f0567bd;hpb=417161dbb36323b5a6572859dedad02ca92fc65c diff --git a/src/lisp/ao_lisp_make_const.c b/src/lisp/ao_lisp_make_const.c index 6f852f9d..0f243eb0 100644 --- a/src/lisp/ao_lisp_make_const.c +++ b/src/lisp/ao_lisp_make_const.c @@ -15,6 +15,8 @@ #include "ao_lisp.h" #include #include +#include +#include static struct ao_lisp_builtin * ao_lisp_make_builtin(enum ao_lisp_builtin_id func, int args) { @@ -33,32 +35,42 @@ struct builtin_func { }; struct builtin_func funcs[] = { - "lambda", AO_LISP_FUNC_NLAMBDA, builtin_lambda, - "lexpr", AO_LISP_FUNC_NLAMBDA, builtin_lexpr, - "nlambda", AO_LISP_FUNC_NLAMBDA, builtin_nlambda, - "macro", AO_LISP_FUNC_NLAMBDA, builtin_macro, - "car", AO_LISP_FUNC_LAMBDA, builtin_car, - "cdr", AO_LISP_FUNC_LAMBDA, builtin_cdr, - "cons", AO_LISP_FUNC_LAMBDA, builtin_cons, - "last", AO_LISP_FUNC_LAMBDA, builtin_last, - "quote", AO_LISP_FUNC_NLAMBDA, builtin_quote, - "set", AO_LISP_FUNC_LAMBDA, builtin_set, - "setq", AO_LISP_FUNC_MACRO, builtin_setq, - "cond", AO_LISP_FUNC_NLAMBDA, builtin_cond, - "print", AO_LISP_FUNC_LEXPR, builtin_print, - "patom", AO_LISP_FUNC_LEXPR, builtin_patom, - "+", AO_LISP_FUNC_LEXPR, builtin_plus, - "-", AO_LISP_FUNC_LEXPR, builtin_minus, - "*", AO_LISP_FUNC_LEXPR, builtin_times, - "/", AO_LISP_FUNC_LEXPR, builtin_divide, - "%", AO_LISP_FUNC_LEXPR, builtin_mod, - "=", AO_LISP_FUNC_LEXPR, builtin_equal, - "<", AO_LISP_FUNC_LEXPR, builtin_less, - ">", AO_LISP_FUNC_LEXPR, builtin_greater, - "<=", AO_LISP_FUNC_LEXPR, builtin_less_equal, - ">=", AO_LISP_FUNC_LEXPR, builtin_greater_equal, - "delay", AO_LISP_FUNC_LAMBDA, builtin_delay, - "led", AO_LISP_FUNC_LEXPR, builtin_led, + { .name = "eval", .args = AO_LISP_FUNC_F_LAMBDA, .func = builtin_eval }, + { .name = "read", .args = AO_LISP_FUNC_F_LAMBDA, .func = builtin_read }, + { .name = "lambda", .args = AO_LISP_FUNC_NLAMBDA, .func = builtin_lambda }, + { .name = "lexpr", .args = AO_LISP_FUNC_NLAMBDA, .func = builtin_lexpr }, + { .name = "nlambda", .args = AO_LISP_FUNC_NLAMBDA, .func = builtin_nlambda }, + { .name = "macro", .args = AO_LISP_FUNC_NLAMBDA, .func = builtin_macro }, + { .name = "car", .args = AO_LISP_FUNC_F_LAMBDA, .func = builtin_car }, + { .name = "cdr", .args = AO_LISP_FUNC_F_LAMBDA, .func = builtin_cdr }, + { .name = "cons", .args = AO_LISP_FUNC_F_LAMBDA, .func = builtin_cons }, + { .name = "last", .args = AO_LISP_FUNC_F_LAMBDA, .func = builtin_last }, + { .name = "length", .args = AO_LISP_FUNC_F_LAMBDA, .func = builtin_length }, + { .name = "quote", .args = AO_LISP_FUNC_NLAMBDA, .func = builtin_quote }, + { .name = "set", .args = AO_LISP_FUNC_F_LAMBDA, .func = builtin_set }, + { .name = "setq", .args = AO_LISP_FUNC_MACRO, .func = builtin_setq }, + { .name = "cond", .args = AO_LISP_FUNC_NLAMBDA, .func = builtin_cond }, + { .name = "progn", .args = AO_LISP_FUNC_NLAMBDA, .func = builtin_progn }, + { .name = "while", .args = AO_LISP_FUNC_NLAMBDA, .func = builtin_while }, + { .name = "print", .args = AO_LISP_FUNC_F_LEXPR, .func = builtin_print }, + { .name = "patom", .args = AO_LISP_FUNC_F_LEXPR, .func = builtin_patom }, + { .name = "+", .args = AO_LISP_FUNC_F_LEXPR, .func = builtin_plus }, + { .name = "-", .args = AO_LISP_FUNC_F_LEXPR, .func = builtin_minus }, + { .name = "*", .args = AO_LISP_FUNC_F_LEXPR, .func = builtin_times }, + { .name = "/", .args = AO_LISP_FUNC_F_LEXPR, .func = builtin_divide }, + { .name = "%", .args = AO_LISP_FUNC_F_LEXPR, .func = builtin_mod }, + { .name = "=", .args = AO_LISP_FUNC_F_LEXPR, .func = builtin_equal }, + { .name = "<", .args = AO_LISP_FUNC_F_LEXPR, .func = builtin_less }, + { .name = ">", .args = AO_LISP_FUNC_F_LEXPR, .func = builtin_greater }, + { .name = "<=", .args = AO_LISP_FUNC_F_LEXPR, .func = builtin_less_equal }, + { .name = ">=", .args = AO_LISP_FUNC_F_LEXPR, .func = builtin_greater_equal }, + { .name = "pack", .args = AO_LISP_FUNC_F_LAMBDA, .func = builtin_pack }, + { .name = "unpack", .args = AO_LISP_FUNC_F_LAMBDA, .func = builtin_unpack }, + { .name = "flush", .args = AO_LISP_FUNC_F_LAMBDA, .func = builtin_flush }, + { .name = "delay", .args = AO_LISP_FUNC_F_LAMBDA, .func = builtin_delay }, + { .name = "led", .args = AO_LISP_FUNC_F_LEXPR, .func = builtin_led }, + { .name = "save", .args = AO_LISP_FUNC_F_LAMBDA, .func = builtin_save }, + { .name = "restore", .args = AO_LISP_FUNC_F_LAMBDA, .func = builtin_restore }, }; #define N_FUNC (sizeof funcs / sizeof funcs[0]) @@ -76,18 +88,243 @@ is_atom(int offset) return 0; } +#define AO_FEC_CRC_INIT 0xffff + +static inline uint16_t +ao_fec_crc_byte(uint8_t byte, uint16_t crc) +{ + uint8_t bit; + + for (bit = 0; bit < 8; bit++) { + if (((crc & 0x8000) >> 8) ^ (byte & 0x80)) + crc = (crc << 1) ^ 0x8005; + else + crc = (crc << 1); + byte <<= 1; + } + return crc; +} + +uint16_t +ao_fec_crc(const uint8_t *bytes, uint8_t len) +{ + uint16_t crc = AO_FEC_CRC_INIT; + + while (len--) + crc = ao_fec_crc_byte(*bytes++, crc); + return crc; +} + +struct ao_lisp_macro_stack { + struct ao_lisp_macro_stack *next; + ao_poly p; +}; + +struct ao_lisp_macro_stack *macro_stack; + +int +ao_lisp_macro_push(ao_poly p) +{ + struct ao_lisp_macro_stack *m = macro_stack; + + while (m) { + if (m->p == p) + return 1; + m = m->next; + } + m = malloc (sizeof (struct ao_lisp_macro_stack)); + m->p = p; + m->next = macro_stack; + macro_stack = m; + return 0; +} + +void +ao_lisp_macro_pop(void) +{ + struct ao_lisp_macro_stack *m = macro_stack; + + macro_stack = m->next; + free(m); +} + +#define DBG_MACRO 0 +#if DBG_MACRO +int macro_scan_depth; + +void indent(void) +{ + int i; + for (i = 0; i < macro_scan_depth; i++) + printf(" "); +} +#define MACRO_DEBUG(a) a +#else +#define MACRO_DEBUG(a) +#endif + +ao_poly +ao_has_macro(ao_poly p); + +ao_poly +ao_macro_test_get(ao_poly atom) +{ + ao_poly *ref = ao_lisp_atom_ref(ao_lisp_frame_global, atom); + if (ref) + return *ref; + return AO_LISP_NIL; +} + +ao_poly +ao_is_macro(ao_poly p) +{ + struct ao_lisp_builtin *builtin; + struct ao_lisp_lambda *lambda; + ao_poly ret; + + MACRO_DEBUG(indent(); printf ("is macro "); ao_lisp_poly_print(p); printf("\n"); ++macro_scan_depth); + switch (ao_lisp_poly_type(p)) { + case AO_LISP_ATOM: + if (ao_lisp_macro_push(p)) + ret = AO_LISP_NIL; + else { + if (ao_is_macro(ao_macro_test_get(p))) + ret = p; + else + ret = AO_LISP_NIL; + ao_lisp_macro_pop(); + } + break; + case AO_LISP_CONS: + ret = ao_has_macro(p); + break; + case AO_LISP_BUILTIN: + builtin = ao_lisp_poly_builtin(p); + if ((builtin->args & AO_LISP_FUNC_MASK) == AO_LISP_FUNC_MACRO) + ret = p; + else + ret = 0; + break; + + case AO_LISP_LAMBDA: + lambda = ao_lisp_poly_lambda(p); + if (lambda->args == AO_LISP_FUNC_MACRO) + ret = p; + else + ret = ao_has_macro(lambda->code); + break; + default: + ret = AO_LISP_NIL; + break; + } + MACRO_DEBUG(--macro_scan_depth; indent(); printf ("... "); ao_lisp_poly_print(ret); printf("\n")); + return ret; +} + +ao_poly +ao_has_macro(ao_poly p) +{ + struct ao_lisp_cons *cons; + struct ao_lisp_lambda *lambda; + ao_poly m; + + if (p == AO_LISP_NIL) + return AO_LISP_NIL; + + MACRO_DEBUG(indent(); printf("has macro "); ao_lisp_poly_print(p); printf("\n"); ++macro_scan_depth); + switch (ao_lisp_poly_type(p)) { + case AO_LISP_LAMBDA: + lambda = ao_lisp_poly_lambda(p); + p = ao_has_macro(lambda->code); + break; + case AO_LISP_CONS: + cons = ao_lisp_poly_cons(p); + if ((p = ao_is_macro(cons->car))) + break; + + cons = ao_lisp_poly_cons(cons->cdr); + p = AO_LISP_NIL; + while (cons) { + m = ao_has_macro(cons->car); + if (m) { + p = m; + break; + } + cons = ao_lisp_poly_cons(cons->cdr); + } + break; + + default: + p = AO_LISP_NIL; + break; + } + MACRO_DEBUG(--macro_scan_depth; indent(); printf("... "); ao_lisp_poly_print(p); printf("\n")); + return p; +} + +int +ao_lisp_read_eval_abort(void) +{ + ao_poly in, out = AO_LISP_NIL; + for(;;) { + in = ao_lisp_read(); + if (in == _ao_lisp_atom_eof) + break; + out = ao_lisp_eval(in); + if (ao_lisp_exception) + return 0; + ao_lisp_poly_print(out); + putchar ('\n'); + } + return 1; +} + +static FILE *in; +static FILE *out; + +int +ao_lisp_getc(void) +{ + return getc(in); +} + +static const struct option options[] = { + { .name = "out", .has_arg = 1, .val = 'o' }, + { 0, 0, 0, 0 } +}; + +static void usage(char *program) +{ + fprintf(stderr, "usage: %s [--out=] [input]\n", program); + exit(1); +} + int main(int argc, char **argv) { - int f, o, i; - ao_poly sexpr, val; + int f, o; + ao_poly val; struct ao_lisp_atom *a; struct ao_lisp_builtin *b; int in_atom; + char *out_name; + int c; - printf("/*\n"); - printf(" * Generated file, do not edit\n"); - for (f = 0; f < N_FUNC; f++) { + in = stdin; + out = stdout; + + while ((c = getopt_long(argc, argv, "o:", options, NULL)) != -1) { + switch (c) { + case 'o': + out_name = optarg; + break; + default: + usage(argv[0]); + break; + } + } + + for (f = 0; f < (int) N_FUNC; f++) { b = ao_lisp_make_builtin(funcs[f].func, funcs[f].args); a = ao_lisp_atom_intern(funcs[f].name); ao_lisp_atom_set(ao_lisp_atom_poly(a), @@ -101,59 +338,84 @@ main(int argc, char **argv) ao_lisp_atom_set(ao_lisp_atom_poly(a), ao_lisp_atom_poly(a)); - for (;;) { - sexpr = ao_lisp_read(); - if (!sexpr) - break; - printf ("sexpr: "); - ao_lisp_poly_print(sexpr); - printf("\n"); - val = ao_lisp_eval(sexpr); - if (ao_lisp_exception) + /* end of file value */ + a = ao_lisp_atom_intern("eof"); + ao_lisp_atom_set(ao_lisp_atom_poly(a), + ao_lisp_atom_poly(a)); + + if (argv[optind]){ + in = fopen(argv[optind], "r"); + if (!in) { + perror(argv[optind]); exit(1); - printf("\t"); - ao_lisp_poly_print(val); - printf("\n"); + } + } + if (!ao_lisp_read_eval_abort()) { + fprintf(stderr, "eval failed\n"); + exit(1); } /* Reduce to referenced values */ - ao_lisp_collect(); - printf(" */\n"); + ao_lisp_collect(AO_LISP_COLLECT_FULL); + + for (f = 0; f < ao_lisp_frame_num(ao_lisp_frame_global); f++) { + val = ao_has_macro(ao_lisp_frame_global->vals[f].val); + if (val != AO_LISP_NIL) { + printf("error: function %s contains unresolved macro: ", + ao_lisp_poly_atom(ao_lisp_frame_global->vals[f].atom)->name); + ao_lisp_poly_print(val); + printf("\n"); + exit(1); + } + } + + if (out_name) { + out = fopen(out_name, "w"); + if (!out) { + perror(out_name); + exit(1); + } + } + + fprintf(out, "/* Generated file, do not edit */\n\n"); + + fprintf(out, "#define AO_LISP_POOL_CONST %d\n", ao_lisp_top); + fprintf(out, "extern const uint8_t ao_lisp_const[AO_LISP_POOL_CONST] __attribute__((aligned(4)));\n"); + fprintf(out, "#define ao_builtin_atoms 0x%04x\n", ao_lisp_atom_poly(ao_lisp_atoms)); + fprintf(out, "#define ao_builtin_frame 0x%04x\n", ao_lisp_frame_poly(ao_lisp_frame_global)); + fprintf(out, "#define ao_lisp_const_checksum ((uint16_t) 0x%04x)\n", ao_fec_crc(ao_lisp_const, ao_lisp_top)); - printf("#define AO_LISP_POOL_CONST %d\n", ao_lisp_top); - printf("extern const uint8_t ao_lisp_const[AO_LISP_POOL_CONST] __attribute__((aligned(4)));\n"); - printf("#define ao_builtin_atoms 0x%04x\n", ao_lisp_atom_poly(ao_lisp_atoms)); - printf("#define ao_builtin_frame 0x%04x\n", ao_lisp_frame_poly(ao_lisp_frame_global)); for (a = ao_lisp_atoms; a; a = ao_lisp_poly_atom(a->next)) { char *n = a->name, c; - printf ("#define _ao_lisp_atom_"); + fprintf(out, "#define _ao_lisp_atom_"); while ((c = *n++)) { if (isalnum(c)) - printf("%c", c); + fprintf(out, "%c", c); else - printf("%02x", c); + fprintf(out, "%02x", c); } - printf(" 0x%04x\n", ao_lisp_atom_poly(a)); + fprintf(out, " 0x%04x\n", ao_lisp_atom_poly(a)); } - printf("#ifdef AO_LISP_CONST_BITS\n"); - printf("const uint8_t ao_lisp_const[] = {"); + fprintf(out, "#ifdef AO_LISP_CONST_BITS\n"); + fprintf(out, "const uint8_t ao_lisp_const[AO_LISP_POOL_CONST] __attribute((aligned(4))) = {"); for (o = 0; o < ao_lisp_top; o++) { uint8_t c; if ((o & 0xf) == 0) - printf("\n\t"); + fprintf(out, "\n\t"); else - printf(" "); + fprintf(out, " "); c = ao_lisp_const[o]; if (!in_atom) in_atom = is_atom(o); if (in_atom) { - printf (" '%c',", c); + fprintf(out, " '%c',", c); in_atom--; } else { - printf("0x%02x,", c); + fprintf(out, "0x%02x,", c); } } - printf("\n};\n"); - printf("#endif /* AO_LISP_CONST_BITS */\n"); + fprintf(out, "\n};\n"); + fprintf(out, "#endif /* AO_LISP_CONST_BITS */\n"); + exit(0); }