VM: make visit_instruction_operands() skip over uninitialized blocks

It will crash otherwise when compacting the code heap.

diff --git a/basis/compiler/tests/code-heap.factor b/basis/compiler/tests/code-heap.factor
new file mode 100644 (file)
index 0000000..ee55a33
--- /dev/null
+++ b/basis/compiler/tests/code-heap.factor
@@ -0,0 +1,40 @@
+USING: accessors combinators.short-circuit compiler.units kernel
+locals math random sequences tools.memory tools.test vocabs words ;
+IN: compiler.tests.code-heap
+
+! This is a test for filling up the code heap.
+!
+! We take 100 random words and continuously run modify-code-heap with
+! them until the code heap fills up, prompting a compaction of it from
+! allot_code_block() in code_blocks.cpp. Then compaction must work
+! despite there being a number of uninitialized code blocks in the
+! heap. See #1715.
+: special-word? ( word -- ? )
+    {
+        [ "macro" word-prop ]
+        [ "no-compile" word-prop ]
+        [ "special" word-prop ]
+        [ "custom-inlining" word-prop ]
+    } 1|| ;
+
+: normal-words ( -- words )
+    all-words [ special-word? ] reject ;
+
+: random-compilation-data ( -- compiled-data )
+    [
+        normal-words 50 sample recompile
+    ] with-compilation-unit ;
+
+: heap-free ( -- n )
+    code-room total-free>> ;
+
+:: (trash-code-heap) ( data last-free -- )
+    data f f modify-code-heap heap-free :> new-free
+    last-free new-free > [ data new-free (trash-code-heap) ] when ;
+
+: trash-code-heap ( -- )
+    random-compilation-data heap-free (trash-code-heap) ;
+
+{ } [
+    trash-code-heap
+] unit-test

diff --git a/vm/slot_visitor.hpp b/vm/slot_visitor.hpp
index 0027d4264b90e34ddf15480f5b20a6f48bf835e9..0a79b727695da89974bf4d09607fec6d89206dc4 100644 (file)
--- a/vm/slot_visitor.hpp
+++ b/vm/slot_visitor.hpp
@@ -485,6 +485,8 @@ void slot_visitor<Fixup>::visit_instruction_operands(code_block* block,
         break;
     }
   };
+  if (parent->code->uninitialized_p(block))
+    return;
   block->each_instruction_operand(visit_func);
 }