vm: put code block owner directly in the header, instead of as the first entry in the literal table. Reduces x86-64 image size by ~700kb, also eliminates separate 'strip' set of staging images from deploy tool

basis/command-line/command-line-docs.factor

@@ -47,7 +47,6 @@ ARTICLE: "runtime-cli-args" "Command line switches for the VM"
     { { $snippet "-i=" { $emphasis "image" } } { "Specifies the image file to use; see " { $link "images" } } }
     { { $snippet "-datastack=" { $emphasis "n" } } "Data stack size, kilobytes" }
     { { $snippet "-retainstack=" { $emphasis "n" } } "Retain stack size, kilobytes" }
-    { { $snippet "-generations=" { $emphasis "n" } } "Number of generations, must equal 1, 2 or 3" }
     { { $snippet "-young=" { $emphasis "n" } } { "Size of youngest generation (0), megabytes" } }
     { { $snippet "-aging=" { $emphasis "n" } } "Size of aging generation (1), megabytes" }
     { { $snippet "-tenured=" { $emphasis "n" } } "Size of oldest generation (2), megabytes" }

basis/compiler/codegen/codegen.factor

@@ -32,30 +32,21 @@ SYMBOL: calls
     #! Compile this word later.
     calls get push ;
 
-SYMBOL: compiling-word
-
-: compiled-stack-traces? ( -- ? ) 67 getenv ;
-
 ! Mapping _label IDs to label instances
 SYMBOL: labels
 
-: init-generator ( word -- )
+: init-generator ( -- )
     H{ } clone labels set
-    V{ } clone calls set
-    compiling-word set
-    compiled-stack-traces? [ compiling-word get add-literal ] when ;
+    V{ } clone calls set ;
 
 : generate-insns ( asm -- code )
-    [
-        [ word>> init-generator ]
-        [
-            instructions>>
-            [
-                [ class insn-counts get inc-at ]
-                [ generate-insn ]
-                bi
-            ] each
-        ] bi
+    dup word>> [
+        init-generator
+        instructions>> [
+            [ class insn-counts get inc-at ]
+            [ generate-insn ]
+            bi
+        ] each
     ] with-fixup ;
 
 : generate ( mr -- asm )

basis/compiler/codegen/fixup/fixup.factor

@@ -4,9 +4,12 @@ USING: arrays byte-arrays byte-vectors generic assocs hashtables
 io.binary kernel kernel.private math namespaces make sequences
 words quotations strings alien.accessors alien.strings layouts
 system combinators math.bitwise math.order
-accessors growable compiler.constants ;
+accessors growable fry generalizations compiler.constants ;
 IN: compiler.codegen.fixup
 
+! Owner
+SYMBOL: compiling-word
+
 ! Literal table
 SYMBOL: literal-table
 
@@ -91,17 +94,19 @@ SYMBOL: relocation-table
     [ [ resolve-relative-label ] map concat ]
     bi* ;
 
-: init-fixup ( -- )
+: init-fixup ( word -- )
+    compiling-word set
     V{ } clone literal-table set
     V{ } clone label-table set
     BV{ } clone relocation-table set ;
 
-: with-fixup ( quot -- code )
-    [
+: with-fixup ( word quot -- code )
+    '[
         init-fixup
-        call
+        @
         label-table [ resolve-labels ] change
+        compiling-word get
         literal-table get >array
         relocation-table get >byte-array
         label-table get
-    ] B{ } make 4array ; inline
+    ] B{ } make 5 narray ; inline

basis/tools/deploy/backend/backend.factor

@@ -53,9 +53,7 @@ CONSTANT: theme-path "basis/ui/gadgets/theme/"
     ] { } make ;
 
 : staging-image-name ( profile -- name )
-    "staging."
-    swap strip-word-names? [ "strip" suffix ] when
-    "-" join ".image" 3append temp-file ;
+    "-" join "staging." ".image" surround temp-file ;
 
 DEFER: ?make-staging-image
 
