Zander671/simple-lisp
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Get returns working

Browse Source
This commit is contained in:
Alexander Rosenberg
2025-09-19 14:41:32 -07:00
parent 2b7f9b2fd6
commit 342bdfb169
4 changed files with 175 additions and 77 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
src/kernel.sl
View File

@ -138,3 +138,8 @@
(defmacro unwind-protect (form &rest unwind-forms) (defmacro unwind-protect (form &rest unwind-forms)
(list 'condition-case form (list 'condition-case form
(pair :finally unwind-forms))) (pair :finally unwind-forms)))
(defun test ()
(return-from test 10))
(println (test))

167
src/lisp.c
View File

@ -370,8 +370,8 @@ malformed:
Fthrow(Qmalformed_lambda_list_error, Fpair(args, Qnil)); Fthrow(Qmalformed_lambda_list_error, Fpair(args, Qnil));
} }
LispVal *make_lisp_function(LispVal *name, LispVal *args, LispVal *lexenv, LispVal *make_lisp_function(LispVal *name, LispVal *return_tag, LispVal *args,
LispVal *body, bool is_macro) { LispVal *lexenv, LispVal *body, bool is_macro) {
CONSTRUCT_OBJECT(self, LispFunction, TYPE_FUNCTION); CONSTRUCT_OBJECT(self, LispFunction, TYPE_FUNCTION);
self->is_builtin = false; self->is_builtin = false;
self->is_macro = is_macro; self->is_macro = is_macro;
@ -386,6 +386,7 @@ LispVal *make_lisp_function(LispVal *name, LispVal *args, LispVal *lexenv,
// do these after the potential throw // do these after the potential throw
self->name = refcount_ref(name); self->name = refcount_ref(name);
self->return_tag = refcount_ref(return_tag);
self->lexenv = refcount_ref(lexenv); self->lexenv = refcount_ref(lexenv);
if (STRINGP(HEAD(body))) { if (STRINGP(HEAD(body))) {
self->doc = refcount_ref(HEAD(body)); self->doc = refcount_ref(HEAD(body));
@ -687,7 +688,8 @@ DEF_STATIC_SYMBOL(toplevel, "toplevel");
void stack_enter(LispVal *name, LispVal *detail, bool inherit) { void stack_enter(LispVal *name, LispVal *detail, bool inherit) {
StackFrame *frame = lisp_malloc(sizeof(StackFrame)); StackFrame *frame = lisp_malloc(sizeof(StackFrame));
frame->name = (LispSymbol *) name; frame->name = name;
frame->return_tag = Qnil;
frame->hidden = true; frame->hidden = true;
frame->detail = detail; frame->detail = detail;
frame->lexenv = Qnil; frame->lexenv = Qnil;
@ -707,6 +709,7 @@ void stack_leave(void) {
StackFrame *frame = the_stack; StackFrame *frame = the_stack;
the_stack = the_stack->next; the_stack = the_stack->next;
refcount_unref(frame->name); refcount_unref(frame->name);
refcount_unref(frame->return_tag);
refcount_unref(frame->detail); refcount_unref(frame->detail);
refcount_unref(frame->lexenv); refcount_unref(frame->lexenv);
refcount_unref(frame->handlers); refcount_unref(frame->handlers);
@ -797,9 +800,18 @@ DEFUN(backtrace, "backtrace", (void) ) {
return head; return head;
} }
DEFUN(return_from, "return-from", (LispVal * name, LispVal *value)) { DEFMACRO(return_from, "return-from", (LispVal * name, LispVal *value)) {
// TODO actually write this Fthrow(Qreturn_frame_error, const_list(true, 2, name, value));
abort(); }
STATIC_DEFMACRO(internal_real_return, "internal-real-return",
(LispVal * name, LispVal *tag, LispVal *value)) {
for (StackFrame *cur = the_stack; cur; cur = cur->next) {
if (!NILP(cur->return_tag) && cur->return_tag == tag) {
Fthrow(cur->return_tag, const_list(true, 1, value));
}
}
Fthrow(Qreturn_frame_error, const_list(true, 2, name, value));
} }
#pragma GCC diagnostic push #pragma GCC diagnostic push
@ -938,6 +950,7 @@ static bool held_refs_callback(void *obj, RefcountList **held, void *ignored) {
case TYPE_FUNCTION: { case TYPE_FUNCTION: {
LispFunction *fn = obj; LispFunction *fn = obj;
*held = refcount_list_push(*held, fn->name); *held = refcount_list_push(*held, fn->name);
*held = refcount_list_push(*held, fn->return_tag);
*held = refcount_list_push(*held, fn->args); *held = refcount_list_push(*held, fn->args);
*held = refcount_list_push(*held, fn->kwargs); *held = refcount_list_push(*held, fn->kwargs);
*held = refcount_list_push(*held, fn->oargs); *held = refcount_list_push(*held, fn->oargs);
@ -1000,6 +1013,8 @@ static void free_obj_callback(void *obj, void *ignored) {
lisp_free(obj); lisp_free(obj);
} }
static DECLARE_FUNCTION(set_for_return, (LispVal * entry, LispVal *dest));
void lisp_init(void) { void lisp_init(void) {
RefcountContext *ctx = refcount_make_context( RefcountContext *ctx = refcount_make_context(
offsetof(LispVal, refcount), Qnil, held_refs_callback, offsetof(LispVal, refcount), Qnil, held_refs_callback,
@ -1038,8 +1053,10 @@ void lisp_init(void) {
REGISTER_SYMBOL(no_applicable_method_error); REGISTER_SYMBOL(no_applicable_method_error);
REGISTER_SYMBOL(return_frame_error); REGISTER_SYMBOL(return_frame_error);
refcount_init_static(Qtoplevel); // some stuff that musn't be user accesable
refcount_init_static(&_Qtoplevel_symnamestr); REGISTER_SYMBOL_NOINTERN(toplevel);
REGISTER_STATIC_FUNCTION(set_for_return, "(entry dest)", "");
REGISTER_STATIC_FUNCTION(internal_real_return, "(name tag value)", "");
REGISTER_FUNCTION(breakpoint, "(&opt id)", "Do nothing..."); REGISTER_FUNCTION(breakpoint, "(&opt id)", "Do nothing...");
REGISTER_FUNCTION(sethead, "(pair newval)", REGISTER_FUNCTION(sethead, "(pair newval)",
@ -1313,6 +1330,7 @@ too_few:
static LispVal *call_builtin(LispVal *name, LispFunction *func, LispVal *args, static LispVal *call_builtin(LispVal *name, LispFunction *func, LispVal *args,
LispVal *args_lexenv) { LispVal *args_lexenv) {
// builtin macros inherit their parents lexenv
if (func->is_macro) { if (func->is_macro) {
the_stack->lexenv = refcount_ref(args_lexenv); the_stack->lexenv = refcount_ref(args_lexenv);
} }
@ -1501,6 +1519,23 @@ static LispVal *call_lisp_function(LispVal *name, LispFunction *func,
} }
} }
STATIC_DEFUN(set_for_return, "set-for-return",
(LispVal * entry, LispVal *dest)) {
LispVal *retval = HEAD(TAIL(HEAD(entry)));
Fsethead(dest, retval);
return Qnil;
}
static inline void setup_return_handler(LispVal *tag, LispVal *dest) {
LispVal *err_var = INTERN_STATIC("e");
LispVal *quoted_dest = const_list(false, 2, Qquote, dest);
LispVal *handler =
const_list(true, 4, err_var, Qset_for_return, err_var, quoted_dest);
refcount_unref(quoted_dest);
puthash(the_stack->handlers, tag, handler);
refcount_unref(handler);
}
static LispVal *call_function(LispVal *func, LispVal *args, static LispVal *call_function(LispVal *func, LispVal *args,
LispVal *args_lexenv, bool eval_args, LispVal *args_lexenv, bool eval_args,
bool allow_macro) { bool allow_macro) {
@ -1524,21 +1559,32 @@ static LispVal *call_function(LispVal *func, LispVal *args,
args = eval_function_args(args, args_lexenv); args = eval_function_args(args, args_lexenv);
} }
LispVal *retval = Qnil; LispVal *retval = Qnil;
// builtin macros inherit their parents lexenv LispVal *return_ptr = Fpair(Qnil, Qnil);
void *return_cl_handle =
register_cleanup(refcount_unref_as_callback, return_ptr);
refcount_ref(args); refcount_ref(args);
WITH_CLEANUP(args, { WITH_CLEANUP(args, {
WITH_PUSH_FRAME( WITH_PUSH_FRAME_NO_REF_HANDLING_THROWS(
SYMBOLP(func) ? func : Qlambda, args, refcount_ref(fobj->name), refcount_ref(args),
false, // make sure the lexenv is nil false, // make sure the lexenv is nil
{ {
the_stack->hidden = false; the_stack->hidden = false;
if (!NILP(fobj->return_tag)) {
the_stack->return_tag = refcount_ref(fobj->return_tag);
setup_return_handler(fobj->return_tag, return_ptr);
}
if (fobj->is_builtin) { if (fobj->is_builtin) {
retval = call_builtin(func, fobj, args, args_lexenv); retval = call_builtin(func, fobj, args, args_lexenv);
} else { } else {
retval = call_lisp_function(func, fobj, args, args_lexenv); retval = call_lisp_function(func, fobj, args, args_lexenv);
} }
},
{
retval = refcount_ref(HEAD(return_ptr)); //
}); });
}); });
cancel_cleanup(return_cl_handle);
refcount_unref(return_ptr);
cancel_cleanup(cl_handle); cancel_cleanup(cl_handle);
return retval; return retval;
} }
@ -1674,12 +1720,12 @@ DEFUN(macroexpand_toplevel, "macroexpand-toplevel", (LispVal * form)) {
} }
// func should ref its return value // func should ref its return value
static LispVal *filter_body_tree(LispVal *form, static LispVal *filter_body_form(LispVal *form,
LispVal *(*func)(LispVal *body, LispVal *(*func)(LispVal *body,
void *user_data), void *user_data),
void *user_data) { void *user_data) {
if (PAIRP(form)) {
LispVal *toplevel_orig = func(form, user_data); LispVal *toplevel_orig = func(form, user_data);
if (PAIRP(toplevel_orig)) {
LispVal *toplevel; LispVal *toplevel;
WITH_CLEANUP(toplevel_orig, { WITH_CLEANUP(toplevel_orig, {
toplevel = Fcopy_list(toplevel_orig); // toplevel = Fcopy_list(toplevel_orig); //
@ -1689,24 +1735,46 @@ static LispVal *filter_body_tree(LispVal *form,
if (PAIRP(toplevel) && NILP(Feq(Qquote, HEAD(toplevel)))) { if (PAIRP(toplevel) && NILP(Feq(Qquote, HEAD(toplevel)))) {
FOREACH_TAIL(tail, TAIL(toplevel)) { FOREACH_TAIL(tail, TAIL(toplevel)) {
Fsethead(tail, Fsethead(tail,
filter_body_tree(HEAD(tail), func, user_data)); filter_body_form(HEAD(tail), func, user_data));
} }
} }
cancel_cleanup(cl_handler); cancel_cleanup(cl_handler);
}); });
return toplevel; return toplevel;
} else { } else {
return refcount_ref(form); return toplevel_orig;
} }
return Qnil; return Qnil;
} }
static LispVal *filter_body_tree(LispVal *body,
LispVal *(*func)(LispVal *body,
void *user_data),
void *user_data) {
LispVal *start = Qnil;
LispVal *end;
FOREACH(form, body) {
LispVal *filtered = filter_body_form(form, func, user_data);
if (NILP(start)) {
start = Fpair(filtered, Qnil);
end = start;
} else {
LispVal *new_end = Fpair(filtered, Qnil);
Fsettail(end, new_end);
refcount_unref(new_end);
end = new_end;
}
refcount_unref(filtered);
}
return start;
}
static LispVal *macroexpand_toplevel_as_callback(LispVal *form, void *ignored) { static LispVal *macroexpand_toplevel_as_callback(LispVal *form, void *ignored) {
return Fmacroexpand_toplevel(form); return Fmacroexpand_toplevel(form);
} }
DEFUN(macroexpand_all, "macroexpand-all", (LispVal * form)) { DEFUN(macroexpand_all, "macroexpand-all", (LispVal * form)) {
return filter_body_tree(form, macroexpand_toplevel_as_callback, NULL); return filter_body_form(form, macroexpand_toplevel_as_callback, NULL);
} }
DEFUN(apply, "apply", (LispVal * function, LispVal *rest)) { DEFUN(apply, "apply", (LispVal * function, LispVal *rest)) {
@ -2009,12 +2077,45 @@ static bool parse_function_declare(LispVal *form, LispVal **name_ptr) {
return false; return false;
} }
struct NameAndReturnTag {
LispVal *name;
LispVal *return_tag;
};
static LispVal *expand_function_body_callback(LispVal *body, void *data) { static LispVal *expand_function_body_callback(LispVal *body, void *data) {
return Fmacroexpand_toplevel(body); struct NameAndReturnTag *name_and_return_tag = data;
LispVal *expansion = Fmacroexpand_toplevel(body);
// this mess checks that the call is exactly one of
// - (return-from 'symbol)
// - (return-from 'symbol val)
if (PAIRP(expansion) && HEAD(expansion) == Qreturn_from
&& PAIRP(TAIL(expansion)) && LISTP(TAIL(TAIL(expansion)))
&& NILP(TAIL(TAIL(TAIL(expansion)))) && SYMBOLP(HEAD(TAIL(expansion)))
&& HEAD(TAIL(expansion)) == name_and_return_tag->name) {
LispVal *retval = Qnil;
if (!NILP(TAIL(TAIL(expansion)))) {
retval = refcount_ref(HEAD(TAIL(TAIL(expansion))));
}
refcount_unref(expansion);
return const_list(false, 4, Qinternal_real_return,
refcount_ref(name_and_return_tag->name),
refcount_ref(name_and_return_tag->return_tag),
retval);
} else if (PAIRP(expansion) && HEAD(expansion) == Qinternal_real_return
&& list_length(expansion) == 4
&& HEAD(TAIL(expansion)) == name_and_return_tag->name
&& HEAD(TAIL(TAIL(expansion)))
!= name_and_return_tag->return_tag) {
Fsethead(TAIL(TAIL(expansion)), name_and_return_tag->return_tag);
}
return expansion;
} }
static inline LispVal *expand_function_body(LispVal *body) { static inline LispVal *expand_function_body(LispVal *name, LispVal *return_tag,
return filter_body_tree(body, expand_function_body_callback, NULL); LispVal *body) {
return filter_body_tree(
body, expand_function_body_callback,
&(struct NameAndReturnTag) {.name = name, .return_tag = return_tag});
} }
DEFMACRO(defun, "defun", (LispVal * name, LispVal *args, LispVal *body)) { DEFMACRO(defun, "defun", (LispVal * name, LispVal *args, LispVal *body)) {
@ -2022,10 +2123,13 @@ DEFMACRO(defun, "defun", (LispVal * name, LispVal *args, LispVal *body)) {
if (parse_function_declare(HEAD(body), NULL)) { if (parse_function_declare(HEAD(body), NULL)) {
body = TAIL(body); body = TAIL(body);
} }
LispVal *expanded_body = expand_function_body(body); LispVal *return_tag =
make_lisp_symbol(LISPVAL(((LispSymbol *) name)->name));
LispVal *expanded_body = expand_function_body(name, return_tag, body);
LispVal *func = Qnil; LispVal *func = Qnil;
WITH_CLEANUP(expanded_body, { WITH_CLEANUP(expanded_body, {
func = make_lisp_function(name, args, the_stack->lexenv, body, false); func = make_lisp_function(name, return_tag, args, the_stack->lexenv,
expanded_body, false);
}); });
refcount_unref(Ffset(name, func)); refcount_unref(Ffset(name, func));
return func; return func;
@ -2036,25 +2140,36 @@ DEFMACRO(defmacro, "defmacro", (LispVal * name, LispVal *args, LispVal *body)) {
if (parse_function_declare(HEAD(body), NULL)) { if (parse_function_declare(HEAD(body), NULL)) {
body = TAIL(body); body = TAIL(body);
} }
LispVal *expanded_body = expand_function_body(body); LispVal *return_tag =
make_lisp_symbol(LISPVAL(((LispSymbol *) name)->name));
LispVal *expanded_body = expand_function_body(name, return_tag, body);
LispVal *func = Qnil; LispVal *func = Qnil;
WITH_CLEANUP(expanded_body, { WITH_CLEANUP(expanded_body, {
func = make_lisp_function(name, args, the_stack->lexenv, body, true); func = make_lisp_function(name, return_tag, args, the_stack->lexenv,
expanded_body, true);
}); });
refcount_unref(Ffset(name, func)); refcount_unref(Ffset(name, func));
return func; return func;
} }
DEFMACRO(lambda, "lambda", (LispVal * args, LispVal *body)) { DEFMACRO(lambda, "lambda", (LispVal * args, LispVal *body)) {
LispVal *name = Qlambda; LispVal *name = Qunbound;
if (parse_function_declare(HEAD(body), &name)) { if (parse_function_declare(HEAD(body), &name)) {
body = TAIL(body); body = TAIL(body);
} }
LispVal *return_tag;
if (name == Qunbound) {
name = Qlambda;
return_tag = make_lisp_symbol(LISPVAL(((LispSymbol *) Qnil)->name));
} else {
CHECK_TYPE(TYPE_SYMBOL, name);
return_tag = make_lisp_symbol(LISPVAL(((LispSymbol *) name)->name));
}
LispVal *expanded_body = Fmacroexpand_all(body); LispVal *expanded_body = Fmacroexpand_all(body);
LispVal *func = Qnil; LispVal *func = Qnil;
WITH_CLEANUP(expanded_body, { WITH_CLEANUP(expanded_body, {
func = make_lisp_function(name, args, the_stack->lexenv, expanded_body, func = make_lisp_function(name, return_tag, args, the_stack->lexenv,
false); expanded_body, false);
}); });
return func; return func;
} }

24
src/lisp.h
View File

@ -108,6 +108,7 @@ typedef struct {
LISP_OBJECT_HEADER; LISP_OBJECT_HEADER;
LispVal *name; LispVal *name;
LispVal *return_tag;
LispVal *doc; LispVal *doc;
LispVal *args; LispVal *args;
bool is_builtin; bool is_builtin;
@ -267,6 +268,8 @@ inline static bool NUMBERP(LispVal *v) {
_INTERNAL_DEFUN_EXTENDED(true, c_name, lisp_name, c_args, ) _INTERNAL_DEFUN_EXTENDED(true, c_name, lisp_name, c_args, )
#define STATIC_DEFUN(c_name, lisp_name, c_args) \ #define STATIC_DEFUN(c_name, lisp_name, c_args) \
_INTERNAL_DEFUN_EXTENDED(false, c_name, lisp_name, c_args, static) _INTERNAL_DEFUN_EXTENDED(false, c_name, lisp_name, c_args, static)
#define STATIC_DEFMACRO(c_name, lisp_name, c_args) \
_INTERNAL_DEFUN_EXTENDED(true, c_name, lisp_name, c_args, static)
// ############### // ###############
// # Loop macros # // # Loop macros #
@ -318,8 +321,8 @@ LispVal *make_lisp_integer(intmax_t value);
LispVal *make_lisp_float(long double value); LispVal *make_lisp_float(long double value);
LispVal *make_lisp_vector(LispVal **data, size_t length); LispVal *make_lisp_vector(LispVal **data, size_t length);
void set_function_args(LispFunction *func, LispVal *args); void set_function_args(LispFunction *func, LispVal *args);
LispVal *make_lisp_function(LispVal *name, LispVal *args, LispVal *lexenv, LispVal *make_lisp_function(LispVal *name, LispVal *return_tag, LispVal *args,
LispVal *body, bool is_macro); LispVal *lexenv, LispVal *body, bool is_macro);
LispVal *make_lisp_hashtable(LispVal *eq_fn, LispVal *hash_fn); LispVal *make_lisp_hashtable(LispVal *eq_fn, LispVal *hash_fn);
LispVal *make_user_pointer(void *data, void (*free_func)(void *)); LispVal *make_user_pointer(void *data, void (*free_func)(void *));
#define ALLOC_USERPTR(type, free_func) \ #define ALLOC_USERPTR(type, free_func) \
@ -422,7 +425,8 @@ struct CleanupHandlerEntry {
typedef struct StackFrame { typedef struct StackFrame {
struct StackFrame *next; struct StackFrame *next;
bool hidden; bool hidden;
LispSymbol *name; LispVal *name;
LispVal *return_tag;
LispVal *detail; // function arguments LispVal *detail; // function arguments
LispVal *lexenv; // symbol -> value LispVal *lexenv; // symbol -> value
bool enable_handlers; bool enable_handlers;
@ -519,14 +523,18 @@ LispVal *predicate_for_type(LispType type);
extern LispVal *Vobarray; extern LispVal *Vobarray;
#define REGISTER_SYMBOL(sym) \ #define REGISTER_SYMBOL_NOINTERN(sym) \
{ \ { \
refcount_init_static(Q##sym); \ refcount_init_static(Q##sym); \
refcount_init_static(((LispSymbol *) Q##sym)->name); \ refcount_init_static(((LispSymbol *) Q##sym)->name); \
puthash(Vobarray, LISPVAL(((LispSymbol *) Q##sym)->name), Q##sym); \
} }
#define REGISTER_STATIC_FUNCTION(obj, args, docstr) \ #define REGISTER_SYMBOL(sym) \
REGISTER_SYMBOL_NOINTERN(sym) \
puthash(Vobarray, LISPVAL(((LispSymbol *) Q##sym)->name), Q##sym);
#define REGISTER_STATIC_FUNCTION(name, args, docstr) \
REGISTER_SYMBOL_NOINTERN(name); \
{ \ { \
LispVal *obj = ((LispSymbol *) Q##name)->function; \
refcount_init_static(obj); \ refcount_init_static(obj); \
((LispFunction *) (obj))->doc = STATIC_STRING(docstr); \ ((LispFunction *) (obj))->doc = STATIC_STRING(docstr); \
LispVal *src = STATIC_STRING(args); \ LispVal *src = STATIC_STRING(args); \
@ -536,8 +544,8 @@ extern LispVal *Vobarray;
refcount_unref(a); \ refcount_unref(a); \
} }
#define REGISTER_FUNCTION(fn, args, docstr) \ #define REGISTER_FUNCTION(fn, args, docstr) \
REGISTER_SYMBOL(fn); \ REGISTER_STATIC_FUNCTION(fn, args, docstr); \
REGISTER_STATIC_FUNCTION(((LispSymbol *) Q##fn)->function, args, docstr); puthash(Vobarray, LISPVAL(((LispSymbol *) Q##fn)->name), Q##fn);
void lisp_init(void); void lisp_init(void);
void lisp_shutdown(void); void lisp_shutdown(void);

46
src/main.c
View File

@ -3,22 +3,8 @@
static int exit_status = 0; static int exit_status = 0;
LispVal *Ftoplevel_exit_handler(LispVal *except); STATIC_DEFUN(toplevel_exit_handler, "toplevel-exit-handler",
static LispFunction _Ftoplevel_exit_handler_function = { (LispVal * except)) {
.type = TYPE_FUNCTION,
.is_builtin = true,
.is_macro = false,
.builtin = (lisp_function_ptr_t) &Ftoplevel_exit_handler,
.args = Qnil,
.kwargs = Qnil,
.rargs = Qnil,
.oargs = Qnil,
.rest_arg = Qnil,
.lexenv = Qnil,
};
#define Ftoplevel_exit_handler_function \
LISPVAL(&_Ftoplevel_exit_handler_function)
LispVal *Ftoplevel_exit_handler(LispVal *except) {
LispVal *detail = TAIL(HEAD(except)); LispVal *detail = TAIL(HEAD(except));
if (NILP(detail) || NILP(HEAD(detail))) { if (NILP(detail) || NILP(HEAD(detail))) {
exit_status = 0; exit_status = 0;
@ -30,22 +16,8 @@ LispVal *Ftoplevel_exit_handler(LispVal *except) {
return Qnil; return Qnil;
} }
LispVal *Ftoplevel_error_handler(LispVal *except); STATIC_DEFUN(toplevel_error_handler, "toplevel-error-handler",
static LispFunction _Ftoplevel_error_handler_function = { (LispVal * except)) {
.type = TYPE_FUNCTION,
.is_builtin = true,
.is_macro = false,
.builtin = (lisp_function_ptr_t) &Ftoplevel_error_handler,
.args = Qnil,
.kwargs = Qnil,
.lexenv = Qnil,
.rargs = Qnil,
.oargs = Qnil,
.rest_arg = Qnil,
};
#define Ftoplevel_error_handler_function \
LISPVAL(&_Ftoplevel_error_handler_function)
LispVal *Ftoplevel_error_handler(LispVal *except) {
LispVal *type = HEAD(HEAD(except)); LispVal *type = HEAD(HEAD(except));
LispVal *detail = TAIL(HEAD(except)); LispVal *detail = TAIL(HEAD(except));
LispVal *backtrace = HEAD(TAIL(except)); LispVal *backtrace = HEAD(TAIL(except));
@ -84,19 +56,17 @@ int main(int argc, const char **argv) {
fclose(in); fclose(in);
lisp_init(); lisp_init();
REGISTER_SYMBOL(toplevel_read); REGISTER_SYMBOL(toplevel_read);
REGISTER_STATIC_FUNCTION(Ftoplevel_error_handler_function, "(e)", ""); REGISTER_STATIC_FUNCTION(toplevel_error_handler, "(e)", "");
REGISTER_STATIC_FUNCTION(Ftoplevel_exit_handler_function, "(e)", ""); REGISTER_STATIC_FUNCTION(toplevel_exit_handler, "(e)", "");
size_t pos = 0; size_t pos = 0;
WITH_PUSH_FRAME(Qtoplevel, Qnil, false, { WITH_PUSH_FRAME(Qtoplevel, Qnil, false, {
LispVal *err_var = INTERN_STATIC("err-var"); LispVal *err_var = INTERN_STATIC("err-var");
puthash(the_stack->handlers, Qt, puthash(the_stack->handlers, Qt,
// simply call the above function // simply call the above function
const_list(true, 3, err_var, Ftoplevel_error_handler_function, const_list(true, 3, err_var, Qtoplevel_error_handler, err_var));
err_var));
puthash(the_stack->handlers, Qshutdown_signal, puthash(the_stack->handlers, Qshutdown_signal,
// simply call the above function // simply call the above function
const_list(true, 3, err_var, Ftoplevel_exit_handler_function, const_list(true, 3, err_var, Qtoplevel_exit_handler, err_var));
err_var));
LispVal *nil_nil = Fpair(Qnil, Qnil); LispVal *nil_nil = Fpair(Qnil, Qnil);
puthash(the_stack->handlers, Qeof_error, puthash(the_stack->handlers, Qeof_error,
// ignore // ignore