steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'startup'

db4
Doug Coleman 2009-11-15 15:07:07 -06:00
parent 761e6a7bf8 51e21a6aa8
commit 099bf6fd3e
61 changed files with 170 additions and 114 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/alarms/alarms.factor
View File

@ -75,7 +75,7 @@ ERROR: bad-alarm-frequency frequency ;
[ alarm-thread-loop t ] "Alarms" spawn-server [ alarm-thread-loop t ] "Alarms" spawn-server
alarm-thread set-global ; alarm-thread set-global ;
[ init-alarms ] "alarms" add-init-hook [ init-alarms ] "alarms" add-startup-hook
PRIVATE> PRIVATE>

10
basis/bootstrap/finish-bootstrap.factor
View File

@ -1,9 +1,10 @@
USING: init command-line debugger system continuations USING: init command-line debugger system continuations
namespaces eval kernel vocabs.loader io ; namespaces eval kernel vocabs.loader io destructors ;
[ [
boot boot
do-init-hooks [
do-startup-hooks
[ [
(command-line) parse-command-line (command-line) parse-command-line
load-vocab-roots load-vocab-roots
@ -12,6 +13,7 @@ namespaces eval kernel vocabs.loader io ;
ignore-cli-args? not script get and ignore-cli-args? not script get and
[ run-script ] [ "run" get run ] if* [ run-script ] [ "run" get run ] if*
output-stream get [ stream-flush ] when* output-stream get [ stream-flush ] when*
0 exit 0
] [ print-error 1 exit ] recover ] [ print-error 1 ] recover
] with-destructors exit
] set-boot-quot ] set-boot-quot

5
basis/bootstrap/finish-staging.factor
View File

@ -3,9 +3,10 @@ io ;
[ [
boot boot
do-init-hooks [
do-startup-hooks
(command-line) parse-command-line (command-line) parse-command-line
"run" get run "run" get run
output-stream get [ stream-flush ] when* output-stream get [ stream-flush ] when*
0 exit ] with-destructors 0 exit
] set-boot-quot ] set-boot-quot

1
basis/bootstrap/stage2.factor
View File

@ -56,6 +56,7 @@ SYMBOL: bootstrap-time
error-continuation set-global error-continuation set-global
error set-global ; inline error set-global ; inline
[ [
! We time bootstrap ! We time bootstrap
millis millis

2
basis/calendar/model/model.factor
View File

@ -16,4 +16,4 @@ SYMBOL: time
] "Time model update" spawn drop ; ] "Time model update" spawn drop ;
f <model> time set-global f <model> time set-global
[ time-thread ] "calendar.model" add-init-hook [ time-thread ] "calendar.model" add-startup-hook

2
basis/channels/remote/remote.factor
View File

@ -69,4 +69,4 @@ M: remote-channel from ( remote-channel -- value )
[ [
H{ } clone \ remote-channels set-global H{ } clone \ remote-channels set-global
start-channel-node start-channel-node
] "channel-registry" add-init-hook ] "channel-registry" add-startup-hook

2
basis/cocoa/application/application.factor
View File

@ -49,7 +49,7 @@ TUPLE: objc-error alien reason ;
M: objc-error summary ( error -- ) M: objc-error summary ( error -- )
drop "Objective C exception" ; drop "Objective C exception" ;
[ [ objc-error ] 19 setenv ] "cocoa.application" add-init-hook [ [ objc-error ] 19 setenv ] "cocoa.application" add-startup-hook
: running.app? ( -- ? ) : running.app? ( -- ? )
#! Test if we're running a .app. #! Test if we're running a .app.

2
basis/cocoa/cocoa.factor
View File

@ -27,7 +27,7 @@ SYMBOL: frameworks
frameworks [ V{ } clone ] initialize 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 ; SYNTAX: FRAMEWORK: scan [ load-framework ] [ frameworks get push ] bi ;

8
basis/cocoa/messages/messages.factor
View File

