From b5039442ab041efdb6c40b6937943da5e718c3f8 Mon Sep 17 00:00:00 2001
From: slava <slava@factorcode.org>
Date: Mon, 16 Oct 2006 21:43:11 +0000
Subject: [PATCH] Automatically invoke code GC

---
 TODO.FACTOR.txt |  3 +-
 vm/compiler.c   | 80 +++++++++++++++++++++++++++++++++++++++++++++----
 2 files changed, 75 insertions(+), 8 deletions(-)

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 69924e954e..36285dbc1f 100644
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -1,8 +1,7 @@
-- auto-invoke code gc
 - live search: timer delay would be nice
 - help responder has no way to access { "foo" "bar" }
 - httpd search tools
-- code-gc instability with callbacks
+- lock callbacks
 
 + ui:
 
diff --git a/vm/compiler.c b/vm/compiler.c
index 89b9168559..fb20b90c9d 100644
--- a/vm/compiler.c
+++ b/vm/compiler.c
@@ -208,18 +208,86 @@ CELL add_compiled_block(CELL code_format, F_VECTOR *code,
 	return start + sizeof(F_COMPILED);
 }
 
+#define FROB \
+	CELL code_format = to_cell(get(ds)); \
+	F_VECTOR *code = untag_vector(get(ds - CELLS)); \
+	F_VECTOR *words = untag_vector(get(ds - CELLS * 2)); \
+	F_VECTOR *literals = untag_vector(get(ds - CELLS * 3)); \
+	F_VECTOR *rel = untag_vector(get(ds - CELLS * 4)); \
+	CELL code_length = align8(untag_fixnum_fast(code->top) * code_format); \
+	CELL rel_length = untag_fixnum_fast(rel->top) * CELLS; \
+	CELL literal_length = untag_fixnum_fast(literals->top) * CELLS; \
+	CELL words_length = untag_fixnum_fast(words->top) * CELLS;
+
 void primitive_add_compiled_block(void)
 {
-	CELL code_format = to_cell(dpop());
-	F_VECTOR *code = untag_vector(dpop());
-	F_VECTOR *words = untag_vector(dpop());
-	F_VECTOR *literals = untag_vector(dpop());
-	F_VECTOR *rel = untag_vector(dpop());
+	CELL start;
+
+	{
+		/* read parameters from stack, leaving them on the stack */
+		FROB
+
+		/* try allocating a new code block */
+		CELL total_length = sizeof(F_COMPILED) + code_length
+			+ rel_length + literal_length + words_length;
+
+		start = heap_allot(&compiling,total_length);
+
+		/* if allocation failed, do a code GC */
+		if(start == 0)
+		{
+			garbage_collection(TENURED,true);
+			start = heap_allot(&compiling,total_length);
+
+			/* insufficient room even after code GC, give up */
+			if(start == 0)
+				critical_error("code heap exhausted",0);
+		}
+	}
+
+	/* we have to read the parameters again, since we may have called
+	code GC in which case the data heap semi-spaces will have switched */
+	FROB
+
+	/* now we can pop the parameters from the stack */
+	ds -= CELLS * 5;
+
+	/* begin depositing the code block's contents */
+	CELL here = start;
+
+	/* compiled header */
+	F_COMPILED header;
+	header.code_length = code_length;
+	header.reloc_length = rel_length;
+	header.literal_length = literal_length;
+	header.words_length = words_length;
+	header.finalized = false;
+
+	memcpy((void*)here,&header,sizeof(F_COMPILED));
+	here += sizeof(F_COMPILED);
+
+	/* code */
+	deposit_integers(here,code,code_format);
+	here += code_length;
+
+	/* relation info */
+	deposit_integers(here,rel,CELLS);
+	here += rel_length;
+
+	/* literals */
+	deposit_objects(here,literals,literal_length);
+	here += literal_length;
+
+	/* words */
+	deposit_objects(here,words,words_length);
+	here += words_length;
 
 	/* push the XT of the new word on the stack */
-	box_unsigned_cell(add_compiled_block(code_format,code,literals,words,rel));
+	box_unsigned_cell(start + sizeof(F_COMPILED));
 }
 
+#undef FROB
+
 void primitive_finalize_compile(void)
 {
 	F_ARRAY *array = untag_array(dpop());
-- 
2.34.1