Implement reference tracking in vm

mod1.vml

@@ -1,4 +1,6 @@
 (use mod2)
 (use core)
 
-(print (f 1 2 3))
+(define a (cons 1 (cons 2 (cons 3 (cons 4 nil)))))
+
+(print (list-ref a 1))

mod2.vml

@@ -1,6 +1,12 @@
-(export sqr f)
+(export
+  list-ref)
 
-(define (sqr x) (* x x))
+(define (list-ref xs i)
-
+  (if (null? xs)
-(define (f x y z)
+    nil
-  (+ (sqr x) (sqr y) (sqr z)))
+    (if (= i 0)
+      (car xs)
+      (list-ref (cdr xs) (- i 1))
+    )
+  )
+)

vm/include/vmval.h

@@ -55,6 +55,21 @@ static inline int pair_q(uint64_t w) {
     return ref_q(w) && (!null_q(w) && getref(w)->type == VT_CONS);
 }
 
+void vm_value_ref(struct vm_value *v);
+int vm_value_unref(struct vm_value *v);
+
+static inline void vm_ref(uint64_t w) {
+    if (ref_q(w)) {
+        vm_value_ref(getref(w));
+    }
+}
+static inline int vm_unref(uint64_t w) {
+    if (ref_q(w)) {
+        return vm_value_unref(getref(w));
+    }
+    return 0;
+}
+
 void vm_value_free(struct vm_value *val);
 
 struct vm_value *vm_cons(uint64_t w0, uint64_t w1);

vm/load.c

@@ -21,6 +21,7 @@ static int c_print(struct vm_state *vm) {
     }
     vm_print(w);
     printf("\n");
+    vm_unref(w);
     return 0;
 }
 

vm/unit.c

