X-Git-Url: https://git.gag.com/?a=blobdiff_plain;f=src%2Flisp%2Fao_lisp_mem.c;h=5471b137ff4327f5940c5101a9d461f3e701211e;hb=ed6967cef5d82baacafe1c23229f44d58c838326;hp=f333073a339f920db13348227cc6673ece557c97;hpb=5f8f0ed5cd5d4b4f793c602ed09f9b4bdb98f7e8;p=fw%2Faltos

diff --git a/src/lisp/ao_lisp_mem.c b/src/lisp/ao_lisp_mem.c
index f333073a..5471b137 100644
--- a/src/lisp/ao_lisp_mem.c
+++ b/src/lisp/ao_lisp_mem.c
@@ -16,6 +16,7 @@
 
 #include "ao_lisp.h"
 #include <stdio.h>
+#include <assert.h>
 
 #ifdef AO_LISP_MAKE_CONST
 
@@ -148,6 +149,7 @@ struct ao_lisp_root {
 
 static struct ao_lisp_cons 	*save_cons[2];
 static char			*save_string[2];
+static struct ao_lisp_frame	*save_frame[1];
 static ao_poly			save_poly[3];
 
 static const struct ao_lisp_root	ao_lisp_root[] = {
@@ -167,6 +169,10 @@ static const struct ao_lisp_root	ao_lisp_root[] = {
 		.type = &ao_lisp_string_type,
 		.addr = (void **) &save_string[1],
 	},
+	{
+		.type = &ao_lisp_frame_type,
+		.addr = (void **) &save_frame[0],
+	},
 	{
 		.type = NULL,
 		.addr = (void **) (void *) &save_poly[0]
@@ -455,10 +461,12 @@ static const struct ao_lisp_type *ao_lisp_types[AO_LISP_NUM_TYPE] = {
 	[AO_LISP_ATOM] = &ao_lisp_atom_type,
 	[AO_LISP_BUILTIN] = &ao_lisp_builtin_type,
 	[AO_LISP_FRAME] = &ao_lisp_frame_type,
+	[AO_LISP_FRAME_VALS] = &ao_lisp_frame_vals_type,
 	[AO_LISP_LAMBDA] = &ao_lisp_lambda_type,
 	[AO_LISP_STACK] = &ao_lisp_stack_type,
 	[AO_LISP_BOOL] = &ao_lisp_bool_type,
 	[AO_LISP_BIGINT] = &ao_lisp_bigint_type,
+	[AO_LISP_FLOAT] = &ao_lisp_float_type,
 };
 
 static int
@@ -494,6 +502,7 @@ ao_lisp_collect(uint8_t style)
 
 	MDBG_MOVE("collect %d\n", ao_lisp_collects[style]);
 #endif
+	MDBG_DO(ao_lisp_frame_write(ao_lisp_frame_poly(ao_lisp_frame_global)));
 
 	/* The first time through, we're doing a full collect */
 	if (ao_lisp_last_top == 0)
@@ -615,10 +624,59 @@ ao_lisp_collect(uint8_t style)
 	return AO_LISP_POOL - ao_lisp_top;
 }
 
+#if DBG_FREE_CONS
+void
+ao_lisp_cons_check(struct ao_lisp_cons *cons)
+{
+	ao_poly	cdr;
+	int offset;
+
+	chunk_low = 0;
+	reset_chunks();
+	walk(ao_lisp_mark_ref, ao_lisp_poly_mark_ref);
+	while (cons) {
+		if (!AO_LISP_IS_POOL(cons))
+			break;
+		offset = pool_offset(cons);
+		if (busy(ao_lisp_busy, offset)) {
+			ao_lisp_printf("cons at %p offset %d poly %d is busy\n\t%v\n", cons, offset, ao_lisp_cons_poly(cons), ao_lisp_cons_poly(cons));
+			abort();
+		}
+		cdr = cons->cdr;
+		if (!ao_lisp_is_pair(cdr))
+			break;
+		cons = ao_lisp_poly_cons(cdr);
+	}
+}
+#endif
+
 /*
  * Mark interfaces for objects
  */
 
+
+/*
+ * Mark a block of memory with an explicit size
+ */
+
+int
+ao_lisp_mark_block(void *addr, int size)
+{
+	int offset;
+	if (!AO_LISP_IS_POOL(addr))
+		return 1;
+
+	offset = pool_offset(addr);
+	MDBG_MOVE("mark memory %d\n", MDBG_OFFSET(addr));
+	if (busy(ao_lisp_busy, offset)) {
+		MDBG_MOVE("already marked\n");
+		return 1;
+	}
+	mark(ao_lisp_busy, offset);
+	note_chunk(offset, size);
+	return 0;
+}
+
 /*
  * Note a reference to memory and collect information about a few
  * object sizes at a time
@@ -845,12 +903,14 @@ ao_lisp_alloc(int size)
 	}
 	addr = ao_lisp_pool + ao_lisp_top;
 	ao_lisp_top += size;
+	MDBG_MOVE("alloc %d size %d\n", MDBG_OFFSET(addr), size);
 	return addr;
 }
 
 void
 ao_lisp_cons_stash(int id, struct ao_lisp_cons *cons)
 {
+	assert(save_cons[id] == 0);
 	save_cons[id] = cons;
 }
 
@@ -865,6 +925,7 @@ ao_lisp_cons_fetch(int id)
 void
 ao_lisp_poly_stash(int id, ao_poly poly)
 {
+	assert(save_poly[id] == AO_LISP_NIL);
 	save_poly[id] = poly;
 }
 
@@ -879,6 +940,7 @@ ao_lisp_poly_fetch(int id)
 void
 ao_lisp_string_stash(int id, char *string)
 {
+	assert(save_string[id] == NULL);
 	save_string[id] = string;
 }
 
@@ -890,3 +952,17 @@ ao_lisp_string_fetch(int id)
 	return string;
 }
 
+void
+ao_lisp_frame_stash(int id, struct ao_lisp_frame *frame)
+{
+	assert(save_frame[id] == NULL);
+	save_frame[id] = frame;
+}
+
+struct ao_lisp_frame *
+ao_lisp_frame_fetch(int id)
+{
+	struct ao_lisp_frame *frame = save_frame[id];
+	save_frame[id] = NULL;
+	return frame;
+}