VM portion of improved deployment

vm/data_gc.c

@@ -446,6 +446,7 @@ INLINE void *copy_untagged_object(void *pointer, CELL size)
 
 INLINE void forward_object(CELL pointer, CELL newpointer)
 {
+	if(pointer != newpointer)
 		put(UNTAG(pointer),RETAG(newpointer,GC_COLLECTED));
 }
 

vm/debug.c

@@ -1,14 +1,23 @@
 #include "master.h"
 
+void print_chars(F_STRING* str)
+{
+	CELL i;
+	for(i = 0; i < string_capacity(str); i++)
+		putchar(cget(SREF(str,i)));
+}
+
 void print_word(F_WORD* word, CELL nesting)
 {
-	if(type_of(word->name) == STRING_TYPE)
+
+	if(type_of(word->vocabulary) == STRING_TYPE)
 	{
-		F_STRING *string = untag_string(word->name);
-		CELL i;
-		for(i = 0; i < string_capacity(string); i++)
-			putchar(cget(SREF(string,i)));
+		print_chars(untag_string(word->vocabulary));
+		printf(":");
 	}
+	
+	if(type_of(word->name) == STRING_TYPE)
+		print_chars(untag_string(word->name));
 	else
 	{
 		printf("#<not a string: ");
@@ -20,9 +29,7 @@ void print_word(F_WORD* word, CELL nesting)
 void print_string(F_STRING* str)
 {
 	putchar('"');
-	CELL i;
-	for(i = 0; i < string_capacity(str); i++)
-		putchar(cget(SREF(str,i)));
+	print_chars(str);
 	putchar('"');
 }
 
@@ -181,6 +188,24 @@ void dump_generations(void)
 		(CELL)(data_heap->cards_end - data_heap->cards));
 }
 
+void dump_objects(F_FIXNUM type)
+{
+	begin_scan();
+
+	CELL obj;
+	while((obj = next_object()) != F)
+	{
+		if(type == -1 || type_of(obj) == type)
+		{
+			print_nested_obj(obj,3);
+			printf("\n");
+		}
+	}
+
+	/* end scan */
+	gc_off = false;
+}
+
 void factorbug(void)
 {
 	reset_stdio();
@@ -200,6 +225,8 @@ void factorbug(void)
 	printf("g                -- dump generations\n");
 	printf("card <addr>      -- print card containing address\n");
 	printf("addr <card>      -- print address containing card\n");
+	printf("data             -- data heap dump\n");
+	printf("words            -- words dump\n");
 	printf("code             -- code heap dump\n");
 
 	for(;;)
@@ -268,6 +295,10 @@ void factorbug(void)
 			exit(1);
 		else if(strcmp(cmd,"im") == 0)
 			save_image(STR_FORMAT("fep.image"));
+		else if(strcmp(cmd,"data") == 0)
+			dump_objects(-1);
+		else if(strcmp(cmd,"words") == 0)
+			dump_objects(WORD_TYPE);
 		else if(strcmp(cmd,"code") == 0)
 			dump_heap(&code_heap);
 		else

vm/factor.c

@@ -19,6 +19,7 @@ void default_parameters(F_PARAMETERS *p)
 	p->young_size = 2 * CELLS;
 	p->aging_size = 4 * CELLS;
 	p->secure_gc = false;
+	p->fep = false;
 }
 
 /* Get things started */
@@ -101,6 +102,8 @@ void init_factor_from_args(F_CHAR *image, int argc, F_CHAR **argv, bool embedded
 		else if(factor_arg(argv[i],STR_FORMAT("-codeheap=%d"),&p.code_size));
 		else if(STRCMP(argv[i],STR_FORMAT("-securegc")) == 0)
 			p.secure_gc = true;
+		else if(STRCMP(argv[i],STR_FORMAT("-fep")) == 0)
+			p.fep = true;
 		else if(STRNCMP(argv[i],STR_FORMAT("-i="),3) == 0)
 			p.image = argv[i] + 3;
 	}
@@ -127,6 +130,10 @@ void init_factor_from_args(F_CHAR *image, int argc, F_CHAR **argv, bool embedded
 	userenv[EMBEDDED_ENV] = (embedded ? T : F);
 
 	nest_stacks();
+
+	if(p.fep)
+		factorbug();
+
 	c_to_factor_toplevel(userenv[BOOT_ENV]);
 	unnest_stacks();
 

vm/image.h

@@ -31,6 +31,7 @@ typedef struct {
 	CELL gen_count, young_size, aging_size;
 	CELL code_size;
 	bool secure_gc;
+	bool fep;
 } F_PARAMETERS;
 
 void load_image(F_PARAMETERS *p);

vm/primitives.c

@@ -194,4 +194,5 @@ void *primitives[] = {
 	primitive_innermost_stack_frame_scan,
 	primitive_set_innermost_stack_frame_quot,
 	primitive_call_clear,
+	primitive_strip_compiled_quotations,
 };

vm/quotations.c

@@ -231,3 +231,22 @@ DEFINE_PRIMITIVE(quotation_xt)
 	F_QUOTATION *quot = untag_quotation(dpeek());
 	drepl(allot_cell((CELL)quot->xt));
 }
+
+DEFINE_PRIMITIVE(strip_compiled_quotations)
+{
+	begin_scan();
+
+	CELL obj;
+	while((obj = next_object()) != F)
+	{
+		if(type_of(obj) == QUOTATION_TYPE)
+		{
+			F_QUOTATION *quot = untag_object(obj);
+			quot->compiled = F;
+			quot->xt = lazy_jit_compile;
+		}
+	}
+
+	/* end scan */
+	gc_off = false;
+}

vm/quotations.h

@@ -6,3 +6,4 @@ DECLARE_PRIMITIVE(curry);
 DECLARE_PRIMITIVE(array_to_quotation);
 DECLARE_PRIMITIVE(quotation_xt);
 DECLARE_PRIMITIVE(uncurry);
+DECLARE_PRIMITIVE(strip_compiled_quotations);