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

diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor
index ef66cc3cd6957d32dcecd911d6a22ffdbf74f452..8058707efa186c27cc0f07d7d4e9c3f7397a5716 100644 (file)
--- a/core/bootstrap/primitives.factor
+++ b/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 )) }

diff --git a/core/bootstrap/stage1.factor b/core/bootstrap/stage1.factor
index 9c84904ff736db68c7da487bd773d1e0aa5b1a26..6dab0f416289568123df9b314a10525aa73b4a6e 100644 (file)
--- a/core/bootstrap/stage1.factor
+++ b/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

diff --git a/core/init/init.factor b/core/init/init.factor
index 540768ee63ec4e8e94f7e91b464bd9547a466bb1..16a39bbc21cfbb6d0857611ffbba6948cf99894b 100644 (file)
--- a/core/init/init.factor
+++ b/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

diff --git a/core/system/system.factor b/core/system/system.factor
index 38b4a5fd9bb5d9473d093856e31aa78edff8ef7b..5ee10374fc7253c8f34c71831217731cfc0061a7 100644 (file)
--- a/core/system/system.factor
+++ b/core/system/system.factor
@@ -56,3 +56,5 @@ PRIVATE>
 : embedded? ( -- ? ) 15 getenv ;
 
 : millis ( -- ms ) micros 1000 /i ;
+
+: exit ( n -- ) do-shutdown-hooks (exit) ;

diff --git a/vm/factor.cpp b/vm/factor.cpp
index 5548ebd610bfa050590895f376a08ca33a49a86d..2f4994c9a2f73f8e2f09f799a4daf20e31a8f83d 100755 (executable)
--- a/vm/factor.cpp
+++ b/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]);

diff --git a/vm/run.hpp b/vm/run.hpp
index 9a23979066a8ea6b7c4c050343554480748403ee..86590e96a2d396c3ac3ef5f526d5f62dfcf399e8 100755 (executable)
--- a/vm/run.hpp
+++ b/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

diff --git a/vm/vm.hpp b/vm/vm.hpp
index d232d6153d0074c84108662d301c2db6ba1eef70..4aef9a4f7210cdc8f0bd636f040c70182387cdc4 100755 (executable)
--- a/vm/vm.hpp
+++ b/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);