@ -76,13 +76,13 @@ MACRO: (send) ( selector super? -- quot )
: super-send ( receiver args... selector -- return... ) t (send) ; inline : super-send ( receiver args... selector -- return... ) t (send) ; inline
! Runtime introspection ! 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 ) : (objc-class) ( name word -- class )
2dup execute dup [ 2nip ] [ 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 ] [ 2dup execute dup [ 2nip ] [
2drop "No such class: " prepend throw 2drop "No such class: " prepend throw
] if ] if
@ -229,7 +229,7 @@ ERROR: no-objc-type name ;
: class-exists? ( string -- class ) objc_getClass >boolean ; : class-exists? ( string -- class ) objc_getClass >boolean ;
: define-objc-class-word ( quot name -- ) : define-objc-class-word ( quot name -- )
[ class-init-hooks get set-at ] [ class-startup-hooks get set-at ]
[ [
[ "cocoa.classes" create ] [ '[ _ objc-class ] ] bi [ "cocoa.classes" create ] [ '[ _ objc-class ] ] bi
(( -- class )) define-declared (( -- class )) define-declared

2
basis/command-line/command-line.factor
View File

@ -69,4 +69,4 @@ SYMBOL: main-vocab-hook
: ignore-cli-args? ( -- ? ) : ignore-cli-args? ( -- ? )
os macosx? "run" get "ui" = and ; os macosx? "run" get "ui" = and ;
[ default-cli-args ] "command-line" add-init-hook [ default-cli-args ] "command-line" add-startup-hook

2
basis/core-foundation/fsevents/fsevents.factor
View File

@ -156,7 +156,7 @@ SYMBOL: event-stream-callbacks
[ [
event-stream-callbacks event-stream-callbacks
[ [ drop expired? not ] assoc-filter H{ } assoc-like ] change-global [ [ 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 ) : add-event-source-callback ( quot -- id )
event-stream-counter <alien> event-stream-counter <alien>

2
basis/core-text/core-text.factor
View File

@ -149,4 +149,4 @@ SYMBOL: cached-lines
: cached-line ( font string -- line ) : cached-line ( font string -- line )
cached-lines get [ <line> ] 2cache ; 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

2
basis/core-text/fonts/fonts.factor
View File

@ -127,4 +127,4 @@ MEMO: (cache-font-metrics) ( font -- metrics )
[ [
\ (cache-font) reset-memoized \ (cache-font) reset-memoized
\ (cache-font-metrics) reset-memoized \ (cache-font-metrics) reset-memoized
] "core-text.fonts" add-init-hook ] "core-text.fonts" add-startup-hook

2
basis/cpu/x86/features/features.factor
View File

@ -17,7 +17,7 @@ MEMO: sse-version ( -- n )
sse_version sse_version
"sse-version" get string>number [ min ] when* ; "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 >= ; : sse? ( -- ? ) sse-version 10 >= ;
: sse2? ( -- ? ) sse-version 20 >= ; : sse2? ( -- ? ) sse-version 20 >= ;

2
basis/cpu/x86/x86.factor
View File

@ -1413,7 +1413,7 @@ enable-fixnum-log2
flush flush
1 exit 1 exit
] when ] when
] "cpu.x86" add-init-hook ; ] "cpu.x86" add-startup-hook ;
: enable-sse2 ( version -- ) : enable-sse2 ( version -- )
20 >= [ 20 >= [

2
basis/environment/environment.factor
View File

@ -32,4 +32,4 @@ HOOK: (set-os-envs) os ( seq -- )
os windows? ";" ":" ? split os windows? ";" ":" ? split
[ add-vocab-root ] each [ add-vocab-root ] each
] when* ] when*
] "environment" add-init-hook ] "environment" add-startup-hook

2
basis/game/input/input.factor
View File

@ -35,7 +35,7 @@ M: f (reset-game-input) ;
: reset-game-input ( -- ) : 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> PRIVATE>

