Fix FEP if there are too many words in the image, clean up some VM code

core/memory/memory-tests.factor

@@ -27,16 +27,8 @@ TUPLE: testing x y z ;
 
 [ save-image-and-exit ] must-fail
 
-[ ] [
-    num-types get [
-        type>class [
-            dup . flush
-            "predicate" word-prop instances [
-                class drop
-            ] each
-        ] when*
-    ] each
-] unit-test
-
 ! Erg's bug
 2 [ [ [ 3 throw ] instances ] must-fail ] times
+
+! Bug found on Windows build box, having too many words in the image breaks 'become'
+[ ] [ 100000 [ f f <word> ] replicate { } { } become drop ] unit-test

vm/arrays.hpp

@@ -34,7 +34,7 @@ struct growable_array {
 	cell count;
 	gc_root<array> elements;
 
-	growable_array() : count(0), elements(allot_array(2,F)) {}
+	growable_array(cell capacity = 10) : count(0), elements(allot_array(capacity,F)) {}
 
 	void add(cell elt);
 	void trim();

vm/byte_arrays.hpp

@@ -7,12 +7,11 @@ PRIMITIVE(byte_array);
 PRIMITIVE(uninitialized_byte_array);
 PRIMITIVE(resize_byte_array);
 
-/* Macros to simulate a byte vector in C */
 struct growable_byte_array {
 	cell count;
 	gc_root<byte_array> elements;
 
-	growable_byte_array() : count(0), elements(allot_byte_array(2)) { }
+	growable_byte_array(cell capacity = 40) : count(0), elements(allot_byte_array(capacity)) { }
 
 	void append_bytes(void *elts, cell len);
 	void append_byte_array(cell elts);

vm/callstack.cpp

@@ -11,22 +11,6 @@ static void check_frame(stack_frame *frame)
 #endif
 }
 
-void iterate_callstack(cell top, cell bottom, CALLSTACK_ITER iterator)
-{
-	stack_frame *frame = (stack_frame *)bottom - 1;
-
-	while((cell)frame >= top)
-	{
-		iterator(frame);
-		frame = frame_successor(frame);
-	}
-}
-
-void iterate_callstack_object(callstack *stack, CALLSTACK_ITER iterator)
-{
-	iterate_callstack((cell)stack->top(),(cell)stack->bottom(),iterator);
-}
-
 callstack *allot_callstack(cell size)
 {
 	callstack *stack = allot<callstack>(callstack_size(size));
@@ -138,36 +122,39 @@ cell frame_scan(stack_frame *frame)
 		return F;
 }
 
-/* C doesn't have closures... */
+namespace
-static cell frame_count;
-
-void count_stack_frame(stack_frame *frame)
 {
-	frame_count += 2; 
-}
 
-static cell frame_index;
+struct stack_frame_counter {
-static array *frames;
+	cell count;
+	stack_frame_counter() : count(0) {}
+	void operator()(stack_frame *frame) { count += 2; }
+};
+
+struct stack_frame_accumulator {
+	cell index;
+	array *frames;
+	stack_frame_accumulator(cell count) : index(0), frames(allot_array_internal<array>(count)) {}
+	void operator()(stack_frame *frame)
+	{
+		set_array_nth(frames,index++,frame_executing(frame));
+		set_array_nth(frames,index++,frame_scan(frame));
+	}
+};
 
-void stack_frame_to_array(stack_frame *frame)
-{
-	set_array_nth(frames,frame_index++,frame_executing(frame));
-	set_array_nth(frames,frame_index++,frame_scan(frame));
 }
 
 PRIMITIVE(callstack_to_array)
 {
 	gc_root<callstack> callstack(dpop());
 
-	frame_count = 0;
+	stack_frame_counter counter;
-	iterate_callstack_object(callstack.untagged(),count_stack_frame);
+	iterate_callstack_object(callstack.untagged(),counter);
 
-	frames = allot_array_internal<array>(frame_count);
+	stack_frame_accumulator accum(counter.count);
+	iterate_callstack_object(callstack.untagged(),accum);
 
-	frame_index = 0;
+	dpush(tag<array>(accum.frames));
-	iterate_callstack_object(callstack.untagged(),stack_frame_to_array);
-
-	dpush(tag<array>(frames));
 }
 
 stack_frame *innermost_stack_frame(callstack *stack)

vm/callstack.hpp

@@ -6,11 +6,7 @@ inline static cell callstack_size(cell size)
 	return sizeof(callstack) + size;
 }
 
