X-Git-Url: https://git.gag.com/?a=blobdiff_plain;f=src%2Fscheme%2Fao_scheme_mem.c;h=a336fdfe964fccecf901405c0f0b05152a13538f;hb=431165e5fa72ba6dffd477de32960745cdec332c;hp=afa06d546d8b78a2c601a161a408a55f252cce6f;hpb=839a7454686415a52f532d0e4f379061a68d5f1b;p=fw%2Faltos

diff --git a/src/scheme/ao_scheme_mem.c b/src/scheme/ao_scheme_mem.c
index afa06d54..a336fdfe 100644
--- a/src/scheme/ao_scheme_mem.c
+++ b/src/scheme/ao_scheme_mem.c
@@ -71,11 +71,17 @@ _ao_scheme_reset_stack(char *x)
 #define ao_scheme_reset_stack()
 #endif
 
+#if DBG_MEM
+#define DBG_MEM_RECORD	1
+#endif
+
 #if DBG_MEM
 int dbg_move_depth;
 int dbg_mem = DBG_MEM_START;
 int dbg_validate = 0;
+#endif
 
+#if DBG_MEM_RECORD
 struct ao_scheme_record {
 	struct ao_scheme_record		*next;
 	const struct ao_scheme_type	*type;
@@ -129,9 +135,9 @@ ao_scheme_record_save(void)
 }
 
 static void
