Fix some refcount bugs
This commit is contained in:
202
src/lisp.c
202
src/lisp.c
@ -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) {
|
||||
|
||||
Reference in New Issue
Block a user