Fix (I hope) reference counting and garbage collecting

src/lisp.c

@@ -64,82 +64,16 @@ LispSymbol _Qt = {
 DEF_STATIC_SYMBOL(backquote, "`");
 DEF_STATIC_SYMBOL(comma, ",");
 
-void _internal_lisp_delete_object(LispVal *val) {
+struct GCRoot {
-    switch (TYPEOF(val)) {
+    struct GCRoot *next;
-    case TYPE_INTEGER:
+    struct GCRoot *prev;
-    case TYPE_FLOAT:
+    LispVal *object;
-        lisp_free(val);
+};
-        break;
+
-    case TYPE_STRING: {
+static struct GCRoot *gc_roots = NULL;
-        LispString *str = (LispString *) val;
+static size_t bytes_allocated = 0;
-        if (!str->is_static) {
+static size_t last_gc = 0;
-            lisp_free(str->data);
+static bool is_doing_gc;
-        }
-        lisp_free(val);
-    } break;
-    case TYPE_SYMBOL: {
-        LispSymbol *sym = (LispSymbol *) val;
-        lisp_unref(sym->name);
-        lisp_unref(sym->plist);
-        lisp_unref(sym->function);
-        lisp_unref(sym->value);
-        lisp_free(val);
-    } break;
-    case TYPE_PAIR:
-        lisp_unref(((LispPair *) val)->head);
-        lisp_unref(((LispPair *) val)->tail);
-        lisp_free(val);
-        break;
-    case TYPE_VECTOR: {
-        LispVector *vec = (LispVector *) val;
-        for (size_t i = 0; i < vec->length; ++i) {
-            lisp_unref(vec->data[i]);
-        }
-        lisp_free(vec->data);
-        lisp_free(val);
-    } break;
-    case TYPE_FUNCTION: {
-        LispFunction *fn = (LispFunction *) val;
-        lisp_unref(fn->doc);
-        lisp_unref(fn->args);
-        lisp_unref(fn->rargs);
-        lisp_unref(fn->oargs);
-        lisp_unref(fn->rest_arg);
-        lisp_unref(fn->kwargs);
-        if (!fn->is_builtin) {
-            lisp_unref(fn->body);
-        }
-        lisp_unref(fn->lexenv);
-        lisp_free(val);
-    } break;
-    case TYPE_HASHTABLE: {
-        LispHashtable *tbl = (LispHashtable *) val;
-        for (size_t i = 0; i < tbl->table_size; ++i) {
-            struct HashtableBucket *cur = tbl->data[i];
-            while (cur) {
-                lisp_unref(cur->key);
-                lisp_unref(cur->value);
-                struct HashtableBucket *next = cur->next;
-                lisp_free(cur);
-                cur = next;
-            }
-        }
-        lisp_free(tbl->data);
-        lisp_unref(tbl->eq_fn);
-        lisp_unref(tbl->hash_fn);
-        lisp_free(val);
-    } break;
-    case TYPE_USER_POINTER: {
-        LispUserPointer *ptr = (LispUserPointer *) val;
-        if (ptr->free_func) {
-            ptr->free_func(ptr->data);
-        }
-        lisp_free(val);
-    } break;
-    default:
-        abort();
-    };
-}
 
 void *lisp_malloc(size_t size) {
     return lisp_realloc(NULL, size);
@@ -149,6 +83,9 @@ void *lisp_realloc(void *old_ptr, size_t size) {
     if (!size) {
         return NULL;
     }
+    if (!is_doing_gc) {
+        bytes_allocated += size;
+    }
     void *new_ptr = realloc(old_ptr, size);
     if (!new_ptr) {
         abort();
@@ -156,11 +93,300 @@ void *lisp_realloc(void *old_ptr, size_t size) {
     return new_ptr;
 }
 
+void *lisp_ref(void *val) {
+    if (!STATICP(val)) {
+        ++((LispVal *) val)->ref_count;
+    }
+    return val;
+}
+
+static void track_as_gc_root(LispVal *obj) {
+    if (!obj->gc_root) {
+        struct GCRoot *nr = lisp_malloc(sizeof(struct GCRoot));
+        nr->object = obj;
+        nr->next = gc_roots;
+        nr->prev = NULL;
+        if (gc_roots) {
+            gc_roots->prev = nr;
+        }
+        gc_roots = nr;
+        obj->gc_root = nr;
+    }
+}
+
+void *lisp_float_ref(void *val) {
+    if (LISPVAL(val)->ref_count > 0) {
+        --LISPVAL(val)->ref_count;
+    }
+    return val;
+}
+
+struct ToCheck {
+    struct ToCheck *next;
+    LispVal *obj;
+};
+
+#define CHECK(no)                                                  \
+    if (!STATICP(no)) {                                            \
+        struct ToCheck *new = lisp_malloc(sizeof(struct ToCheck)); \
+        new->obj = no;                                             \
+        new->next = queue;                                         \
+        queue = new;                                               \
+    }
+
+static struct ToCheck *check_object(LispVal *obj, struct ToCheck *queue) {
+    switch (TYPEOF(obj)) {
+    case TYPE_INTEGER:
+    case TYPE_FLOAT:
+    case TYPE_STRING:
+    case TYPE_USER_POINTER:
+        // can't hold references, do nothing
+        break;
+    case TYPE_SYMBOL: {
+        LispSymbol *sym = (LispSymbol *) obj;
+        CHECK(LISPVAL(sym->name));
+        CHECK(LISPVAL(sym->function));
+        CHECK(LISPVAL(sym->value));
+        CHECK(LISPVAL(sym->plist));
+    } break;
+    case TYPE_PAIR:
+        CHECK(((LispPair *) obj)->head);
+        CHECK(((LispPair *) obj)->tail);
+        break;
+    case TYPE_VECTOR: {
+        LispVector *vec = (LispVector *) obj;
+        for (size_t i = 0; i > vec->length; ++i) {
+            CHECK(vec->data[i]);
+        }
+    } break;
+    case TYPE_FUNCTION: {
+        LispFunction *func = (LispFunction *) obj;
+        CHECK(func->body);
+        CHECK(func->args);
+        CHECK(func->doc);
+        CHECK(func->kwargs);
+        CHECK(func->oargs);
+        CHECK(func->rargs);
+        CHECK(func->lexenv);
+        CHECK(func->rest_arg);
+    } break;
+    case TYPE_HASHTABLE: {
+        HASHTABLE_FOREACH(key, val, obj, {
+            CHECK(key);
+            CHECK(val);
+        });
+    } break;
+    default:
+        abort();
+    }
+    return queue;
+}
+
+static void lisp_free_object(LispVal *val, bool is_static) {
+    struct GCRoot *root = val->gc_root;
+    if (!STATICP(val) && (root = val->gc_root)) {
+        if (root->next) {
+            root->next->prev = root->prev;
+        }
+        if (root->prev) {
+            root->prev->next = root->next;
+        } else {
+            gc_roots = gc_roots->next;
+            if (gc_roots) {
+                gc_roots->prev = NULL;
+            }
+        }
+        lisp_free(root);
+    }
+    switch (TYPEOF(val)) {
+    case TYPE_INTEGER:
+    case TYPE_FLOAT:
+    case TYPE_SYMBOL:
+    case TYPE_PAIR:
+    case TYPE_FUNCTION:
+        break;
+    case TYPE_STRING: {
+        LispString *str = (LispString *) val;
+        if (!str->is_static) {
+            lisp_free(str->data);
+        }
+    } break;
+    case TYPE_VECTOR: {
+        LispVector *vec = (LispVector *) val;
+        lisp_free(vec->data);
+    } break;
+    case TYPE_HASHTABLE: {
+        LispHashtable *tbl = (LispHashtable *) val;
+        for (size_t i = 0; i < tbl->table_size; ++i) {
+            struct HashtableBucket *cur = tbl->data[i];
+            while (cur) {
+                struct HashtableBucket *next = cur->next;
+                lisp_free(cur);
+                cur = next;
+            }
+        }
+        lisp_free(tbl->data);
+    } break;
+    case TYPE_USER_POINTER: {
+        LispUserPointer *ptr = (LispUserPointer *) val;
+        if (ptr->free_func) {
+            ptr->free_func(ptr->data);
+        }
+    } break;
+    default:
+        abort();
+    };
+    if (!is_static) {
+        lisp_free(val);
+    }
+}
+
+static bool check_gc_root(struct GCRoot *root) {
+    LispVal *found = make_lisp_hashtable(Qnil, Qnil);
+    struct ToCheck *queue = NULL;
+    CHECK(root->object);
+    size_t num_at_zero = 0;
+    bool first_pass = true;
+    while (queue) {
+        LispVal *obj = queue->obj;
+        struct ToCheck *next = queue->next;
+        lisp_free(queue);
+        queue = next;
+        LispVal *index = Fgethash(found, obj, Qnil);
+        if (!NILP(index)) {
+            if (((LispInteger *) index)->value > 0
+                && !--((LispInteger *) index)->value) {
+                ++num_at_zero;
+            }
+            // we already searched this object, don't dereference everything
+            // again!
+            continue;
+        } else {
+            Fputhash(found, obj,
+                     make_lisp_integer(obj->ref_count
+                                       && obj->ref_count - !first_pass));
+        }
+        first_pass = false;
+        queue = check_object(obj, queue);
+    }
+    if (num_at_zero == ((LispHashtable *) found)->count) {
+        LispHashtable *tbl = (LispHashtable *) found;
+        for (size_t i = 0; i < tbl->count; ++i) {
+            for (struct HashtableBucket *bucket = tbl->data[i]; bucket;
+                 bucket = bucket->next) {
+                lisp_free_object(bucket->key, false);
+                bucket->key = Qnil;
+            }
+        }
+    }
+    lisp_unref(found);
+    return false;
+}
+
+void garbage_collect() {
+    if (is_doing_gc) {
+        return;
+    }
+    is_doing_gc = true;
+    struct GCRoot *root = gc_roots;
+    while (root) {
+        if (check_gc_root(root)) {
+            root = gc_roots;
+        } else {
+            root = root->next;
+        }
+    }
+    is_doing_gc = false;
+}
+
+struct ToFree {
+    struct ToFree *next;
+    LispVal *obj;
+};
+
+#define FREE(l, no)                                              \
+    {                                                            \
+        struct ToFree *new = lisp_malloc(sizeof(struct ToFree)); \
+        new->obj = no;                                           \
+        new->next = l;                                           \
+        l = new;                                                 \
+    }
+
+static struct ToFree *lisp_unref_recursive(LispVal *val) {
+    struct ToFree *to_free = NULL;
+    struct ToCheck *queue = NULL;
+    CHECK(val);
+    val->ref_count = 0; // prevent double free
+    FREE(to_free, val);
+    while (queue) {
+        LispVal *obj = queue->obj;
+        struct ToCheck *next = queue->next;
+        lisp_free(queue);
+        queue = next;
+        if (STATICP(obj) || obj->finalizing) {
+            continue;
+        } else if (obj->ref_count >= 2) {
+            --obj->ref_count;
+        } else {
+            if (obj->ref_count) {
+                --obj->ref_count;
+                // don't check multiple times
+                FREE(to_free, obj);
+            }
+            obj->finalizing = true;
+            queue = check_object(obj, queue);
+        }
+    }
+    return to_free;
+}
+
+#undef CHECK
+#undef FREE
+
+static void *lisp_unref_extended(void *val, bool even_if_static) {
+    if (!even_if_static && STATICP(val)) {
+        return val;
+    } else if (LISPVAL(val)->ref_count > 1) {
+        --LISPVAL(val)->ref_count;
+        if (!is_doing_gc) {
+            track_as_gc_root(val);
+        }
+        if (bytes_allocated - last_gc > GC_EVERY_N_BYTES) {
+            garbage_collect();
+            last_gc = bytes_allocated;
+        }
+        return val;
+    } else {
+        struct ToFree *to_free = lisp_unref_recursive(val);
+        while (to_free) {
+            LispVal *obj = to_free->obj;
+            struct ToFree *next = to_free->next;
+            lisp_free(to_free);
+            to_free = next;
+            lisp_free_object(obj, false);
+        }
+        return Qnil;
+    }
+}
+
+void *lisp_unref(void *val) {
+    return lisp_unref_extended(val, false);
+}
+
+void lisp_unref_double_ptr(void **val) {
+    lisp_unref(*val);
+}
+
+#define CONSTRUCT_OBJECT(var, Type, TYPE)  \
+    Type *var = lisp_malloc(sizeof(Type)); \
+    var->type = TYPE;                      \
+    var->ref_count = 0;                    \
+    var->gc_root = NULL;                   \
+    var->finalizing = false;
+
 LispVal *make_lisp_string(const char *data, size_t length, bool take,
                           bool is_static) {
-    LispString *self = lisp_malloc(sizeof(LispString));
+    CONSTRUCT_OBJECT(self, LispString, TYPE_STRING);
-    self->type = TYPE_STRING;
-    self->ref_count = 0;
     if (take) {
         self->data = (char *) data;
     } else {
@@ -188,9 +414,7 @@ LispVal *sprintf_lisp(const char *format, ...) {
 }
 
 LispVal *make_lisp_symbol(LispVal *name) {
-    LispSymbol *self = lisp_malloc(sizeof(LispSymbol));
+    CONSTRUCT_OBJECT(self, LispSymbol, TYPE_SYMBOL);
-    self->type = TYPE_SYMBOL;
-    self->ref_count = 0;
     self->name = (LispString *) lisp_ref(name);
     self->plist = Qnil;
     self->function = Qunbound;
@@ -200,16 +424,14 @@ LispVal *make_lisp_symbol(LispVal *name) {
 }
 
 LispVal *make_lisp_pair(LispVal *head, LispVal *tail) {
-    LispPair *self = lisp_malloc(sizeof(LispPair));
+    CONSTRUCT_OBJECT(self, LispPair, TYPE_PAIR);
-    self->type = TYPE_PAIR;
-    self->ref_count = 0;
     self->head = lisp_ref(head);
     self->tail = lisp_ref(tail);
     return LISPVAL(self);
 }
 
 LispVal *make_lisp_integer(intmax_t value) {
-    LispInteger *self = lisp_malloc(sizeof(LispInteger));
+    CONSTRUCT_OBJECT(self, LispInteger, TYPE_INTEGER);
     self->type = TYPE_INTEGER;
     self->ref_count = 0;
     self->value = value;
@@ -217,17 +439,13 @@ LispVal *make_lisp_integer(intmax_t value) {
 }
 
 LispVal *make_lisp_float(long double value) {
-    LispFloat *self = lisp_malloc(sizeof(LispFloat));
+    CONSTRUCT_OBJECT(self, LispFloat, TYPE_FLOAT);
-    self->type = TYPE_FLOAT;
-    self->ref_count = 0;
     self->value = value;
     return LISPVAL(self);
 }
 
 LispVal *make_lisp_vector(LispVal **data, size_t length) {
-    LispVector *self = lisp_malloc(sizeof(LispVector));
+    CONSTRUCT_OBJECT(self, LispVector, TYPE_VECTOR);
-    self->type = TYPE_VECTOR;
-    self->ref_count = 0;
     self->data = data;
     self->length = length;
     return LISPVAL(self);
@@ -435,9 +653,7 @@ malformed:
 
 LispVal *make_lisp_function(LispVal *args, LispVal *doc, LispVal *lexenv,
                             LispVal *body, bool is_macro) {
-    LispFunction *self = lisp_malloc(sizeof(LispFunction));
+    CONSTRUCT_OBJECT(self, LispFunction, TYPE_FUNCTION);
-    self->type = TYPE_FUNCTION;
-    self->ref_count = 0;
     self->is_builtin = false;
     self->is_macro = is_macro;
     self->args = Qnil;
@@ -457,9 +673,7 @@ LispVal *make_lisp_function(LispVal *args, LispVal *doc, LispVal *lexenv,
 }
 
 LispVal *make_lisp_hashtable(LispVal *eq_fn, LispVal *hash_fn) {
-    LispHashtable *self = lisp_malloc(sizeof(LispHashtable));
+    CONSTRUCT_OBJECT(self, LispHashtable, TYPE_HASHTABLE);
-    self->type = TYPE_HASHTABLE;
-    self->ref_count = 0;
     self->table_size = LISP_HASHTABLE_INITIAL_SIZE;
     self->data =
         lisp_malloc(sizeof(struct HashtableBucket *) * self->table_size);
@@ -471,9 +685,7 @@ LispVal *make_lisp_hashtable(LispVal *eq_fn, LispVal *hash_fn) {
 }
 
 LispVal *make_user_pointer(void *data, void (*free_func)(void *)) {
-    LispUserPointer *self = lisp_malloc(sizeof(LispUserPointer));
+    CONSTRUCT_OBJECT(self, LispUserPointer, TYPE_USER_POINTER);
-    self->type = TYPE_USER_POINTER;
-    self->ref_count = 0;
     self->data = data;
     self->free_func = free_func;
     return LISPVAL(self);
@@ -906,6 +1118,15 @@ DEF_STATIC_SYMBOL(circular_error, "circular-error");
 DEF_STATIC_SYMBOL(malformed_lambda_list_error, "malformed-lambda-list-error");
 DEF_STATIC_SYMBOL(argument_error, "argument-error");
 
+struct StaticReference *static_references = NULL;
+
+void add_static_reference(LispVal *obj) {
+    struct StaticReference *sr = lisp_malloc(sizeof(struct StaticReference));
+    sr->next = static_references;
+    sr->obj = obj;
+    static_references = sr;
+}
+
 LispVal *Vobarray = Qnil;
 
 void lisp_init() {
@@ -941,7 +1162,7 @@ void lisp_init() {
         if, "(cond then &rest else)",
         "Evaluate THEN if COND is non-nil, otherwise evaluate ELSE.");
     REGISTER_FUNCTION(
-        setq, "(&rest args)",
+        setq, "(var val)",
         "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)", "");
@@ -951,10 +1172,21 @@ void lisp_init() {
     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");
 }
 
 void lisp_shutdown() {
+    while (static_references) {
+        struct StaticReference *next = static_references->next;
+        lisp_unref_extended(static_references->obj, false);
+        lisp_free(static_references);
+        static_references = next;
+    }
+
     UNREF_INPLACE(Vobarray);
+
+    garbage_collect();
 }
 
 void register_static_function(LispVal *func) {}
@@ -1523,7 +1755,7 @@ static void debug_dump_real(FILE *stream, void *obj, bool first) {
         fputc(']', stream);
     } break;
     case TYPE_FUNCTION:
-        if (((LispFunction *) obj)->builtin) {
+        if (((LispFunction *) obj)->is_builtin) {
             fprintf(stream, "<builtin at %#jx>", (uintmax_t) obj);
         } else {
             fprintf(stream, "<function at %#jx>", (uintmax_t) obj);

src/lisp.h

@@ -41,7 +41,9 @@ extern struct _TypeNameEntry LISP_TYPE_NAMES[N_LISP_TYPES];
 
 #define LISP_OBJECT_HEADER \
     LispType type;         \
-    ptrdiff_t ref_count;
+    void *gc_root;         \
+    ptrdiff_t ref_count;   \
+    bool finalizing;
 
 typedef struct {
     LISP_OBJECT_HEADER;
@@ -270,7 +272,7 @@ inline static bool NUMBERP(LispVal *v) {
     {                                                                       \
         LispHashtable *__hashtable_foreach_table = (LispHashtable *) table; \
         for (size_t __hashtable_foreach_i = 0;                              \
-             __hashtable_foreach_i < __hashtable_foreach_table->count;      \
+             __hashtable_foreach_i < __hashtable_foreach_table->table_size; \
              ++__hashtable_foreach_i) {                                     \
             struct HashtableBucket *__hashtable_foreach_cur =               \
                 __hashtable_foreach_table->data[__hashtable_foreach_i];     \
@@ -292,43 +294,21 @@ inline static bool NUMBERP(LispVal *v) {
 // #############################
 // # Allocation and references #
 // #############################
+
+#define GC_EVERY_N_BYTES 1024 * 80
 void *lisp_malloc(size_t size);
 void *lisp_realloc(void *old_ptr, size_t size);
 #define lisp_free free
 
-inline static void *lisp_ref(void *val) {
+void *lisp_ref(void *val);
-    if (!STATICP(val)) {
+void *lisp_float_ref(void *val);
-        ++((LispVal *) val)->ref_count;
+void garbage_collect();
-    }
+void *lisp_unref(void *val);
-    return val;
-}
-
-inline static void *lisp_float_ref(void *val) {
-    if (LISPVAL(val)->ref_count > 0) {
-        --LISPVAL(val)->ref_count;
-    }
-    return val;
-}
-
-void _internal_lisp_delete_object(LispVal *val);
-inline static void *lisp_unref(void *val) {
-    if (STATICP(val)) {
-        return val;
-    } else if (LISPVAL(val)->ref_count > 1) {
-        --LISPVAL(val)->ref_count;
-        return val;
-    } else {
-        _internal_lisp_delete_object(val);
-        return Qnil;
-    }
-}
 #define UNREF_INPLACE(variable)          \
     {                                    \
         variable = lisp_unref(variable); \
     }
-inline static void lisp_unref_double_ptr(void **val) {
+void lisp_unref_double_ptr(void **val);
-    lisp_unref(*val);
-}
 #define IGNORE_REF(val) (lisp_unref(lisp_ref(val)))
 
 // ################
@@ -481,10 +461,22 @@ extern LispVal *Qargument_error;
         Fthrow(Qtype_error, Qnil); \
     }
 
+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) \
+#define REGISTER_SYMBOL(sym)                                                \
-    Fputhash(Vobarray, LISPVAL(((LispSymbol *) Q##sym)->name), Q##sym)
+    {                                                                       \
+        Fputhash(Vobarray, LISPVAL(((LispSymbol *) Q##sym)->name), Q##sym); \
+        add_static_reference(Q##sym);                                       \
+    }
 #define REGISTER_STATIC_FUNCTION(obj, args, docstr)            \
     ((LispFunction *) (obj))->doc = STATIC_STRING(docstr);     \
     {                                                          \
@@ -492,6 +484,7 @@ extern LispVal *Vobarray;
         lisp_ref(src);                                         \
         set_function_args((LispFunction *) (obj), Fread(src)); \
         lisp_unref(src);                                       \
+        add_static_reference(obj);                             \
     }
 #define REGISTER_FUNCTION(fn, args, docstr) \
     REGISTER_SYMBOL(fn);                    \

src/main.c

@@ -88,30 +88,76 @@ int main(int argc, const char **argv) {
     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, {
+    // 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");
-        Fputhash(
+    //     Fputhash(
-            the_stack->handlers, Qt,
+    //         the_stack->handlers, Qt,
-            // simply call the above function
+    //         // simply call the above function
-            const_list(3, err_var, Ftoplevel_error_handler_function, err_var));
+    //         const_list(3, err_var, Ftoplevel_error_handler_function,
-        Fputhash(
+    //         err_var));
-            the_stack->handlers, Qshutdown_signal,
+    //     Fputhash(
-            // simply call the above function
+    //         the_stack->handlers, Qshutdown_signal,
-            const_list(3, err_var, Ftoplevel_exit_handler_function, err_var));
+    //         // simply call the above function
-        Fputhash(the_stack->handlers, Qeof_error,
+    //         const_list(3, err_var, Ftoplevel_exit_handler_function,
-                 // ignore
+    //         err_var));
-                 Fpair(Qnil, Qnil));
+    //     Fputhash(the_stack->handlers, Qeof_error,
-        while (pos < file_len) {
+    //              // ignore
-            LispVal *tv;
+    //              Fpair(Qnil, Qnil));
-            WITH_PUSH_FRAME(Qtoplevel_read, Qnil, false, {
+    //     while (pos < file_len) {
-                pos += read_from_buffer(buffer + pos, file_len - pos, &tv);
+    //         LispVal *tv;
-            });
+    //         WITH_PUSH_FRAME(Qtoplevel_read, Qnil, false, {
-            WITH_CLEANUP(tv, {
+    //             pos += read_from_buffer(buffer + pos, file_len - pos, &tv);
-                IGNORE_REF(Feval(tv)); //
+    //         });
-            })
+    //         WITH_CLEANUP(tv, {
-        }
+    //             IGNORE_REF(Feval(tv)); //
-    });
+    //         });
-    lisp_shutdown();
+    //     }
-    return exit_status;
+    // });
+    stack_enter(Qtoplevel, (((LispVal *) (&_Qnil))), 0);
+    if (_setjmp(the_stack->start) == 0) {
+        {
+            the_stack->hidden = 1;
+            LispVal *err_var =
+                (_internal_INTERN_STATIC(("err-var"), sizeof("err-var") - 1));
+            Fputhash(
+                the_stack->handlers, (((LispVal *) (&_Qt))),
+                const_list(3, err_var,
+                           ((LispVal *) (&_Ftoplevel_error_handler_function)),
+                           err_var));
+            Fputhash(
+                the_stack->handlers, Qshutdown_signal,
+                const_list(3, err_var,
+                           ((LispVal *) (&_Ftoplevel_exit_handler_function)),
+                           err_var));
+            Fputhash(the_stack->handlers, Qeof_error,
+                     Fpair((((LispVal *) (&_Qnil))), (((LispVal *) (&_Qnil)))));
+            while (pos < file_len) {
+                LispVal *tv;
+                stack_enter(Qtoplevel_read, (((LispVal *) (&_Qnil))), 0);
+                if (_setjmp(the_stack->start) == 0) {
+                    {
+                        pos +=
+                            read_from_buffer(buffer + pos, file_len - pos, &tv);
+                    }
+                }
+                stack_leave();
+                ;
+                lisp_ref(tv);
+                {
+                    void *__with_cleanup_cleanup = register_cleanup(
+                        (lisp_cleanup_func_t) &lisp_unref_double_ptr, &(tv));
+                    {{(lisp_unref(lisp_ref(Feval(tv))));
+                }
+            };
+            cancel_cleanup(__with_cleanup_cleanup);
+            lisp_unref(tv);
+        };
+    }
+}
+}
+stack_leave();
+;
+lisp_shutdown();
+return exit_status;
 }

src/read.c

@@ -79,8 +79,8 @@ static LispVal *read_list(struct ReadState *state) {
     int c;
     while ((c = peekc(state)) != ')') {
         if (c == EOS) {
-            EOF_ERROR(state);
             UNREF_INPLACE(list);
+            EOF_ERROR(state);
             return Qnil;
         }
         LispVal *elt = read_internal(state);