2
basis/io/launcher/launcher.factor
View File

@ -75,7 +75,7 @@ SYMBOL: wait-flag
[ [
H{ } clone processes set-global H{ } clone processes set-global
start-wait-thread start-wait-thread
] "io.launcher" add-init-hook ] "io.launcher" add-startup-hook
: process-started ( process handle -- ) : process-started ( process handle -- )
>>handle >>handle

2
basis/io/sockets/unix/unix.factor
View File

@ -117,7 +117,7 @@ SYMBOL: receive-buffer
CONSTANT: packet-size 65536 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 ) :: do-receive ( port -- packet sockaddr )
port addr>> empty-sockaddr/size :> ( sockaddr len ) port addr>> empty-sockaddr/size :> ( sockaddr len )

2
basis/io/thread/thread.factor
View File

@ -17,4 +17,4 @@ SYMBOL: io-thread-running?
[ [
t io-thread-running? set-global t io-thread-running? set-global
start-io-thread start-io-thread
] "io.thread" add-init-hook ] "io.thread" add-startup-hook

2
basis/logging/server/server.factor
View File

@ -106,4 +106,4 @@ CONSTANT: keep-logs 10
[ [
H{ } clone log-files set-global H{ } clone log-files set-global
log-server log-server
] "logging" add-init-hook ] "logging" add-startup-hook

2
basis/opengl/gl/extensions/extensions.factor
View File

@ -19,7 +19,7 @@ SYMBOL: +gl-function-pointers+
: reset-gl-function-pointers ( -- ) : reset-gl-function-pointers ( -- )
100 <hashtable> +gl-function-pointers+ set-global ; 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-pointers
reset-gl-function-number-counter reset-gl-function-number-counter

2
basis/openssl/openssl.factor
View File

@ -34,4 +34,4 @@ SYMBOL: ssl-initialized?
t ssl-initialized? set-global t ssl-initialized? set-global
] unless ; ] unless ;
[ f ssl-initialized? set-global ] "openssl" add-init-hook [ f ssl-initialized? set-global ] "openssl" add-startup-hook

2
basis/pango/cairo/cairo.factor
View File

@ -240,4 +240,4 @@ SYMBOL: cached-layouts
: cached-line ( font string -- line ) : cached-line ( font string -- line )
cached-layout layout>> first-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

2
basis/pango/fonts/fonts.factor
View File

