add collect-rendezvous

original commit: aef0458c08d10e02a2b50b7018564c0cca7c709c
This commit is contained in:
Matthew Flatt 2018-01-20 21:02:15 -07:00
parent 0c55348453
commit 15d1acd2f5
3 changed files with 7 additions and 0 deletions

View File

@ -180,6 +180,7 @@ void S_prim_init() {
Sforeign_symbol("(cs)enable_object_backreferences", (void *)S_enable_object_backreferences); Sforeign_symbol("(cs)enable_object_backreferences", (void *)S_enable_object_backreferences);
Sforeign_symbol("(cs)set_enable_object_backreferences", (void *)S_set_enable_object_backreferences); Sforeign_symbol("(cs)set_enable_object_backreferences", (void *)S_set_enable_object_backreferences);
Sforeign_symbol("(cs)object_backreferences", (void *)S_object_backreferences); Sforeign_symbol("(cs)object_backreferences", (void *)S_object_backreferences);
Sforeign_symbol("(cs)fire_collector", (void *)S_fire_collector);
} }
static void s_instantiate_code_object() { static void s_instantiate_code_object() {

5
s/7.ss
View File

@ -769,6 +769,11 @@
($oops who "invalid target generation ~s for generation ~s" gtarget g)) ($oops who "invalid target generation ~s for generation ~s" gtarget g))
(collect2 g (if (eq? gtarget 'static) (constant static-generation) gtarget))]))) (collect2 g (if (eq? gtarget 'static) (constant static-generation) gtarget))])))
(set! collect-rendezvous
(let ([fire-collector (foreign-procedure "(cs)fire_collector" () void)])
(lambda ()
(fire-collector))))
(set! keyboard-interrupt-handler (set! keyboard-interrupt-handler
($make-thread-parameter ($make-thread-parameter
(lambda () (lambda ()

View File

@ -1201,6 +1201,7 @@
(clear-input-port [sig [() (input-port) -> (void)]] [flags true]) (clear-input-port [sig [() (input-port) -> (void)]] [flags true])
(clear-output-port [sig [() (output-port) -> (void)]] [flags true]) (clear-output-port [sig [() (output-port) -> (void)]] [flags true])
(collect [sig [() (sub-ufixnum) (sub-ufixnum ptr) -> (void)]] [flags true]) (collect [sig [() (sub-ufixnum) (sub-ufixnum ptr) -> (void)]] [flags true])
(collect-rendezvous [sig [() -> (void)]] [flags])
(collections [sig [() -> (uint)]] [flags unrestricted alloc]) (collections [sig [() -> (uint)]] [flags unrestricted alloc])
(compile [sig [(sub-ptr) (sub-ptr environment) -> (ptr ...)]] [flags]) (compile [sig [(sub-ptr) (sub-ptr environment) -> (ptr ...)]] [flags])
(compile-file [sig [(pathname) (pathname pathname) (pathname pathname sub-symbol) -> (void)]] [flags true]) (compile-file [sig [(pathname) (pathname pathname) (pathname pathname sub-symbol) -> (void)]] [flags true])