-ao_scheme_record_compare(char *where,
-		       struct ao_scheme_record *a,
-		       struct ao_scheme_record *b)
+ao_scheme_record_compare(const char *where,
+			 struct ao_scheme_record *a,
+			 struct ao_scheme_record *b)
 {
 	while (a && b) {
 		if (a->type != b->type || a->size != b->size) {
@@ -168,6 +174,7 @@ ao_scheme_record_compare(char *where,
 
 #else
 #define ao_scheme_record_reset()
+#define ao_scheme_record(t,a,s)
 #endif
 
 uint8_t	ao_scheme_exception;
@@ -178,7 +185,7 @@ struct ao_scheme_root {
 };
 
 static struct ao_scheme_cons 	*save_cons[2];
-static char			*save_string[2];
+static struct ao_scheme_string	*save_string[2];
 static struct ao_scheme_frame	*save_frame[1];
 static ao_poly			save_poly[3];
 
@@ -280,6 +287,10 @@ static const void ** const ao_scheme_cache[] = {
 
 #define AO_SCHEME_BUSY_SIZE	((AO_SCHEME_POOL + 31) / 32)
 
+static int	ao_scheme_printing, ao_scheme_print_cleared;
+#if DBG_MEM
+static int	ao_scheme_collecting;
+#endif
 static uint8_t	ao_scheme_busy[AO_SCHEME_BUSY_SIZE];
 static uint8_t	ao_scheme_cons_note[AO_SCHEME_BUSY_SIZE];
 static uint8_t	ao_scheme_cons_last[AO_SCHEME_BUSY_SIZE];
@@ -386,6 +397,9 @@ note_chunk(uint16_t offset, uint16_t size)
 	/* Off the left side */
 	if (l == 0 && chunk_last && offset > ao_scheme_chunk[0].old_offset)
 		ao_scheme_abort();
+
+	if (l < chunk_last && ao_scheme_chunk[l].old_offset == offset)
+		ao_scheme_abort();
 #endif
 
 	/* Shuffle existing entries right */
@@ -465,20 +479,19 @@ static void
 dump_busy(void)
 {
 	int	i;
-	MDBG_MOVE("busy:");
+	printf("busy:");
 	for (i = 0; i < ao_scheme_top; i += 4) {
 		if ((i & 0xff) == 0) {
-			MDBG_MORE("\n");
-			MDBG_MOVE("%s", "");
+			printf("\n\t");
 		}
 		else if ((i & 0x1f) == 0)
-			MDBG_MORE(" ");
+			printf(" ");
 		if (busy(ao_scheme_busy, i))
-			MDBG_MORE("*");
+			printf("*");
 		else
-			MDBG_MORE("-");
+			printf("-");
 	}
-	MDBG_MORE ("\n");
+	printf ("\n");
 }
 #define DUMP_BUSY()	dump_busy()
 #else
@@ -488,7 +501,9 @@ dump_busy(void)
 static const struct ao_scheme_type * const ao_scheme_types[AO_SCHEME_NUM_TYPE] = {
 	[AO_SCHEME_CONS] = &ao_scheme_cons_type,
 	[AO_SCHEME_INT] = NULL,
-	[AO_SCHEME_STRING] = &ao_scheme_string_type,
+#ifdef AO_SCHEME_FEATURE_BIGINT
+	[AO_SCHEME_BIGINT] = &ao_scheme_bigint_type,
+#endif
 	[AO_SCHEME_OTHER] = (void *) 0x1,
 	[AO_SCHEME_ATOM] = &ao_scheme_atom_type,
 	[AO_SCHEME_BUILTIN] = &ao_scheme_builtin_type,
@@ -497,9 +512,7 @@ static const struct ao_scheme_type * const ao_scheme_types[AO_SCHEME_NUM_TYPE] =
 	[AO_SCHEME_LAMBDA] = &ao_scheme_lambda_type,
 	[AO_SCHEME_STACK] = &ao_scheme_stack_type,
 	[AO_SCHEME_BOOL] = &ao_scheme_bool_type,
-#ifdef AO_SCHEME_FEATURE_BIGINT
-	[AO_SCHEME_BIGINT] = &ao_scheme_bigint_type,
-#endif
+	[AO_SCHEME_STRING] = &ao_scheme_string_type,
 #ifdef AO_SCHEME_FEATURE_FLOAT
 	[AO_SCHEME_FLOAT] = &ao_scheme_float_type,
 #endif
@@ -533,6 +546,7 @@ uint64_t ao_scheme_loops[2];
 #endif
 
 int ao_scheme_last_top;
+int ao_scheme_collect_counts;
 
 int
 ao_scheme_collect(uint8_t style)
@@ -543,12 +557,13 @@ ao_scheme_collect(uint8_t style)
 #if DBG_MEM_STATS
 	int	loops = 0;
 #endif
-#if DBG_MEM
+#if DBG_MEM_RECORD
 	struct ao_scheme_record	*mark_record = NULL, *move_record = NULL;
-
-	MDBG_MOVE("collect %d\n", ao_scheme_collects[style]);
 #endif
+	MDBG_MOVE("collect %lu\n", ao_scheme_collects[style]);
+
 	MDBG_DO(ao_scheme_frame_write(ao_scheme_frame_poly(ao_scheme_frame_global)));
+	MDBG_DO(++ao_scheme_collecting);
 
 	ao_scheme_reset_stack();
 
@@ -556,6 +571,14 @@ ao_scheme_collect(uint8_t style)
 	if (ao_scheme_last_top == 0)
 		style = AO_SCHEME_COLLECT_FULL;
 
+	/* One in a while, just do a full collect */
+
+	if (ao_scheme_collect_counts >= 128)
+		style = AO_SCHEME_COLLECT_FULL;
+
+	if (style == AO_SCHEME_COLLECT_FULL)
+		ao_scheme_collect_counts = 0;
+
 	/* Clear references to all caches */
 	for (i = 0; i < (int) AO_SCHEME_CACHE; i++)
 		*ao_scheme_cache[i] = NULL;
@@ -565,15 +588,12 @@ ao_scheme_collect(uint8_t style)
 		chunk_low = top = ao_scheme_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_scheme_mark_ref, ao_scheme_poly_mark_ref);
-#if DBG_MEM
 
+#if DBG_MEM_RECORD
 		ao_scheme_record_free(mark_record);
 		mark_record = ao_scheme_record_save();
 		if (mark_record && move_record)
@@ -585,7 +605,6 @@ ao_scheme_collect(uint8_t style)
 		/* Find the first moving object */
 		for (i = 0; i < chunk_last; i++) {
 			uint16_t	size = ao_scheme_chunk[i].size;
-
 #if DBG_MEM
 			if (!size)
 				ao_scheme_abort();
@@ -604,6 +623,20 @@ ao_scheme_collect(uint8_t style)
 			top += size;
 		}
 
+		/* Short-circuit the rest of the loop when all of the
+		 * found objects aren't moving. This isn't strictly
+		 * necessary as the rest of the loop is structured to
+		 * work in this case, but GCC 7.2.0 with optimization
+		 * greater than 2 generates incorrect code for this...
+		 */
+		if (i == AO_SCHEME_NCHUNK) {
+			chunk_low = chunk_high;
+#if DBG_MEM_STATS
+			loops++;
+#endif
+			continue;
+		}
+
 		/*
 		 * Limit amount of chunk array used in mapping moves
 		 * to the active region
@@ -637,7 +670,7 @@ ao_scheme_collect(uint8_t style)
 			/* Relocate all references to the objects */
 			walk(ao_scheme_move, ao_scheme_poly_move);
 
-#if DBG_MEM
+#if DBG_MEM_RECORD
 			ao_scheme_record_free(move_record);
 			move_record = ao_scheme_record_save();
 			if (mark_record && move_record)
@@ -645,6 +678,9 @@ ao_scheme_collect(uint8_t style)
 #endif
 		}
 
+#if DBG_MEM_STATS
+		loops++;
+#endif
 		/* If we ran into the end of the heap, then
 		 * there's no need to keep walking
 		 */
@@ -672,6 +708,7 @@ ao_scheme_collect(uint8_t style)
 #if DBG_MEM_STACK
 	fprintf(stderr, "max collect stack depth %lu\n", mem_collect_max_depth);
 #endif
+	MDBG_DO(--ao_scheme_collecting);
 	return AO_SCHEME_POOL - ao_scheme_top;
 }
 
@@ -846,7 +883,7 @@ ao_scheme_move_memory(const struct ao_scheme_type *type, void **ref)
 		return 1;
 	}
 	mark(ao_scheme_busy, offset);
-	MDBG_DO(ao_scheme_record(type, addr, ao_scheme_size(type, addr)));
+	ao_scheme_record(type, addr, ao_scheme_size(type, addr));
 	return 0;
 }
 
@@ -913,14 +950,14 @@ ao_scheme_poly_move(ao_poly *ref, uint8_t do_note_cons)
 	if (offset != orig_offset) {
 		ao_poly np = ao_scheme_poly(ao_scheme_pool + offset, ao_scheme_poly_base_type(p));
 		MDBG_MOVE("poly %d moved %d -> %d\n",
-			  type, orig_offset, offset);
+			  ao_scheme_poly_type(np), orig_offset, offset);
 		*ref = np;
 	}
 	return ret;
 }
 
 #if DBG_MEM