@ -111,4 +111,4 @@ MEMO: (cache-font-description) ( font -- description )
: cache-font-description ( font -- description ) : cache-font-description ( font -- description )
strip-font-colors (cache-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

2
basis/random/mersenne-twister/mersenne-twister.factor
View File

@ -79,5 +79,5 @@ M: mersenne-twister random-32* ( mt -- r )
[ [
default-mersenne-twister random-generator set-global default-mersenne-twister random-generator set-global
] "bootstrap.random" add-init-hook ] "bootstrap.random" add-startup-hook

16
basis/random/unix/unix.factor
View File

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

8
basis/random/windows/windows.factor
View File

@ -65,5 +65,11 @@ M: windows-rng random-bytes* ( n tuple -- bytes )
[ MS_STRONG_PROV PROV_RSA_FULL <windows-rng> ] [ MS_STRONG_PROV PROV_RSA_FULL <windows-rng> ]
[ drop MS_ENH_RSA_AES_PROV PROV_RSA_AES <windows-rng> ] recover [ drop MS_ENH_RSA_AES_PROV PROV_RSA_AES <windows-rng> ] recover
secure-random-generator set-global 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

2
basis/threads/threads-docs.factor
View File

@ -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:" "Threads stop either when the quotation given to " { $link spawn } " returns, or when the following word is called:"
{ $subsections stop } { $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" ARTICLE: "threads-yield" "Yielding and suspending threads"
"Yielding to other threads:" "Yielding to other threads:"

2
basis/threads/threads.factor
View File

@ -225,4 +225,4 @@ GENERIC: error-in-thread ( error thread -- )
PRIVATE> PRIVATE>
[ init-threads ] "threads" add-init-hook [ init-threads ] "threads" add-startup-hook

2
basis/tools/crossref/crossref.factor
View File

@ -135,6 +135,6 @@ SINGLETON: invalidate-crossref
M: invalidate-crossref definitions-changed 2drop crossref global delete-at ; 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> PRIVATE>

28
basis/tools/deploy/shaker/shaker.factor
View File

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

2
basis/tools/deploy/shaker/strip-cocoa.factor
View File

@ -17,7 +17,7 @@ IN: cocoa.application
: objc-error ( error -- ) die ; : objc-error ( error -- ) die ;
[ [ die ] 19 setenv ] "cocoa.application" add-init-hook [ [ die ] 19 setenv ] "cocoa.application" add-startup-hook
H{ } clone \ pool [ H{ } clone \ pool [
global [ global [

2
basis/tools/deprecation/deprecation.factor
View File

@ -73,6 +73,6 @@ M: deprecation-observer definitions-changed
[ drop initialize-deprecation-notes ] if ; [ drop initialize-deprecation-notes ] if ;
[ \ deprecation-observer add-definition-observer ] [ \ deprecation-observer add-definition-observer ]
"tools.deprecation" add-init-hook "tools.deprecation" add-startup-hook
initialize-deprecation-notes initialize-deprecation-notes

2
basis/tools/errors/model/model.factor
View File

@ -14,5 +14,5 @@ SINGLETON: updater
M: updater errors-changed drop f (error-list-model) get-global set-model ; 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

6
basis/ui/backend/cocoa/cocoa.factor
View File

@ -225,9 +225,9 @@ CLASS: {
: install-app-delegate ( -- ) : install-app-delegate ( -- )
NSApp FactorApplicationDelegate install-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 ] [ "MiniFactor.nib" load-nib install-app-delegate ]
] initialize ] initialize
@ -235,7 +235,7 @@ M: cocoa-ui-backend (with-ui)
"UI" assert.app [ "UI" assert.app [
[ [
init-clipboard init-clipboard
cocoa-init-hook get call( -- ) cocoa-startup-hook get call( -- )
start-ui start-ui
f io-thread-running? set-global f io-thread-running? set-global
init-thread-timer init-thread-timer

2
basis/ui/backend/cocoa/tools/tools.factor
View File

@ -101,4 +101,4 @@ FUNCTION: void NSUpdateDynamicServices ;
install-app-delegate install-app-delegate
"Factor.nib" load-nib "Factor.nib" load-nib
register-services register-services
] cocoa-init-hook set-global ] cocoa-startup-hook set-global

2
basis/ui/ui.factor
View File

@ -236,7 +236,7 @@ M: object close-window
[ [
f \ ui-running set-global f \ ui-running set-global
<flag> ui-notify-flag set-global <flag> ui-notify-flag set-global
] "ui" add-init-hook ] "ui" add-startup-hook
: with-ui ( quot -- ) : with-ui ( quot -- )
ui-running? [ call( -- ) ] [ '[ init-ui @ ] (with-ui) ] if ; ui-running? [ call( -- ) ] [ '[ init-ui @ ] (with-ui) ] if ;

2
basis/vocabs/cache/cache.factor vendored
View File

@ -18,4 +18,4 @@ M: cache-observer vocabs-changed drop reset-cache ;
[ [
f changed-vocabs set-global f changed-vocabs set-global
cache-observer add-vocab-observer cache-observer add-vocab-observer
] "vocabs.cache" add-init-hook ] "vocabs.cache" add-startup-hook

2
basis/vocabs/refresh/monitor/monitor.factor
View File

@ -56,4 +56,4 @@ TR: convert-separators "/\\" ".." ;
[ [
"-no-monitors" (command-line) member? "-no-monitors" (command-line) member?
[ start-monitor-thread ] unless [ start-monitor-thread ] unless
] "vocabs.refresh.monitor" add-init-hook ] "vocabs.refresh.monitor" add-startup-hook

4
basis/windows/com/wrapper/wrapper.factor
View File

@ -141,11 +141,11 @@ unless
dup callbacks>> (callbacks>vtbls) >>vtbls dup callbacks>> (callbacks>vtbls) >>vtbls
f >>disposed drop ; f >>disposed drop ;
: (init-hook) ( -- ) : com-startup-hook ( -- )
+live-wrappers+ get-global [ (allocate-wrapper) ] each +live-wrappers+ get-global [ (allocate-wrapper) ] each
H{ } +wrapped-objects+ set-global ; H{ } +wrapped-objects+ set-global ;
[ (init-hook) ] "windows.com.wrapper" add-init-hook [ com-startup-hook ] "windows.com.wrapper" add-startup-hook
PRIVATE> PRIVATE>

2
basis/windows/dinput/constants/constants.factor
View File

@ -831,7 +831,7 @@ M: array array-base-type first ;
define-guid-constants define-guid-constants
define-format-constants ; define-format-constants ;
[ define-constants ] "windows.dinput.constants" add-init-hook [ define-constants ] "windows.dinput.constants" add-startup-hook
: uninitialize ( variable quot -- ) : uninitialize ( variable quot -- )
'[ _ when* f ] change-global ; inline '[ _ when* f ] change-global ; inline

2
basis/windows/fonts/fonts.factor
View File

@ -37,7 +37,7 @@ MEMO:: (cache-font) ( font -- HFONT )
: cache-font ( font -- HFONT ) strip-font-colors (cache-font) ; : 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 ) : TEXTMETRIC>metrics ( TEXTMETRIC -- metrics )
[ metrics new 0 >>width ] dip { [ metrics new 0 >>width ] dip {

4
basis/windows/uniscribe/uniscribe.factor
View File

@ -113,5 +113,5 @@ SYMBOL: cached-script-strings
: cached-script-string ( font string -- script-string ) : cached-script-string ( font string -- script-string )
cached-script-strings get-global [ <script-string> ] 2cache ; cached-script-strings get-global [ <script-string> ] 2cache ;
[ <cache-assoc> cached-script-strings set-global ] [ <cache-assoc> &dispose cached-script-strings set-global ]
"windows.uniscribe" add-init-hook "windows.uniscribe" add-startup-hook

5
basis/windows/winsock/winsock.factor
View File

@ -442,4 +442,7 @@ CONSTANT: WSAID_CONNECTEX GUID: {25a207b9-ddf3-4660-8ee9-76e58c74063e}
: init-winsock ( -- ) : init-winsock ( -- )
HEX: 0202 <wsadata> WSAStartup winsock-return-check ; 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

2
core/alien/alien.factor
View File

@ -63,7 +63,7 @@ ERROR: alien-invoke-error library symbol ;
! cleared on startup. ! cleared on startup.
SYMBOL: callbacks SYMBOL: callbacks
[ H{ } clone callbacks set-global ] "alien" add-init-hook [ H{ } clone callbacks set-global ] "alien" add-startup-hook
<PRIVATE <PRIVATE

3
core/alien/strings/strings.factor
View File

@ -69,5 +69,4 @@ M: sequence string>symbol [ string>symbol* ] map ;
[ [
8 getenv utf8 alien>string string>cpu \ cpu set-global 8 getenv utf8 alien>string string>cpu \ cpu set-global
9 getenv utf8 alien>string string>os \ os set-global 9 getenv utf8 alien>string string>os \ os set-global
] "alien.strings" add-init-hook ] "alien.strings" add-startup-hook

2
core/bootstrap/primitives.factor
View File

@ -429,7 +429,7 @@ tuple
{ "set-datastack" "kernel" (( ds -- )) } { "set-datastack" "kernel" (( ds -- )) }
{ "set-retainstack" "kernel" (( rs -- )) } { "set-retainstack" "kernel" (( rs -- )) }
{ "set-callstack" "kernel" (( cs -- )) } { "set-callstack" "kernel" (( cs -- )) }
{ "exit" "system" (( n -- )) } { "(exit)" "system" (( n -- )) }
{ "data-room" "memory" (( -- data-room )) } { "data-room" "memory" (( -- data-room )) }
{ "code-room" "memory" (( -- code-room )) } { "code-room" "memory" (( -- code-room )) }
{ "micros" "system" (( -- us )) } { "micros" "system" (( -- us )) }

6
core/bootstrap/stage1.factor
View File

@ -3,7 +3,7 @@
USING: arrays assocs continuations debugger generic hashtables USING: arrays assocs continuations debugger generic hashtables
init io io.files kernel kernel.private make math memory init io io.files kernel kernel.private make math memory
namespaces parser prettyprint sequences splitting system namespaces parser prettyprint sequences splitting system
vectors vocabs vocabs.loader words ; vectors vocabs vocabs.loader words destructors ;
QUALIFIED: bootstrap.image.private QUALIFIED: bootstrap.image.private
IN: bootstrap.stage1 IN: bootstrap.stage1
@ -37,12 +37,12 @@ load-help? off
[ [
"resource:basis/bootstrap/stage2.factor" "resource:basis/bootstrap/stage2.factor"
dup exists? [ dup exists? [
run-file [ run-file ] with-destructors
] [ ] [
"Cannot find " write write "." print "Cannot find " write write "." print
"Please move " write image write " to the same directory as the Factor sources," print "Please move " write image write " to the same directory as the Factor sources," print
"and try again." print "and try again." print
1 exit 1 (exit)
] if ] if
] % ] %
] [ ] make ] [ ] make

4
core/compiler/units/units.factor
View File

@ -81,11 +81,11 @@ SYMBOL: definition-observers
GENERIC: definitions-changed ( assoc obj -- ) GENERIC: definitions-changed ( assoc obj -- )
[ V{ } clone definition-observers set-global ] [ 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 ! This goes here because vocabs cannot depend on init
[ V{ } clone vocab-observers set-global ] [ V{ } clone vocab-observers set-global ]
"vocabs" add-init-hook "vocabs" add-startup-hook
: add-definition-observer ( obj -- ) : add-definition-observer ( obj -- )
definition-observers get push ; definition-observers get push ;

7
core/destructors/destructors.factor
View File

@ -6,7 +6,7 @@ IN: destructors
SYMBOL: disposables SYMBOL: disposables
[ H{ } clone disposables set-global ] "destructors" add-init-hook [ H{ } clone disposables set-global ] "destructors" add-startup-hook
ERROR: already-unregistered disposable ; ERROR: already-unregistered disposable ;
@ -87,3 +87,8 @@ PRIVATE>
[ do-error-destructors ] [ do-error-destructors ]
cleanup cleanup
] with-scope ; inline ] with-scope ; inline
[
always-destructors get-global
error-destructors get-global append dispose-each
] "destructors.global" add-shutdown-hook

24
core/init/init-docs.factor
View File

@ -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." } { $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." } ; { $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." } ; { $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." } ; { $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 } } { $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." } ; { $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" ARTICLE: "init" "Initialization and startup"
"When Factor starts, the first thing it does is call a word:" "When Factor starts, the first thing it does is call a word:"
{ $subsections boot } { $subsections boot }
"Next, initialization hooks are called:" "Next, initialization hooks are called:"
{ $subsections do-init-hooks } { $subsections do-startup-hooks }
"Initialization hooks can be defined:" "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:" "The boot quotation can be changed:"
{ $subsections { $subsections
boot-quot boot-quot
set-boot-quot set-boot-quot
} ; }
"When quitting Factor, shutdown hooks are called:"
{ $subsection do-shutdown-hooks } ;
ABOUT: "init" ABOUT: "init"

30
core/init/init.factor
View File

@ -4,19 +4,35 @@ USING: continuations continuations.private kernel
kernel.private sequences assocs namespaces namespaces.private ; kernel.private sequences assocs namespaces namespaces.private ;
IN: init 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 ( -- ) : do-hooks ( symbol -- )
init-hooks get [ nip call( -- ) ] assoc-each ; get [ nip call( -- ) ] assoc-each ;
: add-init-hook ( quot name -- ) : do-startup-hooks ( -- ) startup-hooks do-hooks ;
dup init-hooks get at [ over call( -- ) ] unless
init-hooks get set-at ; : 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 ( -- ) init-namespaces init-catchstack init-error-handler ;
: boot-quot ( -- quot ) 20 getenv ; : boot-quot ( -- quot ) 20 getenv ;
: set-boot-quot ( quot -- ) 20 setenv ; : set-boot-quot ( quot -- ) 20 setenv ;
: shutdown-quot ( -- quot ) 67 getenv ;
: set-shutdown-quot ( quot -- ) 67 setenv ;
[ do-shutdown-hooks ] set-shutdown-quot

4
core/io/backend/backend.factor
View File

@ -29,9 +29,9 @@ M: object normalize-directory normalize-path ;
: set-io-backend ( io-backend -- ) : set-io-backend ( io-backend -- )
io-backend set-global init-io init-stdio 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 ! Note that we have 'alien' in our using list so that the alien
! init hook runs before this one. ! init hook runs before this one.
[ init-io embedded? [ init-stdio ] unless ] [ init-io embedded? [ init-stdio ] unless ]
"io.backend" add-init-hook "io.backend" add-startup-hook

2
core/io/files/files.factor
View File

@ -60,4 +60,4 @@ PRIVATE>
13 getenv alien>native-string cwd prepend-path \ image set-global 13 getenv alien>native-string cwd prepend-path \ image set-global
14 getenv alien>native-string cwd prepend-path \ vm set-global 14 getenv alien>native-string cwd prepend-path \ vm set-global
image parent-directory "resource-path" set-global image parent-directory "resource-path" set-global
] "io.files" add-init-hook ] "io.files" add-startup-hook

2
core/source-files/errors/errors.factor
View File

@ -68,7 +68,7 @@ GENERIC: errors-changed ( observer -- )
SYMBOL: error-observers 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 ; : add-error-observer ( observer -- ) error-observers get push ;

2
core/system/system.factor
View File

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

2
extra/site-watcher/site-watcher.factor
View File

@ -10,7 +10,7 @@ SYMBOL: site-watcher-frequency
5 minutes site-watcher-frequency set-global 5 minutes site-watcher-frequency set-global
SYMBOL: running-site-watcher 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 <PRIVATE

7
vm/factor.cpp
View File

@ -171,6 +171,13 @@ void factor_vm::start_factor(vm_parameters *p)
unnest_stacks(); 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 *factor_vm::factor_eval_string(char *string)
{ {
char *(*callback)(char *) = (char *(*)(char *))alien_offset(special_objects[OBJ_EVAL_CALLBACK]); char *(*callback)(char *) = (char *(*)(char *))alien_offset(special_objects[OBJ_EVAL_CALLBACK]);

1
vm/objects.hpp
View File

@ -34,6 +34,7 @@ enum special_object {
OBJ_BOOT = 20, /* boot quotation */ OBJ_BOOT = 20, /* boot quotation */
OBJ_GLOBAL, /* global namespace */ OBJ_GLOBAL, /* global namespace */
OBJ_SHUTDOWN,
/* Quotation compilation in quotations.c */ /* Quotation compilation in quotations.c */
JIT_PROLOG = 23, JIT_PROLOG = 23,

1
vm/vm.hpp
View File

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