Merge branch 'master' into startup

Conflicts:
	core/bootstrap/primitives.factor
	vm/run.hpp

diff --git a/basis/alarms/alarms.factor b/basis/alarms/alarms.factor
index 9943d39ad194a6d0efe5d356d3873afa6099ed94..c29371d26f47866af7cf88ce3bf3b07b2cea8398 100644 (file)
--- a/basis/alarms/alarms.factor
+++ b/basis/alarms/alarms.factor
@@ -75,7 +75,7 @@ ERROR: bad-alarm-frequency frequency ;
     [ alarm-thread-loop t ] "Alarms" spawn-server
     alarm-thread set-global ;
 
-[ init-alarms ] "alarms" add-init-hook
+[ init-alarms ] "alarms" add-startup-hook
 
 PRIVATE>
 

diff --git a/basis/bootstrap/finish-bootstrap.factor b/basis/bootstrap/finish-bootstrap.factor
index ab08aa87a9b02fa170d8cebe5f386a7cbaff74bd..35b40df97a322e967807bbd8d9e4d5547a68f14f 100644 (file)
--- a/basis/bootstrap/finish-bootstrap.factor
+++ b/basis/bootstrap/finish-bootstrap.factor
@@ -1,17 +1,19 @@
 USING: init command-line debugger system continuations
-namespaces eval kernel vocabs.loader io ;
+namespaces eval kernel vocabs.loader io destructors ;
 
 [
     boot
-    do-init-hooks
     [
-        (command-line) parse-command-line
-        load-vocab-roots
-        run-user-init
-        "e" get [ eval( -- ) ] when*
-        ignore-cli-args? not script get and
-        [ run-script ] [ "run" get run ] if*
-        output-stream get [ stream-flush ] when*
-        0 exit
-    ] [ print-error 1 exit ] recover
+        do-startup-hooks
+        [
+            (command-line) parse-command-line
+            load-vocab-roots
+            run-user-init
+            "e" get [ eval( -- ) ] when*
+            ignore-cli-args? not script get and
+            [ run-script ] [ "run" get run ] if*
+            output-stream get [ stream-flush ] when*
+            0
+        ] [ print-error 1 ] recover
+     ] with-destructors exit
 ] set-boot-quot

diff --git a/basis/bootstrap/finish-staging.factor b/basis/bootstrap/finish-staging.factor
index 49f504fd41441d34f148171aefb5c9f3a43f70b4..10d81d6ff6e9ec6f173a6193e82dd5551166aee2 100644 (file)
--- a/basis/bootstrap/finish-staging.factor
+++ b/basis/bootstrap/finish-staging.factor
@@ -3,9 +3,10 @@ io ;
 
 [
     boot
-    do-init-hooks
-    (command-line) parse-command-line
-    "run" get run
-    output-stream get [ stream-flush ] when*
-    0 exit
+    [
+        do-startup-hooks
+        (command-line) parse-command-line
+        "run" get run
+        output-stream get [ stream-flush ] when*
+    ] with-destructors 0 exit
 ] set-boot-quot

diff --git a/basis/bootstrap/stage2.factor b/basis/bootstrap/stage2.factor
index 0b517c0e66f649fd0c4d1228d2d422fa52390b26..b011b41c4b8735fe50bacadb68fa3041de903b48 100644 (file)
--- a/basis/bootstrap/stage2.factor
+++ b/basis/bootstrap/stage2.factor
@@ -56,6 +56,7 @@ SYMBOL: bootstrap-time
     error-continuation set-global
     error set-global ; inline
 
+
 [
     ! We time bootstrap
     millis

diff --git a/basis/calendar/model/model.factor b/basis/calendar/model/model.factor
index 8665cc22cefe67749a59f0dca7fbe8bd490a42a8..38ad986952c224800a29ca4e4b58ca1c4a94fb9e 100644 (file)
--- a/basis/calendar/model/model.factor
+++ b/basis/calendar/model/model.factor
@@ -16,4 +16,4 @@ SYMBOL: time
     ] "Time model update" spawn drop ;\r
 \r
 f <model> time set-global\r
-[ time-thread ] "calendar.model" add-init-hook\r
+[ time-thread ] "calendar.model" add-startup-hook\r

diff --git a/basis/channels/remote/remote.factor b/basis/channels/remote/remote.factor
index 0a8887554491c777078ad001552996d3f62bd66b..4eab29fd81f15322cf6f5283c9663dfb5d4cb6ef 100644 (file)
--- a/basis/channels/remote/remote.factor
+++ b/basis/channels/remote/remote.factor
@@ -69,4 +69,4 @@ M: remote-channel from ( remote-channel -- value )
 [
     H{ } clone \ remote-channels set-global
     start-channel-node
-] "channel-registry" add-init-hook
+] "channel-registry" add-startup-hook

diff --git a/basis/cocoa/application/application.factor b/basis/cocoa/application/application.factor
index cbf8636a7537f4a3862b3d30c70a98010ee1690c..83213b47ba005ec11c6442898a74a9b96a9d214c 100644 (file)
--- a/basis/cocoa/application/application.factor
+++ b/basis/cocoa/application/application.factor
@@ -49,7 +49,7 @@ TUPLE: objc-error alien reason ;
 M: objc-error summary ( error -- )
     drop "Objective C exception" ;
 
-[ [ objc-error ] 19 setenv ] "cocoa.application" add-init-hook
+[ [ objc-error ] 19 setenv ] "cocoa.application" add-startup-hook
 
 : running.app? ( -- ? )
     #! Test if we're running a .app.

diff --git a/basis/cocoa/cocoa.factor b/basis/cocoa/cocoa.factor
index ec09f8f2ba3108a017b52b017eae01f1c146544d..34bac0a5055229e13b7a738190f577359fd3ab7e 100644 (file)
--- a/basis/cocoa/cocoa.factor
+++ b/basis/cocoa/cocoa.factor
@@ -27,7 +27,7 @@ SYMBOL: frameworks
 
 frameworks [ V{ } clone ] initialize
 
-[ frameworks get [ load-framework ] each ] "cocoa" add-init-hook
+[ frameworks get [ load-framework ] each ] "cocoa" add-startup-hook
 
 SYNTAX: FRAMEWORK: scan [ load-framework ] [ frameworks get push ] bi ;
 

