]> gitweb.factorcode.org Git - factor.git/commitdiff
Fix botched replace all in VM source, clean up image saving code, and fix save-image...
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Tue, 5 May 2009 15:29:22 +0000 (10:29 -0500)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Tue, 5 May 2009 15:29:22 +0000 (10:29 -0500)
basis/tools/deploy/shaker/shaker.factor
core/memory/memory.factor
vm/factor.cpp
vm/image.cpp
vm/run.hpp

index fd43d1ccc9d512a2bc70819c7ca1c7d82c8ee68f..e8f4238ed609bb1a2e3d07ffd3c4e84175602fc8 100755 (executable)
@@ -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 ;
 
index c748f71c8e9df855f997872e21ca456706c5920a..1c61e33d83542a8eb27a604b3ed6d404a67a2be3 100644 (file)
@@ -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 ;
index b607adba6303d24c83b81a5c39c41f459a4a5845..f8f7901304c288b7c89446dcb54b55eae509e8f0 100755 (executable)
@@ -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;
index 2aa7727136a2711ada3973271ea2cb486159e309..fd547cca50d1b97b4f2ec49d6b8a54dbd3f73ba1 100755 (executable)
@@ -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;
index 2204585fe5b1cbe3f1361a94de8602ac85ed0345..829e25d2f725817fb1dfe37af1f2fd9d4fa4c9ce 100755 (executable)
@@ -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;