-typedef void (*CALLSTACK_ITER)(stack_frame *frame);
-
 stack_frame *fix_callstack_top(stack_frame *top, stack_frame *bottom);
-void iterate_callstack(cell top, cell bottom, CALLSTACK_ITER iterator);
-void iterate_callstack_object(callstack *stack, CALLSTACK_ITER iterator);
 stack_frame *frame_successor(stack_frame *frame);
 code_block *frame_code(stack_frame *frame);
 cell frame_executing(stack_frame *frame);
@@ -26,4 +22,20 @@ PRIMITIVE(set_innermost_stack_frame_quot);
 
 VM_ASM_API void save_callstack_bottom(stack_frame *callstack_bottom);
 
+template<typename T> void iterate_callstack(cell top, cell bottom, T &iterator)
+{
+	stack_frame *frame = (stack_frame *)bottom - 1;
+
+	while((cell)frame >= top)
+	{
+		iterator(frame);
+		frame = frame_successor(frame);
+	}
+}
+
+template<typename T> void iterate_callstack_object(callstack *stack, T &iterator)
+{
+	iterate_callstack((cell)stack->top(),(cell)stack->bottom(),iterator);
+}
+
 }

vm/code_heap.cpp

@@ -173,8 +173,7 @@ void forward_object_xts()
 		}
 	}
 
-	/* End the heap scan */
+	end_scan();
-	gc_off = false;
 }
 
 /* Set the XT fields now that the heap has been compacted */
@@ -203,8 +202,7 @@ void fixup_object_xts()
 		}
 	}
 
-	/* End the heap scan */
+	end_scan();
-	gc_off = false;
 }
 
 /* Move all free space to the end of the code heap. This is not very efficient,

vm/data_heap.cpp

@@ -318,6 +318,11 @@ void begin_scan()
 	gc_off = true;
 }
 
+void end_scan()
+{
+	gc_off = false;
+}
+
 PRIMITIVE(begin_scan)
 {
 	begin_scan();
@@ -348,24 +353,40 @@ PRIMITIVE(end_scan)
 	gc_off = false;
 }
 
-cell find_all_words()
+template<typename T> void each_object(T &functor)
 {
-	growable_array words;
-
 	begin_scan();
-
 	cell obj;
 	while((obj = next_object()) != F)
-	{
+		functor(tagged<object>(obj));
-		if(tagged<object>(obj).type_p(WORD_TYPE))
+	end_scan();
-			words.add(obj);
+}
-	}
 
-	/* End heap scan */
+namespace
-	gc_off = false;
+{
 
-	words.trim();
+struct word_counter {
-	return words.elements.value();
+	cell count;
+	word_counter() : count(0) {}
+	void operator()(tagged<object> obj) { if(obj.type_p(WORD_TYPE)) count++; }
+};
+
+struct word_accumulator {
+	growable_array words;
+	word_accumulator(int count) : words(count) {}
+	void operator()(tagged<object> obj) { if(obj.type_p(WORD_TYPE)) words.add(obj.value()); }
+};
+
+}
+
+cell find_all_words()
+{
+	word_counter counter;
+	each_object(counter);
+	word_accumulator accum(counter.count);
+	each_object(accum);
+	accum.words.trim();
+	return accum.words.elements.value();
 }
 
 }

vm/data_heap.hpp

@@ -89,6 +89,7 @@ cell binary_payload_start(object *pointer);
 cell object_size(cell tagged);
 
 void begin_scan();
+void end_scan();
 cell next_object();
 
 PRIMITIVE(data_room);

vm/debug.cpp

@@ -253,8 +253,7 @@ void dump_objects(cell type)
 		}
 	}
 
-	/* end scan */
+	end_scan();
-	gc_off = false;
 }
 
 cell look_for;
@@ -280,8 +279,7 @@ void find_data_references(cell look_for_)
 	while((obj = next_object()) != F)
 		do_slots(UNTAG(obj),find_data_references_step);
 
-	/* end scan */
+	end_scan();
-	gc_off = false;
 }
 
 /* Dump all code blocks for debugging */