diff --git a/basis/cocoa/messages/messages.factor b/basis/cocoa/messages/messages.factor
index fce7adc04a18a73088aef343bc6123146e1880a5..4cc9554d3c4be5b84d1be3a1f09b7ceabd02fded 100755 (executable)
--- a/basis/cocoa/messages/messages.factor
+++ b/basis/cocoa/messages/messages.factor
@@ -76,13 +76,13 @@ MACRO: (send) ( selector super? -- quot )
 : super-send ( receiver args... selector -- return... ) t (send) ; inline
 
 ! Runtime introspection
-SYMBOL: class-init-hooks
+SYMBOL: class-startup-hooks
 
-class-init-hooks [ H{ } clone ] initialize
+class-startup-hooks [ H{ } clone ] initialize
 
 : (objc-class) ( name word -- class )
     2dup execute dup [ 2nip ] [
-        drop over class-init-hooks get at [ call( -- ) ] when*
+        drop over class-startup-hooks get at [ call( -- ) ] when*
         2dup execute dup [ 2nip ] [
             2drop "No such class: " prepend throw
         ] if
@@ -229,7 +229,7 @@ ERROR: no-objc-type name ;
 : class-exists? ( string -- class ) objc_getClass >boolean ;
 
 : define-objc-class-word ( quot name -- )
-    [ class-init-hooks get set-at ]
+    [ class-startup-hooks get set-at ]
     [
         [ "cocoa.classes" create ] [ '[ _ objc-class ] ] bi
         (( -- class )) define-declared

diff --git a/basis/command-line/command-line.factor b/basis/command-line/command-line.factor
index 19421359a395f96168981a6bcb37073c34a20561..f1748d37083f7ebbaba5663eb8a238f39db590c3 100644 (file)
--- a/basis/command-line/command-line.factor
+++ b/basis/command-line/command-line.factor
@@ -69,4 +69,4 @@ SYMBOL: main-vocab-hook
 : ignore-cli-args? ( -- ? )
     os macosx? "run" get "ui" = and ;
 
-[ default-cli-args ] "command-line" add-init-hook
+[ default-cli-args ] "command-line" add-startup-hook

diff --git a/basis/core-foundation/fsevents/fsevents.factor b/basis/core-foundation/fsevents/fsevents.factor
index 24ac24bb6aa9dd8114528e78b0c51a3260297688..37dbcd1e4feb4c925177c904dc760ffe6269fd52 100755 (executable)
--- a/basis/core-foundation/fsevents/fsevents.factor
+++ b/basis/core-foundation/fsevents/fsevents.factor
@@ -156,7 +156,7 @@ SYMBOL: event-stream-callbacks
 [
     event-stream-callbacks
     [ [ drop expired? not ] assoc-filter H{ } assoc-like ] change-global
-] "core-foundation" add-init-hook
+] "core-foundation" add-startup-hook
 
 : add-event-source-callback ( quot -- id )
     event-stream-counter <alien>

diff --git a/basis/core-text/core-text.factor b/basis/core-text/core-text.factor
index e431df941424ef135bd90861886a50cc4aade04e..7af6792e79845d8d14517139ba4d86f0b66513b7 100644 (file)
--- a/basis/core-text/core-text.factor
+++ b/basis/core-text/core-text.factor
@@ -149,4 +149,4 @@ SYMBOL: cached-lines
 : cached-line ( font string -- line )
     cached-lines get [ <line> ] 2cache ;
 
-[ <cache-assoc> cached-lines set-global ] "core-text" add-init-hook
+[ <cache-assoc> cached-lines set-global ] "core-text" add-startup-hook

diff --git a/basis/core-text/fonts/fonts.factor b/basis/core-text/fonts/fonts.factor
index 5c57034632ea973d43a023f0e3a3d4e1ca2ce985..63b9a0f6e155e5670194e5a78181dde923660bb1 100644 (file)
--- a/basis/core-text/fonts/fonts.factor
+++ b/basis/core-text/fonts/fonts.factor
@@ -127,4 +127,4 @@ MEMO: (cache-font-metrics) ( font -- metrics )
 [
     \ (cache-font) reset-memoized
     \ (cache-font-metrics) reset-memoized
-] "core-text.fonts" add-init-hook
+] "core-text.fonts" add-startup-hook

diff --git a/basis/cpu/x86/features/features.factor b/basis/cpu/x86/features/features.factor
index b21aa762d861c078f29588d2ea02ffa3bbd259bd..38364805eb90215a362676f461ff34edd8384313 100644 (file)
--- a/basis/cpu/x86/features/features.factor
+++ b/basis/cpu/x86/features/features.factor
@@ -17,7 +17,7 @@ MEMO: sse-version ( -- n )
     sse_version
     "sse-version" get string>number [ min ] when* ;
 
-[ \ sse-version reset-memoized ] "cpu.x86.features" add-init-hook
+[ \ sse-version reset-memoized ] "cpu.x86.features" add-startup-hook
 
 : sse? ( -- ? ) sse-version 10 >= ;
 : sse2? ( -- ? ) sse-version 20 >= ;

diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor
index d78d05bac75c51d04cdec4a368768c099e28d230..86006f843ec11f57397d4f9d73222d5a1fa6b06f 100644 (file)
--- a/basis/cpu/x86/x86.factor
+++ b/basis/cpu/x86/x86.factor
@@ -1413,7 +1413,7 @@ enable-fixnum-log2
             flush
             1 exit
         ] when
-    ] "cpu.x86" add-init-hook ;
+    ] "cpu.x86" add-startup-hook ;
 
 : enable-sse2 ( version -- )
     20 >= [

diff --git a/basis/environment/environment.factor b/basis/environment/environment.factor
index e60a52c995b94fb2613c4b272242ff1a88663a9c..ccdbd66d96c53f8fb35d797cd0a3b3256a08755c 100644 (file)
--- a/basis/environment/environment.factor
+++ b/basis/environment/environment.factor
@@ -32,4 +32,4 @@ HOOK: (set-os-envs) os ( seq -- )
         os windows? ";" ":" ? split
         [ add-vocab-root ] each
     ] when*    
-] "environment" add-init-hook
+] "environment" add-startup-hook

