Call object destructors on deletion

heap.c

@@ -100,23 +100,68 @@ void heap_unref(int slot)
 #endif
 		VM_ERROR("double free of slot %d (%s)", slot, vm_ptrtype_string(heap[slot].type));
 	}
-	if (--heap[slot].ref <= 0) {
-#ifdef DEBUG_HEAP
-		heap[slot].free_addr = instr_ptr;
-#endif
-		switch (heap[slot].type) {
-		case VM_PAGE:
-			if (heap[slot].page) {
-				delete_page(heap[slot].page);
-				free_page(heap[slot].page);
-			}
-			break;
-		case VM_STRING:
-			free_string(heap[slot].s);
-			break;
-		}
-		heap_free_slot(slot);
+	if (heap[slot].ref > 1) {
+		heap[slot].ref--;
+		return;
 	}
+#ifdef DEBUG_HEAP
+	heap[slot].free_addr = instr_ptr;
+#endif
+	switch (heap[slot].type) {
+	case VM_PAGE:
+		if (heap[slot].page) {
+			delete_page(slot);
+		}
+		break;
+	case VM_STRING:
+		free_string(heap[slot].s);
+		break;
+	}
+	heap[slot].ref = 0;
+	heap_free_slot(slot);
+}
+
+// XXX: special version of heap_unref which avoids calling destructors
+void exit_unref(int slot)
+{
+	if (slot < 0 || (size_t)slot >= heap_size) {
+		WARNING("out of bounds heap index: %d", slot);
+		return;
+	}
+	if (heap[slot].ref <= 0) {
+		WARNING("double free of slot %d", slot);
+		return;
+	}
+	if (heap[slot].ref > 1) {
+		heap[slot].ref--;
+		return;
+	}
+	switch (heap[slot].type) {
+	case VM_PAGE:
+		if (heap[slot].page) {
+			struct page *page = heap[slot].page;
+			for (int i = 0; i < page->nr_vars; i++) {
+				switch (variable_type(page, i, NULL, NULL)) {
+				case AIN_STRING:
+				case AIN_STRUCT:
+				case AIN_ARRAY_TYPE:
+				case AIN_REF_TYPE:
+					if (page->values[i].i == -1)
+						break;
+					exit_unref(page->values[i].i);
+					break;
+				default:
+					break;
+				}
+			}
+		}
+		break;
+	case VM_STRING:
+		free_string(heap[slot].s);
+		break;
+	}
+	heap[slot].ref = 0;
+	heap_free_slot(slot);
 }
 
 bool heap_index_valid(int index)

heap.h

@@ -54,6 +54,7 @@ void heap_delete(void);
 int32_t heap_alloc_slot(enum vm_pointer_type type);
 void heap_ref(int slot);
 void heap_unref(int slot);
+void exit_unref(int slot);
 
 bool heap_index_valid(int index);
 bool page_index_valid(int index);

page.c

@@ -176,13 +176,23 @@ enum ain_data_type variable_type(struct page *page, int varno, int *struct_type,
 	return AIN_VOID;
 }
 
-void delete_page(struct page *page)
+void delete_page_vars(struct page *page)
 {
 	for (int i = 0; i < page->nr_vars; i++) {
 		variable_fini(page->values[i], variable_type(page, i, NULL, NULL));
 	}
 }
 
+void delete_page(int slot)
+{
+	struct page *page = heap[slot].page;
+	if (page->type == STRUCT_PAGE) {
+		delete_struct(page->index, slot);
+	}
+	delete_page_vars(page);
+	free_page(page);
+}
+
 /*
  * Recursively copy a page.
  */
@@ -227,6 +237,14 @@ void init_struct(int no, int slot)
 	}
 }
 
+void delete_struct(int no, int slot)
+{
+	struct ain_struct *s = &ain->structures[no];
+	if (s->destructor > 0) {
+		vm_call(s->destructor, slot);
+	}
+}
+
 void create_struct(int no, union vm_value *var)
 {
 	var->i = alloc_struct(no);
@@ -272,7 +290,7 @@ struct page *realloc_array(struct page *src, int rank, union vm_value *dimension
 	if (src->rank != rank)
 		ERROR("Attempt to reallocate array with different rank");
 	if (!dimensions->i) {
-		delete_page(src);
+		delete_page_vars(src);
 		return NULL;
 	}
 
@@ -413,7 +431,7 @@ struct page *array_erase(struct page *page, int i, bool *success)
 
 	// if array will be empty...
 	if (page->nr_vars == 1) {
-		delete_page(page);
+		delete_page_vars(page);
 		*success = true;
 		return NULL;
 	}

page.h

@@ -70,11 +70,13 @@ enum ain_data_type variable_type(struct page *page, int varno, int *struct_type,
 struct page *alloc_page(enum page_type type, int type_index, int nr_vars);
 void free_page(struct page *page);
 struct page *copy_page(struct page *page);
-void delete_page(struct page *page);
+void delete_page_vars(struct page *page);
+void delete_page(int slot);
 
 // structs
 int alloc_struct(int no);
 void init_struct(int no, int slot);
+void delete_struct(int no, int slot);
 void create_struct(int no, union vm_value *var);
 
 // arrays

vm.c

@@ -1390,8 +1390,7 @@ static void execute_instruction(enum opcode opcode)
 		if (lval == -1)
 			VM_ERROR("Assignment to null-pointer");
 		if (heap[lval].page) {
-			delete_page(heap[lval].page);
-			free_page(heap[lval].page);
+			delete_page(lval);
 		}
 		heap_set_page(lval, copy_page(heap[rval].page));
 		stack_push(rval);
@@ -1425,7 +1424,7 @@ static void execute_instruction(enum opcode opcode)
 	case A_FREE: {
 		int array = stack_pop_var()->i;
 		if (heap[array].page) {
-			delete_page(heap[array].page);
+			delete_page_vars(heap[array].page);
 			free_page(heap[array].page);
 			heap_set_page(array, NULL);
 		}
@@ -1751,7 +1750,7 @@ noreturn void vm_exit(int code)
 		heap_unref(call_stack[i].page_slot);
 	}
 	// free globals
-	heap_unref(0);
+	exit_unref(0);
 #ifdef DEBUG_HEAP
 	for (size_t i = 0; i < heap_size; i++) {
 		if (heap[i].ref > 0)