vm: add primitives for getting at GC events, data-room and code-room primitives now return structs instead of arrays

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

@@ -505,10 +505,10 @@ M: bad-executable summary
 
 \ (save-image-and-exit) { byte-array } { } define-primitive
 
-\ data-room { } { array } define-primitive
+\ data-room { } { byte-array } define-primitive
 \ data-room make-flushable
 
-\ code-room { } { array } define-primitive
+\ code-room { } { byte-array } define-primitive
 \ code-room  make-flushable
 
 \ micros { } { integer } define-primitive
@@ -713,3 +713,6 @@ M: bad-executable summary
 \ strip-stack-traces { } { } define-primitive
 
 \ <callback> { word } { alien } define-primitive
+
+\ enable-gc-events { } { } define-primitive
+\ disable-gc-events { } { object } define-primitive

basis/tools/memory/memory.factor

@@ -3,7 +3,9 @@
 USING: kernel sequences arrays generic assocs io math
 namespaces parser prettyprint strings io.styles words
 system sorting splitting grouping math.parser classes memory
-combinators fry ;
+combinators fry vm specialized-arrays accessors continuations
+classes.struct ;
+SPECIALIZED-ARRAY: gc-event
 IN: tools.memory
 
 <PRIVATE
@@ -13,51 +15,61 @@ IN: tools.memory
     dup length 4 > [ 3 cut* "," glue ] when
     " KB" append ;
 
-: fancy-table. ( seq alist -- )
+: fancy-table. ( obj alist -- )
-    [ [ nip first ] [ second call( obj -- str ) ] 2bi 2array ] 2map
+    [ [ nip first ] [ second call( obj -- str ) ] 2bi 2array ] with map
     simple-table. ;
 
-: young-room. ( seq -- )
+: copying-room. ( copying-sizes -- )
     {
-        { "Total:" [ kilobytes ] }
+        { "Size:" [ size>> kilobytes ] }
-        { "Allocated:" [ kilobytes ] }
+        { "Occupied:" [ occupied>> kilobytes ] }
-        { "Free:" [ kilobytes ] }
+        { "Free:" [ free>> kilobytes ] }
     } fancy-table. ;
 
-: nursery-room. ( seq -- ) "- Nursery space" print young-room. ;
+: nursery-room. ( data-room -- )
+    "- Nursery space" print nursery>> copying-room. ;
 
-: aging-room. ( seq -- ) "- Aging space" print young-room. ;
+: aging-room. ( data-room -- )
+    "- Aging space" print aging>> copying-room. ;
 
-: mark-sweep-table. ( sizes -- )
+: mark-sweep-table. ( mark-sweep-sizes -- )
     {
-        { "Total:" [ kilobytes ] }
+        { "Size:" [ size>> kilobytes ] }
-        { "Allocated:" [ kilobytes ] }
+        { "Occupied:" [ occupied>> kilobytes ] }
-        { "Total free:" [ kilobytes ] }
+        { "Total free:" [ total-free>> kilobytes ] }
-        { "Contiguous free:" [ kilobytes ] }
+        { "Contiguous free:" [ contiguous-free>> kilobytes ] }
-        { "Free list entries:" [ number>string ] }
+        { "Free block count:" [ free-block-count>> number>string ] }
     } fancy-table. ;
 
-: tenured-room. ( seq -- ) "- Tenured space" print mark-sweep-table. ;
+: tenured-room. ( data-room -- )
+    "- Tenured space" print tenured>> mark-sweep-table. ;
 
-: misc-room. ( seq -- )
+: misc-room. ( data-room -- )
     "- Miscellaneous buffers" print
     {
-        { "Card array:" [ kilobytes ] }
+        { "Card array:" [ cards>> kilobytes ] }
-        { "Deck array:" [ kilobytes ] }
+        { "Deck array:" [ decks>> kilobytes ] }
-        { "Mark stack:" [ kilobytes ] }
+        { "Mark stack:" [ mark-stack>> kilobytes ] }
     } fancy-table. ;
 
 : data-room. ( -- )
     "==== DATA HEAP" print nl