diff --git a/basis/game/input/input.factor b/basis/game/input/input.factor
index 954602cf0671e95894b41087d782877dd75eade1..261f19cb9e908689d869c9fa9a9f59238ab2f835 100755 (executable)
--- a/basis/game/input/input.factor
+++ b/basis/game/input/input.factor
@@ -35,7 +35,7 @@ M: f (reset-game-input) ;
 : reset-game-input ( -- )
     (reset-game-input) ;
 
-[ reset-game-input ] "game-input" add-init-hook
+[ reset-game-input ] "game-input" add-startup-hook
 
 PRIVATE>
 

diff --git a/basis/io/launcher/launcher.factor b/basis/io/launcher/launcher.factor
index d4bfbb35c227f0a31e4de64ac256e51b81f751f1..cb20f78a3301c764436b386370b2da0190a5c6cd 100755 (executable)
--- a/basis/io/launcher/launcher.factor
+++ b/basis/io/launcher/launcher.factor
@@ -75,7 +75,7 @@ SYMBOL: wait-flag
 [
     H{ } clone processes set-global
     start-wait-thread
-] "io.launcher" add-init-hook
+] "io.launcher" add-startup-hook
 
 : process-started ( process handle -- )
     >>handle

diff --git a/basis/io/sockets/unix/unix.factor b/basis/io/sockets/unix/unix.factor
index 6bf62a034e586c075b719fb5fc78f165687d491b..71ad5a57582a91b7aa4866cc4497e01dc6a5953a 100755 (executable)
--- a/basis/io/sockets/unix/unix.factor
+++ b/basis/io/sockets/unix/unix.factor
@@ -117,7 +117,7 @@ SYMBOL: receive-buffer
 
 CONSTANT: packet-size 65536
 
-[ packet-size malloc receive-buffer set-global ] "io.sockets.unix" add-init-hook
+[ packet-size malloc &free receive-buffer set-global ] "io.sockets.unix" add-startup-hook
 
 :: do-receive ( port -- packet sockaddr )
     port addr>> empty-sockaddr/size :> ( sockaddr len )

diff --git a/basis/io/thread/thread.factor b/basis/io/thread/thread.factor
index 88db135f447c24975117ee9a579dddb384bae4a1..994dcd9c501f81d07dfe571f8a4b0f6f29432936 100644 (file)
--- a/basis/io/thread/thread.factor
+++ b/basis/io/thread/thread.factor
@@ -17,4 +17,4 @@ SYMBOL: io-thread-running?
 [\r
     t io-thread-running? set-global\r
     start-io-thread\r
-] "io.thread" add-init-hook\r
+] "io.thread" add-startup-hook\r

diff --git a/basis/logging/server/server.factor b/basis/logging/server/server.factor
index 848ad5d40e8d160b8001d780c4ff3e7b189b5e74..f5539b281325aeae295f86e3aa308bee4c254b12 100644 (file)
--- a/basis/logging/server/server.factor
+++ b/basis/logging/server/server.factor
@@ -106,4 +106,4 @@ CONSTANT: keep-logs 10
 [\r
     H{ } clone log-files set-global\r
     log-server\r
-] "logging" add-init-hook\r
+] "logging" add-startup-hook\r

diff --git a/basis/opengl/gl/extensions/extensions.factor b/basis/opengl/gl/extensions/extensions.factor
index 6292a683e3066d4e44d928cff397ceb2a27018c5..540fba40f0294d84173e03437001bab8702d8f4d 100644 (file)
--- a/basis/opengl/gl/extensions/extensions.factor
+++ b/basis/opengl/gl/extensions/extensions.factor
@@ -19,7 +19,7 @@ SYMBOL: +gl-function-pointers+
 : reset-gl-function-pointers ( -- )
     100 <hashtable> +gl-function-pointers+ set-global ;
     
-[ reset-gl-function-pointers ] "opengl.gl" add-init-hook
+[ reset-gl-function-pointers ] "opengl.gl" add-startup-hook
 reset-gl-function-pointers
 reset-gl-function-number-counter
 

diff --git a/basis/openssl/openssl.factor b/basis/openssl/openssl.factor
index 8f14c60e14abf4bda8766efc662bd932d5d43654..76806f9523c0151a1d0500ff17abbc6dbcb5c314 100644 (file)
--- a/basis/openssl/openssl.factor
+++ b/basis/openssl/openssl.factor
@@ -34,4 +34,4 @@ SYMBOL: ssl-initialized?
         t ssl-initialized? set-global
     ] unless ;
 
-[ f ssl-initialized? set-global ] "openssl" add-init-hook
+[ f ssl-initialized? set-global ] "openssl" add-startup-hook

diff --git a/basis/pango/cairo/cairo.factor b/basis/pango/cairo/cairo.factor
index 6fd8d57893183c9855b8a62acfed36ea752d2046..d6baaffe2e77da6557751c3b40d320e5ff6819e1 100644 (file)
--- a/basis/pango/cairo/cairo.factor
+++ b/basis/pango/cairo/cairo.factor
@@ -240,4 +240,4 @@ SYMBOL: cached-layouts
 : cached-line ( font string -- line )
     cached-layout layout>> first-line ;
 
-[ <cache-assoc> cached-layouts set-global ] "pango.cairo" add-init-hook
+[ <cache-assoc> cached-layouts set-global ] "pango.cairo" add-startup-hook

diff --git a/basis/pango/fonts/fonts.factor b/basis/pango/fonts/fonts.factor
index 280ddd20d6257881971dc915d05200bbe3ff9d8d..31a51e3f128013f8f6bac3a2bb2eb57c493464ba 100644 (file)
--- a/basis/pango/fonts/fonts.factor
+++ b/basis/pango/fonts/fonts.factor
@@ -111,4 +111,4 @@ MEMO: (cache-font-description) ( font -- description )
 : cache-font-description ( font -- description )
     strip-font-colors (cache-font-description) ;
 
-[ \ (cache-font-description) reset-memoized ] "pango.fonts" add-init-hook
+[ \ (cache-font-description) reset-memoized ] "pango.fonts" add-startup-hook

