vm: simpler object space implementation. begin-scan/next-object/end-scan primitives replaced by a single all-instances primitive

basis/stack-checker/known-words/known-words.factor

@@ -623,11 +623,7 @@ M: bad-executable summary
 \ <array> { integer object } { array } define-primitive
 \ <array> make-flushable
 
-\ begin-scan { } { } define-primitive
+\ all-instances { } { array } define-primitive
-
-\ next-object { } { object } define-primitive
-
-\ end-scan { } { } define-primitive
 
 \ size { object } { fixnum } define-primitive
 \ size make-flushable

basis/tools/memory/memory-docs.factor

@@ -13,11 +13,8 @@ ARTICLE: "tools.memory" "Object memory tools"
     data-room
     code-room
 }
-"There are a pair of combinators, analogous to " { $link each } " and " { $link filter } ", which operate on the entire collection of objects in the object heap:"
+"A combinator to get objects from the heap:"
-{ $subsections
+{ $subsections instances }
-    each-object
-    instances
-}
 "You can check an object's the heap memory usage:"
 { $subsections size }
 "The garbage collector can be invoked manually:"

core/bootstrap/primitives.factor

@@ -473,9 +473,7 @@ tuple
     { "resize-array" "arrays" (( n array -- newarray )) }
     { "resize-string" "strings" (( n str -- newstr )) }
     { "<array>" "arrays" (( n elt -- array )) }
-    { "begin-scan" "memory" (( -- )) }
+    { "all-instances" "memory" (( -- array )) }
-    { "next-object" "memory" (( -- obj )) }
-    { "end-scan" "memory" (( -- )) }
     { "size" "memory" (( obj -- n )) }
     { "die" "kernel" (( -- )) }
     { "(fopen)" "io.streams.c" (( path mode -- alien )) }

core/bootstrap/stage1.factor