@@ -72,7 +70,6 @@ DEFER: ?make-staging-image
         ] if
         "-output-image=" over staging-image-name append ,
         "-include=" swap " " join append ,
-        strip-word-names? [ "-no-stack-traces" , ] when
         "-no-user-init" ,
     ] { } make ;
 
@@ -102,7 +99,6 @@ DEFER: ?make-staging-image
             [ "-deploy-vocab=" prepend , ]
             [ make-deploy-config "-deploy-config=" prepend , ] bi
             "-output-image=" prepend ,
-            strip-word-names? [ "-no-stack-traces" , ] when
         ] { } make
     ] bind ;
 

basis/tools/deploy/deploy-tests.factor

@@ -11,7 +11,7 @@ IN: tools.deploy.tests
 
 [ t ] [ "hello-ui" shake-and-bake 1300000 small-enough? ] unit-test
 
-[ "staging.math-threads-compiler-ui-strip.image" ] [
+[ "staging.math-threads-compiler-ui.image" ] [
     "hello-ui" deploy-config
     [ bootstrap-profile staging-image-name file-name ] bind
 ] unit-test

basis/tools/deploy/shaker/shaker.factor

@@ -208,7 +208,7 @@ IN: tools.deploy.shaker
     [ word? ] instances
     deploy-word-props? get [ 2dup strip-word-props ] unless
     deploy-word-defs? get [ dup strip-word-defs ] unless
-    strip-word-names? [ dup strip-word-names ] when
+    strip-word-names? [ dup strip-word-names strip-stack-traces ] when
     2drop ;
 
 : compiler-classes ( -- seq )

core/bootstrap/primitives.factor

@@ -522,6 +522,7 @@ tuple
     { "optimized?" "words" (( word -- ? )) }
     { "quot-compiled?" "quotations" (( quot -- ? )) }
     { "vm-ptr" "vm" (( -- ptr )) }
+    { "strip-stack-traces" "kernel.private" (( -- )) }
 } [ [ first3 ] dip swap make-primitive ] each-index
 
 ! Bump build number

vm/callstack.cpp

@@ -86,16 +86,7 @@ cell factor_vm::frame_type(stack_frame *frame)
 
 cell factor_vm::frame_executing(stack_frame *frame)
 {
-	code_block *compiled = frame_code(frame);
-	if(compiled->literals == F || !stack_traces_p())
-		return F;
-	else
-	{
-		array *literals = untag<array>(compiled->literals);
-		cell executing = array_nth(literals,0);
-		check_data_pointer((object *)executing);
-		return executing;
-	}
+	return frame_code(frame)->owner;
 }
 
 stack_frame *factor_vm::frame_successor(stack_frame *frame)

vm/code_block.cpp

