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);
oargs_end = new_end;
}
refcount_unref(desc);
puthash(found_args, USERPTR(struct OptArgDesc, desc)->name, Qt);
if (!NILP(USERPTR(struct OptArgDesc, desc)->pred_var)) {
puthash(found_args,
@ -316,18 +317,22 @@ void set_function_args(LispFunction *func, LispVal *args) {
refcount_unref(desc);
goto malformed;
}
USERPTR(struct OptArgDesc, desc)->index = 0;
USERPTR(struct OptArgDesc, desc)->index =
((LispHashtable *) func->kwargs)->count;
LispString *sn =
((LispSymbol *) USERPTR(struct OptArgDesc, desc)->name)
->name;
char kns[sn->length + 2];
kns[0] = ':';
memcpy(kns + 1, sn->data, sn->length);
kns[sn->length + 1] = '\n';
kns[sn->length + 1] = '\0';
LispVal *kn =
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(desc);
puthash(found_args, USERPTR(struct OptArgDesc, desc)->name, Qt);
if (!NILP(USERPTR(struct OptArgDesc, desc)->pred_var)) {
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->lexenv);
*held = refcount_list_push(*held, fn->doc);
*held = refcount_list_push(*held, fn->rest_arg);
if (!fn->is_builtin) {
*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_name);
{
refcount_init_static(Qbreakpoint);
refcount_init_static(((LispSymbol *) Qbreakpoint)->name);
puthash(Vobarray, ((LispVal *) (((LispSymbol *) Qbreakpoint)->name)),
Qbreakpoint);
};
{
refcount_init_static(((LispSymbol *) Qbreakpoint)->function);
((LispFunction *) (((LispSymbol *) Qbreakpoint)->function))->doc =
(make_lisp_string(("Do nothing..."), sizeof("") - 1, 1, 1));
LispVal *src =
(make_lisp_string(("(&opt id)"), sizeof("(&opt id)") - 1, 1, 1));
LispVal *a = Fread(src);
set_function_args(
(LispFunction *) (((LispSymbol *) Qbreakpoint)->function), a);
refcount_unref(src);
refcount_unref(a);
};
;
/* REGISTER_FUNCTION(sethead, "(pair newval)", */
/* "Set the head of PAIR to NEWVAL."); */
/* REGISTER_FUNCTION(settail, "(pair newval)", */
/* "Set the tail of PAIR to NEWVAL."); */
/* REGISTER_FUNCTION(funcall, "(function &rest args)", "") */
/* REGISTER_FUNCTION(apply, "(function &rest args)", "") */
/* REGISTER_FUNCTION(throw, "(signal &rest data)", ""); */
/* REGISTER_FUNCTION(pair, "(head tail)", */
/* "Return a new pair with HEAD and TAIL."); */
/* REGISTER_FUNCTION(head, "(pair)", "Return the head of PAIR."); */
/* REGISTER_FUNCTION(tail, "(pair)", "Return the tail of PAIR."); */
/* REGISTER_FUNCTION(quote, "(form)", "Return FORM as read by the reader.");
*/
/* REGISTER_FUNCTION(exit, "(&opt code)", */
/* "Exit with CODE, defaulting to zero."); */
/* REGISTER_FUNCTION(print, "(obj)", */
/* "Print a human-readable representation of OBJ."); */
/* REGISTER_FUNCTION( */
/* println, "(obj)", */
/* "Print a human-readable representation of OBJ followed by a
* newline."); */
/* REGISTER_FUNCTION(not, "(obj)", */
/* "Return t if OBJ is nil, otherwise return t."); */
/* REGISTER_FUNCTION(add, "(&rest nums)", "Return the sun of NUMS."); */
/* REGISTER_FUNCTION(sub, "(&rest nums)", */
/* "Return (head NUMS) - (apply '+ (tail NUMS))."); */
/* REGISTER_FUNCTION( */
/* if, "(cond then &rest else)", */
/* "Evaluate THEN if COND is non-nil, otherwise evaluate ELSE."); */
/* REGISTER_FUNCTION( */
/* setq, "(&rest name-value-pairs)", */
/* "Set each of a number of variables to their respective values."); */
/* REGISTER_FUNCTION(progn, "(&rest forms)", "Evaluate each of FORMS."); */
/* REGISTER_FUNCTION(symbol_function, "(sym &opt resolve)", ""); */
/* REGISTER_FUNCTION(fset, "(sym new-func)", ""); */
/* REGISTER_FUNCTION(defun, "(name args &rest body)", */
/* "Define NAME to be a new function."); */
/* REGISTER_FUNCTION(defmacro, "(name args &rest body)", */
/* "Define NAME to be a new macro."); */
/* REGISTER_FUNCTION(lambda, "(args &rest body)", "Return a new closure.");
*/
/* REGISTER_FUNCTION(while, "(cond &rest body)", */
/* "Run BODY until COND returns nil."); */
/* REGISTER_FUNCTION(eval, "(expr)", "Evaluate the lisp expression EXPR");
*/
/* REGISTER_FUNCTION(read, "(source)", */
/* "Read and return the next s-expr from SOURCE."); */
/* REGISTER_FUNCTION(eq, "(obj1 obj2)", */
/* "Return non-nil if OBJ1 and OBJ2 are equal"); */
/* REGISTER_FUNCTION(make_symbol, "(name)", */
/* "Return a new un-interned symbol named NAME."); */
/* REGISTER_FUNCTION(macroexpand_1, "(form)", */
/* "Return the form which FORM expands to."); */
/* REGISTER_FUNCTION(stringp, "(val)", "Return non-nil if VAL is a
* string."); */
/* REGISTER_FUNCTION(symbolp, "(val)", "Return non-nil if VAL is a
* symbol."); */
/* REGISTER_FUNCTION(pairp, "(val)", "Return non-nil if VAL is a pair."); */
/* REGISTER_FUNCTION(integerp, "(val)", "Return non-nil if VAL is a
* integer."); */
/* 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.") */
REGISTER_FUNCTION(breakpoint, "(&opt id)", "Do nothing...");
REGISTER_FUNCTION(sethead, "(pair newval)",
"Set the head of PAIR to NEWVAL.");
REGISTER_FUNCTION(settail, "(pair newval)",
"Set the tail of PAIR to NEWVAL.");
REGISTER_FUNCTION(funcall, "(function &rest args)", "")
REGISTER_FUNCTION(apply, "(function &rest args)", "")
REGISTER_FUNCTION(throw, "(signal &rest data)", "");
REGISTER_FUNCTION(pair, "(head tail)",
"Return a new pair with HEAD and TAIL.");
REGISTER_FUNCTION(head, "(pair)", "Return the head of PAIR.");
REGISTER_FUNCTION(tail, "(pair)", "Return the tail of PAIR.");
REGISTER_FUNCTION(quote, "(form)", "Return FORM as read by the reader.");
REGISTER_FUNCTION(exit, "(&opt code)",
"Exit with CODE, defaulting to zero.");
REGISTER_FUNCTION(print, "(obj)",
"Print a human-readable representation of OBJ.");
REGISTER_FUNCTION(
println, "(obj)",
"Print a human-readable representation of OBJ followed by a newline.");
REGISTER_FUNCTION(not, "(obj)",
"Return t if OBJ is nil, otherwise return t.");
REGISTER_FUNCTION(add, "(&rest nums)", "Return the sun of NUMS.");
REGISTER_FUNCTION(sub, "(&rest nums)",
"Return (head NUMS) - (apply '+ (tail NUMS)).");
REGISTER_FUNCTION(
if, "(cond then &rest else)",
"Evaluate THEN if COND is non-nil, otherwise evaluate ELSE.");
REGISTER_FUNCTION(
setq, "(&rest name-value-pairs)",
"Set each of a number of variables to their respective values.");
REGISTER_FUNCTION(progn, "(&rest forms)", "Evaluate each of FORMS.");
REGISTER_FUNCTION(symbol_function, "(sym &opt resolve)", "");
REGISTER_FUNCTION(fset, "(sym new-func)", "");
REGISTER_FUNCTION(defun, "(name args &rest body)",
"Define NAME to be a new function.");
REGISTER_FUNCTION(defmacro, "(name args &rest body)",
"Define NAME to be a new macro.");
REGISTER_FUNCTION(lambda, "(args &rest body)", "Return a new closure.");
REGISTER_FUNCTION(while, "(cond &rest body)",
"Run BODY until COND returns nil.");
REGISTER_FUNCTION(eval, "(expr)", "Evaluate the lisp expression EXPR");
REGISTER_FUNCTION(read, "(source)",
"Read and return the next s-expr from SOURCE.");
REGISTER_FUNCTION(eq, "(obj1 obj2)",
"Return non-nil if OBJ1 and OBJ2 are equal");
REGISTER_FUNCTION(make_symbol, "(name)",
"Return a new un-interned symbol named NAME.");
REGISTER_FUNCTION(macroexpand_1, "(form)",
"Return the form which FORM expands to.");
REGISTER_FUNCTION(stringp, "(val)", "Return non-nil if VAL is a string.");
REGISTER_FUNCTION(symbolp, "(val)", "Return non-nil if VAL is a symbol.");
REGISTER_FUNCTION(pairp, "(val)", "Return non-nil if VAL is a pair.");
REGISTER_FUNCTION(integerp, "(val)", "Return non-nil if VAL is a integer.");
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) {

102
src/main.c
View File

@ -67,56 +67,60 @@ LispVal *Ftoplevel_error_handler(LispVal *except) {
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); */
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();
/* refcount_init_static(Qtoplevel_read); */
/* REGISTER_STATIC_FUNCTION(Ftoplevel_error_handler_function, "(e)", ""); */
/* REGISTER_STATIC_FUNCTION(Ftoplevel_exit_handler_function, "(e)", ""); */
/* size_t pos = 0; */
/* WITH_PUSH_FRAME(Qtoplevel, Qnil, false, { */
/* the_stack->hidden = true; */
/* LispVal *err_var = INTERN_STATIC("err-var"); */
/* puthash( */
/* the_stack->handlers, Qt, */
/* // simply call the above function */
/* const_list(3, err_var, Ftoplevel_error_handler_function,
* err_var)); */
/* puthash( */
/* the_stack->handlers, Qshutdown_signal, */
/* // simply call the above function */
/* const_list(3, err_var, Ftoplevel_exit_handler_function,
* 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 (pos < file_len) { */
/* LispVal *tv; */
/* WITH_PUSH_FRAME(Qtoplevel_read, Qnil, false, { */
/* pos += read_from_buffer(buffer + pos, file_len - pos, &tv);
*/
/* }); */
/* WITH_CLEANUP(tv, { */
/* refcount_unref(Feval(tv)); // */
/* }); */
/* } */
/* }); */
REGISTER_SYMBOL(toplevel_read);
REGISTER_STATIC_FUNCTION(Ftoplevel_error_handler_function, "(e)", "");
REGISTER_STATIC_FUNCTION(Ftoplevel_exit_handler_function, "(e)", "");
size_t pos = 0;
WITH_PUSH_FRAME(Qtoplevel, Qnil, false, {
the_stack->hidden = true;
/* LispVal *err_var = INTERN_STATIC("err-var"); */
/* puthash( */
/* the_stack->handlers, Qt, */
/* // simply call the above function */
/* const_list(3, err_var, Ftoplevel_error_handler_function,
* err_var)); */
/* puthash( */
/* the_stack->handlers, Qshutdown_signal, */
/* // simply call the above function */
/* const_list(3, err_var, Ftoplevel_exit_handler_function,
* 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, &tv);
if (res == LISP_EOF) {
break;
}
pos += res;
});
WITH_CLEANUP(tv, {
refcount_unref(Feval(tv)); //
});
}
});
lisp_shutdown();
return exit_status;
}

33
src/read.c
View File

@ -40,8 +40,9 @@ static int peekc(struct ReadState *state) {
return *state->head;
}
static inline void _internal_read_error(struct ReadState *state, size_t len,
LispVal *desc, LispVal *cause) {
static inline _Noreturn void _internal_read_error(struct ReadState *state,
size_t len, LispVal *desc,
LispVal *cause) {
if (len > state->left) {
len = state->left;
}
@ -96,6 +97,7 @@ static LispVal *read_list(struct ReadState *state) {
}
LispVal *elt = read_internal(state);
if (is_dot_symbol(elt)) {
refcount_unref(elt);
if (NILP(list)) {
READ_ERROR(state, 1, "Dot cannot start a list");
}
@ -116,9 +118,11 @@ static LispVal *read_list(struct ReadState *state) {
break;
} else if (NILP(list)) {
list = Fpair(elt, Qnil);
refcount_unref(elt);
end = list;
} else {
LispVal *new_end = Fpair(elt, Qnil);
refcount_unref(elt);
Fsettail(end, new_end);
refcount_unref(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'},
{"\\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;
popc(state); // #
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,
start);
return Qnil;
#undef LOOKUP_TABLE_SIZE
}
#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);
if (!res) {
EOF_ERROR(&state);
*out = Qnil;
return LISP_EOF;
} else {
*out = res;
}
@ -482,12 +486,19 @@ size_t read_from_buffer(const char *text, size_t length, LispVal **out) {
}
DEFUN(read, "read", (LispVal * source)) {
if (STRINGP(source)) {
LispString *str = (LispString *) source;
LispVal *v;
read_from_buffer(str->data, str->length, &v);
return v;
LispString *str = (LispString *) source;
struct ReadState state = {
.head = str->data,
.left = str->length,
.off = 0,
.line = 1,
.col = 0,
.backquote_level = 0,
};
LispVal *res = read_internal(&state);
if (!res) {
EOF_ERROR(&state);
} else {
Fthrow(Qtype_error, Qnil);
return res;
}
}

3
src/read.h
View File

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