#include "lisp.h" #include "read.h" static int exit_status = 0; STATIC_DEFUN(toplevel_exit_handler, "toplevel-exit-handler", (LispVal * except)) { LispVal *detail = TAIL(HEAD(except)); if (NILP(detail) || NILP(HEAD(detail))) { exit_status = 0; } else if (!INTEGERP(HEAD(detail))) { exit_status = 1; } else { exit_status = ((LispInteger *) HEAD(detail))->value; } return Qnil; } STATIC_DEFUN(toplevel_error_handler, "toplevel-error-handler", (LispVal * except)) { LispVal *type = HEAD(HEAD(except)); LispVal *detail = TAIL(HEAD(except)); LispVal *backtrace = HEAD(TAIL(except)); fprintf(stderr, "Caught signal of type "); debug_dump(stderr, type, true); if (!NILP(detail)) { fprintf(stderr, "Details: "); debug_dump(stderr, detail, true); } fprintf(stderr, "\nBacktrace (toplevel comes last):\n"); FOREACH(frame, backtrace) { fprintf(stderr, " "); debug_dump(stderr, frame, true); } exit_status = 1; return Qnil; } DEF_STATIC_SYMBOL(toplevel_read, "toplevel-read"); int main(int argc, const char **argv) { if (argc < 2) { fprintf(stderr, "No input file!\n"); return 1; } FILE *in = fopen(argv[1], "r"); if (!in) { perror("fopen"); return 1; } fseek(in, 0, SEEK_END); off_t file_len = ftello(in); rewind(in); char buffer[file_len]; fread(buffer, 1, file_len, in); fclose(in); lisp_init(); REGISTER_SYMBOL(toplevel_read); REGISTER_STATIC_FUNCTION(toplevel_error_handler, "(e)", ""); REGISTER_STATIC_FUNCTION(toplevel_exit_handler, "(e)", ""); size_t pos = 0; WITH_PUSH_FRAME(Qtoplevel, Qnil, false, { the_stack->hidden = false; LispVal *err_var = INTERN_STATIC("err-var", system_package); puthash(the_stack->handlers, Qt, // simply call the above function const_list(true, 3, err_var, Qtoplevel_error_handler, err_var)); puthash(the_stack->handlers, Qshutdown_signal, // simply call the above function const_list(true, 3, err_var, Qtoplevel_exit_handler, err_var)); LispVal *nil_nil = Fpair(Qnil, Qnil); puthash(the_stack->handlers, Qeof_error, // ignore nil_nil); refcount_unref(nil_nil); refcount_unref(err_var); while (true) { LispVal *tv; WITH_PUSH_FRAME(Qtoplevel_read, Qnil, false, { size_t res = read_from_buffer(buffer + pos, file_len - pos, current_package, &tv); if (res == LISP_EOF) { break; } pos += res; }); WITH_CLEANUP(tv, { // this is not needed right now as we eval right after reading, // but it will be later when we read the whole file before // evaling, so I am testing this here if (PAIRP(tv) && HEAD(tv) == Qin_package && list_length(tv) == 2) { refcount_unref(Fset_current_package(HEAD(TAIL(tv)))); } else { refcount_unref(Feval(tv)); // } }); } }); lisp_shutdown(); return exit_status; }