Automatically gc during evaluation + perf improvements

Still ~25x slower than Python when calculating fib 27

SConstruct

@@ -151,6 +151,8 @@ release_ccflags = [
     "-ffunction-sections",
     "-fdata-sections",
     "-Wl,--gc-sections",
+    "-DNDEBUG",
+    "-ggdb"
 ]
 
 variants = [

src/builtins.c

@@ -189,12 +189,20 @@ struct ucl_object *ucl_builtin_list(struct ucl *state, UNUSED struct ucl_scope *
 LISP_FUNC_2(ucl_builtin_mapcar, state, scope, fun, elems) {
     // TODO: Support arbitrary number of 'elems' lists
     struct ucl_object *result = ucl_nil_create(state);
+    ucl_object_pin(result);
     FOREACH_LIST(elems, iter, elem) {
         struct ucl_object *form = ucl_tuple_create(state, fun, elem);
+        ucl_object_pin(form);
         struct ucl_object *value = ucl_evaluate_in_scope(state, scope, form);
+        ucl_object_unpin(form);
+        if (value->type == UCL_TYPE_ERROR) {
+            ucl_object_unpin(result);
+            return value;
+        }
         UCL_RET_IF_ERROR(value);
         ucl_list_append(state, result, value);
     }
+    ucl_object_unpin(result);
     return result;
 }
 
@@ -202,14 +210,21 @@ LISP_FUNC_2(ucl_builtin_filter, state, scope, predicate, elems) {
     // TODO: Support arbitrary number of 'elems' lists
     struct ucl_object *result = ucl_nil_create(state);
     struct ucl_object *result_tail = result;
+    ucl_object_pin(result);
     FOREACH_LIST(elems, iter, elem) {
         struct ucl_object *form = ucl_tuple_create(state, predicate, elem);
+        ucl_object_pin(form);
         struct ucl_object *value = ucl_evaluate_in_scope(state, scope, form);
-        UCL_RET_IF_ERROR(value);
+        ucl_object_unpin(form);
+        if (value->type == UCL_TYPE_ERROR) {
+            ucl_object_unpin(result);
+            return value;
+        }
         if (ucl_truthy_bool(value)) {
             result_tail = ucl_list_append(state, result_tail, elem);
         }
     }
+    ucl_object_unpin(result);
     return result;
 }
 
@@ -218,8 +233,10 @@ LISP_FUNC_3(ucl_builtin_reduce, state, scope, fun, elems, initial_value) {
     struct ucl_object *result = initial_value;
     FOREACH_LIST(elems, iter, elem) {
         struct ucl_object *form = ucl_tuple_create(state, fun, elem);
+        ucl_object_pin(form);
         ucl_list_append(state, form, result);
         result = ucl_evaluate_in_scope(state, scope, form);
+        ucl_object_unpin(form);
         UCL_RET_IF_ERROR(result);
     }
     return result;

src/evaluate.c

@@ -1,6 +1,8 @@
 #include <assert.h>
 #include <stddef.h>
 
+#include "memory.h"
+#include "types.h"
 #include "uclisp.h"
 #include "common.h"
 #include "scope.h"
@@ -12,8 +14,14 @@ struct ucl_object *ucl_evaluate_builtin_form(struct ucl *state, struct ucl_scope
     struct ucl_object *evaluated_list = ucl_nil_create(state);
     struct ucl_object *evaluated_list_tail = evaluated_list;
 
+    ucl_object_pin(evaluated_list);
+
     FOREACH_LIST(list, iter, item) {
         struct ucl_object *obj = ucl_evaluate_in_scope(state, scope, item);
+        if (obj->type == UCL_TYPE_ERROR) {
+            ucl_object_unpin(evaluated_list);
+            return obj;
+        }
         UCL_RET_IF_ERROR(obj);
         evaluated_list_tail = ucl_list_append(state, evaluated_list_tail, obj);
     };
@@ -38,6 +46,11 @@ struct ucl_object *ucl_evaluate_builtin_form(struct ucl *state, struct ucl_scope
     } else {
         assert(0);
     }
+    ucl_object_unpin(evaluated_list);
+
+    ucl_object_pin(result);
+    ucl_gc(state);
+    ucl_object_unpin(result);
 
     return (result == NULL) ? ucl_nil_create(state) : result;
 }
@@ -96,9 +109,17 @@ struct ucl_object *ucl_evaluate_in_scope(struct ucl *state, struct ucl_scope *sc
 }
 
 struct ucl_object *ucl_evaluate(struct ucl *state, struct ucl_object *obj) {
-    return ucl_evaluate_in_scope(state, state->global_scope, obj);
+    struct ucl_object *result = NULL;
+    ucl_object_pin(obj);
+    result =  ucl_evaluate_in_scope(state, state->global_scope, obj);
+    ucl_object_unpin(obj);
+    return result;
 }
 
 struct ucl_object *ucl_evaluate_progn(struct ucl *state, struct ucl_object *forms) {
-    return ucl_progn(state, state->global_scope, forms);
+    struct ucl_object *result = NULL;
+    ucl_object_pin(forms);
+    result =  ucl_progn(state, state->global_scope, forms);
+    ucl_object_unpin(forms);
+    return result;
 }

src/lisp.h

@@ -5,6 +5,18 @@
 
 #define UNUSED __attribute__((unused))
 
+
+/**
+ * Memory management invariants for lisp-functions in C:
+ *
+ * + If the function creates no new objects (typically ucl_*_create()), no care is needed
+ * + If the function does not call ucl_evaluate() directly or indirectly, no care is needed
+ * + Otherwise, the caller must ensure one of the following is true for all allocated objects before calling ucl_evalate()
+ *   1. The object is pinned via ucl_object_pin() and unpinned before the function exis
+ *   2. The object is referenced by an object that is pinned
+ *   3. The object is managed by a ucl_scope (via ucl_scope_put())
+ * */
+
 void ucl_add_builtin(struct ucl *state, const char *name, ucl_lisp fun);
 void ucl_add_special(struct ucl *state, const char *name, ucl_lisp fun);
 

src/memory.c

@@ -160,12 +160,17 @@ static void ucl_gc_unmark_all(struct ucl_arena * arena, void *obj) {
 
 static void ucl_gc_sweep(struct ucl_arena * arena, void *obj) {
     struct ucl_object *object = (struct ucl_object *) obj;
-    if (!(object->flags &UCL_OBJ_FLAG_REACHABLE)) {
+    if (!(object->flags & UCL_OBJ_FLAG_REACHABLE)) {
          ucl_object_delete_internal(arena, object);
     }
 }
 
 void ucl_gc(struct ucl* ucl) {
+    // If there's still plenty of remaining objects, don't bother with gc yet
+    if (ucl->obj_arena->stats.used < ucl->obj_arena->capacity / 2) {
+        return;
+    }
+
     ucl_arena_map(ucl->obj_arena, ucl_gc_unmark_all);
     ucl_arena_map(ucl->obj_arena, ucl_gc_mark_pinned);
     ucl_arena_map(ucl->obj_arena, ucl_gc_sweep);

src/scope.c

@@ -20,7 +20,7 @@ static struct ucl_object *ucl_scope_get_cell(struct ucl_scope *scope, const char
     FOREACH_LIST(scope->list, iter, item) {
         assert(item->type == UCL_TYPE_CELL);
         const char *item_name = ucl_list_nth(item, NAME_POSITION)->string;
-        if (!strcmp(name, item_name)) {
+        if (ucl_strequal(name, item_name)) {
             return item;
         }
     }

src/special.c

@@ -20,7 +20,6 @@ struct ucl_object *ucl_special_let(struct ucl *state, struct ucl_scope *scope, s
         struct ucl_object *value = ucl_evaluate_in_scope(state, let_scope, expr);
 
         assert(sym->type == UCL_TYPE_SYMBOL);
-        //assert(ucl_list_length(expr)->integer == 1);
 
         if (value->type == UCL_TYPE_ERROR) {
             ucl_scope_delete(state, let_scope);
@@ -98,7 +97,7 @@ struct ucl_object *ucl_special_dotimes(struct ucl *state, struct ucl_scope *scop
     struct ucl_scope *let_scope = ucl_scope_create_child(state, scope);
 
     struct ucl_object *iter = ucl_int_create(state, 0);
-    ucl_scope_put(state, let_scope, var->symbol, var);
+    ucl_scope_put(state, let_scope, var->symbol, iter);
 
     for (int i = 0; i < times->integer; i++) {
         iter->integer = i;
@@ -182,25 +181,25 @@ struct ucl_object *ucl_special_quote(struct ucl *state, UNUSED struct ucl_scope
 }
 
 struct ucl_object *ucl_special_and(struct ucl *state, struct ucl_scope *scope, struct ucl_object *args) {
-    struct ucl_object *value = ucl_t_create(state);
+    struct ucl_object *value = NULL;
     FOREACH_LIST(args, iter, form) {
         value = ucl_evaluate_in_scope(state, scope, form);
         if (!ucl_truthy_bool(value)) {
             return value;
         }
     }
-    return value;
+    return (value == NULL) ? ucl_t_create(state) : value;
 }
 
 struct ucl_object *ucl_special_or(struct ucl *state, struct ucl_scope *scope, struct ucl_object *args) {
-    struct ucl_object *value = ucl_nil_create(state);
+    struct ucl_object *value = NULL;
     FOREACH_LIST(args, iter, form) {
         value = ucl_evaluate_in_scope(state, scope, form);
         if (ucl_truthy_bool(value)) {
             return value;
         }
     }
-    return value;
+    return (value == NULL) ? ucl_nil_create(state) : value;
 }
 
 void ucl_add_special(struct ucl *state, const char *name, ucl_lisp fun) {

src/utility.c

@@ -86,13 +86,13 @@ struct ucl_object *ucl_list_nth(struct ucl_object *list, int n) {
         list != NULL && list->type == UCL_TYPE_CELL,
         "Invalid type of argument 0 to 'ucl_list_nth'");
 
-    int length = ucl_list_length_int(list);
-    UCL_COND_OR_RET_ERROR(length > n, "Position n >= list length in ucl_list_nth");
+    //int length = ucl_list_length_int(list);
     UCL_COND_OR_RET_ERROR(n >= 0, "Index to ucl_list_nth was less that zero");
 
     struct ucl_object *node = list;
     for (int i = 0; i < n; i++) {
         node = node->cell.cdr;
+        UCL_COND_OR_RET_ERROR(node != NULL, "Position n >= list length in ucl_list_nth");
     }
 
     return node->cell.car;
@@ -231,3 +231,14 @@ struct ucl_object *ucl_equal(struct ucl *state,
     assert(0);
     return ucl_error_create(state, "Unreachable error in ucl_equal");
 }
+
+bool ucl_strequal(const char *first, const char *second) {
+    while (*first == *second) {
+        if (*first == '\0') {
+            return true;
+        }
+        first++;
+        second++;
+    }
+    return false;
+}

src/utility.h

@@ -27,4 +27,6 @@ struct ucl_object* ucl_evaluate_in_scope(struct ucl *state, struct ucl_scope *sc
 void ucl_add_builtins(struct ucl *state);
 void ucl_add_specials(struct ucl *state);
 
+bool ucl_strequal(const char *first, const char *second);
+
 #endif

test/test_e2e.c

@@ -95,8 +95,7 @@ void test_eval_nested_error(void) {
 
 void test_eval_list(void) {
     response = eval("(list 1 2 3)");
-    TEST_ASSERT_OBJ_LIST(response);
-    TEST_ASSERT_EQUAL(ucl_list_length(state, response)->integer, 3);
+    TEST_ASSERT_LIST_LEN(response, 3);
 
     int i = 1;
     FOREACH_LIST(response, iter, item) {
@@ -225,34 +224,14 @@ void test_complex(void) {
     TEST_ASSERT_OBJ_INT_V(response, 9);
 }
 
-void test_memory_perf_low(void) {
+void test_memory_perf(void) {
     response = eval("(defun fib (n) (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2)))))");
 
     TEST_ASSERT_OBJ_SYMBOL_V(response, "fib");
 
-    response = eval("(fib 4)");
+    response = eval("(fib 11)");
 
-    TEST_ASSERT_OBJ_INT_V(response, 3);
-}
-
-void test_memory_perf_medium(void) {
-    response = eval("(defun fib (n) (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2)))))");
-
-    TEST_ASSERT_OBJ_SYMBOL_V(response, "fib");
-
-    response = eval("(fib 10)");
-
-    TEST_ASSERT_OBJ_INT_V(response, 55);
-}
-
-void test_memory_perf_high(void) {
-    response = eval("(defun fib (n) (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2)))))");
-
-    TEST_ASSERT_OBJ_SYMBOL_V(response, "fib");
-
-    response = eval("(fib 8)");
-
-    TEST_ASSERT_OBJ_INT_V(response, 21);
+    TEST_ASSERT_OBJ_INT_V(response, 89);
 }
 
 int main(void) {
@@ -284,9 +263,7 @@ int main(void) {
     RUN_TEST(test_nth_oob);
     RUN_TEST(test_eval_defun_gc);
     RUN_TEST(test_complex);
-    RUN_TEST(test_memory_perf_low);
-    RUN_TEST(test_memory_perf_medium);
-    RUN_TEST(test_memory_perf_high);
+    RUN_TEST(test_memory_perf);
 
     return UNITY_END();
 }

test/testing_helpers.h

@@ -45,7 +45,7 @@
 #define TEST_ASSERT_LIST_LEN(list, len)                                 \
     do {                                                                \
         TEST_ASSERT_OBJ_LIST(list);                                     \
-        TEST_ASSERT_EQUAL_MESSAGE(len, ucl_list_length(state, list)->integer, "Unexpected list length"); \
+        TEST_ASSERT_EQUAL_MESSAGE(len, ucl_list_length_int(list), "Unexpected list length"); \
     } while(0)
 
 #define TEST_ASSERT_NIL(obj)                    \