X-Git-Url: https://git.gag.com/?p=fw%2Faltos;a=blobdiff_plain;f=src%2Flisp%2Fao_lisp_make_const.c;h=ae53bd35ca6f0de86d123e0c07970c55330d7194;hp=178b041efbc5773d3457f81724ac842ba55b7966;hb=974717eb9dad105c9897ee24f953d98d57eaec77;hpb=b3b5bd2c14cfcde6c551a87ee6da08a53f1e4bc6 diff --git a/src/lisp/ao_lisp_make_const.c b/src/lisp/ao_lisp_make_const.c index 178b041e..ae53bd35 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,42 +35,42 @@ struct builtin_func { }; struct builtin_func funcs[] = { - "eval", AO_LISP_FUNC_F_LAMBDA, builtin_eval, - "read", AO_LISP_FUNC_F_LAMBDA, builtin_read, - "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_F_LAMBDA, builtin_car, - "cdr", AO_LISP_FUNC_F_LAMBDA, builtin_cdr, - "cons", AO_LISP_FUNC_F_LAMBDA, builtin_cons, - "last", AO_LISP_FUNC_F_LAMBDA, builtin_last, - "length", AO_LISP_FUNC_F_LAMBDA, builtin_length, - "quote", AO_LISP_FUNC_NLAMBDA, builtin_quote, - "set", AO_LISP_FUNC_F_LAMBDA, builtin_set, - "setq", AO_LISP_FUNC_MACRO, builtin_setq, - "cond", AO_LISP_FUNC_NLAMBDA, builtin_cond, - "progn", AO_LISP_FUNC_NLAMBDA, builtin_progn, - "while", AO_LISP_FUNC_NLAMBDA, builtin_while, - "print", AO_LISP_FUNC_F_LEXPR, builtin_print, - "patom", AO_LISP_FUNC_F_LEXPR, builtin_patom, - "+", AO_LISP_FUNC_F_LEXPR, builtin_plus, - "-", AO_LISP_FUNC_F_LEXPR, builtin_minus, - "*", AO_LISP_FUNC_F_LEXPR, builtin_times, - "/", AO_LISP_FUNC_F_LEXPR, builtin_divide, - "%", AO_LISP_FUNC_F_LEXPR, builtin_mod, - "=", AO_LISP_FUNC_F_LEXPR, builtin_equal, - "<", AO_LISP_FUNC_F_LEXPR, builtin_less, - ">", AO_LISP_FUNC_F_LEXPR, builtin_greater, - "<=", AO_LISP_FUNC_F_LEXPR, builtin_less_equal, - ">=", AO_LISP_FUNC_F_LEXPR, builtin_greater_equal, - "pack", AO_LISP_FUNC_F_LAMBDA, builtin_pack, - "unpack", AO_LISP_FUNC_F_LAMBDA, builtin_unpack, - "flush", AO_LISP_FUNC_F_LAMBDA, builtin_flush, - "delay", AO_LISP_FUNC_F_LAMBDA, builtin_delay, - "led", AO_LISP_FUNC_F_LEXPR, builtin_led, - "save", AO_LISP_FUNC_F_LAMBDA, builtin_save, - "restore", AO_LISP_FUNC_F_LAMBDA, builtin_restore, + { .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]) @@ -113,18 +115,127 @@ ao_fec_crc(const uint8_t *bytes, uint8_t len) return crc; } +int +ao_is_macro(ao_poly p) +{ + struct ao_lisp_builtin *builtin; + struct ao_lisp_lambda *lambda; + +// printf ("macro scanning "); ao_lisp_poly_print(p); printf("\n"); + switch (ao_lisp_poly_type(p)) { + case AO_LISP_ATOM: + return ao_is_macro(ao_lisp_atom_get(p)); + case AO_LISP_BUILTIN: + builtin = ao_lisp_poly_builtin(p); + if ((builtin->args & AO_LISP_FUNC_MASK) == AO_LISP_FUNC_MACRO) + return 1; + return 0; + case AO_LISP_LAMBDA: + lambda = ao_lisp_poly_lambda(p); + if (lambda->args == AO_LISP_FUNC_MACRO) + return 1; + return 0; + default: + return 0; + } +} + +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; + + switch (ao_lisp_poly_type(p)) { + case AO_LISP_LAMBDA: + lambda = ao_lisp_poly_lambda(p); + return ao_has_macro(lambda->code); + case AO_LISP_CONS: + cons = ao_lisp_poly_cons(p); + if (ao_is_macro(cons->car)) + return cons->car; + + cons = ao_lisp_poly_cons(cons->cdr); + while (cons) { + m = ao_has_macro(cons->car); + if (m) + return m; + cons = ao_lisp_poly_cons(cons->cdr); + } + return AO_LISP_NIL; + + default: + return AO_LISP_NIL; + } +} + +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; + + 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; + } + } - printf("/*\n"); - printf(" * Generated file, do not edit\n"); - for (f = 0; f < N_FUNC; f++) { + 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), @@ -143,47 +254,79 @@ main(int argc, char **argv) ao_lisp_atom_set(ao_lisp_atom_poly(a), ao_lisp_atom_poly(a)); - ao_lisp_read_eval_print(); + if (argv[optind]){ + in = fopen(argv[optind], "r"); + if (!in) { + perror(argv[optind]); + exit(1); + } + } + if (!ao_lisp_read_eval_abort()) { + fprintf(stderr, "eval failed\n"); + exit(1); + } /* Reduce to referenced values */ ao_lisp_collect(); - printf(" */\n"); - 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)); - printf("#define ao_lisp_const_checksum ((uint16_t) 0x%04x)\n", ao_fec_crc(ao_lisp_const, ao_lisp_top)); + for (f = 0; f < ao_lisp_frame_global->num; 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(stderr, "\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)); + 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[] = {"); 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); }