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

diff --git a/src/lisp/ao_lisp_mem.c b/src/lisp/ao_lisp_mem.c
index e8907cf6..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
 
@@ -36,6 +37,10 @@ uint8_t	ao_lisp_pool[AO_LISP_POOL + AO_LISP_POOL_EXTRA] __attribute__((aligned(4
 
 #endif
 
+#ifndef DBG_MEM_STATS
+#define DBG_MEM_STATS	DBG_MEM
+#endif
+
 #if DBG_MEM
 int dbg_move_depth;
 int dbg_mem = DBG_MEM_START;
@@ -144,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[] = {
@@ -163,17 +169,21 @@ 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 **) &save_poly[0]
+		.addr = (void **) (void *) &save_poly[0]
 	},
 	{
 		.type = NULL,
-		.addr = (void **) &save_poly[1]
+		.addr = (void **) (void *) &save_poly[1]
 	},
 	{
 		.type = NULL,
-		.addr = (void **) &save_poly[2]
+		.addr = (void **) (void *) &save_poly[2]
 	},
 	{
 		.type = &ao_lisp_atom_type,
@@ -193,7 +203,7 @@ static const struct ao_lisp_root	ao_lisp_root[] = {
 	},
 	{
 		.type = NULL,
-		.addr = (void **) &ao_lisp_v,
+		.addr = (void **) (void *) &ao_lisp_v,
 	},
 	{
 		.type = &ao_lisp_cons_type,
@@ -207,6 +217,16 @@ static const struct ao_lisp_root	ao_lisp_root[] = {
 		.type = &ao_lisp_cons_type,
 		.addr = (void **) &ao_lisp_read_stack,
 	},
+#ifdef AO_LISP_MAKE_CONST
+	{
+		.type = &ao_lisp_bool_type,
+		.addr = (void **) &ao_lisp_false,
+	},
+	{
+		.type = &ao_lisp_bool_type,
+		.addr = (void **) &ao_lisp_true,
+	},
+#endif
 };
 
 #define AO_LISP_ROOT	(sizeof (ao_lisp_root) / sizeof (ao_lisp_root[0]))
@@ -218,9 +238,11 @@ static const void ** const ao_lisp_cache[] = {
 	(const void **) &ao_lisp_frame_free_list[1],
 	(const void **) &ao_lisp_frame_free_list[2],
 	(const void **) &ao_lisp_frame_free_list[3],
+	(const void **) &ao_lisp_frame_free_list[4],
+	(const void **) &ao_lisp_frame_free_list[5],
 };
 
-#if AO_LISP_FRAME_FREE != 4
+#if AO_LISP_FRAME_FREE != 6
 #error Unexpected AO_LISP_FRAME_FREE value
 #endif
 
@@ -281,8 +303,6 @@ static inline int limit(int offset) {
 	return min(AO_LISP_POOL, max(offset, 0));
 }
 
-static int total_marked;
-
 static void
 note_cons(uint16_t offset)
 {
@@ -293,19 +313,14 @@ note_cons(uint16_t offset)
 
 static uint16_t	chunk_low, chunk_high;
 static uint16_t	chunk_first, chunk_last;
-static int chunk_busy;
 
-static void
-note_chunk(uint16_t offset, uint16_t size)
+static int
+find_chunk(uint16_t offset)
 {
 	int l, r;
-
-	if (offset < chunk_low || chunk_high <= offset)
-		return;
-
 	/* Binary search for the location */
-	l = 0;
-	r = chunk_busy - 1;
+	l = chunk_first;
+	r = chunk_last - 1;
 	while (l <= r) {
 		int m = (l + r) >> 1;
 		if (ao_lisp_chunk[m].old_offset < offset)
@@ -313,6 +328,19 @@ note_chunk(uint16_t offset, uint16_t size)
 		else
 			r = m - 1;
 	}
+	return l;
+}
+
+static void
+note_chunk(uint16_t offset, uint16_t size)
+{
+	int l;
+
+	if (offset < chunk_low || chunk_high <= offset)
+		return;
+
+	l = find_chunk(offset);
+
 	/*
 	 * The correct location is always in 'l', with r = l-1 being
 	 * the entry before the right one
@@ -324,12 +352,12 @@ note_chunk(uint16_t offset, uint16_t size)
 		ao_lisp_abort();
 
 	/* Off the left side */
-	if (l == 0 && chunk_busy && offset > ao_lisp_chunk[0].old_offset)
+	if (l == 0 && chunk_last && offset > ao_lisp_chunk[0].old_offset)
 		ao_lisp_abort();
 #endif
 
 	/* Shuffle existing entries right */
-	int end = min(AO_LISP_NCHUNK, chunk_busy + 1);
+	int end = min(AO_LISP_NCHUNK, chunk_last + 1);
 
 	memmove(&ao_lisp_chunk[l+1],
 		&ao_lisp_chunk[l],
@@ -340,11 +368,11 @@ note_chunk(uint16_t offset, uint16_t size)
 	ao_lisp_chunk[l].size = size;
 
 	/* Increment the number of elements up to the size of the array */
-	if (chunk_busy < AO_LISP_NCHUNK)
-		chunk_busy++;
+	if (chunk_last < AO_LISP_NCHUNK)
+		chunk_last++;
 
 	/* Set the top address if the array is full */
-	if (chunk_busy == AO_LISP_NCHUNK)
+	if (chunk_last == AO_LISP_NCHUNK)
 		chunk_high = ao_lisp_chunk[AO_LISP_NCHUNK-1].old_offset +
 			ao_lisp_chunk[AO_LISP_NCHUNK-1].size;
 }
@@ -352,9 +380,9 @@ note_chunk(uint16_t offset, uint16_t size)
 static void
 reset_chunks(void)
 {
-	memset(ao_lisp_chunk, '\0', sizeof (ao_lisp_chunk));
 	chunk_high = ao_lisp_top;
-	chunk_busy = 0;
+	chunk_last = 0;
+	chunk_first = 0;
 }
 
 /*
@@ -367,7 +395,6 @@ walk(int (*visit_addr)(const struct ao_lisp_type *type, void **addr),
 {
 	int i;
 
-	total_marked = 0;
 	ao_lisp_record_reset();
 	memset(ao_lisp_busy, '\0', sizeof (ao_lisp_busy));
 	memset(ao_lisp_cons_note, '\0', sizeof (ao_lisp_cons_note));
@@ -426,7 +453,7 @@ dump_busy(void)
 #define DUMP_BUSY()
 #endif
 
-static const struct ao_lisp_type const *ao_lisp_types[AO_LISP_NUM_TYPE] = {
+static const struct ao_lisp_type *ao_lisp_types[AO_LISP_NUM_TYPE] = {
 	[AO_LISP_CONS] = &ao_lisp_cons_type,
 	[AO_LISP_INT] = NULL,
 	[AO_LISP_STRING] = &ao_lisp_string_type,
@@ -434,8 +461,12 @@ static const struct ao_lisp_type const *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
@@ -450,27 +481,28 @@ ao_lisp_poly_mark_ref(ao_poly *p, uint8_t do_note_cons)
 	return ao_lisp_poly_mark(*p, do_note_cons);
 }
 
+#if DBG_MEM_STATS
 int ao_lisp_collects[2];
 int ao_lisp_freed[2];
 int ao_lisp_loops[2];
+#endif
 
 int ao_lisp_last_top;
 
 int
 ao_lisp_collect(uint8_t style)
 {
-	int	ret;
 	int	i;
 	int	top;
+#if DBG_MEM_STATS
 	int	loops = 0;
+#endif
 #if DBG_MEM
-	int	marked;
-	int	moved;
 	struct ao_lisp_record	*mark_record = NULL, *move_record = NULL;
 
-	MDBG_MOVE("collect %d\n", ao_lisp_collects);
-	marked = moved = 0;
+	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)
@@ -485,27 +517,25 @@ ao_lisp_collect(uint8_t style)
 		chunk_low = top = ao_lisp_last_top;
 	}
 	for (;;) {
+#if DBG_MEM_STATS
 		loops++;
+#endif
 		MDBG_MOVE("move chunks from %d to %d\n", chunk_low, top);
 		/* Find the sizes of the first chunk of objects to move */
 		reset_chunks();
 		walk(ao_lisp_mark_ref, ao_lisp_poly_mark_ref);
 #if DBG_MEM
-		marked = total_marked;
 
 		ao_lisp_record_free(mark_record);
 		mark_record = ao_lisp_record_save();
 		if (mark_record && move_record)
 			ao_lisp_record_compare("mark", move_record, mark_record);
-
-		if (moved && moved != marked)
-			ao_lisp_abort();
 #endif
 
 		DUMP_BUSY();
 
 		/* Find the first moving object */
-		for (i = 0; i < chunk_busy; i++) {
+		for (i = 0; i < chunk_last; i++) {
 			uint16_t	size = ao_lisp_chunk[i].size;
 
 #if DBG_MEM
@@ -534,7 +564,7 @@ ao_lisp_collect(uint8_t style)
 		chunk_low = ao_lisp_chunk[i].old_offset;
 
 		/* Copy all of the objects */
-		for (; i < chunk_busy; i++) {
+		for (; i < chunk_last; i++) {
 			uint16_t	size = ao_lisp_chunk[i].size;
 
 #if DBG_MEM
@@ -555,8 +585,6 @@ ao_lisp_collect(uint8_t style)
 			top += size;
 		}
 
-		chunk_last = i;
-
 		if (chunk_first < chunk_last) {
 			/* Relocate all references to the objects */
 			walk(ao_lisp_move, ao_lisp_poly_move);
@@ -566,10 +594,6 @@ ao_lisp_collect(uint8_t style)
 			move_record = ao_lisp_record_save();
 			if (mark_record && move_record)
 				ao_lisp_record_compare("move", mark_record, move_record);
-
-			moved = total_marked;
-			if (moved != marked)
-				ao_lisp_abort();
 #endif
 		}
 
@@ -583,13 +607,12 @@ ao_lisp_collect(uint8_t style)
 		chunk_low = chunk_high;
 	}
 
-	/* Compute amount of memory freed */
-	ret = ao_lisp_top - top;
-
+#if DBG_MEM_STATS
 	/* Collect stats */
 	++ao_lisp_collects[style];
-	ao_lisp_freed[style] += ret;
+	ao_lisp_freed[style] += ao_lisp_top - top;
 	ao_lisp_loops[style] += loops;
+#endif
 
 	ao_lisp_top = top;
 	if (style == AO_LISP_COLLECT_FULL)
@@ -598,13 +621,62 @@ ao_lisp_collect(uint8_t style)
 	MDBG_DO(memset(ao_lisp_chunk, '\0', sizeof (ao_lisp_chunk));
 		walk(ao_lisp_mark_ref, ao_lisp_poly_mark_ref));
 
-	return ret;
+	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
@@ -695,21 +767,13 @@ ao_lisp_poly_mark(ao_poly p, uint8_t do_note_cons)
 static uint16_t
 move_map(uint16_t offset)
 {
-	int		l, r;
+	int		l;
 
 	if (offset < chunk_low || chunk_high <= offset)
 		return offset;
 
-	/* Binary search for the location */
-	l = chunk_first;
-	r = chunk_busy - 1;
-	while (l <= r) {
-		int m = (l + r) >> 1;
-		if (ao_lisp_chunk[m].old_offset < offset)
-			l = m + 1;
-		else
-			r = m - 1;
-	}
+	l = find_chunk(offset);
+
 #if DBG_MEM
 	if (ao_lisp_chunk[l].old_offset != offset)
 		ao_lisp_abort();
@@ -830,22 +894,23 @@ ao_lisp_alloc(int size)
 	MDBG_DO(++dbg_allocs);
 	MDBG_DO(if (dbg_validate) ao_lisp_validate());
 	size = ao_lisp_size_round(size);
-	if (ao_lisp_top + size > AO_LISP_POOL) {
-		if (ao_lisp_collect(AO_LISP_COLLECT_INCREMENTAL) < size &&
-		    ao_lisp_collect(AO_LISP_COLLECT_FULL) < size)
-		{
-			ao_lisp_error(AO_LISP_OOM, "out of memory");
-			return NULL;
-		}
+	if (AO_LISP_POOL - ao_lisp_top < size &&
+	    ao_lisp_collect(AO_LISP_COLLECT_INCREMENTAL) < size &&
+	    ao_lisp_collect(AO_LISP_COLLECT_FULL) < size)
+	{
+		ao_lisp_error(AO_LISP_OOM, "out of memory");
+		return NULL;
 	}
 	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;
 }
 
@@ -860,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;
 }
 
@@ -874,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;
 }
 
@@ -885,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;
+}