VM: new primitive (callback-room) for querying the VM about memory usage

The word works exactly like (code-room) except it looks at the memory
usage in the callback heap instead of the code heap.

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

@@ -359,6 +359,7 @@ M: object infer-call* \ call bad-macro-input ;
 \ context-object { fixnum } { object } define-primitive \ context-object make-flushable
 \ context-object-for { fixnum c-ptr } { object } define-primitive \ context-object-for make-flushable
 \ current-callback { } { fixnum } define-primitive \ current-callback make-flushable
+\ (callback-room) { } { byte-array } define-primitive \ (callback-room) make-flushable
 \ (data-room) { } { byte-array } define-primitive \ (data-room) make-flushable
 \ datastack { } { array } define-primitive \ datastack make-flushable
 \ datastack-for { c-ptr } { array } define-primitive \ datastack-for make-flushable

basis/tools/memory/memory-docs.factor

@@ -51,8 +51,12 @@ HELP: gc-events
 
 HELP: data-room
 { $values { "data-heap-room" data-heap-room } }
-{ $description "Queries the VM for memory usage information." } ;
+{ $description "Queries the VM for memory usage in the data heap." } ;
 
 HELP: code-room
 { $values { "mark-sweep-sizes" mark-sweep-sizes } }
-{ $description "Queries the VM for memory usage information." } ;
+{ $description "Queries the VM for memory usage in the code heap." } ;
+
+HELP: callback-room
+{ $values { "mark-sweep-sizes" mark-sweep-sizes } }
+{ $description "Queries the VM for memory usage in the callback heap." } ;

basis/tools/memory/memory-tests.factor

@@ -7,3 +7,4 @@ IN: tools.memory.tests
 [ ] [ gc-events. ] unit-test
 [ ] [ gc-stats. ] unit-test
 [ ] [ gc-summary. ] unit-test
+[ ] [ callback-room. ] unit-test

basis/tools/memory/memory.factor

@@ -291,10 +291,17 @@ PRIVATE>
 : code-room ( -- mark-sweep-sizes )
     (code-room) mark-sweep-sizes memory>struct ;
 
+: callback-room ( -- mark-sweep-sizes )
+    (callback-room) mark-sweep-sizes memory>struct ;
+
 : code-room. ( -- )
     "== Code heap ==" print nl
     code-room mark-sweep-table. nl
     get-code-blocks code-block-stats code-block-table. ;
 
+: callback-room. ( -- )
+    "== Callback heap ==" print nl
+    callback-room mark-sweep-table. ;
+
 : room. ( -- )
-    data-room. nl code-room. ;
+    data-room. nl code-room. nl callback-room. ;

core/bootstrap/primitives.factor

@@ -525,8 +525,9 @@ tuple
     { "float>fixnum" "math.private" "primitive_float_to_fixnum" ( x -- y ) }
     { "all-instances" "memory" "primitive_all_instances" ( -- array ) }
     { "(code-blocks)" "tools.memory.private" "primitive_code_blocks" ( -- array ) }
-    { "(code-room)" "tools.memory.private" "primitive_code_room" ( -- code-room ) }
+    { "(code-room)" "tools.memory.private" "primitive_code_room" ( -- allocator-room ) }
     { "compact-gc" "memory" "primitive_compact_gc" ( -- ) }
+    { "(callback-room)" "tools.memory.private" "primitive_callback_room" ( -- allocator-room ) }
     { "(data-room)" "tools.memory.private" "primitive_data_room" ( -- data-room ) }
     { "disable-gc-events" "tools.memory.private" "primitive_disable_gc_events" ( -- events ) }
     { "enable-gc-events" "tools.memory.private" "primitive_enable_gc_events" ( -- ) }

core/kernel/kernel.factor

@@ -352,8 +352,6 @@ CONSTANT: OBJ-WAITING-CALLBACKS 73
 
 CONSTANT: OBJ-SIGNAL-PIPE 74
 
-CONSTANT: OBJ-INSTALL-PREFIX 75
-
 ! Context object count and identifiers must be kept in sync with:
 !   vm/contexts.hpp
 

extra/tools/time/struct/struct.factor

@@ -7,7 +7,8 @@ IN: tools.time.struct
 STRUCT: benchmark-data
     { time ulonglong }
     { data-room data-heap-room }
-    { code-room mark-sweep-sizes } ;
+    { code-room mark-sweep-sizes }
+    { callback-room mark-sweep-sizes } ;
 
 STRUCT: benchmark-data-pair
     { start benchmark-data }
@@ -16,8 +17,9 @@ STRUCT: benchmark-data-pair
 : <benchmark-data> ( -- benchmark-data )
     \ benchmark-data <struct>
         nano-count >>time
+        data-room >>data-room
         code-room >>code-room
-        data-room >>data-room ; inline
+        callback-room >>callback-room ; inline
 
 : <benchmark-data-pair> ( start stop -- benchmark-data-pair )
     \ benchmark-data-pair <struct>
@@ -28,4 +30,3 @@ STRUCT: benchmark-data-pair
     <benchmark-data>
     [ call ] dip
     <benchmark-data> <benchmark-data-pair> ; inline
-

vm/callbacks.cpp