-    data-room
+    data-room data-heap-room memory>struct {
-    3 cut [ nursery-room. nl ] dip
+        [ nursery-room. nl ]
-    3 cut [ aging-room. nl ] dip
+        [ aging-room. nl ]
-    5 cut [ tenured-room. nl ] dip
+        [ tenured-room. nl ]
-    misc-room. ;
+        [ misc-room. ]
+    } cleave ;
 
 : code-room. ( -- )
     "==== CODE HEAP" print nl
-    code-room mark-sweep-table. ;
+    code-room mark-sweep-sizes memory>struct mark-sweep-table. ;
+
+PRIVATE>
+
+: room. ( -- ) data-room. nl code-room. ;
+
+<PRIVATE
 
 : heap-stat-step ( obj counts sizes -- )
     [ [ class ] dip inc-at ]
@@ -65,8 +77,6 @@ IN: tools.memory
 
 PRIVATE>
 
-: room. ( -- ) data-room. nl code-room. ;
-
 : heap-stats ( -- counts sizes )
     [ ] instances H{ } clone H{ } clone
     [ '[ _ _ heap-stat-step ] each ] 2keep ;
@@ -82,3 +92,7 @@ PRIVATE>
             ] with-row
         ] each 2drop
     ] tabular-output nl ;
+
+: collect-gc-events ( quot -- events )
+    enable-gc-events [ ] [ disable-gc-events drop ] cleanup
+    disable-gc-events byte-array>gc-event-array ;

basis/vm/vm.factor

@@ -3,7 +3,7 @@
 USING: classes.struct alien.c-types alien.syntax ;
 IN: vm
 
-TYPEDEF: void* cell
+TYPEDEF: intptr_t cell
 C-TYPE: context
 
 STRUCT: zone
@@ -20,3 +20,56 @@ STRUCT: vm
     { userenv cell[70] } ;
 
 : vm-field-offset ( field -- offset ) vm offset-of ; inline
+
+C-ENUM:
+collect-nursery-op
+collect-aging-op
+collect-to-tenured-op
+collect-full-op
+collect-compact-op
+collect-growing-heap-op ;
+
+STRUCT: gc-event
+{ op uint }
+{ nursery-size-before cell }
+{ aging-size-before cell }
+{ tenured-size-before cell }
+{ tenured-free-block-count-before cell }
+{ code-size-before cell }
+{ code-free-block-count-before cell }
+{ nursery-size-after cell }
+{ aging-size-after cell }
+{ tenured-size-after cell }
+{ tenured-free-block-count-after cell }
+{ code-size-after cell }
+{ code-free-block-count-after cell }
+{ cards-scanned cell }
+{ decks-scanned cell }
+{ code-blocks-scanned cell }
+{ start-time ulonglong }
+{ total-time cell }
+{ card-scan-time cell }
+{ code-scan-time cell }
+{ data-sweep-time cell }
+{ code-sweep-time cell }
+{ compaction-time cell } ;
+
+STRUCT: copying-sizes
+{ size cell }
+{ occupied cell }
+{ free cell } ;
+
+STRUCT: mark-sweep-sizes
+{ size cell }
+{ occupied cell }
+{ total-free cell }
+{ contiguous-free cell }
+{ free-block-count cell } ;
+
+STRUCT: data-heap-room
+{ nursery copying-sizes }
+{ aging copying-sizes }
+{ tenured mark-sweep-sizes }
+{ cards cell }
+{ decks cell }
+{ mark-stack cell } ;

core/bootstrap/primitives.factor

@@ -432,8 +432,8 @@ tuple
     { "set-retainstack" "kernel" (( rs -- )) }
     { "set-callstack" "kernel" (( cs -- )) }
     { "exit" "system" (( n -- )) }