diff --git a/basis/random/mersenne-twister/mersenne-twister.factor b/basis/random/mersenne-twister/mersenne-twister.factor
index a0e40e5c382847d5b44a976b693b7097819fc8a6..90489d30521940781ef2c29e98c5a86dd9779247 100644 (file)
--- a/basis/random/mersenne-twister/mersenne-twister.factor
+++ b/basis/random/mersenne-twister/mersenne-twister.factor
@@ -79,5 +79,5 @@ M: mersenne-twister random-32* ( mt -- r )
 
 [
     default-mersenne-twister random-generator set-global
-] "bootstrap.random" add-init-hook
+] "bootstrap.random" add-startup-hook
 

diff --git a/basis/random/unix/unix.factor b/basis/random/unix/unix.factor
index 599cd5e0ad6b3cbc03e1015e3eac9c324935ef5b..fd93d6492cc73336460f934ad9a9ca2202cf2823 100644 (file)
--- a/basis/random/unix/unix.factor
+++ b/basis/random/unix/unix.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Doug Coleman
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien.c-types io io.files kernel namespaces random
-io.encodings.binary init accessors system ;
+io.encodings.binary init accessors system destructors ;
 IN: random.unix
 
 TUPLE: unix-random reader ;
@@ -9,17 +9,19 @@ TUPLE: unix-random reader ;
 : <unix-random> ( path -- random )
     binary <file-reader> unix-random boa ;
 
+M: unix-random dispose reader>> dispose ;
+
 M: unix-random random-bytes* ( n tuple -- byte-array )
     reader>> stream-read ;
 
 os openbsd? [
     [
-        "/dev/srandom" <unix-random> secure-random-generator set-global
-        "/dev/arandom" <unix-random> system-random-generator set-global
-    ] "random.unix" add-init-hook
+        "/dev/srandom" <unix-random> &dispose secure-random-generator set-global
+        "/dev/arandom" <unix-random> &dispose system-random-generator set-global
+    ] "random.unix" add-startup-hook
 ] [
     [
-        "/dev/random" <unix-random> secure-random-generator set-global
-        "/dev/urandom" <unix-random> system-random-generator set-global
-    ] "random.unix" add-init-hook
+        "/dev/random" <unix-random> &dispose secure-random-generator set-global
+        "/dev/urandom" <unix-random> &dispose system-random-generator set-global
+    ] "random.unix" add-startup-hook
 ] if

diff --git a/basis/random/windows/windows.factor b/basis/random/windows/windows.factor
index d959b191c9993170f017167e9f031332992b3c16..c948fc01e44c78089313d71db3127b5f90909883 100644 (file)
--- a/basis/random/windows/windows.factor
+++ b/basis/random/windows/windows.factor
@@ -65,5 +65,11 @@ M: windows-rng random-bytes* ( n tuple -- bytes )
     [ MS_STRONG_PROV PROV_RSA_FULL <windows-rng> ]
     [ drop MS_ENH_RSA_AES_PROV PROV_RSA_AES <windows-rng> ] recover
     secure-random-generator set-global
+] "random.windows" add-startup-hook
 
-] "random.windows" add-init-hook
+[
+    [
+        system-random-generator get-global &dispose drop
+        secure-random-generator get-global &dispose drop
+    ] with-destructors
+] "random.windows" add-shutdown-hook

diff --git a/basis/threads/threads-docs.factor b/basis/threads/threads-docs.factor
index 8956051b251fd27634aeef7aeef4b40b8b3426e0..85952ccd911f38d93bcaf7788f19b09b5a474775 100644 (file)
--- a/basis/threads/threads-docs.factor
+++ b/basis/threads/threads-docs.factor
@@ -16,7 +16,7 @@ ARTICLE: "threads-start/stop" "Starting and stopping threads"
 }
 "Threads stop either when the quotation given to " { $link spawn } " returns, or when the following word is called:"
 { $subsections stop }
-"If the image is saved and started again, all runnable threads are stopped. Vocabularies wishing to have a background thread always running should use " { $link add-init-hook } "." ;
+"If the image is saved and started again, all runnable threads are stopped. Vocabularies wishing to have a background thread always running should use " { $link add-startup-hook } "." ;
 
 ARTICLE: "threads-yield" "Yielding and suspending threads"
 "Yielding to other threads:"

diff --git a/basis/threads/threads.factor b/basis/threads/threads.factor
index dec44625f72a74b10a023942b46fcc9cabc5183f..b7e0e1b87f1e8f9ed275d15b1d2673e712a5b0b9 100644 (file)
--- a/basis/threads/threads.factor
+++ b/basis/threads/threads.factor
@@ -225,4 +225,4 @@ GENERIC: error-in-thread ( error thread -- )
 
 PRIVATE>
 
-[ init-threads ] "threads" add-init-hook
+[ init-threads ] "threads" add-startup-hook

diff --git a/basis/tools/crossref/crossref.factor b/basis/tools/crossref/crossref.factor
index 90fe7e8e9daee1a6715b8b55c2a56f066e1b8804..134395f1a85881e02a047c8f90f2fd3e8fa9659f 100644 (file)
--- a/basis/tools/crossref/crossref.factor
+++ b/basis/tools/crossref/crossref.factor
@@ -135,6 +135,6 @@ SINGLETON: invalidate-crossref
 
 M: invalidate-crossref definitions-changed 2drop crossref global delete-at ;
 
-[ invalidate-crossref add-definition-observer ] "tools.crossref" add-init-hook
+[ invalidate-crossref add-definition-observer ] "tools.crossref" add-startup-hook
 
 PRIVATE>

diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor
index 856b99fd98ebae6729c7e7d6b4d9ed61a8afb96c..c79065bb29b17baf8ca449199c5e62f8b19cb44f 100755 (executable)
--- a/basis/tools/deploy/shaker/shaker.factor
+++ b/basis/tools/deploy/shaker/shaker.factor
@@ -24,9 +24,9 @@ IN: tools.deploy.shaker
 
 : add-command-line-hook ( -- )
     [ (command-line) command-line set-global ] "command-line"
-    init-hooks get set-at ;
+    startup-hooks get set-at ;
 
-: strip-init-hooks ( -- )
+: strip-startup-hooks ( -- )
     "Stripping startup hooks" show
     {
         "alien.strings"
@@ -35,17 +35,17 @@ IN: tools.deploy.shaker
         "environment"
         "libc"
     }