@@ -17,15 +17,9 @@ load-help? off
 ! Create a boot quotation for the target
 [
     [
-        ! Rehash hashtables, since bootstrap.image creates them
+        ! Rehash hashtables first, since bootstrap.image creates
-        ! using the host image's hashing algorithms. We don't
+        ! them using the host image's hashing algorithms.
-        ! use each-object here since the catch stack isn't yet
+        [ hashtable? ] instances [ rehash ] each
-        ! set up.
-        gc
-        begin-scan
-        [ hashtable? ] pusher [ (each-object) ] dip
-        end-scan
-        [ rehash ] each
         boot
     ] %
 

core/memory/memory-docs.factor

@@ -2,31 +2,9 @@ USING: help.markup help.syntax debugger sequences kernel
 quotations math ;
 IN: memory
 
-HELP: begin-scan ( -- )
-{ $description "Disables the garbage collector and resets the heap scan pointer to point at the first object in the heap. The " { $link next-object } " word can then be called to advance the heap scan pointer and return successive objects."
-$nl
-"This word must always be paired with a call to " { $link end-scan } "." }
-{ $notes "This is a low-level facility and can be dangerous. Use the " { $link each-object } " combinator instead." } ;
-
-HELP: next-object ( -- obj )
-{ $values { "obj" object } }
-{ $description "Outputs the object at the heap scan pointer, and then advances the heap scan pointer. If the end of the heap has been reached, outputs " { $link f } ". This is unambiguous since the " { $link f } " object is tagged immediate and not actually stored in the heap." }
-{ $errors "Throws a " { $link heap-scan-error. } " if called outside a " { $link begin-scan } "/" { $link end-scan } " pair." }
-{ $notes "This is a low-level facility and can be dangerous. Use the " { $link each-object } " combinator instead." } ;
-
-HELP: end-scan ( -- )
-{ $description "Finishes a heap iteration by re-enabling the garbage collector. This word must always be paired with a call to " { $link begin-scan } "." }
-{ $notes "This is a low-level facility and can be dangerous. Use the " { $link each-object } " combinator instead." } ;
-
-HELP: each-object
-{ $values { "quot" { $quotation "( obj -- )" } } }
-{ $description "Applies a quotation to each object in the heap. The garbage collector is switched off while this combinator runs, so the given quotation must not allocate too much memory." }
-{ $notes "This word is the low-level facility used to implement the " { $link instances } " word." } ;
-
 HELP: instances
 { $values { "quot" { $quotation "( obj -- ? )" } } { "seq" "a fresh sequence" } }
-{ $description "Outputs a sequence of all objects in the heap which satisfy the quotation." }
+{ $description "Outputs a sequence of all objects in the heap which satisfy the quotation." } ;
-{ $notes "This word relies on " { $link each-object } ", so in particular the garbage collector is switched off while it runs and the given quotation must not allocate too much memory." } ;
 
 HELP: gc ( -- )
 { $description "Performs a full garbage collection." } ;
@@ -56,17 +34,6 @@ HELP: save-image-and-exit ( path -- )
 HELP: save
 { $description "Saves a snapshot of the heap to the current image file." } ;
 
-HELP: count-instances
-{ $values
-     { "quot" quotation }
-     { "n" integer } }
-{ $description "Applies the predicate quotation to each object in the heap and returns the number of objects that match. Since this word uses " { $link each-object } " with the garbage collector switched off, avoid allocating too much memory in the quotation." }
-{ $examples { $unchecked-example
-    "USING: memory words prettyprint ;"
-    "[ word? ] count-instances ."
-    "24210"
-} } ;
-
 ARTICLE: "images" "Images"
 "Factor has the ability to save the entire state of the system into an " { $emphasis "image file" } ". The image contains a complete dump of all data and code in the current Factor instance."
 { $subsections

core/memory/memory.factor

@@ -1,26 +1,11 @@
 ! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel continuations sequences vectors arrays system math
+USING: kernel continuations sequences system
 io.backend alien.strings memory.private ;
 IN: memory
 
-: (each-object) ( quot: ( obj -- ) -- )
-    next-object dup [
-        swap [ call ] keep (each-object)
-    ] [ 2drop ] if ; inline recursive
-
-: each-object ( quot -- )
-    gc begin-scan [ (each-object) ] [ end-scan ] [ ] cleanup ; inline
-
-: count-instances ( quot -- n )
-    0 swap [ 1 0 ? + ] compose each-object ; inline
-
 : instances ( quot -- seq )
-    #! To ensure we don't need to grow the vector while scanning
+    [ all-instances ] dip filter ; inline
-    #! the heap, we do two scans, the first one just counts the
-    #! number of objects that satisfy the predicate.
-    [ count-instances 100 + <vector> ] keep swap
-    [ [ push-if ] 2curry each-object ] keep >array ; inline
 
 : save-image ( path -- )
     normalize-path native-string>alien (save-image) ;

vm/compaction.cpp

@@ -150,9 +150,9 @@ struct object_code_block_updater {
 	explicit object_code_block_updater(code_block_visitor<forwarder<code_block> > *visitor_) :
 		visitor(visitor_) {}
 
-	void operator()(cell obj)
+	void operator()(object *obj)
 	{
-		visitor->visit_object_code_block(tagged<object>(obj).untagged());
+		visitor->visit_object_code_block(obj);
 	}
 };
 

vm/data_heap.cpp

@@ -226,82 +226,42 @@ void factor_vm::primitive_data_room()
 	dpush(tag<byte_array>(byte_array_from_value(&room)));
 }
 
-/* Disables GC and activates next-object ( -- obj ) primitive */
+struct object_accumulator {
-void factor_vm::begin_scan()
+	cell type;
+	std::vector<cell> objects;
+
+	explicit object_accumulator(cell type_) : type(type_) {}
+
+	void operator()(object *obj)
+	{
+		if(type == TYPE_COUNT || obj->h.hi_tag() == type)
+			objects.push_back(tag_dynamic(obj));
+	}
+};
+
+cell factor_vm::instances(cell type)
 {
-	heap_scan_ptr = data->tenured->first_object();
+	object_accumulator accum(type);
+	each_object(accum);
+	cell object_count = accum.objects.size();
+
 	gc_off = true;
-}
+	array *objects = allot_array(object_count,false_object);
-
+	memcpy(objects->data(),&accum.objects[0],object_count * sizeof(cell));
-void factor_vm::end_scan()
-{
 	gc_off = false;
+
+	return tag<array>(objects);
 }
 
-void factor_vm::primitive_begin_scan()
+void factor_vm::primitive_all_instances()
 {
-	begin_scan();
+	primitive_full_gc();
+	dpush(instances(TYPE_COUNT));
 }
 
-cell factor_vm::next_object()
-{
-	if(!gc_off)
-		general_error(ERROR_HEAP_SCAN,false_object,false_object,NULL);
-
-	if(heap_scan_ptr)
-	{
-		cell current = heap_scan_ptr;
-		heap_scan_ptr = data->tenured->next_object_after(heap_scan_ptr);
-		return tag_dynamic((object *)current);
-	}
-	else
-		return false_object;
-}
-
-/* Push object at heap scan cursor and advance; pushes f when done */
-void factor_vm::primitive_next_object()
-{
-	dpush(next_object());
-}
-
-/* Re-enables GC */
-void factor_vm::primitive_end_scan()
-{
-	gc_off = false;
-}
-
-struct word_counter {
-	cell count;
-
-	explicit word_counter() : count(0) {}
-
-	void operator()(cell obj)
-	{
-		if(tagged<object>(obj).type_p(WORD_TYPE))
-			count++;
-	}
-};
-
-struct word_accumulator {
-	growable_array words;
-
-	explicit word_accumulator(int count,factor_vm *vm) : words(vm,count) {}
-
-	void operator()(cell obj)
-	{
-		if(tagged<object>(obj).type_p(WORD_TYPE))
-			words.add(obj);
-	}
-};
-
 cell factor_vm::find_all_words()
 {
-	word_counter counter;
+	return instances(WORD_TYPE);
-	each_object(counter);
-	word_accumulator accum(counter.count,this);
-	each_object(accum);
-	accum.words.trim();
-	return accum.words.elements.value();
 }
 
 }

