the exit primitive is now called (exit) and exit calls shutdown hooks.

add a stop_factor function to the vm to allow calling the shutdown quotation

core/bootstrap/primitives.factor

@@ -432,7 +432,7 @@ tuple
     { "set-datastack" "kernel" (( ds -- )) }
     { "set-retainstack" "kernel" (( rs -- )) }
     { "set-callstack" "kernel" (( cs -- )) }
-    { "exit" "system" (( n -- )) }
+    { "(exit)" "system" (( n -- )) }
     { "data-room" "memory" (( -- cards decks generations )) }
     { "code-room" "memory" (( -- code-total code-used code-free largest-free-block )) }
     { "micros" "system" (( -- us )) }

core/bootstrap/stage1.factor

@@ -47,7 +47,7 @@ load-help? off
             "Cannot find " write write "." print
             "Please move " write image write " to the same directory as the Factor sources," print
             "and try again." print
-            1 exit
+            1 (exit)
         ] if
     ] %
 ] [ ] make

core/init/init.factor

@@ -10,12 +10,12 @@ SYMBOL: shutdown-hooks
 startup-hooks global [ drop V{ } clone ] cache drop
 shutdown-hooks global [ drop V{ } clone ] cache drop
 
-: do-hooks ( assoc -- )
-    [ nip call( -- ) ] assoc-each ;
+: do-hooks ( symbol -- )
+    get [ nip call( -- ) ] assoc-each ;
 
-: do-startup-hooks ( -- ) startup-hooks get do-hooks ;
+: do-startup-hooks ( -- ) startup-hooks do-hooks ;
 
-: do-shutdown-hooks ( -- ) shutdown-hooks get do-hooks ;
+: do-shutdown-hooks ( -- ) shutdown-hooks do-hooks ;
 
 : add-startup-hook ( quot name -- )
     startup-hooks get
@@ -30,3 +30,9 @@ shutdown-hooks global [ drop V{ } clone ] cache drop
 : boot-quot ( -- quot ) 20 getenv ;
 
 : set-boot-quot ( quot -- ) 20 setenv ;
+
+: shutdown-quot ( -- quot ) 67 getenv ;
+
+: set-shutdown-quot ( quot -- ) 67 setenv ;
+
+[ do-shutdown-hooks ] set-shutdown-quot

core/system/system.factor

@@ -56,3 +56,5 @@ PRIVATE>
 : embedded? ( -- ? ) 15 getenv ;
 
 : millis ( -- ms ) micros 1000 /i ;
+
+: exit ( n -- ) do-shutdown-hooks (exit) ;

vm/factor.cpp

@@ -185,6 +185,13 @@ void factor_vm::start_factor(vm_parameters *p)
 	unnest_stacks();
 }
 
+void factor_vm::stop_factor()
+{
+	nest_stacks(NULL);
+	c_to_factor_toplevel(userenv[SHUTDOWN_ENV]);
+	unnest_stacks();
+}
+
 char *factor_vm::factor_eval_string(char *string)
 {
 	char *(*callback)(char *) = (char *(*)(char *))alien_offset(userenv[EVAL_CALLBACK_ENV]);

vm/run.hpp

@@ -90,6 +90,7 @@ enum special_object {
 	THREADS_ENV         = 64,
 	RUN_QUEUE_ENV       = 65,
 	SLEEP_QUEUE_ENV     = 66,
+	SHUTDOWN_ENV        = 67,
 };
 
 #define FIRST_SAVE_ENV BOOT_ENV

vm/vm.hpp

@@ -668,6 +668,7 @@ struct factor_vm
 	void init_factor(vm_parameters *p);
 	void pass_args_to_factor(int argc, vm_char **argv);
 	void start_factor(vm_parameters *p);
+	void stop_factor();
 	void start_embedded_factor(vm_parameters *p);
 	void start_standalone_factor(int argc, vm_char **argv);
 	char *factor_eval_string(char *string);