-    { "data-room" "memory" (( -- cards decks generations )) }
+    { "data-room" "memory" (( -- data-room )) }
-    { "code-room" "memory" (( -- code-total code-used code-free largest-free-block )) }
+    { "code-room" "memory" (( -- code-room )) }
     { "micros" "system" (( -- us )) }
     { "modify-code-heap" "compiler.units" (( alist -- )) }
     { "(dlopen)" "alien.libraries" (( path -- dll )) }
@@ -524,6 +524,8 @@ tuple
     { "vm-ptr" "vm" (( -- ptr )) }
     { "strip-stack-traces" "kernel.private" (( -- )) }
     { "<callback>" "alien" (( word -- alien )) }
+    { "enable-gc-events" "memory" (( -- )) }
+    { "disable-gc-events" "memory" (( -- events )) }
 } [ [ first3 ] dip swap make-primitive ] each-index
 
 ! Bump build number

vm/byte_arrays.hpp

@@ -13,4 +13,17 @@ struct growable_byte_array {
 	void trim();
 };
 
+template<typename T> byte_array *factor_vm::byte_array_from_value(T *value)
+{
+	return byte_array_from_values(value,1);
+}
+
+template<typename T> byte_array *factor_vm::byte_array_from_values(T *values, cell len)
+{
+	cell size = sizeof(T) * len;
+	byte_array *data = allot_uninitialized_array<byte_array>(size);
+	memcpy(data->data<char>(),values,size);
+	return data;
+}
+
 }

vm/code_heap.cpp

@@ -196,19 +196,17 @@ void factor_vm::primitive_modify_code_heap()
 	update_code_heap_words();
 }
 
-/* Push the free space and total size of the code heap */
 void factor_vm::primitive_code_room()
 {
-	growable_array a(this);
+	code_heap_room room;
 
-	a.add(tag_fixnum(code->allocator->size));
+	room.size             = code->allocator->size;
-	a.add(tag_fixnum(code->allocator->occupied_space()));
+	room.occupied_space   = code->allocator->occupied_space();
-	a.add(tag_fixnum(code->allocator->free_space()));
+	room.total_free       = code->allocator->free_space();
-	a.add(tag_fixnum(code->allocator->free_blocks.largest_free_block()));
+	room.contiguous_free  = code->allocator->free_blocks.largest_free_block();
-	a.add(tag_fixnum(code->allocator->free_blocks.free_block_count));
+	room.free_block_count = code->allocator->free_blocks.free_block_count;
 
-	a.trim();
+	dpush(tag<byte_array>(byte_array_from_value(&room)));
-	dpush(a.elements.value());
 }
 
 struct stack_trace_stripper {

vm/code_heap.hpp

@@ -28,4 +28,12 @@ struct code_heap {
 	void code_heap_free(code_block *compiled);
 };
 
+struct code_heap_room {
+	cell size;
+	cell occupied_space;
+	cell total_free;
+	cell contiguous_free;
+	cell free_block_count;
+};
+
 }

vm/data_heap.cpp

@@ -201,31 +201,26 @@ void factor_vm::primitive_size()
 	box_unsigned_cell(object_size(dpop()));
 }
 