vm/debug.cpp

@@ -241,12 +241,12 @@ struct object_dumper {
 	explicit object_dumper(factor_vm *parent_, cell type_) :
 		parent(parent_), type(type_) {}
 
-	void operator()(cell obj)
+	void operator()(object *obj)
 	{
-		if(type == TYPE_COUNT || tagged<object>(obj).type_p(type))
+		if(type == TYPE_COUNT || obj->h.hi_tag() == type)
 		{
-			std::cout << padded_address(obj) << " ";
+			std::cout << padded_address((cell)obj) << " ";
-			parent->print_nested_obj(obj,2);
+			parent->print_nested_obj(tag_dynamic(obj),2);
 			std::cout << std::endl;
 		}
 	}
@@ -260,18 +260,19 @@ void factor_vm::dump_objects(cell type)
 }
 
 struct data_reference_slot_visitor {
-	cell look_for, obj;
+	cell look_for;
+	object *obj;
 	factor_vm *parent;
 
-	explicit data_reference_slot_visitor(cell look_for_, cell obj_, factor_vm *parent_) :
+	explicit data_reference_slot_visitor(cell look_for_, object *obj_, factor_vm *parent_) :
 		look_for(look_for_), obj(obj_), parent(parent_) { }
 
 	void operator()(cell *scan)
 	{
 		if(look_for == *scan)
 		{
-			std::cout << padded_address(obj) << " ";
+			std::cout << padded_address((cell)obj) << " ";
-			parent->print_nested_obj(obj,2);
+			parent->print_nested_obj(tag_dynamic(obj),2);
 			std::cout << std::endl;
 		}
 	}
@@ -284,10 +285,10 @@ struct data_reference_object_visitor {
 	explicit data_reference_object_visitor(cell look_for_, factor_vm *parent_) :
 		look_for(look_for_), parent(parent_) {}
 
-	void operator()(cell obj)
+	void operator()(object *obj)
 	{
 		data_reference_slot_visitor visitor(look_for,obj,parent);
-		parent->do_slots(UNTAG(obj),visitor);
+		parent->do_slots(obj,visitor);
 	}
 };
 

vm/image.cpp

@@ -154,7 +154,7 @@ void factor_vm::relocate_object(object *object,
 	else
 	{
 		object_fixupper fixupper(this,data_relocation_base);
-		do_slots((cell)object,fixupper);
+		do_slots(object,fixupper);
 
 		switch(hi_tag)
 		{

vm/objects.cpp

@@ -83,9 +83,9 @@ struct object_become_visitor {
 	explicit object_become_visitor(slot_visitor<slot_become_visitor> *workhorse_) :
 		workhorse(workhorse_) {}
 
-	void operator()(cell obj)
+	void operator()(object *obj)
 	{
-		workhorse->visit_slots(tagged<object>(obj).untagged());
+		workhorse->visit_slots(obj);
 	}
 };
 
@@ -123,6 +123,7 @@ void factor_vm::primitive_become()
 	/* Since we may have introduced old->new references, need to revisit
 	all objects on a minor GC. */
 	data->mark_all_cards();
+	primitive_minor_gc();
 
 	/* If a word's definition quotation was in old_objects and the
 	   quotation in new_objects is not compiled, we might leak memory

vm/primitives.cpp

@@ -82,9 +82,7 @@ PRIMITIVE_FORWARD(set_string_nth_slow)
 PRIMITIVE_FORWARD(resize_array)
 PRIMITIVE_FORWARD(resize_string)
 PRIMITIVE_FORWARD(array)
-PRIMITIVE_FORWARD(begin_scan)
+PRIMITIVE_FORWARD(all_instances)
-PRIMITIVE_FORWARD(next_object)
-PRIMITIVE_FORWARD(end_scan)
 PRIMITIVE_FORWARD(size)
 PRIMITIVE_FORWARD(die)
 PRIMITIVE_FORWARD(fopen)
@@ -244,9 +242,7 @@ const primitive_type primitives[] = {
 	primitive_resize_array,
 	primitive_resize_string,
 	primitive_array,
-	primitive_begin_scan,
+	primitive_all_instances,
-	primitive_next_object,
-	primitive_end_scan,
 	primitive_size,
 	primitive_die,
 	primitive_fopen,

vm/vm.hpp

@@ -40,10 +40,6 @@ struct factor_vm
 	unsigned int signal_fpu_status;
 	stack_frame *signal_callstack_top;
 
-	/* A heap walk allows useful things to be done, like finding all
-	   references to an object for debugging purposes. */
-	cell heap_scan_ptr;
-
 	/* GC is off during heap walking */
 	bool gc_off;
 
@@ -224,10 +220,8 @@ struct factor_vm
 	void primitive_data_room();
 	void begin_scan();
 	void end_scan();
-	void primitive_begin_scan();
+	cell instances(cell type);
-	cell next_object();
+	void primitive_all_instances();
-	void primitive_next_object();
-	void primitive_end_scan();
 	cell find_all_words();
 
 	template<typename Generation, typename Iterator>
@@ -236,7 +230,7 @@ struct factor_vm
 		cell obj = gen->first_object();
 		while(obj)
 		{
-			iterator(obj);
+			iterator((object *)obj);
 			obj = gen->next_object_after(obj);
 		}
 	}
@@ -589,11 +583,11 @@ struct factor_vm
 	/* Every object has a regular representation in the runtime, which makes GC
 	much simpler. Every slot of the object until binary_payload_start is a pointer
 	to some other object. */
-	template<typename Iterator> void do_slots(cell obj, Iterator &iter)
+	template<typename Iterator> void do_slots(object *obj, Iterator &iter)
 	{
-		cell scan = obj;
+		cell scan = (cell)obj;
-		cell payload_start = ((object *)obj)->binary_payload_start();
+		cell payload_start = obj->binary_payload_start();
-		cell end = obj + payload_start;
+		cell end = scan + payload_start;
 
 		scan += sizeof(cell);