@@ -65,7 +65,6 @@ void callback_heap::update(code_block* stub) {
 }
 
 code_block* callback_heap::add(cell owner, cell return_rewind) {
-  std::cout << "callback_heap::add" << std::endl;
   tagged<array> code_template(parent->special_objects[CALLBACK_STUB]);
   tagged<byte_array> insns(array_nth(code_template.untagged(), 1));
   cell size = array_capacity(insns.untagged());
@@ -137,4 +136,10 @@ void factor_vm::primitive_callback() {
   ctx->push(allot_alien(func));
 }
 
+/* Allocates memory */
+void factor_vm::primitive_callback_room() {
+  allocator_room room = callbacks->allocator->as_allocator_room();
+  ctx->push(tag<byte_array>(byte_array_from_value(&room)));
+}
+
 }

vm/code_heap.cpp

@@ -215,21 +215,9 @@ void factor_vm::primitive_modify_code_heap() {
     initialize_code_blocks();
 }
 
-code_heap_room factor_vm::code_room() {
-  code_heap_room room;
-
-  room.size = code->allocator->size;
-  room.occupied_space = code->allocator->occupied_space();
-  room.total_free = code->allocator->free_space();
-  room.contiguous_free = code->allocator->largest_free_block();
-  room.free_block_count = code->allocator->free_block_count();
-
-  return room;
-}
-
 /* Allocates memory */
 void factor_vm::primitive_code_room() {
-  code_heap_room room = code_room();
+  allocator_room room = code->allocator->as_allocator_room();
   ctx->push(tag<byte_array>(byte_array_from_value(&room)));
 }
 

vm/code_heap.hpp

@@ -57,12 +57,4 @@ struct code_heap {
   }
 };
 
-struct code_heap_room {
-  cell size;
-  cell occupied_space;
-  cell total_free;
-  cell contiguous_free;
-  cell free_block_count;
-};
-
 }

vm/free_list_allocator.hpp

@@ -1,5 +1,13 @@
 namespace factor {
 
+struct allocator_room {
+  cell size;
+  cell occupied_space;
+  cell total_free;
+  cell contiguous_free;
+  cell free_block_count;
+};
+
 template <typename Block> struct free_list_allocator {
   cell size;
   cell start;
@@ -28,6 +36,7 @@ template <typename Block> struct free_list_allocator {
   template <typename Iterator, typename Fixup>
   void iterate(Iterator& iter, Fixup fixup);
   template <typename Iterator> void iterate(Iterator& iter);
+  allocator_room as_allocator_room();
 };
 
 template <typename Block>
@@ -208,4 +217,16 @@ void free_list_allocator<Block>::iterate(Iterator& iter) {
   iterate(iter, no_fixup());
 }
 
+template <typename Block>
+allocator_room free_list_allocator<Block>::as_allocator_room() {
+  allocator_room room;
+
+  room.size = size;
+  room.occupied_space = occupied_space();
+  room.total_free = free_space();
+  room.contiguous_free = largest_free_block();
+  room.free_block_count = free_block_count();
+  return room;
+}
+
 }

vm/gc.cpp

@@ -14,7 +14,7 @@ gc_event::gc_event(gc_op op, factor_vm* parent)
       code_sweep_time(0),
       compaction_time(0) {
   data_heap_before = parent->data_room();
-  code_heap_before = parent->code_room();
+  code_heap_before = parent->code->allocator->as_allocator_room();
   start_time = nano_count();
 }
 
@@ -53,7 +53,7 @@ void gc_event::ended_compaction() {
 
 void gc_event::ended_gc(factor_vm* parent) {
   data_heap_after = parent->data_room();
-  code_heap_after = parent->code_room();
+  code_heap_after = parent->code->allocator->as_allocator_room();
   total_time = (cell)(nano_count() - start_time);
 }
 

vm/gc.hpp

@@ -12,9 +12,9 @@ enum gc_op {
 struct gc_event {
   gc_op op;
   data_heap_room data_heap_before;
-  code_heap_room code_heap_before;
+  allocator_room code_heap_before;
   data_heap_room data_heap_after;
-  code_heap_room code_heap_after;
+  allocator_room code_heap_after;
   cell cards_scanned;
   cell decks_scanned;
   cell code_blocks_scanned;

vm/primitives.hpp

@@ -10,8 +10,8 @@ namespace factor {
       _(bignum_gcd) _(bignum_multiply) _(bignum_not) _(bignum_or)              \
       _(bignum_shift) _(bignum_subtract) _(bignum_to_fixnum)                   \
       _(bignum_to_fixnum_strict) _(bignum_xor)                                 \
-      _(bits_double) _(bits_float) _(byte_array) _(callback) _(callstack)      \
-      _(callstack_bounds) _(callstack_for) _(callstack_to_array)               \
+      _(bits_double) _(bits_float) _(byte_array) _(callback) _(callback_room)  \
+      _(callstack) _(callstack_bounds) _(callstack_for) _(callstack_to_array)  \
       _(check_datastack) _(clear_samples) _(clone) _(code_blocks) _(code_room) \
       _(compact_gc) _(compute_identity_hashcode) _(context_object)             \
       _(context_object_for) _(current_callback) _(data_room) _(datastack)      \

vm/vm.hpp

@@ -605,7 +605,6 @@ struct factor_vm {
   void update_code_heap_words(bool reset_inline_caches);
   void initialize_code_blocks();
   void primitive_modify_code_heap();
-  code_heap_room code_room();
   void primitive_code_room();
   void primitive_strip_stack_traces();
   cell code_blocks();
@@ -614,6 +613,7 @@ struct factor_vm {
   // callbacks
   void init_callbacks(cell size);
   void primitive_callback();
+  void primitive_callback_room();
 
   // image
   void init_objects(image_header* h);