[ alarm-thread-loop t ] "Alarms" spawn-server
alarm-thread set-global ;
-[ init-alarms ] "alarms" add-init-hook
+[ init-alarms ] "alarms" add-startup-hook
PRIVATE>
[
boot
- do-init-hooks
+ do-startup-hooks
[
(command-line) parse-command-line
load-vocab-roots
[
boot
- do-init-hooks
+ do-startup-hooks
(command-line) parse-command-line
"run" get run
output-stream get [ stream-flush ] when*
] "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
[
H{ } clone \ remote-channels set-global
start-channel-node
-] "channel-registry" add-init-hook
+] "channel-registry" add-startup-hook
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.
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 ;
: 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
: 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
: 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
[
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>
: 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
[
\ (cache-font) reset-memoized
\ (cache-font-metrics) reset-memoized
-] "core-text.fonts" add-init-hook
+] "core-text.fonts" add-startup-hook
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 >= ;
flush
1 exit
] when
- ] "cpu.x86" add-init-hook ;
+ ] "cpu.x86" add-startup-hook ;
: enable-sse2 ( version -- )
20 >= [
os windows? ";" ":" ? split
[ add-vocab-root ] each
] when*
-] "environment" add-init-hook
+] "environment" add-startup-hook
: reset-game-input ( -- )
(reset-game-input) ;
-[ reset-game-input ] "game-input" add-init-hook
+[ reset-game-input ] "game-input" add-startup-hook
PRIVATE>
[
H{ } clone processes set-global
start-wait-thread
-] "io.launcher" add-init-hook
+] "io.launcher" add-startup-hook
: process-started ( process handle -- )
>>handle
CONSTANT: packet-size 65536
-[ packet-size malloc receive-buffer set-global ] "io.sockets.unix" add-init-hook
+[ packet-size malloc receive-buffer set-global ] "io.sockets.unix" add-startup-hook
+[ receive-buffer get-global free ] "io.sockets.unix" add-shutdown-hook
:: do-receive ( port -- packet sockaddr )
port addr>> empty-sockaddr/size :> len :> sockaddr
[\r
t io-thread-running? set-global\r
start-io-thread\r
-] "io.thread" add-init-hook\r
+] "io.thread" add-startup-hook\r
[\r
H{ } clone log-files set-global\r
log-server\r
-] "logging" add-init-hook\r
+] "logging" add-startup-hook\r
: 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
t ssl-initialized? set-global
] unless ;
-[ f ssl-initialized? set-global ] "openssl" add-init-hook
+[ f ssl-initialized? set-global ] "openssl" add-startup-hook
: 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
: 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
[
default-mersenne-twister random-generator set-global
-] "bootstrap.random" add-init-hook
+] "bootstrap.random" add-startup-hook
! 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 ;
: <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 ;
[
"/dev/srandom" <unix-random> secure-random-generator set-global
"/dev/arandom" <unix-random> 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/urandom" <unix-random> system-random-generator set-global
- ] "random.unix" add-init-hook
+ ] "random.unix" add-startup-hook
] if
+
+[
+ [
+ secure-random-generator get-global &dispose drop
+ system-random-generator get-global &dispose drop
+ ] with-destructors
+] "random.unix" add-shutdown-hook
[ 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
}
"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:"
PRIVATE>
-[ init-threads ] "threads" add-init-hook
+[ init-threads ] "threads" add-startup-hook
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>
\ No newline at end of file
+PRIVATE>
: 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"
"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? [
{
"vocabs"
"vocabs.cache"
"source-files.errors"
- } [ init-hooks get delete-at ] each
+ } [ startup-hooks get delete-at ] each
] when ;
: strip-debugger ( -- )
continuations:error-continuation
continuations:error-thread
continuations:restarts
- init:init-hooks
+ init:startup-hooks
source-files:source-files
input-stream
output-stream
: 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
] [ ] make
set-boot-quot ;
-: init-stripper ( -- )
+: startup-stripper ( -- )
t "quiet" set-global
f output-stream set-global ;
[ clear-megamorphic-cache ] each ;
: strip ( -- )
- init-stripper
+ startup-stripper
strip-libc
strip-destructors
strip-call
strip-debugger
strip-specialized-arrays
compute-next-methods
- strip-init-hooks
+ strip-startup-hooks
add-command-line-hook
strip-c-io
strip-default-methods
: objc-error ( error -- ) die ;
-[ [ die ] 19 setenv ] "cocoa.application" add-init-hook
+[ [ die ] 19 setenv ] "cocoa.application" add-startup-hook
H{ } clone \ pool [
global [
\ make-prepare-send reset-memoized
\ <selector> reset-memoized
-\ (send) def>> second clear-assoc
\ No newline at end of file
+\ (send) def>> second clear-assoc
[ drop initialize-deprecation-notes ] if ;
[ \ deprecation-observer add-definition-observer ]
-"tools.deprecation" add-init-hook
+"tools.deprecation" add-startup-hook
initialize-deprecation-notes
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
: 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
"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
install-app-delegate
"Factor.nib" load-nib
register-services
-] cocoa-init-hook set-global
+] cocoa-startup-hook set-global
[
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 ;
[
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
[\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
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>
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
: 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 {
cached-script-strings get-global [ <script-string> ] 2cache ;
[ <cache-assoc> cached-script-strings set-global ]
-"windows.uniscribe" add-init-hook
+"windows.uniscribe" add-startup-hook
+
+[ cached-script-strings get-global dispose ]
+"windows.uniscribe" add-shutdown-hook
: 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
! cleared on startup.
SYMBOL: callbacks
-[ H{ } clone callbacks set-global ] "alien" add-init-hook
+[ H{ } clone callbacks set-global ] "alien" add-startup-hook
<PRIVATE
[
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
{ "set-datastack" "kernel" (( ds -- )) }
{ "set-retainstack" "kernel" (( rs -- )) }
{ "set-callstack" "kernel" (( cs -- )) }
- { "exit" "system" (( n -- )) }
+ { "(exit)" "system" (( n -- )) }
{ "data-room" "memory" (( -- cards decks generations )) }
{ "code-room" "memory" (( -- code-total code-used code-free largest-free-block )) }
{ "micros" "system" (( -- us )) }
"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
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 ;
SYMBOL: disposables
-[ H{ } clone disposables set-global ] "destructors" add-init-hook
+[ H{ } clone disposables set-global ] "destructors" add-startup-hook
ERROR: already-unregistered disposable ;
{ $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"
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
: 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
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
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 ;
error-types get [
second forget-quot>> dup
[ call( definition -- ) ] [ 2drop ] if
- ] with each ;
\ No newline at end of file
+ ] with each ;
: embedded? ( -- ? ) 15 getenv ;
: millis ( -- ms ) micros 1000 /i ;
+
+: exit ( n -- ) do-shutdown-hooks (exit) ;
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
unnest_stacks();
}
+void factor_vm::stop_factor()
+{
+ nest_stacks(NULL);
+ c_to_factor_toplevel(userenv[SHUTDOWN_ENV]);
+ unnest_stacks();
+}
+
char *factor_vm::factor_eval_string(char *string)
{
char *(*callback)(char *) = (char *(*)(char *))alien_offset(userenv[EVAL_CALLBACK_ENV]);
THREADS_ENV = 64,
RUN_QUEUE_ENV = 65,
SLEEP_QUEUE_ENV = 66,
+ SHUTDOWN_ENV = 67,
};
#define FIRST_SAVE_ENV BOOT_ENV
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);