From 94c93f0bc7f838b8ad0beb334aa20e711f1554ca Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 27 Jan 2010 18:42:31 +1300
Subject: [PATCH] vm: 'become' primitive needs to update literal references in
 code blocks

---
 core/classes/tuple/tuple-tests.factor | 21 +++++++++++-
 vm/objects.cpp                        | 48 +++++++++++++++++++++++----
 2 files changed, 61 insertions(+), 8 deletions(-)

diff --git a/core/classes/tuple/tuple-tests.factor b/core/classes/tuple/tuple-tests.factor
index 710a011aa4..73c501716d 100644
--- a/core/classes/tuple/tuple-tests.factor
+++ b/core/classes/tuple/tuple-tests.factor
@@ -6,7 +6,7 @@ io.streams.string kernel kernel.private math math.constants
 math.order namespaces parser parser.notes prettyprint
 quotations random see sequences sequences.private slots
 slots.private splitting strings summary threads tools.test
-vectors vocabs words words.symbol fry literals ;
+vectors vocabs words words.symbol fry literals memory ;
 IN: classes.tuple.tests
 
 TUPLE: rect x y w h ;
@@ -765,3 +765,22 @@ USE: classes.struct
     [ "prototype" word-prop ] map
     [ '[ _ hashcode drop f ] [ drop t ] recover ] filter
 ] unit-test
+
+! Make sure that tuple reshaping updates code heap roots
+TUPLE: code-heap-ref ;
+
+: code-heap-ref' ( -- a ) T{ code-heap-ref } ;
+
+! Push foo's literal to tenured space
+[ ] [ gc ] unit-test
+
+! Reshape!
+[ ] [ "IN: classes.tuple.tests USE: math TUPLE: code-heap-ref { x integer initial: 5 } ;" eval( -- ) ] unit-test
+
+! Code heap reference
+[ t ] [ code-heap-ref' code-heap-ref? ] unit-test
+[ 5 ] [ code-heap-ref' x>> ] unit-test
+
+! Data heap reference
+[ t ] [ \ code-heap-ref' def>> first code-heap-ref? ] unit-test
+[ 5 ] [ \ code-heap-ref' def>> first x>> ] unit-test
diff --git a/vm/objects.cpp b/vm/objects.cpp
index 21948e5e7a..f1201c4de7 100644
--- a/vm/objects.cpp
+++ b/vm/objects.cpp
@@ -110,6 +110,31 @@ struct object_become_visitor {
 	}
 };
 
+struct code_block_become_visitor {
+	slot_visitor<slot_become_visitor> *workhorse;
+
+	explicit code_block_become_visitor(slot_visitor<slot_become_visitor> *workhorse_) :
+		workhorse(workhorse_) {}
+
+	void operator()(code_block *compiled, cell size)
+	{
+		workhorse->visit_code_block_objects(compiled);
+		workhorse->visit_embedded_literals(compiled);
+	}
+};
+
+struct code_block_write_barrier_visitor {
+	code_heap *code;
+
+	explicit code_block_write_barrier_visitor(code_heap *code_) :
+		code(code_) {}
+
+	void operator()(code_block *compiled, cell size)
+	{
+		code->write_barrier(compiled);
+	}
+};
+
 /* classes.tuple uses this to reshape tuples; tools.deploy.shaker uses this
    to coalesce equal but distinct quotations and wrappers. */
 void factor_vm::primitive_become()
@@ -134,17 +159,26 @@ void factor_vm::primitive_become()
 	}
 
 	/* Update all references to old objects to point to new objects */
-	slot_visitor<slot_become_visitor> workhorse(this,slot_become_visitor(&become_map));
-	workhorse.visit_roots();
-	workhorse.visit_contexts();
+	{
+		slot_visitor<slot_become_visitor> workhorse(this,slot_become_visitor(&become_map));
+		workhorse.visit_roots();
+		workhorse.visit_contexts();
 
-	object_become_visitor object_visitor(&workhorse);
-	each_object(object_visitor);
+		object_become_visitor object_visitor(&workhorse);
+		each_object(object_visitor);
+
+		code_block_become_visitor code_block_visitor(&workhorse);
+		each_code_block(code_block_visitor);
+	}
 
 	/* Since we may have introduced old->new references, need to revisit
-	all objects on a minor GC. */
+	all objects and code blocks on a minor GC. */
 	data->mark_all_cards();
-	primitive_minor_gc();
+
+	{
+		code_block_write_barrier_visitor code_block_visitor(code);
+		each_code_block(code_block_visitor);
+	}
 }
 
 }