Move things arround
This commit is contained in:
3442
src/lisp.c
3442
src/lisp.c
File diff suppressed because it is too large
Load Diff
630
src/lisp.h
630
src/lisp.h
@ -48,6 +48,7 @@ extern struct _TypeNameEntry LISP_TYPE_NAMES[N_LISP_TYPES];
|
|||||||
typedef struct {
|
typedef struct {
|
||||||
LISP_OBJECT_HEADER;
|
LISP_OBJECT_HEADER;
|
||||||
} LispVal;
|
} LispVal;
|
||||||
|
#define LISPVAL(obj) ((LispVal *) (obj))
|
||||||
|
|
||||||
typedef struct {
|
typedef struct {
|
||||||
LISP_OBJECT_HEADER;
|
LISP_OBJECT_HEADER;
|
||||||
@ -95,17 +96,7 @@ typedef struct {
|
|||||||
bool is_static;
|
bool is_static;
|
||||||
} LispVector;
|
} LispVector;
|
||||||
|
|
||||||
struct OptArgDesc {
|
|
||||||
size_t index; // only for keywords
|
|
||||||
LispVal *name;
|
|
||||||
LispVal *default_form;
|
|
||||||
LispVal *pred_var;
|
|
||||||
};
|
|
||||||
|
|
||||||
void free_opt_arg_desc(void *obj);
|
|
||||||
|
|
||||||
typedef void (*lisp_function_ptr_t)(void);
|
typedef void (*lisp_function_ptr_t)(void);
|
||||||
|
|
||||||
typedef struct {
|
typedef struct {
|
||||||
LISP_OBJECT_HEADER;
|
LISP_OBJECT_HEADER;
|
||||||
|
|
||||||
@ -175,8 +166,6 @@ typedef struct {
|
|||||||
// #######################
|
// #######################
|
||||||
// # nil, unbound, and t #
|
// # nil, unbound, and t #
|
||||||
// #######################
|
// #######################
|
||||||
#define LISPVAL(obj) ((LispVal *) (obj))
|
|
||||||
|
|
||||||
extern LispSymbol _Qnil;
|
extern LispSymbol _Qnil;
|
||||||
extern LispSymbol _Qunbound; // don't intern!
|
extern LispSymbol _Qunbound; // don't intern!
|
||||||
extern LispSymbol _Qt;
|
extern LispSymbol _Qt;
|
||||||
@ -187,6 +176,27 @@ extern LispSymbol _Qt;
|
|||||||
|
|
||||||
#define LISP_BOOL(v) ((v) ? Qt : Qnil)
|
#define LISP_BOOL(v) ((v) ? Qt : Qnil)
|
||||||
|
|
||||||
|
// ###########################
|
||||||
|
// # Other important symbols #
|
||||||
|
// ###########################
|
||||||
|
extern LispVal *Qbackquote;
|
||||||
|
extern LispVal *Qcomma;
|
||||||
|
extern LispVal *Qcomma_at;
|
||||||
|
extern LispVal *Qopt;
|
||||||
|
extern LispVal *Qkey;
|
||||||
|
extern LispVal *Qallow_other_keys;
|
||||||
|
extern LispVal *Qrest;
|
||||||
|
extern LispVal *Qdeclare;
|
||||||
|
extern LispVal *Qname;
|
||||||
|
|
||||||
|
// ############################
|
||||||
|
// # Global Package Variables #
|
||||||
|
// ############################
|
||||||
|
extern LispVal *package_table;
|
||||||
|
extern LispVal *system_package;
|
||||||
|
extern LispVal *keyword_package;
|
||||||
|
extern LispVal *current_package;
|
||||||
|
|
||||||
// ###################
|
// ###################
|
||||||
// # Type predicates #
|
// # Type predicates #
|
||||||
// ###################
|
// ###################
|
||||||
@ -210,11 +220,6 @@ extern LispSymbol _Qt;
|
|||||||
|
|
||||||
#define ATOM(v) (TYPEOF(v) != TYPE_PAIR)
|
#define ATOM(v) (TYPEOF(v) != TYPE_PAIR)
|
||||||
|
|
||||||
extern LispVal *package_table;
|
|
||||||
extern LispVal *system_package;
|
|
||||||
extern LispVal *keyword_package;
|
|
||||||
extern LispVal *current_package;
|
|
||||||
|
|
||||||
inline static bool KEYWORDP(LispVal *v) {
|
inline static bool KEYWORDP(LispVal *v) {
|
||||||
return SYMBOLP(v) && ((LispSymbol *) v)->package == keyword_package;
|
return SYMBOLP(v) && ((LispSymbol *) v)->package == keyword_package;
|
||||||
}
|
}
|
||||||
@ -295,6 +300,36 @@ inline static bool NUMBERP(LispVal *v) {
|
|||||||
#define STATIC_DEFMACRO(c_name, lisp_name, c_args) \
|
#define STATIC_DEFMACRO(c_name, lisp_name, c_args) \
|
||||||
_INTERNAL_DEFUN_EXTENDED(true, false, c_name, lisp_name, c_args, static)
|
_INTERNAL_DEFUN_EXTENDED(true, false, c_name, lisp_name, c_args, static)
|
||||||
|
|
||||||
|
// registration
|
||||||
|
#define REGISTER_SYMBOL_NOINTERN(sym) \
|
||||||
|
{ \
|
||||||
|
refcount_init_static(Q##sym); \
|
||||||
|
refcount_init_static(((LispSymbol *) Q##sym)->name); \
|
||||||
|
}
|
||||||
|
#define REGISTER_SYMBOL_INTO(sym, pkg) \
|
||||||
|
REGISTER_SYMBOL_NOINTERN(sym) \
|
||||||
|
((LispSymbol *) Q##sym)->package = refcount_ref(pkg); \
|
||||||
|
puthash(((LispPackage *) pkg)->obarray, \
|
||||||
|
LISPVAL(((LispSymbol *) Q##sym)->name), Q##sym);
|
||||||
|
#define REGISTER_SYMBOL(sym) REGISTER_SYMBOL_INTO(sym, system_package)
|
||||||
|
#define REGISTER_STATIC_FUNCTION(name, args, docstr) \
|
||||||
|
REGISTER_SYMBOL_NOINTERN(name); \
|
||||||
|
{ \
|
||||||
|
LispVal *obj = ((LispSymbol *) Q##name)->function; \
|
||||||
|
refcount_init_static(obj); \
|
||||||
|
((LispFunction *) (obj))->doc = STATIC_STRING(docstr); \
|
||||||
|
LispVal *src = STATIC_STRING(args); \
|
||||||
|
LispVal *a = Fread(src, system_package); \
|
||||||
|
set_function_args((LispFunction *) (obj), a); \
|
||||||
|
refcount_unref(src); \
|
||||||
|
refcount_unref(a); \
|
||||||
|
}
|
||||||
|
#define REGISTER_FUNCTION(fn, args, docstr) \
|
||||||
|
REGISTER_STATIC_FUNCTION(fn, args, docstr); \
|
||||||
|
((LispSymbol *) Q##fn)->package = refcount_ref(system_package); \
|
||||||
|
puthash(((LispPackage *) system_package)->obarray, \
|
||||||
|
LISPVAL(((LispSymbol *) Q##fn)->name), Q##fn);
|
||||||
|
|
||||||
// ###############
|
// ###############
|
||||||
// # Loop macros #
|
// # Loop macros #
|
||||||
// ###############
|
// ###############
|
||||||
@ -324,7 +359,6 @@ inline static bool NUMBERP(LispVal *v) {
|
|||||||
// #############################
|
// #############################
|
||||||
// # Allocation and references #
|
// # Allocation and references #
|
||||||
// #############################
|
// #############################
|
||||||
|
|
||||||
#define GC_EVERY_N_BYTES 1024 * 80
|
#define GC_EVERY_N_BYTES 1024 * 80
|
||||||
void *lisp_malloc(size_t size);
|
void *lisp_malloc(size_t size);
|
||||||
void *lisp_realloc(void *old_ptr, size_t size);
|
void *lisp_realloc(void *old_ptr, size_t size);
|
||||||
@ -338,13 +372,11 @@ void garbage_collect(void);
|
|||||||
LispVal *make_lisp_string(const char *data, size_t length, bool take,
|
LispVal *make_lisp_string(const char *data, size_t length, bool take,
|
||||||
bool is_static);
|
bool is_static);
|
||||||
#define STATIC_STRING(s) (make_lisp_string((s), sizeof(s) - 1, true, true))
|
#define STATIC_STRING(s) (make_lisp_string((s), sizeof(s) - 1, true, true))
|
||||||
LispVal *sprintf_lisp(const char *format, ...) PRINTF_FORMAT(1, 2);
|
|
||||||
LispVal *make_lisp_symbol(LispVal *name);
|
LispVal *make_lisp_symbol(LispVal *name);
|
||||||
LispVal *make_lisp_pair(LispVal *head, LispVal *tail);
|
LispVal *make_lisp_pair(LispVal *head, LispVal *tail);
|
||||||
LispVal *make_lisp_integer(intmax_t value);
|
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);
|
|
||||||
LispVal *make_lisp_function(LispVal *name, LispVal *return_tag, LispVal *args,
|
LispVal *make_lisp_function(LispVal *name, LispVal *return_tag, LispVal *args,
|
||||||
LispVal *lexenv, 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);
|
||||||
@ -353,41 +385,309 @@ LispVal *make_user_pointer(void *data, void (*free_func)(void *));
|
|||||||
(make_user_pointer(lisp_malloc(sizeof(type)), &free_func))
|
(make_user_pointer(lisp_malloc(sizeof(type)), &free_func))
|
||||||
LispVal *make_lisp_package(LispVal *name);
|
LispVal *make_lisp_package(LispVal *name);
|
||||||
|
|
||||||
// ########################
|
LispVal *predicate_for_type(LispType type);
|
||||||
// # Utility and internal #
|
|
||||||
// ########################
|
|
||||||
bool strings_equal_nocase(const char *s1, const char *s2, size_t n);
|
|
||||||
|
|
||||||
DECLARE_FUNCTION(make_hashtable, (LispVal * hash_fn, LispVal *eq_fn));
|
// ###############################
|
||||||
DECLARE_FUNCTION(pair, (LispVal * head, LispVal *tail));
|
// # Initialization and Shutdown #
|
||||||
DECLARE_FUNCTION(hash_string, (LispVal * obj));
|
// ###############################
|
||||||
DECLARE_FUNCTION(strings_equal, (LispVal * obj1, LispVal *obj2));
|
void lisp_init(void);
|
||||||
|
void lisp_shutdown(void);
|
||||||
|
|
||||||
|
// ###############################
|
||||||
|
// # General and Misc. Functions #
|
||||||
|
// ###############################
|
||||||
|
noreturn DECLARE_FUNCTION(exit, (LispVal * code));
|
||||||
DECLARE_FUNCTION(id, (LispVal * obj));
|
DECLARE_FUNCTION(id, (LispVal * obj));
|
||||||
DECLARE_FUNCTION(eq, (LispVal * obj1, LispVal *obj2));
|
DECLARE_FUNCTION(eq, (LispVal * obj1, LispVal *obj2));
|
||||||
DECLARE_FUNCTION(puthash, (LispVal * table, LispVal *key, LispVal *value));
|
DECLARE_FUNCTION(breakpoint, (LispVal * id));
|
||||||
DECLARE_FUNCTION(gethash, (LispVal * table, LispVal *key, LispVal *def));
|
DECLARE_FUNCTION(not, (LispVal * obj));
|
||||||
DECLARE_FUNCTION(remhash, (LispVal * table, LispVal *key));
|
DECLARE_FUNCTION(type_of, (LispVal * val));
|
||||||
DECLARE_FUNCTION(hash_table_count, (LispVal * table));
|
DECLARE_FUNCTION(user_pointer_p, (LispVal * val));
|
||||||
|
|
||||||
|
DECLARE_FUNCTION(print, (LispVal * obj));
|
||||||
|
DECLARE_FUNCTION(println, (LispVal * obj));
|
||||||
|
|
||||||
|
// ##################################
|
||||||
|
// # Evaluation and Macro Expansion #
|
||||||
|
// ##################################
|
||||||
|
DECLARE_FUNCTION(eval_in_env, (LispVal * form, LispVal *lexenv));
|
||||||
|
DECLARE_FUNCTION(eval, (LispVal * form));
|
||||||
|
DECLARE_FUNCTION(funcall, (LispVal * function, LispVal *rest));
|
||||||
|
DECLARE_FUNCTION(apply, (LispVal * function, LispVal *rest));
|
||||||
|
DECLARE_FUNCTION(macroexpand_1, (LispVal * form, LispVal *lexical_macros));
|
||||||
|
DECLARE_FUNCTION(macroexpand_toplevel,
|
||||||
|
(LispVal * form, LispVal *lexical_macros));
|
||||||
|
DECLARE_FUNCTION(macroexpand_all, (LispVal * form, LispVal *lexical_macros));
|
||||||
|
|
||||||
|
// #################
|
||||||
|
// # Special Forms #
|
||||||
|
// #################
|
||||||
|
DECLARE_FUNCTION(quote, (LispVal * form));
|
||||||
|
DECLARE_FUNCTION(if, (LispVal * cond, LispVal *t, LispVal *nil));
|
||||||
|
DECLARE_FUNCTION(setq, (LispVal * args));
|
||||||
|
DECLARE_FUNCTION(progn, (LispVal * forms));
|
||||||
|
DECLARE_FUNCTION(condition_case, (LispVal * form, LispVal *rest));
|
||||||
|
DECLARE_FUNCTION(defun, (LispVal * name, LispVal *args, LispVal *body));
|
||||||
|
DECLARE_FUNCTION(defmacro, (LispVal * name, LispVal *args, LispVal *body));
|
||||||
|
DECLARE_FUNCTION(lambda, (LispVal * args, LispVal *body));
|
||||||
|
DECLARE_FUNCTION(while, (LispVal * condition, LispVal *body));
|
||||||
|
DECLARE_FUNCTION(and, (LispVal * rest));
|
||||||
|
DECLARE_FUNCTION(or, (LispVal * rest));
|
||||||
DECLARE_FUNCTION(in_package, (LispVal * package));
|
DECLARE_FUNCTION(in_package, (LispVal * package));
|
||||||
|
noreturn DECLARE_FUNCTION(return_from, (LispVal * name, LispVal *value));
|
||||||
|
|
||||||
|
// ######################
|
||||||
|
// # Function Functions #
|
||||||
|
// ######################
|
||||||
|
DECLARE_FUNCTION(functionp, (LispVal * val));
|
||||||
|
DECLARE_FUNCTION(macrop, (LispVal * val, LispVal *lexical_macros));
|
||||||
|
DECLARE_FUNCTION(builtinp, (LispVal * val));
|
||||||
|
DECLARE_FUNCTION(special_form_p, (LispVal * val));
|
||||||
|
DECLARE_FUNCTION(function_docstr, (LispVal * func));
|
||||||
|
|
||||||
|
struct OptArgDesc {
|
||||||
|
size_t index; // only for keywords
|
||||||
|
LispVal *name;
|
||||||
|
LispVal *default_form;
|
||||||
|
LispVal *pred_var;
|
||||||
|
};
|
||||||
|
void free_opt_arg_desc(void *obj);
|
||||||
|
void set_function_args(LispFunction *func, LispVal *args);
|
||||||
|
|
||||||
|
// ###########################
|
||||||
|
// # Pair and List Functions #
|
||||||
|
// ###########################
|
||||||
|
DECLARE_FUNCTION(pairp, (LispVal * val));
|
||||||
|
DECLARE_FUNCTION(atom, (LispVal * val));
|
||||||
|
DECLARE_FUNCTION(pair, (LispVal * head, LispVal *tail));
|
||||||
|
DECLARE_FUNCTION(head, (LispVal * list));
|
||||||
|
DECLARE_FUNCTION(tail, (LispVal * list));
|
||||||
|
DECLARE_FUNCTION(sethead, (LispVal * pair, LispVal *head));
|
||||||
|
DECLARE_FUNCTION(settail, (LispVal * pair, LispVal *tail));
|
||||||
|
|
||||||
|
// lists
|
||||||
|
DECLARE_FUNCTION(listp, (LispVal * val));
|
||||||
|
DECLARE_FUNCTION(list_length, (LispVal * list));
|
||||||
|
DECLARE_FUNCTION(copy_list, (LispVal * list));
|
||||||
|
DECLARE_FUNCTION(copy_tree, (LispVal * tree));
|
||||||
|
size_t list_length(LispVal *obj);
|
||||||
|
|
||||||
|
// plists
|
||||||
|
DECLARE_FUNCTION(plist_get,
|
||||||
|
(LispVal * plist, LispVal *key, LispVal *def, LispVal *pred));
|
||||||
|
DECLARE_FUNCTION(plist_set, (LispVal * plist, LispVal *key, LispVal *value,
|
||||||
|
LispVal *pred));
|
||||||
|
DECLARE_FUNCTION(plist_rem, (LispVal * plist, LispVal *key, LispVal *pred));
|
||||||
|
DECLARE_FUNCTION(plist_assoc, (LispVal * plist, LispVal *key, LispVal *pred));
|
||||||
|
|
||||||
|
// ####################
|
||||||
|
// # String Functions #
|
||||||
|
// ####################
|
||||||
|
DECLARE_FUNCTION(stringp, (LispVal * val));
|
||||||
|
DECLARE_FUNCTION(hash_string, (LispVal * obj));
|
||||||
|
DECLARE_FUNCTION(strings_equal, (LispVal * obj1, LispVal *obj2));
|
||||||
|
LispVal *sprintf_lisp(const char *format, ...) PRINTF_FORMAT(1, 2);
|
||||||
|
bool strings_equal_nocase(const char *s1, const char *s2, size_t n);
|
||||||
|
|
||||||
|
// #####################
|
||||||
|
// # Package Functions #
|
||||||
|
// #####################
|
||||||
|
DECLARE_FUNCTION(packagep, (LispVal * val));
|
||||||
|
DECLARE_FUNCTION(make_package, (LispVal * name));
|
||||||
DECLARE_FUNCTION(package_name, (LispVal * package));
|
DECLARE_FUNCTION(package_name, (LispVal * package));
|
||||||
DECLARE_FUNCTION(mapsymbols, (LispVal * func, LispVal *package));
|
DECLARE_FUNCTION(register_package, (LispVal * package));
|
||||||
DECLARE_FUNCTION(set_current_package, (LispVal * package));
|
|
||||||
DECLARE_FUNCTION(current_package, (void) );
|
DECLARE_FUNCTION(current_package, (void) );
|
||||||
|
DECLARE_FUNCTION(set_current_package, (LispVal * package));
|
||||||
|
DECLARE_FUNCTION(mapsymbols, (LispVal * func, LispVal *package));
|
||||||
DECLARE_FUNCTION(export_symbol, (LispVal * symbol));
|
DECLARE_FUNCTION(export_symbol, (LispVal * symbol));
|
||||||
DECLARE_FUNCTION(import_package,
|
DECLARE_FUNCTION(import_package,
|
||||||
(LispVal * source, LispVal *names, LispVal *target));
|
(LispVal * source, LispVal *names, LispVal *target));
|
||||||
DECLARE_FUNCTION(make_package, (LispVal * name));
|
|
||||||
DECLARE_FUNCTION(register_package, (LispVal * package));
|
|
||||||
DECLARE_FUNCTION(find_package, (LispVal * name));
|
DECLARE_FUNCTION(find_package, (LispVal * name));
|
||||||
|
LispVal *find_package(const char *name, size_t length);
|
||||||
|
#define FIND_PACKAGE_STATIC(name) (find_package(name, sizeof(name)))
|
||||||
|
|
||||||
|
// ####################
|
||||||
|
// # Symbol Functions #
|
||||||
|
// ####################
|
||||||
|
DECLARE_FUNCTION(symbolp, (LispVal * val));
|
||||||
|
DECLARE_FUNCTION(keywordp, (LispVal * val));
|
||||||
|
DECLARE_FUNCTION(make_symbol, (LispVal * name));
|
||||||
|
DECLARE_FUNCTION(symbol_package, (LispVal * symbol));
|
||||||
|
DECLARE_FUNCTION(symbol_name, (LispVal * symbol));
|
||||||
|
DECLARE_FUNCTION(symbol_function, (LispVal * symbol, LispVal *resolve));
|
||||||
|
DECLARE_FUNCTION(symbol_value, (LispVal * symbol));
|
||||||
|
DECLARE_FUNCTION(symbol_plist, (LispVal * symbol));
|
||||||
|
DECLARE_FUNCTION(setplist, (LispVal * symbol, LispVal *plist));
|
||||||
|
DECLARE_FUNCTION(fset, (LispVal * sym, LispVal *new_func));
|
||||||
DECLARE_FUNCTION(exported_symbol_p, (LispVal * symbol));
|
DECLARE_FUNCTION(exported_symbol_p, (LispVal * symbol));
|
||||||
DECLARE_FUNCTION(intern_soft, (LispVal * name, LispVal *def, LispVal *package,
|
DECLARE_FUNCTION(intern_soft, (LispVal * name, LispVal *def, LispVal *package,
|
||||||
LispVal *included_too));
|
LispVal *included_too));
|
||||||
LispVal *find_package(const char *name, size_t length);
|
|
||||||
#define FIND_PACKAGE_STATIC(name) (find_package(name, sizeof(name)))
|
|
||||||
LispVal *intern(const char *name, size_t length, bool take, LispVal *package,
|
|
||||||
bool included_too);
|
|
||||||
DECLARE_FUNCTION(intern,
|
DECLARE_FUNCTION(intern,
|
||||||
(LispVal * name, LispVal *package, LispVal *included_too));
|
(LispVal * name, LispVal *package, LispVal *included_too));
|
||||||
|
LispVal *intern(const char *name, size_t length, bool take, LispVal *package,
|
||||||
|
bool included_too);
|
||||||
|
|
||||||
|
// #######################
|
||||||
|
// # Hashtable Functions #
|
||||||
|
// #######################
|
||||||
|
DECLARE_FUNCTION(hashtablep, (LispVal * val));
|
||||||
|
DECLARE_FUNCTION(make_hashtable, (LispVal * hash_fn, LispVal *eq_fn));
|
||||||
|
DECLARE_FUNCTION(copy_hash_table, (LispVal * table));
|
||||||
|
DECLARE_FUNCTION(hash_table_count, (LispVal * table));
|
||||||
|
DECLARE_FUNCTION(puthash, (LispVal * table, LispVal *key, LispVal *value));
|
||||||
|
DECLARE_FUNCTION(gethash, (LispVal * table, LispVal *key, LispVal *def));
|
||||||
|
DECLARE_FUNCTION(remhash, (LispVal * table, LispVal *key));
|
||||||
|
|
||||||
|
// Don't ref their return value
|
||||||
|
LispVal *puthash(LispVal *table, LispVal *key, LispVal *value);
|
||||||
|
LispVal *gethash(LispVal *table, LispVal *key, LispVal *def);
|
||||||
|
LispVal *remhash(LispVal *table, LispVal *key);
|
||||||
|
|
||||||
|
// #####################
|
||||||
|
// # Numeric Functions #
|
||||||
|
// #####################
|
||||||
|
DECLARE_FUNCTION(integerp, (LispVal * val));
|
||||||
|
DECLARE_FUNCTION(floatp, (LispVal * val));
|
||||||
|
DECLARE_FUNCTION(num_eq, (LispVal * n1, LispVal *n2));
|
||||||
|
DECLARE_FUNCTION(num_gt, (LispVal * n1, LispVal *n2));
|
||||||
|
DECLARE_FUNCTION(add, (LispVal * args));
|
||||||
|
DECLARE_FUNCTION(sub, (LispVal * args));
|
||||||
|
|
||||||
|
// ####################
|
||||||
|
// # Vector Functions #
|
||||||
|
// ####################
|
||||||
|
DECLARE_FUNCTION(vectorp, (LispVal * val));
|
||||||
|
DECLARE_FUNCTION(vector, (LispVal * elems));
|
||||||
|
|
||||||
|
// ########################
|
||||||
|
// # Lexenv and the Stack #
|
||||||
|
// ########################
|
||||||
|
// used in condition-case
|
||||||
|
extern LispVal *Qkw_success;
|
||||||
|
extern LispVal *Qkw_finally;
|
||||||
|
|
||||||
|
DECLARE_FUNCTION(backtrace, (void) );
|
||||||
|
noreturn DECLARE_FUNCTION(throw, (LispVal * signal, LispVal *rest));
|
||||||
|
|
||||||
|
typedef void (*lisp_cleanup_func_t)(void *);
|
||||||
|
struct CleanupHandlerEntry {
|
||||||
|
struct CleanupHandlerEntry *next;
|
||||||
|
lisp_cleanup_func_t fun;
|
||||||
|
void *data;
|
||||||
|
};
|
||||||
|
typedef struct StackFrame {
|
||||||
|
struct StackFrame *next;
|
||||||
|
bool hidden;
|
||||||
|
LispVal *name;
|
||||||
|
LispVal *return_tag;
|
||||||
|
LispVal *detail; // function arguments
|
||||||
|
LispVal *lexenv; // symbol -> value
|
||||||
|
bool enable_handlers;
|
||||||
|
LispVal *handlers; // symbol -> (error-var form)
|
||||||
|
LispVal *unwind_form;
|
||||||
|
struct CleanupHandlerEntry *cleanup_handlers;
|
||||||
|
|
||||||
|
jmp_buf start;
|
||||||
|
} StackFrame;
|
||||||
|
|
||||||
|
#define STACK_EXIT_NORMAL 0
|
||||||
|
#define STACK_EXIT_THROW 1
|
||||||
|
|
||||||
|
extern StackFrame *the_stack;
|
||||||
|
extern LispVal *stack_return;
|
||||||
|
extern LispVal *Qtoplevel;
|
||||||
|
|
||||||
|
void stack_enter(LispVal *name, LispVal *detail, bool inherit);
|
||||||
|
void stack_leave(void);
|
||||||
|
void *register_cleanup(lisp_cleanup_func_t fun, void *data);
|
||||||
|
void free_double_ptr(void *ptr);
|
||||||
|
struct UnrefListData {
|
||||||
|
LispVal **vals;
|
||||||
|
size_t len;
|
||||||
|
};
|
||||||
|
void unref_free_list_double_ptr(void *ptr);
|
||||||
|
void unref_double_ptr(void *ptr);
|
||||||
|
void cancel_cleanup(void *handle);
|
||||||
|
|
||||||
|
// ################
|
||||||
|
// # Stack Macros #
|
||||||
|
// ################
|
||||||
|
#define WITH_PUSH_FRAME_NO_REF_HANDLING_THROWS(name, detail, inherit, body, \
|
||||||
|
on_return) \
|
||||||
|
stack_enter(name, detail, inherit); \
|
||||||
|
{ \
|
||||||
|
int __with_push_frame_jmpval = setjmp(the_stack->start); \
|
||||||
|
if (__with_push_frame_jmpval == STACK_EXIT_NORMAL) { \
|
||||||
|
body \
|
||||||
|
} else if (__with_push_frame_jmpval == STACK_EXIT_THROW) { \
|
||||||
|
on_return; \
|
||||||
|
refcount_unref(stack_return); \
|
||||||
|
stack_return = NULL; \
|
||||||
|
} \
|
||||||
|
stack_leave(); \
|
||||||
|
}
|
||||||
|
#define WITH_PUSH_FRAME_NO_REF(name, detail, inherit, body) \
|
||||||
|
WITH_PUSH_FRAME_NO_REF_HANDLING_THROWS(name, detail, inherit, body, )
|
||||||
|
#define WITH_PUSH_FRAME(name, detail, inherit, body) \
|
||||||
|
WITH_PUSH_FRAME_NO_REF(refcount_ref(name), refcount_ref(detail), inherit, \
|
||||||
|
body)
|
||||||
|
|
||||||
|
#define WITH_CLEANUP_DOUBLE_PTR(var, body) \
|
||||||
|
{ \
|
||||||
|
void *__with_cleanup_cleanup = register_cleanup( \
|
||||||
|
(lisp_cleanup_func_t) & unref_double_ptr, &(var)); \
|
||||||
|
{body}; \
|
||||||
|
cancel_cleanup(__with_cleanup_cleanup); \
|
||||||
|
refcount_unref(var); \
|
||||||
|
}
|
||||||
|
#define WITH_CLEANUP(var, body) \
|
||||||
|
{ \
|
||||||
|
void *__with_cleanup_cleanup = \
|
||||||
|
register_cleanup(&refcount_unref_as_callback, (var)); \
|
||||||
|
{body}; \
|
||||||
|
cancel_cleanup(__with_cleanup_cleanup); \
|
||||||
|
refcount_unref(var); \
|
||||||
|
}
|
||||||
|
#define WITH_CLEANUP_IF_THROW(var, body) \
|
||||||
|
{ \
|
||||||
|
void *__with_cleanup_cleanup = \
|
||||||
|
register_cleanup(&refcount_unref_as_callback, (var)); \
|
||||||
|
{body}; \
|
||||||
|
cancel_cleanup(__with_cleanup_cleanup); \
|
||||||
|
}
|
||||||
|
|
||||||
|
// #########################
|
||||||
|
// # Errors and Conditions #
|
||||||
|
// #########################
|
||||||
|
extern LispVal *Qshutdown_signal;
|
||||||
|
extern LispVal *Qtype_error;
|
||||||
|
extern LispVal *Qread_error;
|
||||||
|
extern LispVal *Qeof_error;
|
||||||
|
extern LispVal *Qunclosed_error;
|
||||||
|
extern LispVal *Qvoid_variable_error;
|
||||||
|
extern LispVal *Qvoid_function_error;
|
||||||
|
extern LispVal *Qcircular_error;
|
||||||
|
extern LispVal *Qmalformed_lambda_list_error;
|
||||||
|
extern LispVal *Qargument_error;
|
||||||
|
extern LispVal *Qinvalid_function_error;
|
||||||
|
extern LispVal *Qno_applicable_method_error;
|
||||||
|
extern LispVal *Qreturn_frame_error;
|
||||||
|
extern LispVal *Qpackage_exists_error;
|
||||||
|
extern LispVal *Qimport_error;
|
||||||
|
extern LispVal *Qunknown_package_error;
|
||||||
|
|
||||||
|
#define CHECK_TYPE(type, val) \
|
||||||
|
if (TYPEOF(val) != type) { \
|
||||||
|
LispVal *inner_list = const_list(false, 1, predicate_for_type(type)); \
|
||||||
|
LispVal *args = \
|
||||||
|
const_list(true, 2, inner_list, Ftype_of(LISPVAL(val))); \
|
||||||
|
refcount_unref(inner_list); \
|
||||||
|
Fthrow(Qtype_error, args); \
|
||||||
|
}
|
||||||
|
|
||||||
|
// ############################
|
||||||
|
// # Inline Utility Functions #
|
||||||
|
// ############################
|
||||||
static inline LispVal *_internal_INTERN_STATIC(const char *name, size_t len,
|
static inline LispVal *_internal_INTERN_STATIC(const char *name, size_t len,
|
||||||
LispVal *package) {
|
LispVal *package) {
|
||||||
LispVal *kn = make_lisp_string(name, len, true, true);
|
LispVal *kn = make_lisp_string(name, len, true, true);
|
||||||
@ -398,9 +698,6 @@ static inline LispVal *_internal_INTERN_STATIC(const char *name, size_t len,
|
|||||||
#define INTERN_STATIC(name, package) \
|
#define INTERN_STATIC(name, package) \
|
||||||
(_internal_INTERN_STATIC((name), sizeof(name) - 1, package))
|
(_internal_INTERN_STATIC((name), sizeof(name) - 1, package))
|
||||||
|
|
||||||
DECLARE_FUNCTION(sethead, (LispVal * pair, LispVal *head));
|
|
||||||
DECLARE_FUNCTION(settail, (LispVal * pair, LispVal *tail));
|
|
||||||
size_t list_length(LispVal *obj);
|
|
||||||
static inline LispVal *const_list(bool do_ref, int len, ...) {
|
static inline LispVal *const_list(bool do_ref, int len, ...) {
|
||||||
LispVal *list = Qnil;
|
LispVal *list = Qnil;
|
||||||
LispVal *end = Qnil;
|
LispVal *end = Qnil;
|
||||||
@ -455,6 +752,7 @@ static inline LispVal *push_many(LispVal *list, int count, ...) {
|
|||||||
va_end(args);
|
va_end(args);
|
||||||
return new_list;
|
return new_list;
|
||||||
}
|
}
|
||||||
|
|
||||||
static inline void push_to_lexenv(LispVal **lexenv, LispVal *key,
|
static inline void push_to_lexenv(LispVal **lexenv, LispVal *key,
|
||||||
LispVal *value) {
|
LispVal *value) {
|
||||||
LispVal *old = *lexenv;
|
LispVal *old = *lexenv;
|
||||||
@ -462,244 +760,7 @@ static inline void push_to_lexenv(LispVal **lexenv, LispVal *key,
|
|||||||
refcount_unref(old);
|
refcount_unref(old);
|
||||||
}
|
}
|
||||||
|
|
||||||
typedef void (*lisp_cleanup_func_t)(void *);
|
// These are like the internal functions, but they don't ref their return value
|
||||||
struct CleanupHandlerEntry {
|
|
||||||
struct CleanupHandlerEntry *next;
|
|
||||||
lisp_cleanup_func_t fun;
|
|
||||||
void *data;
|
|
||||||
};
|
|
||||||
typedef struct StackFrame {
|
|
||||||
struct StackFrame *next;
|
|
||||||
bool hidden;
|
|
||||||
LispVal *name;
|
|
||||||
LispVal *return_tag;
|
|
||||||
LispVal *detail; // function arguments
|
|
||||||
LispVal *lexenv; // symbol -> value
|
|
||||||
bool enable_handlers;
|
|
||||||
LispVal *handlers; // symbol -> (error-var form)
|
|
||||||
LispVal *unwind_form;
|
|
||||||
struct CleanupHandlerEntry *cleanup_handlers;
|
|
||||||
|
|
||||||
jmp_buf start;
|
|
||||||
} StackFrame;
|
|
||||||
|
|
||||||
#define STACK_EXIT_NORMAL 0
|
|
||||||
#define STACK_EXIT_THROW 1
|
|
||||||
|
|
||||||
extern StackFrame *the_stack;
|
|
||||||
extern LispVal *stack_return;
|
|
||||||
extern LispVal *Qtoplevel;
|
|
||||||
|
|
||||||
void stack_enter(LispVal *name, LispVal *detail, bool inherit);
|
|
||||||
void stack_leave(void);
|
|
||||||
void *register_cleanup(lisp_cleanup_func_t fun, void *data);
|
|
||||||
void free_double_ptr(void *ptr);
|
|
||||||
struct UnrefListData {
|
|
||||||
LispVal **vals;
|
|
||||||
size_t len;
|
|
||||||
};
|
|
||||||
void unref_free_list_double_ptr(void *ptr);
|
|
||||||
void unref_double_ptr(void *ptr);
|
|
||||||
void cancel_cleanup(void *handle);
|
|
||||||
#define WITH_PUSH_FRAME_NO_REF_HANDLING_THROWS(name, detail, inherit, body, \
|
|
||||||
on_return) \
|
|
||||||
stack_enter(name, detail, inherit); \
|
|
||||||
{ \
|
|
||||||
int __with_push_frame_jmpval = setjmp(the_stack->start); \
|
|
||||||
if (__with_push_frame_jmpval == STACK_EXIT_NORMAL) { \
|
|
||||||
body \
|
|
||||||
} else if (__with_push_frame_jmpval == STACK_EXIT_THROW) { \
|
|
||||||
on_return; \
|
|
||||||
refcount_unref(stack_return); \
|
|
||||||
stack_return = NULL; \
|
|
||||||
} \
|
|
||||||
stack_leave(); \
|
|
||||||
}
|
|
||||||
#define WITH_PUSH_FRAME_NO_REF(name, detail, inherit, body) \
|
|
||||||
WITH_PUSH_FRAME_NO_REF_HANDLING_THROWS(name, detail, inherit, body, )
|
|
||||||
#define WITH_PUSH_FRAME(name, detail, inherit, body) \
|
|
||||||
WITH_PUSH_FRAME_NO_REF(refcount_ref(name), refcount_ref(detail), inherit, \
|
|
||||||
body)
|
|
||||||
|
|
||||||
#define WITH_CLEANUP_DOUBLE_PTR(var, body) \
|
|
||||||
{ \
|
|
||||||
void *__with_cleanup_cleanup = register_cleanup( \
|
|
||||||
(lisp_cleanup_func_t) & unref_double_ptr, &(var)); \
|
|
||||||
{body}; \
|
|
||||||
cancel_cleanup(__with_cleanup_cleanup); \
|
|
||||||
refcount_unref(var); \
|
|
||||||
}
|
|
||||||
#define WITH_CLEANUP(var, body) \
|
|
||||||
{ \
|
|
||||||
void *__with_cleanup_cleanup = \
|
|
||||||
register_cleanup(&refcount_unref_as_callback, (var)); \
|
|
||||||
{body}; \
|
|
||||||
cancel_cleanup(__with_cleanup_cleanup); \
|
|
||||||
refcount_unref(var); \
|
|
||||||
}
|
|
||||||
#define WITH_CLEANUP_IF_THROW(var, body) \
|
|
||||||
{ \
|
|
||||||
void *__with_cleanup_cleanup = \
|
|
||||||
register_cleanup(&refcount_unref_as_callback, (var)); \
|
|
||||||
{body}; \
|
|
||||||
cancel_cleanup(__with_cleanup_cleanup); \
|
|
||||||
}
|
|
||||||
|
|
||||||
DECLARE_FUNCTION(backtrace, (void) );
|
|
||||||
noreturn DECLARE_FUNCTION(return_from, (LispVal * name, LispVal *value));
|
|
||||||
noreturn DECLARE_FUNCTION(throw, (LispVal * signal, LispVal *rest));
|
|
||||||
|
|
||||||
extern LispVal *Qkw_success;
|
|
||||||
extern LispVal *Qkw_finally;
|
|
||||||
extern LispVal *Qshutdown_signal;
|
|
||||||
extern LispVal *Qtype_error;
|
|
||||||
extern LispVal *Qread_error;
|
|
||||||
extern LispVal *Qeof_error;
|
|
||||||
extern LispVal *Qunclosed_error;
|
|
||||||
extern LispVal *Qvoid_variable_error;
|
|
||||||
extern LispVal *Qvoid_function_error;
|
|
||||||
extern LispVal *Qcircular_error;
|
|
||||||
extern LispVal *Qmalformed_lambda_list_error;
|
|
||||||
extern LispVal *Qargument_error;
|
|
||||||
extern LispVal *Qinvalid_function_error;
|
|
||||||
extern LispVal *Qno_applicable_method_error;
|
|
||||||
extern LispVal *Qreturn_frame_error;
|
|
||||||
extern LispVal *Qpackage_exists_error;
|
|
||||||
extern LispVal *Qunknown_package_error;
|
|
||||||
extern LispVal *Qimport_error;
|
|
||||||
|
|
||||||
LispVal *predicate_for_type(LispType type);
|
|
||||||
#define CHECK_TYPE(type, val) \
|
|
||||||
if (TYPEOF(val) != type) { \
|
|
||||||
LispVal *inner_list = const_list(false, 1, predicate_for_type(type)); \
|
|
||||||
LispVal *args = \
|
|
||||||
const_list(true, 2, inner_list, Ftype_of(LISPVAL(val))); \
|
|
||||||
refcount_unref(inner_list); \
|
|
||||||
Fthrow(Qtype_error, args); \
|
|
||||||
}
|
|
||||||
|
|
||||||
#define REGISTER_SYMBOL_NOINTERN(sym) \
|
|
||||||
{ \
|
|
||||||
refcount_init_static(Q##sym); \
|
|
||||||
refcount_init_static(((LispSymbol *) Q##sym)->name); \
|
|
||||||
}
|
|
||||||
#define REGISTER_SYMBOL_INTO(sym, pkg) \
|
|
||||||
REGISTER_SYMBOL_NOINTERN(sym) \
|
|
||||||
((LispSymbol *) Q##sym)->package = refcount_ref(pkg); \
|
|
||||||
puthash(((LispPackage *) pkg)->obarray, \
|
|
||||||
LISPVAL(((LispSymbol *) Q##sym)->name), Q##sym);
|
|
||||||
#define REGISTER_SYMBOL(sym) REGISTER_SYMBOL_INTO(sym, system_package)
|
|
||||||
#define REGISTER_STATIC_FUNCTION(name, args, docstr) \
|
|
||||||
REGISTER_SYMBOL_NOINTERN(name); \
|
|
||||||
{ \
|
|
||||||
LispVal *obj = ((LispSymbol *) Q##name)->function; \
|
|
||||||
refcount_init_static(obj); \
|
|
||||||
((LispFunction *) (obj))->doc = STATIC_STRING(docstr); \
|
|
||||||
LispVal *src = STATIC_STRING(args); \
|
|
||||||
LispVal *a = Fread(src, system_package); \
|
|
||||||
set_function_args((LispFunction *) (obj), a); \
|
|
||||||
refcount_unref(src); \
|
|
||||||
refcount_unref(a); \
|
|
||||||
}
|
|
||||||
#define REGISTER_FUNCTION(fn, args, docstr) \
|
|
||||||
REGISTER_STATIC_FUNCTION(fn, args, docstr); \
|
|
||||||
((LispSymbol *) Q##fn)->package = refcount_ref(system_package); \
|
|
||||||
puthash(((LispPackage *) system_package)->obarray, \
|
|
||||||
LISPVAL(((LispSymbol *) Q##fn)->name), Q##fn);
|
|
||||||
|
|
||||||
void lisp_init(void);
|
|
||||||
void lisp_shutdown(void);
|
|
||||||
void register_static_function(LispVal *func);
|
|
||||||
|
|
||||||
extern LispVal *Qbackquote;
|
|
||||||
extern LispVal *Qcomma;
|
|
||||||
extern LispVal *Qcomma_at;
|
|
||||||
DECLARE_FUNCTION(quote, (LispVal * form));
|
|
||||||
|
|
||||||
DECLARE_FUNCTION(breakpoint, (LispVal * id));
|
|
||||||
DECLARE_FUNCTION(symbol_package, (LispVal * symbol));
|
|
||||||
DECLARE_FUNCTION(symbol_name, (LispVal * symbol));
|
|
||||||
DECLARE_FUNCTION(symbol_function, (LispVal * symbol, LispVal *resolve));
|
|
||||||
DECLARE_FUNCTION(symbol_value, (LispVal * symbol));
|
|
||||||
DECLARE_FUNCTION(symbol_plist, (LispVal * symbol));
|
|
||||||
DECLARE_FUNCTION(setplist, (LispVal * symbol, LispVal *plist));
|
|
||||||
DECLARE_FUNCTION(eval_in_env, (LispVal * form, LispVal *lexenv));
|
|
||||||
DECLARE_FUNCTION(eval, (LispVal * form));
|
|
||||||
DECLARE_FUNCTION(funcall, (LispVal * function, LispVal *rest));
|
|
||||||
DECLARE_FUNCTION(apply, (LispVal * function, LispVal *rest));
|
|
||||||
|
|
||||||
DECLARE_FUNCTION(head, (LispVal * list));
|
|
||||||
DECLARE_FUNCTION(tail, (LispVal * list));
|
|
||||||
|
|
||||||
noreturn DECLARE_FUNCTION(exit, (LispVal * code));
|
|
||||||
DECLARE_FUNCTION(print, (LispVal * obj));
|
|
||||||
DECLARE_FUNCTION(println, (LispVal * obj));
|
|
||||||
DECLARE_FUNCTION(not, (LispVal * obj));
|
|
||||||
DECLARE_FUNCTION(if, (LispVal * cond, LispVal *t, LispVal *nil));
|
|
||||||
DECLARE_FUNCTION(add, (LispVal * args));
|
|
||||||
DECLARE_FUNCTION(sub, (LispVal * args));
|
|
||||||
DECLARE_FUNCTION(setq, (LispVal * args));
|
|
||||||
DECLARE_FUNCTION(progn, (LispVal * forms));
|
|
||||||
DECLARE_FUNCTION(fset, (LispVal * sym, LispVal *new_func));
|
|
||||||
DECLARE_FUNCTION(condition_case, (LispVal * form, LispVal *rest));
|
|
||||||
DECLARE_FUNCTION(defun, (LispVal * name, LispVal *args, LispVal *body));
|
|
||||||
DECLARE_FUNCTION(defmacro, (LispVal * name, LispVal *args, LispVal *body));
|
|
||||||
DECLARE_FUNCTION(lambda, (LispVal * args, LispVal *body));
|
|
||||||
DECLARE_FUNCTION(while, (LispVal * condition, LispVal *body));
|
|
||||||
DECLARE_FUNCTION(make_symbol, (LispVal * name));
|
|
||||||
DECLARE_FUNCTION(macroexpand_1, (LispVal * form, LispVal *lexical_macros));
|
|
||||||
DECLARE_FUNCTION(macroexpand_toplevel,
|
|
||||||
(LispVal * form, LispVal *lexical_macros));
|
|
||||||
DECLARE_FUNCTION(macroexpand_all, (LispVal * form, LispVal *lexical_macros));
|
|
||||||
DECLARE_FUNCTION(stringp, (LispVal * val));
|
|
||||||
DECLARE_FUNCTION(symbolp, (LispVal * val));
|
|
||||||
DECLARE_FUNCTION(pairp, (LispVal * val));
|
|
||||||
DECLARE_FUNCTION(integerp, (LispVal * val));
|
|
||||||
DECLARE_FUNCTION(floatp, (LispVal * val));
|
|
||||||
DECLARE_FUNCTION(vectorp, (LispVal * val));
|
|
||||||
DECLARE_FUNCTION(packagep, (LispVal * val));
|
|
||||||
DECLARE_FUNCTION(functionp, (LispVal * val));
|
|
||||||
DECLARE_FUNCTION(macrop, (LispVal * val, LispVal *lexical_macros));
|
|
||||||
DECLARE_FUNCTION(builtinp, (LispVal * val));
|
|
||||||
DECLARE_FUNCTION(special_form_p, (LispVal * val));
|
|
||||||
DECLARE_FUNCTION(hashtablep, (LispVal * val));
|
|
||||||
DECLARE_FUNCTION(user_pointer_p, (LispVal * val));
|
|
||||||
DECLARE_FUNCTION(atom, (LispVal * val));
|
|
||||||
DECLARE_FUNCTION(listp, (LispVal * val));
|
|
||||||
DECLARE_FUNCTION(keywordp, (LispVal * val));
|
|
||||||
DECLARE_FUNCTION(numberp, (LispVal * val));
|
|
||||||
DECLARE_FUNCTION(list_length, (LispVal * list));
|
|
||||||
DECLARE_FUNCTION(copy_list, (LispVal * list));
|
|
||||||
DECLARE_FUNCTION(copy_tree, (LispVal * tree));
|
|
||||||
DECLARE_FUNCTION(num_eq, (LispVal * n1, LispVal *n2));
|
|
||||||
DECLARE_FUNCTION(num_gt, (LispVal * n1, LispVal *n2));
|
|
||||||
DECLARE_FUNCTION(and, (LispVal * rest));
|
|
||||||
DECLARE_FUNCTION(or, (LispVal * rest));
|
|
||||||
DECLARE_FUNCTION(type_of, (LispVal * val));
|
|
||||||
DECLARE_FUNCTION(function_docstr, (LispVal * func));
|
|
||||||
DECLARE_FUNCTION(plist_get,
|
|
||||||
(LispVal * plist, LispVal *key, LispVal *def, LispVal *pred));
|
|
||||||
DECLARE_FUNCTION(plist_set, (LispVal * plist, LispVal *key, LispVal *value,
|
|
||||||
LispVal *pred));
|
|
||||||
DECLARE_FUNCTION(plist_rem, (LispVal * plist, LispVal *key, LispVal *pred));
|
|
||||||
DECLARE_FUNCTION(plist_assoc, (LispVal * plist, LispVal *key, LispVal *pred));
|
|
||||||
|
|
||||||
void debug_dump(FILE *stream, void *obj, bool newline);
|
|
||||||
void debug_print_hashtable(FILE *stream, LispVal *table);
|
|
||||||
void debug_print_tree(FILE *stream, void *obj);
|
|
||||||
void debug_dump_lexenv(FILE *stream, LispVal *lexenv);
|
|
||||||
extern LispVal *Qopt;
|
|
||||||
extern LispVal *Qkey;
|
|
||||||
extern LispVal *Qallow_other_keys;
|
|
||||||
extern LispVal *Qrest;
|
|
||||||
extern LispVal *Qdeclare;
|
|
||||||
extern LispVal *Qname;
|
|
||||||
|
|
||||||
// some internal functions
|
|
||||||
LispVal *puthash(LispVal *table, LispVal *key, LispVal *value);
|
|
||||||
LispVal *gethash(LispVal *table, LispVal *key, LispVal *def);
|
|
||||||
LispVal *remhash(LispVal *table, LispVal *key);
|
|
||||||
|
|
||||||
static inline LispVal *HEAD(LispVal *list) {
|
static inline LispVal *HEAD(LispVal *list) {
|
||||||
if (NILP(list)) {
|
if (NILP(list)) {
|
||||||
return Qnil;
|
return Qnil;
|
||||||
@ -727,4 +788,11 @@ static inline LispVal *TAIL_SAFE(LispVal *list) {
|
|||||||
return ((LispPair *) list)->tail;
|
return ((LispPair *) list)->tail;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
// ###################
|
||||||
|
// # Debug Functions #
|
||||||
|
// ###################
|
||||||
|
void debug_dump(FILE *stream, void *obj, bool newline);
|
||||||
|
void debug_print_hashtable(FILE *stream, LispVal *table);
|
||||||
|
void debug_print_tree(FILE *stream, void *obj);
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
|||||||
@ -60,6 +60,7 @@ int main(int argc, const char **argv) {
|
|||||||
REGISTER_STATIC_FUNCTION(toplevel_exit_handler, "(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, {
|
||||||
|
the_stack->hidden = false;
|
||||||
LispVal *err_var = INTERN_STATIC("err-var", system_package);
|
LispVal *err_var = INTERN_STATIC("err-var", system_package);
|
||||||
puthash(the_stack->handlers, Qt,
|
puthash(the_stack->handlers, Qt,
|
||||||
// simply call the above function
|
// simply call the above function
|
||||||
|
|||||||
Reference in New Issue
Block a user