-/* Push memory usage statistics in data heap */
 void factor_vm::primitive_data_room()
 {
-	growable_array a(this);
+	data_heap_room room;
 
-	a.add(tag_fixnum(nursery.size));
+	room.nursery_size             = nursery.size;
-	a.add(tag_fixnum(nursery.occupied_space()));
+	room.nursery_occupied         = nursery.occupied_space();
-	a.add(tag_fixnum(nursery.free_space()));
+	room.nursery_free             = nursery.free_space();
+	room.aging_size               = data->aging->size;
+	room.aging_occupied           = data->aging->occupied_space();
+	room.aging_free               = data->aging->free_space();
+	room.tenured_size             = data->tenured->size;
+	room.tenured_occupied         = data->tenured->occupied_space();
+	room.tenured_total_free       = data->tenured->free_space();
+	room.tenured_contiguous_free  = data->tenured->free_blocks.largest_free_block();
+	room.tenured_free_block_count = data->tenured->free_blocks.free_block_count;
+	room.cards                    = data->cards_end - data->cards;
+	room.decks                    = data->decks_end - data->decks;
+	room.mark_stack               = data->tenured->mark_stack.capacity();
 
-	a.add(tag_fixnum(data->aging->size));
+	dpush(tag<byte_array>(byte_array_from_value(&room)));
-	a.add(tag_fixnum(data->aging->occupied_space()));
-	a.add(tag_fixnum(data->aging->free_space()));
-
-	a.add(tag_fixnum(data->tenured->size));
-	a.add(tag_fixnum(data->tenured->occupied_space()));
-	a.add(tag_fixnum(data->tenured->free_space()));
-	a.add(tag_fixnum(data->tenured->free_blocks.largest_free_block()));
-	a.add(tag_fixnum(data->tenured->free_blocks.free_block_count));
-
-	a.add(tag_fixnum(data->cards_end - data->cards));
-	a.add(tag_fixnum(data->decks_end - data->decks));
-	a.add(tag_fixnum(data->tenured->mark_stack.capacity()));
-
-	a.trim();
-	dpush(a.elements.value());
 }
 
 /* Disables GC and activates next-object ( -- obj ) primitive */

vm/data_heap.hpp

@@ -31,4 +31,21 @@ struct data_heap {
 	void reset_generation(tenured_space *gen);
 };
 
+struct data_heap_room {
+	cell nursery_size;
+	cell nursery_occupied;
+	cell nursery_free;
+	cell aging_size;
+	cell aging_occupied;
+	cell aging_free;
+	cell tenured_size;
+	cell tenured_occupied;
+	cell tenured_total_free;
+	cell tenured_contiguous_free;
+	cell tenured_free_block_count;
+	cell cards;
+	cell decks;
+	cell mark_stack;
+};
+
 }

vm/gc.cpp

@@ -128,13 +128,40 @@ gc_state::~gc_state()
 	event = NULL;
 }
 
-void gc_state::start_again(gc_op op_, factor_vm *parent)
+void factor_vm::end_gc()
 {
-	event->ended_gc(parent);
+	current_gc->event->ended_gc(this);
-	if(parent->verbose_gc) std::cout << event << std::endl;
+	if(verbose_gc) std::cout << current_gc->event << std::endl;
-	delete event;
+	if(gc_events) gc_events->push_back(*current_gc->event);
-	event = new gc_event(op_,parent);
+	delete current_gc->event;
-	op = op_;
+	current_gc->event = NULL;
+}
+
+void factor_vm::start_gc_again()
+{
+	end_gc();
+
+	switch(current_gc->op)
+	{
+	case collect_nursery_op:
+		current_gc->op = collect_aging_op;
+		break;
+	case collect_aging_op:
+		current_gc->op = collect_to_tenured_op;
+		break;
+	case collect_to_tenured_op:
+		current_gc->op = collect_full_op;
+		break;
+	case collect_full_op:
+	case collect_compact_op:
+		current_gc->op = collect_growing_heap_op;
+		break;
+	default:
+		critical_error("Bad GC op",current_gc->op);
+		break;
+	}
+
+	current_gc->event = new gc_event(current_gc->op,this);
 }
 
 void factor_vm::update_code_heap_for_minor_gc(std::set<code_block *> *remembered_set)
@@ -160,25 +187,7 @@ void factor_vm::gc(gc_op op, cell requested_bytes, bool trace_contexts_p)
 	if(setjmp(current_gc->gc_unwind))
 	{
 		/* We come back here if a generation is full */
-		switch(current_gc->op)
+		start_gc_again();
-		{
-		case collect_nursery_op:
-			current_gc->start_again(collect_aging_op,this);
-			break;
-		case collect_aging_op:
-			current_gc->start_again(collect_to_tenured_op,this);
-			break;
-		case collect_to_tenured_op:
-			current_gc->start_again(collect_full_op,this);
-			break;
-		case collect_full_op:
-		case collect_compact_op:
-			current_gc->start_again(collect_growing_heap_op,this);
-			break;
-		default:
-			critical_error("Bad GC op",current_gc->op);
-			break;
-		}
 	}
 
 	switch(current_gc->op)
