103 lines
3.3 KiB
C
103 lines
3.3 KiB
C
#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;
|
|
}
|