From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 5 May 2009 15:29:22 +0000 (-0500)
Subject: Fix botched replace all in VM source, clean up image saving code, and fix save-image... 
X-Git-Tag: 0.97~6350^2~18
X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=12de56c41e1c46169070989aa23179bfaab2abcb

Fix botched replace all in VM source, clean up image saving code, and fix save-image-and-exit to actually call (save-image-and-exit) instead of (save-image)
---

diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor
index fd43d1ccc9..e8f4238ed6 100755
--- a/basis/tools/deploy/shaker/shaker.factor
+++ b/basis/tools/deploy/shaker/shaker.factor
@@ -346,13 +346,6 @@ IN: tools.deploy.shaker
 : compress-wrappers ( -- )
     [ wrapper? ] [ ] "wrappers" compress ;
 
-: finish-deploy ( final-image -- )
-    "Finishing up" show
-    V{ } set-namestack
-    V{ } set-catchstack
-    "Saving final image" show
-    save-image-and-exit ;
-
 SYMBOL: deploy-vocab
 
 : [:c] ( -- word ) ":c" "debugger" lookup ;
@@ -437,7 +430,8 @@ SYMBOL: deploy-vocab
                 "Vocabulary has no MAIN: word." print flush 1 exit
             ] unless
             strip
-            finish-deploy
+            "Saving final image" show
+            save-image-and-exit
         ] deploy-error-handler
     ] bind ;
 
diff --git a/core/memory/memory.factor b/core/memory/memory.factor
index c748f71c8e..1c61e33d83 100644
--- a/core/memory/memory.factor
+++ b/core/memory/memory.factor
@@ -26,6 +26,6 @@ IN: memory
     normalize-path native-string>alien (save-image) ;
 
 : save-image-and-exit ( path -- )
-    normalize-path native-string>alien (save-image) ;
+    normalize-path native-string>alien (save-image-and-exit) ;
 
 : save ( -- ) image save-image ;
diff --git a/vm/factor.cpp b/vm/factor.cpp
index b607adba63..f8f7901304 100755
--- a/vm/factor.cpp
+++ b/vm/factor.cpp
@@ -134,7 +134,7 @@ VM_C_API void init_factor(vm_parameters *p)
 
 	userenv[CPU_ENV] = allot_alien(F,(cell)FACTOR_CPU_STRING);
 	userenv[OS_ENV] = allot_alien(F,(cell)FACTOR_OS_STRING);
-	userenv[cell_SIZE_ENV] = tag_fixnum(sizeof(cell));
+	userenv[CELL_SIZE_ENV] = tag_fixnum(sizeof(cell));
 	userenv[EXECUTABLE_ENV] = allot_alien(F,(cell)p->executable_path);
 	userenv[ARGS_ENV] = F;
 	userenv[EMBEDDED_ENV] = F;
diff --git a/vm/image.cpp b/vm/image.cpp
index 2aa7727136..fd547cca50 100755
--- a/vm/image.cpp
+++ b/vm/image.cpp
@@ -106,14 +106,8 @@ bool save_image(const vm_char *filename)
 	h.bignum_pos_one = bignum_pos_one;
 	h.bignum_neg_one = bignum_neg_one;
 
-	cell i;
-	for(i = 0; i < USER_ENV; i++)
-	{
-		if(i < FIRST_SAVE_ENV)
-			h.userenv[i] = F;
-		else
-			h.userenv[i] = userenv[i];
-	}
+	for(cell i = 0; i < USER_ENV; i++)
+		h.userenv[i] = (save_env_p(i) ? userenv[i] : F);
 
 	bool ok = true;
 
@@ -149,12 +143,10 @@ PRIMITIVE(save_image_and_exit)
 	path.untag_check();
 
 	/* strip out userenv data which is set on startup anyway */
-	cell i;
-	for(i = 0; i < FIRST_SAVE_ENV; i++)
-		userenv[i] = F;
-
-	for(i = LAST_SAVE_ENV + 1; i < STACK_TRACES_ENV; i++)
-		userenv[i] = F;
+	for(cell i = 0; i < USER_ENV; i++)
+	{
+		if(!save_env_p(i)) userenv[i] = F;
+	}
 
 	/* do a full GC + code heap compaction */
 	performing_compaction = true;
diff --git a/vm/run.hpp b/vm/run.hpp
index 2204585fe5..829e25d2f7 100755
--- a/vm/run.hpp
+++ b/vm/run.hpp
@@ -14,7 +14,7 @@ enum special_object {
 	BREAK_ENV            = 5, /* quotation called by throw primitive */
 	ERROR_ENV,                /* a marker consed onto kernel errors */
 
-	cell_SIZE_ENV        = 7, /* sizeof(cell) */
+	CELL_SIZE_ENV        = 7, /* sizeof(cell) */
 	CPU_ENV,                  /* CPU architecture */
 	OS_ENV,                   /* operating system name */
 
@@ -93,6 +93,11 @@ enum special_object {
 #define FIRST_SAVE_ENV BOOT_ENV
 #define LAST_SAVE_ENV STAGE2_ENV
 
+inline static bool save_env_p(cell i)
+{
+	return (i >= FIRST_SAVE_ENV && i <= LAST_SAVE_ENV) || i == STACK_TRACES_ENV;
+}
+
 /* Canonical T object. It's just a word */
 extern cell T;