@@ -209,9 +218,7 @@ void factor_vm::gc(gc_op op, cell requested_bytes, bool trace_contexts_p)
 		break;
 	}
 
-	current_gc->event->ended_gc(this);
+	end_gc();
-
-	if(verbose_gc) std::cout << current_gc->event << std::endl;
 
 	delete current_gc;
 	current_gc = NULL;
@@ -338,4 +345,23 @@ object *factor_vm::allot_object(header header, cell size)
 	return obj;
 }
 
+void factor_vm::primitive_enable_gc_events()
+{
+	gc_events = new std::vector<gc_event>();
+}
+
+void factor_vm::primitive_disable_gc_events()
+{
+	if(gc_events)
+	{
+		byte_array *data = byte_array_from_values(&gc_events->front(),gc_events->size());
+		dpush(tag<byte_array>(data));
+
+		delete gc_events;
+		gc_events = NULL;
+	}
+	else
+		dpush(false_object);
+}
+
 }

vm/primitives.cpp

@@ -128,6 +128,8 @@ PRIMITIVE_FORWARD(quot_compiled_p)
 PRIMITIVE_FORWARD(vm_ptr)
 PRIMITIVE_FORWARD(strip_stack_traces)
 PRIMITIVE_FORWARD(callback)
+PRIMITIVE_FORWARD(enable_gc_events)
+PRIMITIVE_FORWARD(disable_gc_events)
 
 const primitive_type primitives[] = {
 	primitive_bignum_to_fixnum,
@@ -292,6 +294,8 @@ const primitive_type primitives[] = {
 	primitive_vm_ptr,
 	primitive_strip_stack_traces,
 	primitive_callback,
+	primitive_enable_gc_events,
+	primitive_disable_gc_events,
 };
 
 }

vm/vm.cpp

@@ -8,6 +8,7 @@ factor_vm::factor_vm() :
 	profiling_p(false),
 	gc_off(false),
 	current_gc(NULL),
+	gc_events(NULL),
 	fep_disabled(false),
 	full_output(false)
 	{ }

vm/vm.hpp

@@ -61,6 +61,9 @@ struct factor_vm
 	/* Only set if we're performing a GC */
 	gc_state *current_gc;
 
+	/* If not NULL, we push GC events here */
+	std::vector<gc_event> *gc_events;
+
 	/* If a runtime function needs to call another function which potentially
 	   allocates memory, it must wrap any local variable references to Factor
 	   objects in gc_root instances */
@@ -240,6 +243,8 @@ struct factor_vm
 	}
 
 	// gc
+	void end_gc();
+	void start_gc_again();
 	void update_code_heap_for_minor_gc(std::set<code_block *> *remembered_set);
 	void collect_nursery();
 	void collect_aging();
@@ -255,6 +260,8 @@ struct factor_vm
 	void primitive_become();
 	void inline_gc(cell *gc_roots_base, cell gc_roots_size);
 	object *allot_object(header header, cell size);
+	void primitive_enable_gc_events();
+	void primitive_disable_gc_events();
 
 	template<typename Type> Type *allot(cell size)
 	{
@@ -336,6 +343,9 @@ struct factor_vm
 	void primitive_uninitialized_byte_array();
 	void primitive_resize_byte_array();
 
+	template<typename T> byte_array *byte_array_from_value(T *value);
+	template<typename T> byte_array *byte_array_from_values(T *values, cell len);
+
 	//tuples
 	tuple *allot_tuple(cell layout_);
 	void primitive_tuple();