Fix room.

TODO.FACTOR.txt

@@ -3,9 +3,8 @@
 - signal 4 on datastack underflow on mac intel??
 - test alien-indirect
 - code GC:
-  - get code heap load/save working
-  - get room. working
-  - compact the heap on save
+  - discard the free block at the end of the code heap on save
+  - minor GC takes too long now
 
 + ui:
 

library/bootstrap/primitives.factor

@@ -133,7 +133,8 @@ call
     { "set-retainstack" "kernel"            }
     { "set-callstack" "kernel"              }
     { "exit" "kernel"                       }
-    { "room" "memory"                       }
+    { "data-room" "memory"                  }
+    { "code-room" "memory"                  }
     { "os-env" "kernel"                     }
     { "millis" "kernel"                     }
     { "type" "kernel"                       }

library/compiler/inference/known-words.factor

@@ -239,7 +239,8 @@ t over set-effect-terminated?
 \ gc-time { } { integer } <effect> "infer-effect" set-word-prop
 \ save-image { string } { } <effect> "infer-effect" set-word-prop
 \ exit { integer } { } <effect> "infer-effect" set-word-prop
-\ room { } { integer integer integer integer array } <effect> "infer-effect" set-word-prop
+\ data-room { } { integer integer array } <effect> "infer-effect" set-word-prop
+\ code-room { } { integer integer } <effect> "infer-effect" set-word-prop
 \ os-env { string } { object } <effect> "infer-effect" set-word-prop
 \ millis { } { integer } <effect> "infer-effect" set-word-prop
 

library/tools/memory.factor

@@ -26,15 +26,15 @@ strings styles vectors words ;
     tabular-output ;
 
 : room. ( -- )
-    room [
+    [
         { "" "Total" "Used" "Free" } ,
-        0 [
+        data-room 0 [
             "Generation " pick number>string append
             >r first2 r> total/used/free, 1+
         ] reduce drop
         "Semi-space" total,
         "Cards" total,
-        "Code space" total/used/free,
+        code-room "Code space" total/used/free,
     ] { } make simple-table ;
 
 ! Some words for iterating through the heap.

library/tools/memory.facts

@@ -10,9 +10,15 @@ HELP: gc-time ( -- n )
 { $description "Outputs the total time spent in garbage collection during this Factor session." }
 { $examples "This word is used by " { $link time } " to measure the time spent in garbage collection during the execution of a quotation." } ;
 
-HELP: room ( -- code-free code-total cards semi generations )
-{ $values { "code-free" "bytes free in the code heap" } { "code-total" "total bytes in the code heap" } { "cards" "number of bytes reserved for card marking" } { "semi" "number of bytes reserved for tenured semi-space" } { "generations" "array of free/total bytes pairs" } }
-{ $description "Queries the runtime for memory usage information. To see this in a human-readable form, call " { $link room. } " instead." } ;
+HELP: data-room ( -- cards semi generations )
+{ $values { "cards" "number of bytes reserved for card marking" } { "semi" "number of bytes reserved for tenured semi-space" } { "generations" "array of free/total bytes pairs" } }
+{ $description "Queries the runtime for memory usage information. Use " { $link room. } " for a pretty memory usage display." }
+{ $see-also code-room } ;
+
+HELP: code-room ( -- code-free code-total )
+{ $values { "code-free" "bytes free in the code heap" } { "code-total" "total bytes in the code heap" } }
+{ $description "Queries the runtime for memory usage information. Use " { $link room. } " for a pretty memory usage display." }
+{ $see-also data-room } ;
 
 HELP: size ( obj -- n )
 { $values { "obj" "an object" } { "n" "a size in bytes" } }

vm/compiler.c

@@ -290,3 +290,9 @@ void primitive_finalize_compile(void)
 	iterate_code_heap(finalize_code_block);
 	flush_icache(compiling.base,compiling.limit - compiling.base);
 }
+
+void primitive_code_room(void)
+{
+	box_unsigned_cell(heap_free_space(&compiling));
+	box_unsigned_cell(compiling.limit - compiling.base);
+}

vm/compiler.h

@@ -58,14 +58,10 @@ typedef struct {
 
 void relocate_code_block(F_COMPILED *relocating, CELL code_start,
 	CELL reloc_start, CELL literal_start, CELL words_start);
-
 void finalize_code_block(F_COMPILED *relocating, CELL code_start,
 	CELL reloc_start, CELL literal_start, CELL words_start);
-
 void collect_literals(void);
-
 void init_compiler(CELL size);
-
 void primitive_add_compiled_block(void);
-
 void primitive_finalize_compile(void);
+void primitive_code_room(void);

vm/heap.c

@@ -132,3 +132,18 @@ void free_unmarked(HEAP *heap)
 	if(prev)
 		prev->next_free = NULL;
 }
+
+CELL heap_free_space(HEAP *heap)
+{
+	CELL size = 0;
+	F_BLOCK *scan = (F_BLOCK *)heap->base;
+
+	while(scan)
+	{
+		if(scan->status == B_FREE)
+			size += scan->size;
+		scan = next_block(heap,scan);
+	}
+
+	return size;
+}

vm/heap.h

@@ -22,6 +22,7 @@ void new_heap(HEAP *heap, CELL size);
 void build_free_list(HEAP *heap, CELL size);
 CELL heap_allot(HEAP *heap, CELL size);
 void free_unmarked(HEAP *heap);
+CELL heap_free_space(HEAP *heap);
 
 INLINE F_BLOCK *next_block(HEAP *heap, F_BLOCK *block)
 {

vm/memory.c

@@ -159,12 +159,10 @@ void primitive_clone(void)
 	drepl(clone(dpeek()));
 }
 
-void primitive_room(void)
+void primitive_data_room(void)
 {
 	F_ARRAY *a = array(ARRAY_TYPE,gen_count,F);
 	int gen;
-	box_unsigned_cell(0);
-	box_unsigned_cell(compiling.limit - compiling.base);
 	box_unsigned_cell(cards_end - cards);
 	box_unsigned_cell(prior.limit - prior.base);
 	for(gen = 0; gen < gen_count; gen++)

vm/memory.h

@@ -87,7 +87,7 @@ CELL untagged_object_size(CELL pointer);
 CELL unaligned_object_size(CELL pointer);
 CELL object_size(CELL pointer);
 CELL binary_payload_start(CELL pointer);
-void primitive_room(void);
+void primitive_data_room(void);
 void primitive_type(void);
 void primitive_tag(void);
 void primitive_slot(void);

vm/primitives.c

@@ -102,7 +102,8 @@ void* primitives[] = {
 	primitive_set_retainstack,
 	primitive_set_callstack,
 	primitive_exit,
-	primitive_room,
+	primitive_data_room,
+	primitive_code_room,
 	primitive_os_env,
 	primitive_millis,
 	primitive_type,