@@ -194,9 +194,9 @@ template<typename Iterator> void factor_vm::iterate_relocations(code_block *comp
 	{
 		byte_array *relocation = untag<byte_array>(compiled->relocation);
 
-		cell index = stack_traces_p() ? 1 : 0;
-
+		cell index = 0;
 		cell length = array_capacity(relocation) / sizeof(relocation_entry);
+
 		for(cell i = 0; i < length; i++)
 		{
 			relocation_entry rel = relocation->data<relocation_entry>()[i];
@@ -425,16 +425,19 @@ code_block *factor_vm::allot_code_block(cell size, cell type)
 }
 
 /* Might GC */
-code_block *factor_vm::add_code_block(cell type, cell code_, cell labels_, cell relocation_, cell literals_)
+code_block *factor_vm::add_code_block(cell type, cell code_, cell labels_, cell owner_, cell relocation_, cell literals_)
 {
 	gc_root<byte_array> code(code_,this);
 	gc_root<object> labels(labels_,this);
+	gc_root<object> owner(owner_,this);
 	gc_root<byte_array> relocation(relocation_,this);
 	gc_root<array> literals(literals_,this);
 
 	cell code_length = align8(array_capacity(code.untagged()));
 	code_block *compiled = allot_code_block(code_length,type);
 
+	compiled->owner = owner.value();
+
 	/* slight space optimization */
 	if(relocation.type() == BYTE_ARRAY_TYPE && array_capacity(relocation.untagged()) == 0)
 		compiled->relocation = F;

vm/code_heap.cpp

@@ -91,15 +91,17 @@ void factor_vm::primitive_modify_code_heap()
 		case ARRAY_TYPE:
 			{
 				array *compiled_data = data.as<array>().untagged();
-				cell literals = array_nth(compiled_data,0);
-				cell relocation = array_nth(compiled_data,1);
-				cell labels = array_nth(compiled_data,2);
-				cell code = array_nth(compiled_data,3);
+				cell owner = array_nth(compiled_data,0);
+				cell literals = array_nth(compiled_data,1);
+				cell relocation = array_nth(compiled_data,2);
+				cell labels = array_nth(compiled_data,3);
+				cell code = array_nth(compiled_data,4);
 
 				code_block *compiled = add_code_block(
 					WORD_TYPE,
 					code,
 					labels,
+					owner,
 					relocation,
 					literals);
 
@@ -245,4 +247,19 @@ void factor_vm::compact_code_heap()
 	code->build_free_list(size);
 }
 
+struct stack_trace_stripper {
+	explicit stack_trace_stripper() {}
+
+	void operator()(code_block *compiled)
+	{
+		compiled->owner = F;
+	}
+};
+
+void factor_vm::primitive_strip_stack_traces()
+{
+	stack_trace_stripper stripper;
+	iterate_code_heap(stripper);
+}
+
 }

vm/data_gc.cpp

@@ -287,6 +287,7 @@ template<typename Strategy> void factor_vm::trace_contexts(Strategy &strategy)
 /* Trace all literals referenced from a code block. Only for aging and nursery collections */
 template<typename Strategy> void factor_vm::trace_literal_references(code_block *compiled, Strategy &strategy)
 {
+	trace_handle(&compiled->owner,strategy);
 	trace_handle(&compiled->literals,strategy);
 	trace_handle(&compiled->relocation,strategy);
 }

vm/factor.cpp

@@ -49,8 +49,6 @@ void factor_vm::default_parameters(vm_parameters *p)
 		p->console = false;
 	
 #endif
-
-	p->stack_traces = true;
 }
 
 bool factor_vm::factor_arg(const vm_char* str, const vm_char* arg, cell* value)
@@ -85,7 +83,6 @@ void factor_vm::init_parameters_from_args(vm_parameters *p, int argc, vm_char **
 		else if(STRCMP(argv[i],STRING_LITERAL("-fep")) == 0) p->fep = true;
 		else if(STRNCMP(argv[i],STRING_LITERAL("-i="),3) == 0) p->image_path = argv[i] + 3;
 		else if(STRCMP(argv[i],STRING_LITERAL("-console")) == 0) p->console = true;
-		else if(STRCMP(argv[i],STRING_LITERAL("-no-stack-traces")) == 0) p->stack_traces = false;
 	}
 }
 
@@ -152,10 +149,7 @@ void factor_vm::init_factor(vm_parameters *p)
 	gc_off = false;
 
 	if(userenv[STAGE2_ENV] == F)
-	{
-		userenv[STACK_TRACES_ENV] = tag_boolean(p->stack_traces);
 		do_stage1_init();
-	}
 }
 
 /* May allocate memory */

vm/image.cpp

@@ -295,8 +295,9 @@ void factor_vm::relocate_data()
 void factor_vm::fixup_code_block(code_block *compiled)
 {
 	/* relocate literal table data */
-	data_fixup(&compiled->relocation);
+	data_fixup(&compiled->owner);
 	data_fixup(&compiled->literals);
+	data_fixup(&compiled->relocation);
 
 	relocate_code_block(compiled);
 }

vm/image.hpp

