simple-lisp/src/main.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;
}