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

Change to using RefCount

Browse Source
This commit is contained in:
Alexander Rosenberg
2025-09-10 02:57:48 -07:00
parent a38fef7857
commit 994827431c
6 changed files with 1110 additions and 779 deletions
Download Patch File Download Diff File Expand all files Collapse all files

172
src/lisp.h
View File

@ -1,6 +1,7 @@
#ifndef INCLUDED_LISP_H
#define INCLUDED_LISP_H
#include <refcount/refcount.h>
#include <setjmp.h>
#include <stdarg.h>
#include <stdbool.h>
@ -10,7 +11,7 @@
#include <stdlib.h>
#include <stdnoreturn.h>
#if __has_attribute(format)
#if defined(__has_attribute) && __has_attribute(format)
# define PRINTF_FORMAT(first, second) \
__attribute__((format(printf, first, second)))
#else
@ -41,9 +42,7 @@ extern struct _TypeNameEntry LISP_TYPE_NAMES[N_LISP_TYPES];
#define LISP_OBJECT_HEADER \
LispType type; \
void *gc_root; \
ptrdiff_t ref_count; \
bool finalizing;
RefcountEntry refcount
typedef struct {
LISP_OBJECT_HEADER;
@ -91,6 +90,7 @@ typedef struct {
LispVal **data;
size_t length;
bool is_static;
} LispVector;
struct OptArgDesc {
@ -102,6 +102,8 @@ struct OptArgDesc {
void free_opt_arg_desc(void *obj);
typedef void (*lisp_function_ptr_t)(void);
typedef struct {
LISP_OBJECT_HEADER;
@ -118,7 +120,7 @@ typedef struct {
bool allow_other_keys;
LispVal *rest_arg;
union {
void *builtin;
lisp_function_ptr_t builtin;
LispVal *body;
};
@ -211,36 +213,33 @@ inline static bool NUMBERP(LispVal *v) {
#define DEF_STATIC_STRING(name, value) \
static LispString name = { \
.type = TYPE_STRING, \
.ref_count = -1, \
.data = value, \
.length = sizeof(value) - 1, \
.is_static = true, \
};
}
#define DEF_STATIC_SYMBOL(c_name, lisp_name) \
DEF_STATIC_STRING(_Q##c_name##_name, lisp_name); \
static LispSymbol _Q##c_name = { \
.type = TYPE_SYMBOL, \
.ref_count = -1, \
.name = &_Q##c_name##_name, \
.plist = Qnil, \
.function = Qunbound, \
.value = Qunbound, \
.is_constant = false, \
}; \
LispVal *Q##c_name = LISPVAL(&_Q##c_name);
LispVal *Q##c_name = LISPVAL(&_Q##c_name)
#define DECLARE_FUNCTION(c_name, args) \
LispVal *F##c_name args; \
extern LispVal *Q##c_name;
extern LispVal *Q##c_name
// The args and doc fields are filled when the function is registered
#define _INTERNAL_DEFUN_EXTENDED(macrop, c_name, lisp_name, c_args) \
LispVal *F##c_name c_args; \
DEF_STATIC_STRING(_Q##c_name##_name, lisp_name); \
static LispFunction _Q##c_name##_function = { \
.type = TYPE_FUNCTION, \
.ref_count = -1, \
.is_builtin = true, \
.is_macro = macrop, \
.builtin = &F##c_name, \
.builtin = (void (*)(void)) & F##c_name, \
.doc = Qnil, \
.args = Qnil, \
.rargs = Qnil, \
@ -251,7 +250,6 @@ inline static bool NUMBERP(LispVal *v) {
}; \
static LispSymbol _Q##c_name = { \
.type = TYPE_SYMBOL, \
.ref_count = -1, \
.name = &_Q##c_name##_name, \
.plist = Qnil, \
.value = Qunbound, \
@ -284,12 +282,12 @@ inline static bool NUMBERP(LispVal *v) {
} \
} \
}
#define FOREACH(var, list) \
for (LispVal *__foreach_cur = list, *var = Fhead(list); \
!NILP(__foreach_cur); \
__foreach_cur = Ftail(__foreach_cur), var = Fhead(__foreach_cur))
#define FOREACH(var, list) \
for (LispVal *__foreach_cur = list, *var = HEAD(list); \
!NILP(__foreach_cur); \
__foreach_cur = TAIL(__foreach_cur), var = HEAD(__foreach_cur))
#define FOREACH_TAIL(var, list) \
for (LispVal *var = list; !NILP(var); var = Ftail(var))
for (LispVal *var = list; !NILP(var); var = TAIL(var))
// #############################
// # Allocation and references #
@ -300,16 +298,7 @@ void *lisp_malloc(size_t size);
void *lisp_realloc(void *old_ptr, size_t size);
#define lisp_free free
void *lisp_ref(void *val);
void *lisp_float_ref(void *val);
void garbage_collect();
void *lisp_unref(void *val);
#define UNREF_INPLACE(variable) \
{ \
variable = lisp_unref(variable); \
}
void lisp_unref_double_ptr(void **val);
#define IGNORE_REF(val) (lisp_unref(lisp_ref(val)))
void garbage_collect(void);
// ################
// # Constructors #
@ -324,8 +313,8 @@ LispVal *make_lisp_integer(intmax_t value);
LispVal *make_lisp_float(long double value);
LispVal *make_lisp_vector(LispVal **data, size_t length);
void set_function_args(LispFunction *func, LispVal *args);
LispVal *make_lisp_function(LispVal *args, LispVal *doc, LispVal *lexenv,
LispVal *body, bool is_macro);
LispVal *make_lisp_function(LispVal *args, LispVal *lexenv, LispVal *body,
bool is_macro);
LispVal *make_lisp_hashtable(LispVal *eq_fn, LispVal *hash_fn);
LispVal *make_user_pointer(void *data, void (*free_func)(void *));
#define ALLOC_USERPTR(type, free_func) \
@ -336,7 +325,6 @@ LispVal *make_user_pointer(void *data, void (*free_func)(void *));
// ########################
bool strings_equal_nocase(const char *s1, const char *s2, size_t n);
DECLARE_FUNCTION(type_of, (LispVal * obj));
DECLARE_FUNCTION(pair, (LispVal * head, LispVal *tail));
DECLARE_FUNCTION(hash_string, (LispVal * obj));
DECLARE_FUNCTION(strings_equal, (LispVal * obj1, LispVal *obj2));
@ -349,9 +337,9 @@ DECLARE_FUNCTION(hash_table_count, (LispVal * table));
LispVal *intern(const char *name, size_t length, bool take);
DECLARE_FUNCTION(intern, (LispVal * name));
static inline LispVal *_internal_INTERN_STATIC(const char *name, size_t len) {
LispVal *kn = lisp_ref(make_lisp_string(name, len, true, true));
LispVal *kn = make_lisp_string(name, len, true, true);
LispVal *retval = Fintern(kn);
lisp_unref(kn);
refcount_unref(kn);
return retval;
}
#define INTERN_STATIC(name) (_internal_INTERN_STATIC((name), sizeof(name) - 1))
@ -372,6 +360,7 @@ static inline LispVal *const_list(int len, ...) {
} else {
LispVal *new_end = Fpair(elt, Qnil);
Fsettail(end, new_end);
refcount_unref(new_end);
end = new_end;
}
}
@ -388,6 +377,7 @@ static inline LispVal *make_list(size_t len, LispVal **vals) {
} else {
LispVal *new_end = Fpair(vals[i], Qnil);
Fsettail(end, new_end);
refcount_unref(new_end);
end = new_end;
}
}
@ -426,6 +416,7 @@ struct UnrefListData {
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(name, detail, inherit, body) \
stack_enter(name, detail, inherit); \
@ -433,17 +424,16 @@ void cancel_cleanup(void *handle);
body \
} \
stack_leave();
#define WITH_CLEANUP(var, body) \
lisp_ref(var); \
{ \
void *__with_cleanup_cleanup = register_cleanup( \
(lisp_cleanup_func_t) & lisp_unref_double_ptr, &(var)); \
{body}; \
cancel_cleanup(__with_cleanup_cleanup); \
lisp_unref(var); \
#define WITH_CLEANUP(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); \
}
DECLARE_FUNCTION(backtrace, ());
DECLARE_FUNCTION(backtrace, (void) );
noreturn DECLARE_FUNCTION(throw, (LispVal * signal, LispVal *rest));
extern LispVal *Qshutdown_signal;
@ -455,36 +445,35 @@ 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;
#define CHECK_TYPE(type, val) \
if (TYPEOF(val) != type) { \
Fthrow(Qtype_error, Qnil); \
LispVal *predicate_for_type(LispType type);
#define CHECK_TYPE(type, val) \
if (TYPEOF(val) != type) { \
LispVal *inner_list = const_list(1, predicate_for_type(type)); \
LispVal *args = const_list(2, inner_list, Ftype_of(LISPVAL(val))); \
refcount_unref(inner_list); \
Fthrow(Qtype_error, args); \
}
struct StaticReference {
struct StaticReference *next;
LispVal *obj;
};
extern struct StaticReference *static_references;
void add_static_reference(LispVal *obj);
extern LispVal *Vobarray;
#define REGISTER_SYMBOL(sym) \
{ \
Fputhash(Vobarray, LISPVAL(((LispSymbol *) Q##sym)->name), Q##sym); \
add_static_reference(Q##sym); \
#define REGISTER_SYMBOL(sym) \
{ \
refcount_init_static(Q##sym); \
refcount_init_static(((LispSymbol *) Q##sym)->name); \
puthash(Vobarray, LISPVAL(((LispSymbol *) Q##sym)->name), Q##sym); \
}
#define REGISTER_STATIC_FUNCTION(obj, args, docstr) \
((LispFunction *) (obj))->doc = STATIC_STRING(docstr); \
{ \
refcount_init_static(obj); \
((LispFunction *) (obj))->doc = STATIC_STRING(docstr); \
LispVal *src = STATIC_STRING(args); \
lisp_ref(src); \
set_function_args((LispFunction *) (obj), Fread(src)); \
lisp_unref(src); \
add_static_reference(obj); \
LispVal *a = Fread(src); \
set_function_args((LispFunction *) (obj), a); \
refcount_unref(src); \
refcount_unref(a); \
}
#define REGISTER_FUNCTION(fn, args, docstr) \
REGISTER_SYMBOL(fn); \
@ -496,33 +485,84 @@ 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_function, (LispVal * symbol, LispVal *resolve));
DECLARE_FUNCTION(symbol_value, (LispVal * symbol));
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(when, (LispVal * cond, LispVal *t));
DECLARE_FUNCTION(if, (LispVal * cond, LispVal *t, LispVal *nil));
DECLARE_FUNCTION(add, (LispVal * n1, LispVal *n2));
DECLARE_FUNCTION(setq, (LispVal * name, LispVal *value));
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(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));
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(functionp, (LispVal * val));
DECLARE_FUNCTION(macrop, (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(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));
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);
extern LispVal *Qopt;
extern LispVal *Qkey;
extern LispVal *Qallow_other_keys;
extern LispVal *Qrest;
// 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) {
if (NILP(list)) {
return Qnil;
}
CHECK_TYPE(TYPE_PAIR, list);
return ((LispPair *) list)->head;
}
static inline LispVal *TAIL(LispVal *list) {
if (NILP(list)) {
return Qnil;
}
CHECK_TYPE(TYPE_PAIR, list);
return ((LispPair *) list)->tail;
}
#endif