-void
+static void
 ao_scheme_validate(void)
 {
 	chunk_low = 0;
@@ -984,16 +1021,16 @@ ao_scheme_poly_fetch(int id)
 }
 
 void
-ao_scheme_string_stash(int id, char *string)
+ao_scheme_string_stash(int id, struct ao_scheme_string *string)
 {
 	assert(save_string[id] == NULL);
 	save_string[id] = string;
 }
 
-char *
+struct ao_scheme_string *
 ao_scheme_string_fetch(int id)
 {
-	char *string = save_string[id];
+	struct ao_scheme_string *string = save_string[id];
 	save_string[id] = NULL;
 	return string;
 }
@@ -1012,3 +1049,64 @@ ao_scheme_frame_fetch(int id)
 	save_frame[id] = NULL;
 	return frame;
 }
+
+int
+ao_scheme_print_mark_addr(void *addr)
+{
+	int	offset;
+
+#if DBG_MEM
+	if (ao_scheme_collecting)
+		ao_scheme_abort();
+#endif
+
+	if (!AO_SCHEME_IS_POOL(addr))
+		return 0;
+
+	if (!ao_scheme_print_cleared) {
+		ao_scheme_print_cleared = 1;
+		memset(ao_scheme_busy, '\0', sizeof (ao_scheme_busy));
+	}
+	offset = pool_offset(addr);
+	if (busy(ao_scheme_busy, offset))
+		return 1;
+	mark(ao_scheme_busy, offset);
+	return 0;
+}
+
+void
+ao_scheme_print_clear_addr(void *addr)
+{
+	int	offset;
+
+#if DBG_MEM
+	if (ao_scheme_collecting)
+		ao_scheme_abort();
+#endif
+
+	if (!AO_SCHEME_IS_POOL(addr))
+		return;
+
+	if (!ao_scheme_print_cleared)
+		return;
+	offset = pool_offset(addr);
+	clear(ao_scheme_busy, offset);
+}
+
+/* Notes that printing has started */
+void
+ao_scheme_print_start(void)
+{
+	ao_scheme_printing++;
+}
+
+/* Notes that printing has ended. Returns 1 if printing is still going on */
+int
+ao_scheme_print_stop(void)
+{
+	ao_scheme_printing--;
+	if (ao_scheme_printing != 0)
+		return 1;
+	ao_scheme_print_cleared = 0;
+	return 0;
+}