@@ -37,7 +37,6 @@ struct vm_parameters {
 	bool secure_gc;
 	bool fep;
 	bool console;
-	bool stack_traces;
 	cell max_pic_size;
 };
 

vm/jit.cpp

@@ -20,9 +20,7 @@ jit::jit(cell type_, cell owner_, factor_vm *vm)
 	  position(0),
 	  offset(0),
 	  parent_vm(vm)
-{
-	if(parent_vm->stack_traces_p()) literal(owner.value());
-}
+{}
 
 void jit::emit_relocation(cell code_template_)
 {
@@ -106,6 +104,7 @@ code_block *jit::to_code_block()
 		type,
 		code.elements.value(),
 		F, /* no labels */
+		owner.value(),
 		relocation.elements.value(),
 		literals.elements.value());
 }

vm/layouts.hpp

@@ -233,8 +233,8 @@ struct free_heap_block : public heap_block
 
 struct code_block : public heap_block
 {
-	cell unused;
-	cell literals; /* # bytes */
+	cell owner; /* tagged pointer to word, quotation or f */
+	cell literals; /* tagged pointer to array or f */
 	cell relocation; /* tagged pointer to byte-array or f */
 
 	void *xt() { return (void *)(this + 1); }

vm/primitives.cpp

@@ -164,6 +164,7 @@ const primitive_type primitives[] = {
 	primitive_optimized_p,
 	primitive_quot_compiled_p,
 	primitive_vm_ptr,
+	primitive_strip_stack_traces,
 };
 
 PRIMITIVE_FORWARD(bignum_to_fixnum)
@@ -289,5 +290,6 @@ PRIMITIVE_FORWARD(inline_cache_stats)
 PRIMITIVE_FORWARD(optimized_p)
 PRIMITIVE_FORWARD(quot_compiled_p)
 PRIMITIVE_FORWARD(vm_ptr)
+PRIMITIVE_FORWARD(strip_stack_traces)
 
 }

vm/primitives.hpp

@@ -172,5 +172,6 @@ PRIMITIVE(inline_cache_stats);
 PRIMITIVE(optimized_p);
 PRIMITIVE(quot_compiled_p);
 PRIMITIVE(vm_ptr);
+PRIMITIVE(strip_stack_traces);
 
 }

vm/run.hpp

@@ -87,8 +87,6 @@ enum special_object {
 	THREADS_ENV         = 64,
 	RUN_QUEUE_ENV       = 65,
 	SLEEP_QUEUE_ENV     = 66,
-
-	STACK_TRACES_ENV    = 67,
 };
 
 #define FIRST_SAVE_ENV BOOT_ENV
@@ -96,7 +94,7 @@ enum special_object {
 
 inline static bool save_env_p(cell i)
 {
-	return (i >= FIRST_SAVE_ENV && i <= LAST_SAVE_ENV) || i == STACK_TRACES_ENV;
+	return (i >= FIRST_SAVE_ENV && i <= LAST_SAVE_ENV);
 }
 
 }

vm/vm.hpp

@@ -514,11 +514,7 @@ struct factor_vm
 	void relocate_code_block(code_block *compiled);
 	void fixup_labels(array *labels, code_block *compiled);
 	code_block *allot_code_block(cell size, cell type);
-	code_block *add_code_block(cell type, cell code_, cell labels_, cell relocation_, cell literals_);
-	inline bool stack_traces_p()
-	{
-		return userenv[STACK_TRACES_ENV] != F;
-	}
+	code_block *add_code_block(cell type, cell code_, cell labels_, cell owner_, cell relocation_, cell literals_);
 
 	//code_heap
 	code_heap *code;
@@ -540,6 +536,7 @@ struct factor_vm
 	void forward_object_xts();
 	void fixup_object_xts();
 	void compact_code_heap();
+	void primitive_strip_stack_traces();
 
 	/* Apply a function to every code block */
 	template<typename Iterator> void iterate_code_heap(Iterator &iter)