-    [ init-hooks get delete-at ] each
+    [ startup-hooks get delete-at ] each
     deploy-threads? get [
-        "threads" init-hooks get delete-at
+        "threads" startup-hooks get delete-at
     ] unless
     native-io? [
-        "io.thread" init-hooks get delete-at
+        "io.thread" startup-hooks get delete-at
     ] unless
     strip-io? [
-        "io.files" init-hooks get delete-at
-        "io.backend" init-hooks get delete-at
-        "io.thread" init-hooks get delete-at
+        "io.files" startup-hooks get delete-at
+        "io.backend" startup-hooks get delete-at
+        "io.thread" startup-hooks get delete-at
     ] when
     strip-dictionary? [
         {
@@ -53,7 +53,7 @@ IN: tools.deploy.shaker
             "vocabs"
             "vocabs.cache"
             "source-files.errors"
-        } [ init-hooks get delete-at ] each
+        } [ startup-hooks get delete-at ] each
     ] when ;
 
 : strip-debugger ( -- )
@@ -294,7 +294,7 @@ IN: tools.deploy.shaker
             continuations:error-continuation
             continuations:error-thread
             continuations:restarts
-            init:init-hooks
+            init:startup-hooks
             source-files:source-files
             input-stream
             output-stream
@@ -449,7 +449,7 @@ SYMBOL: deploy-vocab
 : deploy-boot-quot ( word -- )
     [
         [ boot ] %
-        init-hooks get values concat %
+        startup-hooks get values concat %
         strip-debugger? [ , ] [
             ! Don't reference 'try' directly since we don't want
             ! to pull in the debugger and prettyprinter into every
@@ -468,7 +468,7 @@ SYMBOL: deploy-vocab
     ] [ ] make
     set-boot-quot ;
 
-: init-stripper ( -- )
+: startup-stripper ( -- )
     t "quiet" set-global
     f output-stream set-global ;
 
@@ -507,7 +507,7 @@ SYMBOL: deploy-vocab
     [ clear-megamorphic-cache ] each ;
 
 : strip ( -- )
-    init-stripper
+    startup-stripper
     strip-libc
     strip-destructors
     strip-call
@@ -515,7 +515,7 @@ SYMBOL: deploy-vocab
     strip-debugger
     strip-specialized-arrays
     compute-next-methods
-    strip-init-hooks
+    strip-startup-hooks
     add-command-line-hook
     strip-c-io
     strip-default-methods

diff --git a/basis/tools/deploy/shaker/strip-cocoa.factor b/basis/tools/deploy/shaker/strip-cocoa.factor
index 133308b7329858a4f26656c6cce3d7933e5a7efb..d5c5bd54da5d5692a529f8ca2da9b0249279713f 100644 (file)
--- a/basis/tools/deploy/shaker/strip-cocoa.factor
+++ b/basis/tools/deploy/shaker/strip-cocoa.factor
@@ -17,7 +17,7 @@ IN: cocoa.application
 
 : objc-error ( error -- ) die ;
 
-[ [ die ] 19 setenv ] "cocoa.application" add-init-hook
+[ [ die ] 19 setenv ] "cocoa.application" add-startup-hook
 
 H{ } clone \ pool [
     global [
@@ -46,4 +46,4 @@ H{ } clone \ pool [
 \ make-prepare-send reset-memoized
 \ <selector> reset-memoized
 
-\ (send) def>> second clear-assoc
\ No newline at end of file
+\ (send) def>> second clear-assoc

diff --git a/basis/tools/deprecation/deprecation.factor b/basis/tools/deprecation/deprecation.factor
index 0ee60b06b5168c471797c88d562012a47169c4dc..8dbfda3011204cf9a06bfebfb0a6eac7dea3e808 100644 (file)
--- a/basis/tools/deprecation/deprecation.factor
+++ b/basis/tools/deprecation/deprecation.factor
@@ -73,6 +73,6 @@ M: deprecation-observer definitions-changed
     [ drop initialize-deprecation-notes ] if ;
 
 [ \ deprecation-observer add-definition-observer ] 
-"tools.deprecation" add-init-hook
+"tools.deprecation" add-startup-hook
 
 initialize-deprecation-notes

diff --git a/basis/tools/errors/model/model.factor b/basis/tools/errors/model/model.factor
index c874363fe68f49f449ecfb7f6e0894567cb14c27..b41d236fd7b89a36e0bf5bf2640f82cb43250776 100644 (file)
--- a/basis/tools/errors/model/model.factor
+++ b/basis/tools/errors/model/model.factor
@@ -14,5 +14,5 @@ SINGLETON: updater
 
 M: updater errors-changed drop f (error-list-model) get-global set-model ;
 
-[ updater add-error-observer ] "ui.tools.error-list" add-init-hook
+[ updater add-error-observer ] "ui.tools.error-list" add-startup-hook
 

diff --git a/basis/ui/backend/cocoa/cocoa.factor b/basis/ui/backend/cocoa/cocoa.factor
index 9759dbfcc55f36e868851e12687c3c8e80f3facc..8eeca89c2f14903c396d40e4abbd673eee0e17ad 100755 (executable)
--- a/basis/ui/backend/cocoa/cocoa.factor
+++ b/basis/ui/backend/cocoa/cocoa.factor
@@ -225,9 +225,9 @@ CLASS: {
 : install-app-delegate ( -- )
     NSApp FactorApplicationDelegate install-delegate ;
 
-SYMBOL: cocoa-init-hook
+SYMBOL: cocoa-startup-hook
 
-cocoa-init-hook [
+cocoa-startup-hook [
     [ "MiniFactor.nib" load-nib install-app-delegate ]
 ] initialize
 
@@ -235,7 +235,7 @@ M: cocoa-ui-backend (with-ui)
     "UI" assert.app [
         [
             init-clipboard
-            cocoa-init-hook get call( -- )
+            cocoa-startup-hook get call( -- )
             start-ui
             f io-thread-running? set-global
             init-thread-timer

diff --git a/basis/ui/backend/cocoa/tools/tools.factor b/basis/ui/backend/cocoa/tools/tools.factor
index d04bcededac38e52d8f0fe4f4dff7b091523cdb5..00c1ad35831b3cbf639eb60daa864e574076f9d3 100644 (file)
--- a/basis/ui/backend/cocoa/tools/tools.factor
+++ b/basis/ui/backend/cocoa/tools/tools.factor
@@ -101,4 +101,4 @@ FUNCTION: void NSUpdateDynamicServices ;
     install-app-delegate
     "Factor.nib" load-nib
     register-services
-] cocoa-init-hook set-global
+] cocoa-startup-hook set-global

diff --git a/basis/ui/ui.factor b/basis/ui/ui.factor
index 6de303089efcde3e71f1ed38f1e18999e2090660..8260608cd4cb40ccb492cc1bd464ce5010264945 100644 (file)
--- a/basis/ui/ui.factor
+++ b/basis/ui/ui.factor
@@ -236,7 +236,7 @@ M: object close-window
 [
     f \ ui-running set-global
     <flag> ui-notify-flag set-global
-] "ui" add-init-hook
+] "ui" add-startup-hook
 
 : with-ui ( quot -- )
     ui-running? [ call( -- ) ] [ '[ init-ui @ ] (with-ui) ] if ;

diff --git a/basis/vocabs/cache/cache.factor b/basis/vocabs/cache/cache.factor
index 24ccd391f19dd00d4d93edee04cc4f3254f40cd6..1f62f02ddee23d0924f6231efc06309bf5abf67c 100644 (file)
--- a/basis/vocabs/cache/cache.factor
+++ b/basis/vocabs/cache/cache.factor
@@ -18,4 +18,4 @@ M: cache-observer vocabs-changed drop reset-cache ;
 [
     f changed-vocabs set-global
     cache-observer add-vocab-observer
-] "vocabs.cache" add-init-hook
\ No newline at end of file
+] "vocabs.cache" add-startup-hook

diff --git a/basis/vocabs/refresh/monitor/monitor.factor b/basis/vocabs/refresh/monitor/monitor.factor
index 1445b9f882e8788902a6ac15e6044b284a1a69e6..1bf73862e6b58b0da3dcff4cbe08a0c22d331df0 100644 (file)
--- a/basis/vocabs/refresh/monitor/monitor.factor
+++ b/basis/vocabs/refresh/monitor/monitor.factor
@@ -56,4 +56,4 @@ TR: convert-separators "/\\" ".." ;
 [\r
     "-no-monitors" (command-line) member?\r
     [ start-monitor-thread ] unless\r
-] "vocabs.refresh.monitor" add-init-hook\r
+] "vocabs.refresh.monitor" add-startup-hook\r

diff --git a/basis/windows/com/wrapper/wrapper.factor b/basis/windows/com/wrapper/wrapper.factor
index 39f5ce1dad71753051489e3900164c4adf4d042e..696902439ca7f9d075d29c6f5732594ad0cb37fc 100755 (executable)
--- a/basis/windows/com/wrapper/wrapper.factor
+++ b/basis/windows/com/wrapper/wrapper.factor
@@ -141,11 +141,11 @@ unless
     dup callbacks>> (callbacks>vtbls) >>vtbls
     f >>disposed drop ;
 
-: (init-hook) ( -- )
+: com-startup-hook ( -- )
     +live-wrappers+ get-global [ (allocate-wrapper) ] each
     H{ } +wrapped-objects+ set-global ;
 
-[ (init-hook) ] "windows.com.wrapper" add-init-hook
+[ com-startup-hook ] "windows.com.wrapper" add-startup-hook
 
 PRIVATE>
 

diff --git a/basis/windows/dinput/constants/constants.factor b/basis/windows/dinput/constants/constants.factor
index adbf29dfdd90099dceb74a69d12ab5d46d33929a..4e97cb0e01e058d9c78766e013305ce94a9b82f5 100755 (executable)
--- a/basis/windows/dinput/constants/constants.factor
+++ b/basis/windows/dinput/constants/constants.factor
@@ -831,7 +831,7 @@ M: array array-base-type first ;
     define-guid-constants
     define-format-constants ;
 
-[ define-constants ] "windows.dinput.constants" add-init-hook
+[ define-constants ] "windows.dinput.constants" add-startup-hook
 
 : uninitialize ( variable quot -- )
     '[ _ when* f ] change-global ; inline

diff --git a/basis/windows/fonts/fonts.factor b/basis/windows/fonts/fonts.factor
index 9e113e8c3b678d359329f011d4b4d5c11e368cbc..65a08ce3c7e7fa35db00ecf14fbc8e3965614b6e 100755 (executable)
--- a/basis/windows/fonts/fonts.factor
+++ b/basis/windows/fonts/fonts.factor
@@ -37,7 +37,7 @@ MEMO:: (cache-font) ( font -- HFONT )
 
 : cache-font ( font -- HFONT ) strip-font-colors (cache-font) ;
 
-[ \ (cache-font) reset-memoized ] "windows.fonts" add-init-hook
+[ \ (cache-font) reset-memoized ] "windows.fonts" add-startup-hook
 
 : TEXTMETRIC>metrics ( TEXTMETRIC -- metrics )
     [ metrics new 0 >>width ] dip {

diff --git a/basis/windows/uniscribe/uniscribe.factor b/basis/windows/uniscribe/uniscribe.factor
index 9555927ab1b0f0e5b68844ad73f9e378b86b2b8d..87540dc24f7b050124f7829a32ab5b99342a9bd7 100755 (executable)
--- a/basis/windows/uniscribe/uniscribe.factor
+++ b/basis/windows/uniscribe/uniscribe.factor
@@ -113,5 +113,5 @@ SYMBOL: cached-script-strings
 : cached-script-string ( font string -- script-string )
     cached-script-strings get-global [ <script-string> ] 2cache ;
 
-[ <cache-assoc> cached-script-strings set-global ]
-"windows.uniscribe" add-init-hook
+[ <cache-assoc> &dispose cached-script-strings set-global ]
+"windows.uniscribe" add-startup-hook

diff --git a/basis/windows/winsock/winsock.factor b/basis/windows/winsock/winsock.factor
index 7bd86c8e47e14fb65c4845306a159dba517ec602..b8d1f099d20ce7bc6db9fb9e17a26372fb9dbfdb 100755 (executable)
--- a/basis/windows/winsock/winsock.factor
+++ b/basis/windows/winsock/winsock.factor
@@ -442,4 +442,7 @@ CONSTANT: WSAID_CONNECTEX GUID: {25a207b9-ddf3-4660-8ee9-76e58c74063e}
 : init-winsock ( -- )
     HEX: 0202 <wsadata> WSAStartup winsock-return-check ;
 
-[ init-winsock ] "windows.winsock" add-init-hook
+: shutdown-winsock ( -- ) WSACleanup winsock-return-check ;
+
+[ init-winsock ] "windows.winsock" add-startup-hook
+[ shutdown-winsock ] "windows.winsock" add-shutdown-hook

diff --git a/core/alien/alien.factor b/core/alien/alien.factor
index f008a4bd599ace290acf22c8b771c2e12b656b94..91dd150e8f14f0924754fb57ae64e640734bc763 100644 (file)
--- a/core/alien/alien.factor
+++ b/core/alien/alien.factor
@@ -63,7 +63,7 @@ ERROR: alien-invoke-error library symbol ;
 ! cleared on startup.
 SYMBOL: callbacks
 
-[ H{ } clone callbacks set-global ] "alien" add-init-hook
+[ H{ } clone callbacks set-global ] "alien" add-startup-hook
 
 <PRIVATE
 

diff --git a/core/alien/strings/strings.factor b/core/alien/strings/strings.factor
index 83758cd8666ab53a047bc5f9784203feb0068e7f..8e09fa8c2c24ea6b9563d37be834d49602c5df7f 100644 (file)
--- a/core/alien/strings/strings.factor
+++ b/core/alien/strings/strings.factor
@@ -69,5 +69,4 @@ M: sequence string>symbol [ string>symbol* ] map ;
 [
     8 getenv utf8 alien>string string>cpu \ cpu set-global
     9 getenv utf8 alien>string string>os \ os set-global
-] "alien.strings" add-init-hook
-
+] "alien.strings" add-startup-hook

diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor
index ae668ed54fe614529323d2e5285c42ecf78b4b97..ca9056805e18bf364ee63827598c36560a527a8d 100644 (file)
--- a/core/bootstrap/primitives.factor
+++ b/core/bootstrap/primitives.factor
@@ -429,7 +429,7 @@ tuple
     { "set-datastack" "kernel" (( ds -- )) }
     { "set-retainstack" "kernel" (( rs -- )) }
     { "set-callstack" "kernel" (( cs -- )) }
-    { "exit" "system" (( n -- )) }
+    { "(exit)" "system" (( n -- )) }
     { "data-room" "memory" (( -- data-room )) }
     { "code-room" "memory" (( -- code-room )) }
     { "micros" "system" (( -- us )) }

diff --git a/core/bootstrap/stage1.factor b/core/bootstrap/stage1.factor
index 88434cef55f689688589fe0ce6f8467553564beb..29d0a311a311eb5928549d0e9eacfae948c5e2cb 100644 (file)
--- a/core/bootstrap/stage1.factor
+++ b/core/bootstrap/stage1.factor
@@ -3,7 +3,7 @@
 USING: arrays assocs continuations debugger generic hashtables
 init io io.files kernel kernel.private make math memory
 namespaces parser prettyprint sequences splitting system
-vectors vocabs vocabs.loader words ;
+vectors vocabs vocabs.loader words destructors ;
 QUALIFIED: bootstrap.image.private
 IN: bootstrap.stage1
 
@@ -37,12 +37,12 @@ load-help? off
     [
         "resource:basis/bootstrap/stage2.factor"
         dup exists? [
-            run-file
+            [ run-file ] with-destructors
         ] [
             "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/compiler/units/units.factor b/core/compiler/units/units.factor
index 9ffb98a383b2bbeabaa993a7d42112d1b3c66975..bc372d8d90c9df66b873e7b4a5d7e3217dfa6dec 100644 (file)
--- a/core/compiler/units/units.factor
+++ b/core/compiler/units/units.factor
@@ -81,11 +81,11 @@ SYMBOL: definition-observers
 GENERIC: definitions-changed ( assoc obj -- )
 
 [ V{ } clone definition-observers set-global ]
-"compiler.units" add-init-hook
+"compiler.units" add-startup-hook
 
 ! This goes here because vocabs cannot depend on init
 [ V{ } clone vocab-observers set-global ]
-"vocabs" add-init-hook
+"vocabs" add-startup-hook
 
 : add-definition-observer ( obj -- )
     definition-observers get push ;

diff --git a/core/destructors/destructors.factor b/core/destructors/destructors.factor
index 8cceeefdce9df8c6a150117685ed3298dca5c672..577da7c4eb778ea2f566ebf6c91a496284c6161d 100644 (file)
--- a/core/destructors/destructors.factor
+++ b/core/destructors/destructors.factor
@@ -6,7 +6,7 @@ IN: destructors
 
 SYMBOL: disposables
 
-[ H{ } clone disposables set-global ] "destructors" add-init-hook
+[ H{ } clone disposables set-global ] "destructors" add-startup-hook
 
 ERROR: already-unregistered disposable ;
 
@@ -87,3 +87,8 @@ PRIVATE>
         [ do-error-destructors ]
         cleanup
     ] with-scope ; inline
+
+[
+    always-destructors get-global
+    error-destructors get-global append dispose-each
+] "destructors.global" add-shutdown-hook

diff --git a/core/init/init-docs.factor b/core/init/init-docs.factor
index e76b6e8fee053d8e7a3ceb2f9570ed64716c7988..edee683bded8ca8191e997eb3b09d6ccbc1016cf 100644 (file)
--- a/core/init/init-docs.factor
+++ b/core/init/init-docs.factor
@@ -15,29 +15,39 @@ HELP: set-boot-quot
 { $description "Sets the initial quotation called by the VM on startup. This quotation must begin with a call to " { $link boot } ". The image must be saved for changes to the boot quotation to take effect." }
 { $notes "The " { $link "tools.deploy" } " tool uses this word." } ;
 
-HELP: init-hooks
+HELP: startup-hooks
 { $var-description "An association list mapping string identifiers to quotations to be run on startup." } ;
 
-HELP: do-init-hooks
+HELP: shutdown-hooks
+{ $var-description "An association list mapping string identifiers to quotations to be run on shutdown." } ;
+
+HELP: do-startup-hooks
 { $description "Calls all initialization hook quotations." } ;
 
-HELP: add-init-hook
+HELP: do-shutdown-hooks
+{ $description "Calls all shutdown hook quotations." } ;
+
+HELP: add-startup-hook
 { $values { "quot" quotation } { "name" string } }
 { $description "Registers a startup hook. The hook will always run when Factor is started. If the hook was not already defined, this word also calls it immediately." } ;
 
-{ init-hooks do-init-hooks add-init-hook } related-words
+{ startup-hooks do-startup-hooks add-startup-hook add-shutdown-hook do-shutdown-hooks shutdown-hooks } related-words
 
 ARTICLE: "init" "Initialization and startup"
 "When Factor starts, the first thing it does is call a word:"
 { $subsections boot }
 "Next, initialization hooks are called:"
-{ $subsections do-init-hooks }
+{ $subsections do-startup-hooks }
 "Initialization hooks can be defined:"
-{ $subsections add-init-hook }
+{ $subsections add-startup-hook }
+"Corresponding shutdown hooks may also be defined:"
+{ $subsections add-shutdown-hook }
 "The boot quotation can be changed:"
 { $subsections
     boot-quot
     set-boot-quot
-} ;
+}
+"When quitting Factor, shutdown hooks are called:"
+{ $subsection do-shutdown-hooks } ;
 
 ABOUT: "init"

diff --git a/core/init/init.factor b/core/init/init.factor
index 5d8e88b85f5b2ee4a78109e618f868d8773cf913..16a39bbc21cfbb6d0857611ffbba6948cf99894b 100644 (file)
--- a/core/init/init.factor
+++ b/core/init/init.factor
@@ -4,19 +4,35 @@ USING: continuations continuations.private kernel
 kernel.private sequences assocs namespaces namespaces.private ;
 IN: init
 
-SYMBOL: init-hooks
+SYMBOL: startup-hooks
+SYMBOL: shutdown-hooks
 
-init-hooks global [ drop V{ } clone ] cache drop
+startup-hooks global [ drop V{ } clone ] cache drop
+shutdown-hooks global [ drop V{ } clone ] cache drop
 
-: do-init-hooks ( -- )
-    init-hooks get [ nip call( -- ) ] assoc-each ;
+: do-hooks ( symbol -- )
+    get [ nip call( -- ) ] assoc-each ;
 
-: add-init-hook ( quot name -- )
-    dup init-hooks get at [ over call( -- ) ] unless
-    init-hooks get set-at ;
+: do-startup-hooks ( -- ) startup-hooks do-hooks ;
+
+: do-shutdown-hooks ( -- ) shutdown-hooks do-hooks ;
+
+: add-startup-hook ( quot name -- )
+    startup-hooks get
+    [ at [ drop ] [ call( -- ) ] if ]
+    [ set-at ] 3bi ;
+
+: add-shutdown-hook ( quot name -- )
+    shutdown-hooks get set-at ;
 
 : boot ( -- ) init-namespaces init-catchstack init-error-handler ;
 
 : 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/io/backend/backend.factor b/core/io/backend/backend.factor
index 494ccbff22853c73eb35ef983894ddf5ee846135..ee50500754cb329f7b4c75c3229ef32f20b03c56 100644 (file)
--- a/core/io/backend/backend.factor
+++ b/core/io/backend/backend.factor
@@ -29,9 +29,9 @@ M: object normalize-directory normalize-path ;
 
 : set-io-backend ( io-backend -- )
     io-backend set-global init-io init-stdio
-    "io.files" init-hooks get at call( -- ) ;
+    "io.files" startup-hooks get at call( -- ) ;
 
 ! Note that we have 'alien' in our using list so that the alien
 ! init hook runs before this one.
 [ init-io embedded? [ init-stdio ] unless ]
-"io.backend" add-init-hook
+"io.backend" add-startup-hook

diff --git a/core/io/files/files.factor b/core/io/files/files.factor
index 6779c6d09429bc14bc4d055354a2ed709e59bf22..9824fba18cdcb49c3cd1a903f12aaa44b3b38959 100644 (file)
--- a/core/io/files/files.factor
+++ b/core/io/files/files.factor
@@ -60,4 +60,4 @@ PRIVATE>
     13 getenv alien>native-string cwd prepend-path \ image set-global
     14 getenv alien>native-string cwd prepend-path \ vm set-global
     image parent-directory "resource-path" set-global
-] "io.files" add-init-hook
+] "io.files" add-startup-hook

diff --git a/core/source-files/errors/errors.factor b/core/source-files/errors/errors.factor
index ebacc90f633c7b906bc9447847b9520630e94134..4f5473ce9de921869ee2e94e7245102c19d90943 100644 (file)
--- a/core/source-files/errors/errors.factor
+++ b/core/source-files/errors/errors.factor
@@ -68,7 +68,7 @@ GENERIC: errors-changed ( observer -- )
 
 SYMBOL: error-observers
 
-[ V{ } clone error-observers set-global ] "source-files.errors" add-init-hook
+[ V{ } clone error-observers set-global ] "source-files.errors" add-startup-hook
 
 : add-error-observer ( observer -- ) error-observers get push ;
 

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/extra/site-watcher/site-watcher.factor b/extra/site-watcher/site-watcher.factor
index 535c8cd6261e942548cd35f027b07ed5fc475114..dcae438679e80c4eacd9e2adbd7e17e0ab1a8899 100644 (file)
--- a/extra/site-watcher/site-watcher.factor
+++ b/extra/site-watcher/site-watcher.factor
@@ -10,7 +10,7 @@ SYMBOL: site-watcher-frequency
 5 minutes site-watcher-frequency set-global
  
 SYMBOL: running-site-watcher
-[ f running-site-watcher set-global ] "site-watcher" add-init-hook
+[ f running-site-watcher set-global ] "site-watcher" add-startup-hook
 
 <PRIVATE
 

diff --git a/vm/factor.cpp b/vm/factor.cpp
index 589d1898b15ab83e05b8b83aaf9fc4433bad3a8a..c83e9cdb6b11dcc786b50ad15069ac14686b5984 100755 (executable)
--- a/vm/factor.cpp
+++ b/vm/factor.cpp
@@ -171,6 +171,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(special_objects[OBJ_EVAL_CALLBACK]);

diff --git a/vm/vm.hpp b/vm/vm.hpp
index 0e4762d6c5cb8c4e593378b8319c6d654069a032..c1f7fdb1295ce8319fdbe877484ca83172fb2e87 100755 (executable)
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -655,6 +655,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);