Merge branch 'startup'

2009-11-15 15:07:07 -06:00 · 2009-11-15 15:07:07 -06:00 · 099bf6fd3e
parent 761e6a7bf8 51e21a6aa8
commit 099bf6fd3e
61 changed files with 170 additions and 114 deletions
--- 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>

--- a/basis/bootstrap/finish-bootstrap.factor
+++ b/basis/bootstrap/finish-bootstrap.factor
@ -1,9 +1,10 @@
 USING: init command-line debugger system continuations
-namespaces eval kernel vocabs.loader io ;
+namespaces eval kernel vocabs.loader io destructors ;

 [
    boot
-    do-init-hooks
+    [
+        do-startup-hooks
        [
            (command-line) parse-command-line
            load-vocab-roots
@ -12,6 +13,7 @@ namespaces eval kernel vocabs.loader io ;
            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
+            0
+        ] [ print-error 1 ] recover
+     ] with-destructors exit
 ] set-boot-quot
--- a/basis/bootstrap/finish-staging.factor
+++ b/basis/bootstrap/finish-staging.factor
@ -3,9 +3,10 @@ io ;

 [
    boot
-    do-init-hooks
+    [
+        do-startup-hooks
        (command-line) parse-command-line
        "run" get run
        output-stream get [ stream-flush ] when*
-    0 exit
+    ] with-destructors 0 exit
 ] set-boot-quot
--- 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
--- a/basis/calendar/model/model.factor
+++ b/basis/calendar/model/model.factor
@ -16,4 +16,4 @@ SYMBOL: time
    ] "Time model update" spawn drop ;

 f <model> time set-global
-[ time-thread ] "calendar.model" add-init-hook
+[ time-thread ] "calendar.model" add-startup-hook
--- 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
--- 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.
--- 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 ;

--- 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
--- 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
--- 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>
--- 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
--- 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
--- 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 >= ;
--- 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 >= [
--- 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
--- 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>

--- 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
--- 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 )
--- a/basis/io/thread/thread.factor
+++ b/basis/io/thread/thread.factor
@ -17,4 +17,4 @@ SYMBOL: io-thread-running?
 [
    t io-thread-running? set-global
    start-io-thread
-] "io.thread" add-init-hook
+] "io.thread" add-startup-hook
--- a/basis/logging/server/server.factor
+++ b/basis/logging/server/server.factor
@ -106,4 +106,4 @@ CONSTANT: keep-logs 10
 [
    H{ } clone log-files set-global
    log-server
-] "logging" add-init-hook
+] "logging" add-startup-hook
--- 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

--- 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
--- 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
--- 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
--- 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

--- 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
--- 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
--- 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:"
--- 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
--- 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>
--- 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
--- 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 [
--- 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
--- 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

--- 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
--- 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
--- 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 ;
--- 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
+] "vocabs.cache" add-startup-hook
--- a/basis/vocabs/refresh/monitor/monitor.factor
+++ b/basis/vocabs/refresh/monitor/monitor.factor
@ -56,4 +56,4 @@ TR: convert-separators "/\\" ".." ;
 [
    "-no-monitors" (command-line) member?
    [ start-monitor-thread ] unless
-] "vocabs.refresh.monitor" add-init-hook
+] "vocabs.refresh.monitor" add-startup-hook
--- 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>

--- 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
--- 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 {
--- 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
--- 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
--- 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

--- 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
--- 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 )) }
--- 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
--- 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 ;
--- 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
--- 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"
--- 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
--- 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
--- 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
--- 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 ;

--- 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) ;
--- 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

--- 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(special_objects[OBJ_SHUTDOWN]);
+	unnest_stacks();
+}
+
 char *factor_vm::factor_eval_string(char *string)
 {
 	char *(*callback)(char *) = (char *(*)(char *))alien_offset(special_objects[OBJ_EVAL_CALLBACK]);
--- a/vm/objects.hpp
+++ b/vm/objects.hpp
@ -34,6 +34,7 @@ enum special_object {

 	OBJ_BOOT            = 20, /* boot quotation */
 	OBJ_GLOBAL,               /* global namespace */
+	OBJ_SHUTDOWN,

 	/* Quotation compilation in quotations.c */
 	JIT_PROLOG          = 23,
--- 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);