VM: let's merge (save-image) and (save-image-and-exit) into one 3

arg (save-image). it's good not to have to many similar primitives

basis/stack-checker/known-words/known-words.factor

@@ -291,8 +291,7 @@ M: object infer-call* \ call bad-macro-input ;
 \ (format-float) { float byte-array } { byte-array } define-primitive \ (format-float) make-foldable
 \ (fopen) { byte-array byte-array } { alien } define-primitive
 \ (identity-hashcode) { object } { fixnum } define-primitive
-\ (save-image) { byte-array byte-array } { } define-primitive
-\ (save-image-and-exit) { byte-array byte-array } { } define-primitive
+\ (save-image) { byte-array byte-array object } { } define-primitive
 \ (set-context) { object alien } { object } define-primitive
 \ (set-context-and-delete) { object alien } { } define-primitive
 \ (sleep) { integer } { } define-primitive

core/bootstrap/primitives.factor

@@ -530,8 +530,7 @@ tuple
     { "gc" "memory" "primitive_full_gc" ( -- ) }
     { "minor-gc" "memory" "primitive_minor_gc" ( -- ) }
     { "size" "memory" "primitive_size" ( obj -- n ) }
-    { "(save-image)" "memory.private" "primitive_save_image" ( path1 path2 -- ) }
-    { "(save-image-and-exit)" "memory.private" "primitive_save_image_and_exit" ( path1 path2 -- ) }
+    { "(save-image)" "memory.private" "primitive_save_image" ( path1 path2 then-die? -- ) }
     { "jit-compile" "quotations" "primitive_jit_compile" ( quot -- ) }
     { "quot-compiled?" "quotations" "primitive_quot_compiled_p" ( quot -- ? ) }
     { "quotation-code" "quotations" "primitive_quotation_code" ( quot -- start end ) }

core/memory/memory.factor

@@ -11,8 +11,7 @@ PRIMITIVE: minor-gc ( -- )
 PRIMITIVE: size ( obj -- n )
 
 <PRIVATE
-PRIMITIVE: (save-image) ( path1 path2 -- )
-PRIMITIVE: (save-image-and-exit) ( path1 path2 -- )
+PRIMITIVE: (save-image) ( path1 path2 then-die? -- )
 PRIVATE>
 
 : instances ( quot -- seq )
@@ -23,9 +22,9 @@ PRIVATE>
     [ native-string>alien ] bi@ ;
 
 : save-image ( path -- )
-    normalize-path saving-path (save-image) ;
+    normalize-path saving-path f (save-image) ;
 
 : save-image-and-exit ( path -- )
-    normalize-path saving-path (save-image-and-exit) ;
+    normalize-path saving-path t (save-image) ;
 
 : save ( -- ) image save-image ;

vm/image.cpp

@@ -294,27 +294,12 @@ bool factor_vm::save_image(const vm_char* saving_filename,
   return ok;
 }
 
-void factor_vm::primitive_save_image() {
-  byte_array* path2 = tagged<byte_array>(ctx->pop()).untag_check(this);
-  byte_array* path1 = tagged<byte_array>(ctx->pop()).untag_check(this);
-
-  vm_char* path1_saved = safe_strdup(path1->data<vm_char>());
-  vm_char* path2_saved = safe_strdup(path2->data<vm_char>());
-
-  /* do a full GC to push everything into tenured space */
-  primitive_compact_gc();
-
-  save_image(path1_saved, path2_saved);
-
-  free(path1_saved);
-  free(path2_saved);
-}
-
 /* Allocates memory */
-void factor_vm::primitive_save_image_and_exit() {
+void factor_vm::primitive_save_image() {
   /* We unbox this before doing anything else. This is the only point
      where we might throw an error, so we have to throw an error here since
      later steps destroy the current image. */
+  bool then_die = to_boolean(ctx->pop());
   byte_array* path2 = tagged<byte_array>(ctx->pop()).untag_check(this);
   byte_array* path1 = tagged<byte_array>(ctx->pop()).untag_check(this);
 
@@ -323,23 +308,28 @@ void factor_vm::primitive_save_image_and_exit() {
   vm_char* path1_saved = safe_strdup(path1->data<vm_char>());
   vm_char* path2_saved = safe_strdup(path2->data<vm_char>());
 
-  /* strip out special_objects data which is set on startup anyway */
-  for (cell i = 0; i < special_object_count; i++)
-    if (!save_special_p(i))
-      special_objects[i] = false_object;
+  if (then_die) {
+    /* strip out special_objects data which is set on startup anyway */
+    for (cell i = 0; i < special_object_count; i++)
+      if (!save_special_p(i))
+        special_objects[i] = false_object;
 
-  /* dont trace objects only reachable from context stacks so we don't
-     get volatile data saved in the image. */
-  active_contexts.clear();
-  code->uninitialized_blocks.clear();
+    /* dont trace objects only reachable from context stacks so we don't
+       get volatile data saved in the image. */
+    active_contexts.clear();
+    code->uninitialized_blocks.clear();
+  }
 
-  gc(collect_compact_op, 0 /* requested size */);
+  /* do a full GC to push everything remaining into tenured space */
+  primitive_compact_gc();
 
   /* Save the image */
-  if (save_image(path1_saved, path2_saved))
-    exit(0);
-  else
-    exit(1);
+  bool ret = save_image(path1_saved, path2_saved);
+  if (then_die) {
+    exit(ret ? 0 : 1);
+  }
+  free(path1_saved);
+  free(path2_saved);
 }
 
 bool factor_vm::embedded_image_p() {

vm/primitives.hpp

@@ -31,12 +31,11 @@ namespace factor {
       _(quot_compiled_p) _(quotation_code) _(reset_dispatch_stats)             \
       _(resize_array) _(resize_byte_array) _(resize_string) _(retainstack)     \
       _(retainstack_for) _(sampling_profiler) _(save_image)                    \
-      _(save_image_and_exit) _(set_context_object) _(set_datastack)            \
-      _(set_innermost_stack_frame_quot) _(set_retainstack) _(set_slot)         \
-      _(set_special_object) _(set_string_nth_fast) _(size) _(sleep)            \
-      _(special_object) _(string) _(strip_stack_traces) _(tuple) _(tuple_boa)  \
-      _(unimplemented) _(uninitialized_byte_array) _(word) _(word_code)        \
-      _(wrapper)
+      _(set_context_object) _(set_datastack) _(set_innermost_stack_frame_quot) \
+      _(set_retainstack) _(set_slot) _(set_special_object)                     \
+      _(set_string_nth_fast) _(size) _(sleep) _(special_object) _(string)      \
+      _(strip_stack_traces) _(tuple) _(tuple_boa) _(unimplemented)             \
+      _(uninitialized_byte_array) _(word) _(word_code) _(wrapper)
 
 #define EACH_ALIEN_PRIMITIVE(_)                               \
   _(signed_cell, fixnum, from_signed_cell, to_fixnum)         \

vm/vm.hpp

@@ -608,7 +608,6 @@ struct factor_vm {
   void load_code_heap(FILE* file, image_header* h, vm_parameters* p);
   bool save_image(const vm_char* saving_filename, const vm_char* filename);
   void primitive_save_image();
-  void primitive_save_image_and_exit();
   void fixup_data(cell data_offset, cell code_offset);
   void fixup_code(cell data_offset, cell code_offset);
   FILE* open_image(vm_parameters* p);