@@ -13,7 +13,6 @@ struct vm_func_entry *unit_add_function(struct vm_unit *u) {
 
 void unit_free(struct vm_unit *u) {
     struct vm_func_entry *func;
-    uint64_t w;
 
     vector_free(&u->ref_table);
     for (size_t i = 0; i < u->functions.size; ++i) {
@@ -23,10 +22,7 @@ void unit_free(struct vm_unit *u) {
     vector_free(&u->functions);
 
     for (size_t i = 0; i < u->global_pool_size; ++i) {
-        w = u->global_pool[i];
+        vm_unref(u->global_pool[i]);
-        if (ref_q(w)) {
-            vm_value_free(getref(w));
-        }
     }
 
     free(u->global_pool);

vm/vmstate.c

@@ -156,6 +156,7 @@ static int vm_eval_debug(struct vm_state *vm, struct vm_func_entry *func, uint32
         printf("trace: ");
         vm_print(w0);
         printf("\n");
+        vm_unref(w0);
         return 0;
     default:
         return -ERR_OPCODE_UNDEFINED;
@@ -168,6 +169,7 @@ int vm_eval_step(struct vm_state *vm) {
     ssize_t ii0;
     size_t i0;
     struct vm_ref_entry *r0;
+    struct vm_value *v0;
     int res;
 
     assert(vm->lp < vm->units.size);
@@ -176,6 +178,7 @@ int vm_eval_step(struct vm_state *vm) {
     struct vm_func_entry *func = vector_ref(&unit->functions, vm->fp);
     uint32_t opcode = func->bytecode[vm->ip++];
 
+    printf("%02zx:%02zx:%02zx: %08x\n", vm->lp, vm->fp, vm->ip, opcode);
     switch (opcode >> 24) {
     case OP_ADD:
         if ((res = vm_pop_integer(vm, &sw0)) != 0) {
@@ -185,6 +188,14 @@ int vm_eval_step(struct vm_state *vm) {
             return res;
         }
         return vm_push_integer(vm, sw0 + sw1);
+    case OP_SUB:
+        if ((res = vm_pop_integer(vm, &sw0)) != 0) {
+            return res;
+        }
+        if ((res = vm_pop_integer(vm, &sw1)) != 0) {
+            return res;
+        }
+        return vm_push_integer(vm, sw0 - sw1);
     case OP_MUL:
         if ((res = vm_pop_integer(vm, &sw0)) != 0) {
             return res;
@@ -197,7 +208,9 @@ int vm_eval_step(struct vm_state *vm) {
         if ((res = stack_pop(&vm->data_stack, &w0)) != 0) {
             return res;
         }
-        return vm_push_bool(vm, null_q(w0));
+        res = vm_push_bool(vm, null_q(w0));
+        vm_unref(w0);
+        return res;
     case OP_EQ:
         if ((res = stack_pop(&vm->data_stack, &w0)) != 0) {
             return res;
@@ -209,7 +222,10 @@ int vm_eval_step(struct vm_state *vm) {
             // TODO what do?
             return -ERR_OPERAND_TYPE;
         }
-        return vm_push_bool(vm, w0 == w1);
+        res = vm_push_bool(vm, w0 == w1);
+        vm_unref(w0);
+        vm_unref(w1);
+        return res;
 //
     case OP_LDNIL:
         return stack_push(&vm->data_stack, FLAG_REF);
@@ -222,7 +238,10 @@ int vm_eval_step(struct vm_state *vm) {
         if (!pair_q(w0)) {
             return -ERR_OPERAND_TYPE;
         }
-        return stack_push(&vm->data_stack, getref(w0)->v_cons.fat_ar);
+        vm_ref(getref(w0)->v_cons.fat_ar);
+        res = stack_push(&vm->data_stack, getref(w0)->v_cons.fat_ar);
+        vm_unref(w0);
+        return res;
     case OP_CDR:
         if ((res = stack_pop(&vm->data_stack, &w0)) != 0) {
             return res;
@@ -230,7 +249,10 @@ int vm_eval_step(struct vm_state *vm) {
         if (!pair_q(w0)) {
             return -ERR_OPERAND_TYPE;
         }
-        return stack_push(&vm->data_stack, getref(w0)->v_cons.fat_dr);
+        vm_ref(getref(w0)->v_cons.fat_dr);
+        res = stack_push(&vm->data_stack, getref(w0)->v_cons.fat_dr);
+        vm_unref(w0);
+        return res;
     case OP_CONS:
         if ((res = stack_pop(&vm->data_stack, &w0)) != 0) {
             return res;
@@ -238,56 +260,74 @@ int vm_eval_step(struct vm_state *vm) {
         if ((res = stack_pop(&vm->data_stack, &w1)) != 0) {
             return res;
         }
-        return vm_push_ref(vm, vm_cons(w0, w1));
+        v0 = vm_cons(w0, w1);
+        vm_value_ref(v0);
+        res = vm_push_ref(vm, v0);
+        vm_unref(w0);
+        vm_unref(w1);
+        return res;
 //
     case OP_LDARG:
         i0 = opcode & 0xFFFFFF;
         if (i0 >= MAXARG) {
             return -ERR_RANGE;
         }
-        return stack_push(&vm->data_stack, func->arg_regs[i0]);
+        w0 = func->arg_regs[i0];
+        vm_ref(w0);
+        return stack_push(&vm->data_stack, w0);
     case OP_STARG:
         i0 = opcode & 0xFFFFFF;
         if (i0 >= MAXARG) {
             return -ERR_RANGE;
         }
+        vm_unref(func->arg_regs[i0]);
         return stack_pop(&vm->data_stack, &func->arg_regs[i0]);
     case OP_LDG:
         i0 = opcode & 0xFFFFFF;
         if (i0 >= unit->global_pool_size) {
             return -ERR_RANGE;
         }
-        return stack_push(&vm->data_stack, unit->global_pool[i0]);
+        w0 = unit->global_pool[i0];
+        vm_ref(w0);
+        return stack_push(&vm->data_stack, w0);
     case OP_STG:
         i0 = opcode & 0xFFFFFF;
         if (i0 >= unit->global_pool_size) {
             return -ERR_RANGE;
         }
+        vm_unref(unit->global_pool[i0]);
         return stack_pop(&vm->data_stack, &unit->global_pool[i0]);
     case OP_LDF:
         i0 = opcode & 0xFFFFFF;
         if (i0 >= unit->functions.size) {
             return -ERR_RANGE;
         }
-        return vm_push_ref(vm, vm_func(vm->lp, i0));
+        v0 = vm_func(vm->lp, i0);
+        vm_value_ref(v0);
+        return vm_push_ref(vm, v0);
     case OP_STL:
         i0 = opcode & 0xFFFFFF;
         if (i0 >= func->local_count) {
             return -ERR_RANGE;
         }
+        vm_unref(func->local_regs[i0]);
         return stack_pop(&vm->data_stack, &func->local_regs[i0]);
     case OP_LDL:
         i0 = opcode & 0xFFFFFF;
         if (i0 >= func->local_count) {
             return -ERR_RANGE;
         }
-        return stack_push(&vm->data_stack, func->local_regs[i0]);
+        w0 = func->local_regs[i0];
+        vm_ref(w0);
+        return stack_push(&vm->data_stack, w0);
 //
     case OP_ISZ:
         if ((res = stack_pop(&vm->data_stack, &w0)) != 0) {
             return res;
         }
-        return vm_push_bool(vm, null_q(w0));
+        res = vm_push_bool(vm, null_q(w0));
+        vm_unref(w0);
+        return res;
 //
     case OP_XCALL:
         i0 = opcode & 0xFFFFFF;
@@ -327,7 +367,9 @@ int vm_eval_step(struct vm_state *vm) {
         if (!func_q(w0)) {
             return -ERR_OPERAND_TYPE;
         }
-        return vm_call_ref(vm, getref(w0));
+        res = vm_call_ref(vm, getref(w0));
+        vm_unref(w0);
+        return res;
     case OP_BF:
         if ((res = stack_pop(&vm->data_stack, &w0)) != 0) {
             return res;
@@ -339,6 +381,7 @@ int vm_eval_step(struct vm_state *vm) {
             }
             vm->ip += ii0 - 1;
         }
+        vm_unref(w0);
         return 0;
     case OP_JMP:
         ii0 = sximm(opcode & 0xFFFFFF);
@@ -348,11 +391,16 @@ int vm_eval_step(struct vm_state *vm) {
         vm->ip += ii0 - 1;
         return 0;
     case OP_RET:
+        // Drop references to arguments
+        for (size_t i = 0; i < func->argc; ++i) {
+            vm_unref(func->arg_regs[i]);
+        }
         return vm_pop_context(vm);
 //
     case OP_DEBUG:
         return vm_eval_debug(vm, func, opcode & 0xFFFFFF);
     default:
+        fprintf(stderr, "Undefined opcode: %02x\n", opcode >> 24);
         return -ERR_OPCODE_UNDEFINED;
     }
 }

vm/vmval.c

@@ -56,14 +56,58 @@ static struct vm_value *vm_value_create(enum vm_type type) {
     if (!v) {
         return NULL;
     }
+    printf("create %p\n", v);
     v->type = type;
     v->refcount = 0;
     return v;
 }
 
 void vm_value_free(struct vm_value *v) {
+    if (!v) {
+        return;
+    }
+    printf("free %p: ", v);
+    vm_print_ref(v, 0);
+    printf("\n");
     assert(v->refcount == 0);
-    free(v);
+    switch (v->type) {
+    case VT_CONS:
+        vm_unref(v->v_cons.fat_ar);
+        vm_unref(v->v_cons.fat_dr);
+        break;
+    case VT_STRING:
+        // TODO
+    default:
+        break;
+    }
+    //free(v);
+}
+
+void vm_value_ref(struct vm_value *v) {
+    if (!v) {
+        return;
+    }
+    printf("ref %p: ", v);
+    vm_print_ref(v, 0);
+    printf("\n");
+    ++v->refcount;
+}
+
+int vm_value_unref(struct vm_value *v) {
+    if (!v) {
+        return 0;
+    }
+    printf("unref %p: ", v);
+    vm_print_ref(v, 0);
+    printf("\n");
+    assert(v->refcount);
+    --v->refcount;
+    if (v->refcount == 0) {
+        vm_value_free(v);
+        return 1;
+    } else {
+        return 0;
+    }
 }
 
 struct vm_value *vm_cons(uint64_t w0, uint64_t w1) {
@@ -71,6 +115,8 @@ struct vm_value *vm_cons(uint64_t w0, uint64_t w1) {
     if (!v) {
         return NULL;
     }
+    vm_ref(w0);
+    vm_ref(w1);
     v->v_cons.fat_ar = w0;
     v->v_cons.fat_dr = w1;
     return v;