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

Fix some refcount bugs

Browse Source
This commit is contained in:
Alexander Rosenberg
2025-09-11 03:10:59 -07:00
parent 994827431c
commit eb8d54acb1
4 changed files with 166 additions and 174 deletions
Download Patch File Download Diff File Expand all files Collapse all files

202
src/lisp.c
View File

@ -301,6 +301,7 @@ void set_function_args(LispFunction *func, LispVal *args) {
refcount_unref(new_end); refcount_unref(new_end);
oargs_end = new_end; oargs_end = new_end;
} }
refcount_unref(desc);
puthash(found_args, USERPTR(struct OptArgDesc, desc)->name, Qt); puthash(found_args, USERPTR(struct OptArgDesc, desc)->name, Qt);
if (!NILP(USERPTR(struct OptArgDesc, desc)->pred_var)) { if (!NILP(USERPTR(struct OptArgDesc, desc)->pred_var)) {
puthash(found_args, puthash(found_args,
@ -316,18 +317,22 @@ void set_function_args(LispFunction *func, LispVal *args) {
refcount_unref(desc); refcount_unref(desc);
goto malformed; goto malformed;
} }
USERPTR(struct OptArgDesc, desc)->index = 0; USERPTR(struct OptArgDesc, desc)->index =
((LispHashtable *) func->kwargs)->count;
LispString *sn = LispString *sn =
((LispSymbol *) USERPTR(struct OptArgDesc, desc)->name) ((LispSymbol *) USERPTR(struct OptArgDesc, desc)->name)
->name; ->name;
char kns[sn->length + 2]; char kns[sn->length + 2];
kns[0] = ':'; kns[0] = ':';
memcpy(kns + 1, sn->data, sn->length); memcpy(kns + 1, sn->data, sn->length);
kns[sn->length + 1] = '\n'; kns[sn->length + 1] = '\0';
LispVal *kn = LispVal *kn =
make_lisp_string(kns, sn->length + 1, false, false); make_lisp_string(kns, sn->length + 1, false, false);
puthash(func->kwargs, Fintern(kn), desc); LispVal *keyword = Fintern(kn);
puthash(func->kwargs, keyword, desc);
refcount_unref(keyword);
refcount_unref(kn); refcount_unref(kn);
refcount_unref(desc);
puthash(found_args, USERPTR(struct OptArgDesc, desc)->name, Qt); puthash(found_args, USERPTR(struct OptArgDesc, desc)->name, Qt);
if (!NILP(USERPTR(struct OptArgDesc, desc)->pred_var)) { if (!NILP(USERPTR(struct OptArgDesc, desc)->pred_var)) {
puthash(found_args, puthash(found_args,
@ -910,6 +915,7 @@ static bool held_refs_callback(void *obj, RefcountList **held, void *ignored) {
*held = refcount_list_push(*held, fn->rargs); *held = refcount_list_push(*held, fn->rargs);
*held = refcount_list_push(*held, fn->lexenv); *held = refcount_list_push(*held, fn->lexenv);
*held = refcount_list_push(*held, fn->doc); *held = refcount_list_push(*held, fn->doc);
*held = refcount_list_push(*held, fn->rest_arg);
if (!fn->is_builtin) { if (!fn->is_builtin) {
*held = refcount_list_push(*held, fn->body); *held = refcount_list_push(*held, fn->body);
} }
@ -1003,117 +1009,85 @@ void lisp_init(void) {
refcount_init_static(Qparent_lexenv); refcount_init_static(Qparent_lexenv);
refcount_init_static(&_Qparent_lexenv_name); refcount_init_static(&_Qparent_lexenv_name);
{ REGISTER_FUNCTION(breakpoint, "(&opt id)", "Do nothing...");
refcount_init_static(Qbreakpoint); REGISTER_FUNCTION(sethead, "(pair newval)",
refcount_init_static(((LispSymbol *) Qbreakpoint)->name); "Set the head of PAIR to NEWVAL.");
puthash(Vobarray, ((LispVal *) (((LispSymbol *) Qbreakpoint)->name)), REGISTER_FUNCTION(settail, "(pair newval)",
Qbreakpoint); "Set the tail of PAIR to NEWVAL.");
}; REGISTER_FUNCTION(funcall, "(function &rest args)", "")
{ REGISTER_FUNCTION(apply, "(function &rest args)", "")
refcount_init_static(((LispSymbol *) Qbreakpoint)->function); REGISTER_FUNCTION(throw, "(signal &rest data)", "");
((LispFunction *) (((LispSymbol *) Qbreakpoint)->function))->doc = REGISTER_FUNCTION(pair, "(head tail)",
(make_lisp_string(("Do nothing..."), sizeof("") - 1, 1, 1)); "Return a new pair with HEAD and TAIL.");
LispVal *src = REGISTER_FUNCTION(head, "(pair)", "Return the head of PAIR.");
(make_lisp_string(("(&opt id)"), sizeof("(&opt id)") - 1, 1, 1)); REGISTER_FUNCTION(tail, "(pair)", "Return the tail of PAIR.");
LispVal *a = Fread(src); REGISTER_FUNCTION(quote, "(form)", "Return FORM as read by the reader.");
set_function_args( REGISTER_FUNCTION(exit, "(&opt code)",
(LispFunction *) (((LispSymbol *) Qbreakpoint)->function), a); "Exit with CODE, defaulting to zero.");
refcount_unref(src); REGISTER_FUNCTION(print, "(obj)",
refcount_unref(a); "Print a human-readable representation of OBJ.");
}; REGISTER_FUNCTION(
; println, "(obj)",
/* REGISTER_FUNCTION(sethead, "(pair newval)", */ "Print a human-readable representation of OBJ followed by a newline.");
/* "Set the head of PAIR to NEWVAL."); */ REGISTER_FUNCTION(not, "(obj)",
/* REGISTER_FUNCTION(settail, "(pair newval)", */ "Return t if OBJ is nil, otherwise return t.");
/* "Set the tail of PAIR to NEWVAL."); */ REGISTER_FUNCTION(add, "(&rest nums)", "Return the sun of NUMS.");
/* REGISTER_FUNCTION(funcall, "(function &rest args)", "") */ REGISTER_FUNCTION(sub, "(&rest nums)",
/* REGISTER_FUNCTION(apply, "(function &rest args)", "") */ "Return (head NUMS) - (apply '+ (tail NUMS)).");
/* REGISTER_FUNCTION(throw, "(signal &rest data)", ""); */ REGISTER_FUNCTION(
/* REGISTER_FUNCTION(pair, "(head tail)", */ if, "(cond then &rest else)",
/* "Return a new pair with HEAD and TAIL."); */ "Evaluate THEN if COND is non-nil, otherwise evaluate ELSE.");
/* REGISTER_FUNCTION(head, "(pair)", "Return the head of PAIR."); */ REGISTER_FUNCTION(
/* REGISTER_FUNCTION(tail, "(pair)", "Return the tail of PAIR."); */ setq, "(&rest name-value-pairs)",
/* REGISTER_FUNCTION(quote, "(form)", "Return FORM as read by the reader."); "Set each of a number of variables to their respective values.");
*/ REGISTER_FUNCTION(progn, "(&rest forms)", "Evaluate each of FORMS.");
/* REGISTER_FUNCTION(exit, "(&opt code)", */ REGISTER_FUNCTION(symbol_function, "(sym &opt resolve)", "");
/* "Exit with CODE, defaulting to zero."); */ REGISTER_FUNCTION(fset, "(sym new-func)", "");
/* REGISTER_FUNCTION(print, "(obj)", */ REGISTER_FUNCTION(defun, "(name args &rest body)",
/* "Print a human-readable representation of OBJ."); */ "Define NAME to be a new function.");
/* REGISTER_FUNCTION( */ REGISTER_FUNCTION(defmacro, "(name args &rest body)",
/* println, "(obj)", */ "Define NAME to be a new macro.");
/* "Print a human-readable representation of OBJ followed by a REGISTER_FUNCTION(lambda, "(args &rest body)", "Return a new closure.");
* newline."); */ REGISTER_FUNCTION(while, "(cond &rest body)",
/* REGISTER_FUNCTION(not, "(obj)", */ "Run BODY until COND returns nil.");
/* "Return t if OBJ is nil, otherwise return t."); */ REGISTER_FUNCTION(eval, "(expr)", "Evaluate the lisp expression EXPR");
/* REGISTER_FUNCTION(add, "(&rest nums)", "Return the sun of NUMS."); */ REGISTER_FUNCTION(read, "(source)",
/* REGISTER_FUNCTION(sub, "(&rest nums)", */ "Read and return the next s-expr from SOURCE.");
/* "Return (head NUMS) - (apply '+ (tail NUMS))."); */ REGISTER_FUNCTION(eq, "(obj1 obj2)",
/* REGISTER_FUNCTION( */ "Return non-nil if OBJ1 and OBJ2 are equal");
/* if, "(cond then &rest else)", */ REGISTER_FUNCTION(make_symbol, "(name)",
/* "Evaluate THEN if COND is non-nil, otherwise evaluate ELSE."); */ "Return a new un-interned symbol named NAME.");
/* REGISTER_FUNCTION( */ REGISTER_FUNCTION(macroexpand_1, "(form)",
/* setq, "(&rest name-value-pairs)", */ "Return the form which FORM expands to.");
/* "Set each of a number of variables to their respective values."); */ REGISTER_FUNCTION(stringp, "(val)", "Return non-nil if VAL is a string.");
/* REGISTER_FUNCTION(progn, "(&rest forms)", "Evaluate each of FORMS."); */ REGISTER_FUNCTION(symbolp, "(val)", "Return non-nil if VAL is a symbol.");
/* REGISTER_FUNCTION(symbol_function, "(sym &opt resolve)", ""); */ REGISTER_FUNCTION(pairp, "(val)", "Return non-nil if VAL is a pair.");
/* REGISTER_FUNCTION(fset, "(sym new-func)", ""); */ REGISTER_FUNCTION(integerp, "(val)", "Return non-nil if VAL is a integer.");
/* REGISTER_FUNCTION(defun, "(name args &rest body)", */ REGISTER_FUNCTION(floatp, "(val)", "Return non-nil if VAL is a float.");
/* "Define NAME to be a new function."); */ REGISTER_FUNCTION(vectorp, "(val)", "Return non-nil if VAL is a vector.");
/* REGISTER_FUNCTION(defmacro, "(name args &rest body)", */ REGISTER_FUNCTION(functionp, "(val)",
/* "Define NAME to be a new macro."); */ "Return non-nil if VAL is a function.");
/* REGISTER_FUNCTION(lambda, "(args &rest body)", "Return a new closure."); REGISTER_FUNCTION(macrop, "(val)", "Return non-nil if VAL is a macro.");
*/ REGISTER_FUNCTION(hashtablep, "(val)",
/* REGISTER_FUNCTION(while, "(cond &rest body)", */ "Return non-nil if VAL is a hashtable.");
/* "Run BODY until COND returns nil."); */ REGISTER_FUNCTION(user_pointer_p, "(val)",
/* REGISTER_FUNCTION(eval, "(expr)", "Evaluate the lisp expression EXPR"); "Return non-nil if VAL is a user pointer.");
*/ REGISTER_FUNCTION(atom, "(val)", "Return non-nil if VAL is a atom.");
/* REGISTER_FUNCTION(read, "(source)", */ REGISTER_FUNCTION(listp, "(val)", "Return non-nil if VAL is a list.");
/* "Read and return the next s-expr from SOURCE."); */ REGISTER_FUNCTION(keywordp, "(val)", "Return non-nil if VAL is a keyword.");
/* REGISTER_FUNCTION(eq, "(obj1 obj2)", */ REGISTER_FUNCTION(numberp, "(val)", "Return non-nil if VAL is a number.");
/* "Return non-nil if OBJ1 and OBJ2 are equal"); */ REGISTER_FUNCTION(list_length, "(list)", "Return the length of LIST.");
/* REGISTER_FUNCTION(make_symbol, "(name)", */ REGISTER_FUNCTION(num_eq, "(n1 n2)",
/* "Return a new un-interned symbol named NAME."); */ "Return non-nil if N1 and N2 are equal numerically.")
/* REGISTER_FUNCTION(macroexpand_1, "(form)", */ REGISTER_FUNCTION(num_gt, "(n1 n2)",
/* "Return the form which FORM expands to."); */ "Return non-nil if N1 is greather than N2.")
/* REGISTER_FUNCTION(stringp, "(val)", "Return non-nil if VAL is a REGISTER_FUNCTION(and, "(&rest args)",
* string."); */ "Logical and (with short circuit evaluation.)");
/* REGISTER_FUNCTION(symbolp, "(val)", "Return non-nil if VAL is a REGISTER_FUNCTION(or, "(&rest args)",
* symbol."); */ "Logical or (with short circuit evaluation.)");
/* REGISTER_FUNCTION(pairp, "(val)", "Return non-nil if VAL is a pair."); */ REGISTER_FUNCTION(type_of, "(obj)", "Return the type of OBJ.");
/* REGISTER_FUNCTION(integerp, "(val)", "Return non-nil if VAL is a REGISTER_FUNCTION(function_docstr, "(func)",
* integer."); */ "Return the documentation string of FUNC.")
/* REGISTER_FUNCTION(floatp, "(val)", "Return non-nil if VAL is a float.");
*/
/* REGISTER_FUNCTION(vectorp, "(val)", "Return non-nil if VAL is a
* vector."); */
/* REGISTER_FUNCTION(functionp, "(val)", */
/* "Return non-nil if VAL is a function."); */
/* REGISTER_FUNCTION(macrop, "(val)", "Return non-nil if VAL is a macro.");
*/
/* REGISTER_FUNCTION(hashtablep, "(val)", */
/* "Return non-nil if VAL is a hashtable."); */
/* REGISTER_FUNCTION(user_pointer_p, "(val)", */
/* "Return non-nil if VAL is a user pointer."); */
/* REGISTER_FUNCTION(atom, "(val)", "Return non-nil if VAL is a atom."); */
/* REGISTER_FUNCTION(listp, "(val)", "Return non-nil if VAL is a list."); */
/* REGISTER_FUNCTION(keywordp, "(val)", "Return non-nil if VAL is a
* keyword."); */
/* REGISTER_FUNCTION(numberp, "(val)", "Return non-nil if VAL is a
* number."); */
/* REGISTER_FUNCTION(list_length, "(list)", "Return the length of LIST.");
*/
/* REGISTER_FUNCTION(num_eq, "(n1 n2)", */
/* "Return non-nil if N1 and N2 are equal numerically.")
*/
/* REGISTER_FUNCTION(num_gt, "(n1 n2)", */
/* "Return non-nil if N1 is greather than N2.") */
/* REGISTER_FUNCTION(and, "(&rest args)", */
/* "Logical and (with short circuit evaluation.)"); */
/* REGISTER_FUNCTION(or, "(&rest args)", */
/* "Logical or (with short circuit evaluation.)"); */
/* REGISTER_FUNCTION(type_of, "(obj)", "Return the type of OBJ."); */
/* REGISTER_FUNCTION(function_docstr, "(func)", */
/* "Return the documentation string of FUNC.") */
} }
void lisp_shutdown(void) { void lisp_shutdown(void) {

68
src/main.c
View File

@ -67,28 +67,28 @@ LispVal *Ftoplevel_error_handler(LispVal *except) {
DEF_STATIC_SYMBOL(toplevel_read, "toplevel-read"); DEF_STATIC_SYMBOL(toplevel_read, "toplevel-read");
int main(int argc, const char **argv) { int main(int argc, const char **argv) {
/* if (argc < 2) { */ if (argc < 2) {
/* fprintf(stderr, "No input file!\n"); */ fprintf(stderr, "No input file!\n");
/* return 1; */ return 1;
/* } */ }
/* FILE *in = fopen(argv[1], "r"); */ FILE *in = fopen(argv[1], "r");
/* if (!in) { */ if (!in) {
/* perror("fopen"); */ perror("fopen");
/* return 1; */ return 1;
/* } */ }
/* fseek(in, 0, SEEK_END); */ fseek(in, 0, SEEK_END);
/* off_t file_len = ftello(in); */ off_t file_len = ftello(in);
/* rewind(in); */ rewind(in);
/* char buffer[file_len]; */ char buffer[file_len];
/* fread(buffer, 1, file_len, in); */ fread(buffer, 1, file_len, in);
/* fclose(in); */ fclose(in);
lisp_init(); lisp_init();
/* refcount_init_static(Qtoplevel_read); */ REGISTER_SYMBOL(toplevel_read);
/* REGISTER_STATIC_FUNCTION(Ftoplevel_error_handler_function, "(e)", ""); */ REGISTER_STATIC_FUNCTION(Ftoplevel_error_handler_function, "(e)", "");
/* REGISTER_STATIC_FUNCTION(Ftoplevel_exit_handler_function, "(e)", ""); */ REGISTER_STATIC_FUNCTION(Ftoplevel_exit_handler_function, "(e)", "");
/* size_t pos = 0; */ size_t pos = 0;
/* WITH_PUSH_FRAME(Qtoplevel, Qnil, false, { */ WITH_PUSH_FRAME(Qtoplevel, Qnil, false, {
/* the_stack->hidden = true; */ the_stack->hidden = true;
/* LispVal *err_var = INTERN_STATIC("err-var"); */ /* LispVal *err_var = INTERN_STATIC("err-var"); */
/* puthash( */ /* puthash( */
/* the_stack->handlers, Qt, */ /* the_stack->handlers, Qt, */
@ -106,17 +106,21 @@ int main(int argc, const char **argv) {
/* nil_nil); */ /* nil_nil); */
/* refcount_unref(nil_nil); */ /* refcount_unref(nil_nil); */
/* refcount_unref(err_var); */ /* refcount_unref(err_var); */
/* while (pos < file_len) { */ while (true) {
/* LispVal *tv; */ LispVal *tv;
/* WITH_PUSH_FRAME(Qtoplevel_read, Qnil, false, { */ WITH_PUSH_FRAME(Qtoplevel_read, Qnil, false, {
/* pos += read_from_buffer(buffer + pos, file_len - pos, &tv); size_t res =
*/ read_from_buffer(buffer + pos, file_len - pos, &tv);
/* }); */ if (res == LISP_EOF) {
/* WITH_CLEANUP(tv, { */ break;
/* refcount_unref(Feval(tv)); // */ }
/* }); */ pos += res;
/* } */ });
/* }); */ WITH_CLEANUP(tv, {
refcount_unref(Feval(tv)); //
});
}
});
lisp_shutdown(); lisp_shutdown();
return exit_status; return exit_status;
} }

31
src/read.c
View File

@ -40,8 +40,9 @@ static int peekc(struct ReadState *state) {
return *state->head; return *state->head;
} }
static inline void _internal_read_error(struct ReadState *state, size_t len, static inline _Noreturn void _internal_read_error(struct ReadState *state,
LispVal *desc, LispVal *cause) { size_t len, LispVal *desc,
LispVal *cause) {
if (len > state->left) { if (len > state->left) {
len = state->left; len = state->left;
} }
@ -96,6 +97,7 @@ static LispVal *read_list(struct ReadState *state) {
} }
LispVal *elt = read_internal(state); LispVal *elt = read_internal(state);
if (is_dot_symbol(elt)) { if (is_dot_symbol(elt)) {
refcount_unref(elt);
if (NILP(list)) { if (NILP(list)) {
READ_ERROR(state, 1, "Dot cannot start a list"); READ_ERROR(state, 1, "Dot cannot start a list");
} }
@ -116,9 +118,11 @@ static LispVal *read_list(struct ReadState *state) {
break; break;
} else if (NILP(list)) { } else if (NILP(list)) {
list = Fpair(elt, Qnil); list = Fpair(elt, Qnil);
refcount_unref(elt);
end = list; end = list;
} else { } else {
LispVal *new_end = Fpair(elt, Qnil); LispVal *new_end = Fpair(elt, Qnil);
refcount_unref(elt);
Fsettail(end, new_end); Fsettail(end, new_end);
refcount_unref(new_end); refcount_unref(new_end);
end = new_end; end = new_end;
@ -214,7 +218,8 @@ static LispVal *read_character(struct ReadState *state) {
{"null", 4, '\0'}, {"\\0", 2, '\0'}, {"newline", 7, '\n'}, {"null", 4, '\0'}, {"\\0", 2, '\0'}, {"newline", 7, '\n'},
{"\\n", 2, '\n'}, {"tab", 3, '\t'}, {"\\t", 2, '\t'}, {"\\n", 2, '\n'}, {"tab", 3, '\t'}, {"\\t", 2, '\t'},
}; };
#define LOOKUP_TABLE_SIZE (sizeof(LOOKUP_TABLE) / sizeof(LOOKUP_TABLE[0])) static const size_t LOOKUP_TABLE_SIZE =
sizeof(LOOKUP_TABLE) / sizeof(LOOKUP_TABLE[0]);
struct ReadState start_state = *state; struct ReadState start_state = *state;
popc(state); // # popc(state); // #
const char *start = state->head; const char *start = state->head;
@ -231,7 +236,6 @@ static LispVal *read_character(struct ReadState *state) {
READ_ERROR(&start_state, len, "unknown character liternal: %*s", (int) len, READ_ERROR(&start_state, len, "unknown character liternal: %*s", (int) len,
start); start);
return Qnil; return Qnil;
#undef LOOKUP_TABLE_SIZE
} }
#define INVALID_BASE -2 #define INVALID_BASE -2
@ -473,8 +477,8 @@ size_t read_from_buffer(const char *text, size_t length, LispVal **out) {
}; };
LispVal *res = read_internal(&state); LispVal *res = read_internal(&state);
if (!res) { if (!res) {
EOF_ERROR(&state);
*out = Qnil; *out = Qnil;
return LISP_EOF;
} else { } else {
*out = res; *out = res;
} }
@ -482,12 +486,19 @@ size_t read_from_buffer(const char *text, size_t length, LispVal **out) {
} }
DEFUN(read, "read", (LispVal * source)) { DEFUN(read, "read", (LispVal * source)) {
if (STRINGP(source)) {
LispString *str = (LispString *) source; LispString *str = (LispString *) source;
LispVal *v; struct ReadState state = {
read_from_buffer(str->data, str->length, &v); .head = str->data,
return v; .left = str->length,
.off = 0,
.line = 1,
.col = 0,
.backquote_level = 0,
};
LispVal *res = read_internal(&state);
if (!res) {
EOF_ERROR(&state);
} else { } else {
Fthrow(Qtype_error, Qnil); return res;
} }
} }

3
src/read.h
View File

@ -3,8 +3,11 @@
#include "lisp.h" #include "lisp.h"
#include <limits.h>
#include <stddef.h> #include <stddef.h>
#define LISP_EOF SIZE_MAX
size_t read_from_buffer(const char *text, size_t length, LispVal **out); size_t read_from_buffer(const char *text, size_t length, LispVal **out);
DECLARE_FUNCTION(read, (LispVal * source)); DECLARE_FUNCTION(read, (LispVal * source));