suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

cs & io: fix subprocess handling with places

Browse Source 
A table of subprocess handles to finalize was not place-local as it
should have been. The same was true of a table of resolved IP
addresses to finalize.

Related to  #3456
This commit is contained in:
Matthew Flatt 2020-10-23 11:22:46 -06:00
parent fb87a5032c
commit 5f8ad6039d
6 changed files with 94 additions and 64 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
racket/src/ChezScheme/c/thread.c
View File

@ -93,6 +93,13 @@ ptr S_create_thread_object(who, p_tc) const char *who; ptr p_tc; {
}
}
tgc->during_alloc = 0;
tgc->pending_ephemerons = (ptr)0;
for (i = 0; i < (int)DIRTY_SEGMENT_LISTS; i++)
tgc->dirty_segments[i] = NULL;
tgc->queued_fire = 0;
tgc->preserve_ownership = 0;
v = S_vector_in(tc, space_new, 0, n);
for (i = 0; i < n; i += 1)
@ -105,6 +112,8 @@ ptr S_create_thread_object(who, p_tc) const char *who; ptr p_tc; {
GCDATA(tc) = TO_PTR(tgc);
tgc->tc = tc;
tgc->sweeper = main_sweeper_index;
/* override nonclonable tc fields */
THREADNO(tc) = S_G.threadno;
S_G.threadno = S_add(S_G.threadno, FIX(1));
@ -162,13 +171,6 @@ ptr S_create_thread_object(who, p_tc) const char *who; ptr p_tc; {
LZ4OUTBUFFER(tc) = 0;
tgc->during_alloc = 0;
tgc->sweeper = main_sweeper_index;
tgc->pending_ephemerons = (ptr)0;
for (i = 0; i < (int)DIRTY_SEGMENT_LISTS; i++)
tgc->dirty_segments[i] = NULL;
tgc->preserve_ownership = 0;
tc_mutex_release();
return thread;

112
racket/src/cs/schemified/io.scm
View File

@ -3482,20 +3482,20 @@
#f
#f))
(if (vector? ltps_0) rktio_NULL ltps_0))))))
(define cell.1$3 (unsafe-make-place-local (make-ltps)))
(define cell.1$5 (unsafe-make-place-local (make-ltps)))
(define shared-ltps-place-init!
(lambda () (unsafe-place-local-set! cell.1$3 (make-ltps))))
(lambda () (unsafe-place-local-set! cell.1$5 (make-ltps))))
(define shared-ltps-reset!
(lambda () (unsafe-place-local-set! cell.1$3 rktio_NULL)))
(lambda () (unsafe-place-local-set! cell.1$5 rktio_NULL)))
(define fd-semaphore-update!
(lambda (fd_0 mode_0)
(if (eq? (unsafe-place-local-ref cell.1$3) rktio_NULL)
(if (eq? (unsafe-place-local-ref cell.1$5) rktio_NULL)
#f
(let ((h_0
(|#%app|
rktio_ltps_add
(unsafe-place-local-ref cell.1)
(unsafe-place-local-ref cell.1$3)
(unsafe-place-local-ref cell.1$5)
fd_0
(if (eq? mode_0 'read)
1
@ -3524,13 +3524,13 @@
s_0))))))))))
(define fd-semaphore-poll-ready?
(lambda ()
(if (eq? (unsafe-place-local-ref cell.1$3) rktio_NULL)
(if (eq? (unsafe-place-local-ref cell.1$5) rktio_NULL)
#f
(begin
(|#%app|
rktio_ltps_poll
(unsafe-place-local-ref cell.1)
(unsafe-place-local-ref cell.1$3))
(unsafe-place-local-ref cell.1$5))
(letrec*
((loop_0
(|#%name|
@ -3541,7 +3541,7 @@
(|#%app|
rktio_ltps_get_signaled_handle
(unsafe-place-local-ref cell.1)
(unsafe-place-local-ref cell.1$3))))
(unsafe-place-local-ref cell.1$5))))
(if (vector? h_0)
did?_0
(let ((ib_0
@ -3657,12 +3657,12 @@
(void)))))
(define sandman-poll-ctx-poll?
(lambda (poll-ctx_0) (|#%app| poll-ctx-poll? poll-ctx_0)))
(define cell.1$8 (unsafe-make-place-local #f))
(define cell.1$10 (unsafe-make-place-local #f))
(define cell.2$3 (unsafe-make-place-local #f))
(define sandman-set-background-sleep!
(lambda (sleep_0 fd_0)
(begin
(unsafe-place-local-set! cell.1$8 sleep_0)
(unsafe-place-local-set! cell.1$10 sleep_0)
(unsafe-place-local-set! cell.2$3 fd_0))))
(define effect_2049
(begin
@ -3701,16 +3701,16 @@
(begin
(if (if sleep-secs_0 (<= sleep-secs_0 0.0) #f)
(void)
(if (unsafe-place-local-ref cell.1$8)
(if (unsafe-place-local-ref cell.1$10)
(begin
(|#%app|
rktio_start_sleep
(unsafe-place-local-ref cell.1)
(if sleep-secs_0 sleep-secs_0 0.0)
ps_0
(unsafe-place-local-ref cell.1$3)
(unsafe-place-local-ref cell.1$5)
(unsafe-place-local-ref cell.2$3))
(|#%app| (unsafe-place-local-ref cell.1$8))
(|#%app| (unsafe-place-local-ref cell.1$10))
(|#%app|
rktio_end_sleep
(unsafe-place-local-ref cell.1)))
@ -3719,7 +3719,7 @@
(unsafe-place-local-ref cell.1)
(if sleep-secs_0 sleep-secs_0 0.0)
ps_0
(unsafe-place-local-ref cell.1$3))))
(unsafe-place-local-ref cell.1$5))))
(|#%app|
rktio_poll_set_forget
(unsafe-place-local-ref cell.1)
@ -11824,12 +11824,12 @@
unsafe-undefined
temp6_0
'stderr))))
(define cell.1$7 (unsafe-make-place-local (make-stdin)))
(define cell.1$9 (unsafe-make-place-local (make-stdin)))
(define cell.2$2 (unsafe-make-place-local (make-stdout)))
(define cell.3 (unsafe-make-place-local (make-stderr)))
(define 1/current-input-port
(make-parameter
(unsafe-place-local-ref cell.1$7)
(unsafe-place-local-ref cell.1$9)
(lambda (v_0)
(begin
(if (1/input-port? v_0)
@ -11861,10 +11861,10 @@
(lambda (in-fd_0 out-fd_0 err-fd_0 cust_0 plumber_0)
(begin
(unsafe-place-local-set!
cell.1$7
cell.1$9
(let ((temp10_0 "stdin"))
(open-input-fd.1 cust_0 unsafe-undefined in-fd_0 temp10_0)))
(1/current-input-port (unsafe-place-local-ref cell.1$7))
(1/current-input-port (unsafe-place-local-ref cell.1$9))
(unsafe-place-local-set!
cell.2$2
(let ((temp13_0 "stdout"))
@ -12698,7 +12698,7 @@
((p1_0) (flush-output_0 p1_0))))))
(define maybe-flush-stdout
(lambda (in_0)
(if (eq? in_0 (unsafe-place-local-ref cell.1$7))
(if (eq? in_0 (unsafe-place-local-ref cell.1$9))
(begin
(1/flush-output (unsafe-place-local-ref cell.2$2))
(1/flush-output (unsafe-place-local-ref cell.3)))
@ -15619,21 +15619,21 @@
(raise-argument-error 'current-locale "(or/c #f string?)" v_0))
(if v_0 (string->immutable-string v_0) #f)))
'current-locale))
(define cell.1$6 (unsafe-make-place-local #f))
(define cell.1$8 (unsafe-make-place-local #f))
(define sync-locale!
(lambda ()
(let ((loc_0 (1/current-locale)))
(if (let ((or-part_0 (not loc_0)))
(if or-part_0
or-part_0
(equal? (unsafe-place-local-ref cell.1$6) loc_0)))
(equal? (unsafe-place-local-ref cell.1$8) loc_0)))
(void)
(begin
(unsafe-place-local-set! cell.1$6 (1/current-locale))
(unsafe-place-local-set! cell.1$8 (1/current-locale))
(|#%app|
rktio_set_locale
(unsafe-place-local-ref cell.1)
(1/string->bytes/utf-8 (unsafe-place-local-ref cell.1$6))))))))
(1/string->bytes/utf-8 (unsafe-place-local-ref cell.1$8))))))))
(define effect_2454 (begin (void (sync-locale!)) (void)))
(define locale-encoding-is-utf-8?
(lambda ()
@ -17724,32 +17724,32 @@
(register-struct-field-mutator! set-cache-from! struct:cache 3)
(void)))
(define new-cache (lambda () (cache1.1 #f #f #f #f)))
(define cell.1$5 (unsafe-make-place-local (new-cache)))
(define cell.1$7 (unsafe-make-place-local (new-cache)))
(define cell.2$1
(unsafe-make-place-local (|#%app| 1/unsafe-make-custodian-at-root)))
(define convert-cache-init!
(lambda ()
(begin
(unsafe-place-local-set! cell.1$5 (new-cache))
(unsafe-place-local-set! cell.1$7 (new-cache))
(unsafe-place-local-set!
cell.2$1
(|#%app| 1/unsafe-make-custodian-at-root)))))
(define cache-clear!
(lambda (get_0 update!_0)
(let ((c_0 (|#%app| get_0 (unsafe-place-local-ref cell.1$5))))
(let ((c_0 (|#%app| get_0 (unsafe-place-local-ref cell.1$7))))
(begin
(|#%app| update!_0 (unsafe-place-local-ref cell.1$5) #f)
(|#%app| update!_0 (unsafe-place-local-ref cell.1$7) #f)
(if c_0 (1/bytes-close-converter c_0) (void))))))
(define cache-lookup!
(lambda (enc_0 get_0 update!_0)
(begin
(unsafe-start-atomic)
(begin0
(if (equal? enc_0 (cache-enc (unsafe-place-local-ref cell.1$5)))
(let ((c_0 (|#%app| get_0 (unsafe-place-local-ref cell.1$5))))
(if (equal? enc_0 (cache-enc (unsafe-place-local-ref cell.1$7)))
(let ((c_0 (|#%app| get_0 (unsafe-place-local-ref cell.1$7))))
(begin
(if c_0
(|#%app| update!_0 (unsafe-place-local-ref cell.1$5) #f)
(|#%app| update!_0 (unsafe-place-local-ref cell.1$7) #f)
(void))
c_0))
#f)
@ -17761,18 +17761,18 @@
(unsafe-start-atomic)
(begin0
(begin
(if (equal? enc_0 (cache-enc (unsafe-place-local-ref cell.1$5)))
(if (equal? enc_0 (cache-enc (unsafe-place-local-ref cell.1$7)))
(void)
(begin
(cache-clear! cache-to set-cache-to!)
(cache-clear! cache-to_3068 set-cache-to2!)
(cache-clear! cache-from set-cache-from!)
(set-cache-enc! (unsafe-place-local-ref cell.1$5) enc_0)))
(if (|#%app| get_0 (unsafe-place-local-ref cell.1$5))
(set-cache-enc! (unsafe-place-local-ref cell.1$7) enc_0)))
(if (|#%app| get_0 (unsafe-place-local-ref cell.1$7))
(1/bytes-close-converter c_0)
(begin
(bytes-reset-converter c_0)
(|#%app| update!_0 (unsafe-place-local-ref cell.1$5) c_0))))
(|#%app| update!_0 (unsafe-place-local-ref cell.1$7) c_0))))
(unsafe-end-atomic)))
(void))))
(define bytes-open-converter/cached-to
@ -34896,11 +34896,11 @@
(for-loop_0 null (hash-iterate-first topics_0)))))))))
(args (raise-binding-result-arity-error 2 args))))))
(define make-root-logger (lambda () (create-logger.1 #f 'none #f)))
(define cell.1$4 (unsafe-make-place-local (make-root-logger)))
(define unsafe-root-logger (lambda () (unsafe-place-local-ref cell.1$4)))
(define cell.1$6 (unsafe-make-place-local (make-root-logger)))
(define unsafe-root-logger (lambda () (unsafe-place-local-ref cell.1$6)))
(define 1/current-logger
(make-parameter
(unsafe-place-local-ref cell.1$4)
(unsafe-place-local-ref cell.1$6)
(lambda (l_0)
(begin
(if (1/logger? l_0)
@ -34911,8 +34911,8 @@
(define logger-init!
(lambda ()
(begin
(unsafe-place-local-set! cell.1$4 (make-root-logger))
(1/current-logger (unsafe-place-local-ref cell.1$4)))))
(unsafe-place-local-set! cell.1$6 (make-root-logger))
(1/current-logger (unsafe-place-local-ref cell.1$6)))))
(define 1/make-logger
(let ((make-logger_0
(|#%name|
@ -34977,14 +34977,14 @@
(begin
(|#%app| start-atomic/no-interrupts)
(begin0
(log-level?* (unsafe-place-local-ref cell.1$4) 'debug 'future)
(log-level?* (unsafe-place-local-ref cell.1$6) 'debug 'future)
(|#%app| end-atomic/no-interrupts)))))
(define logging-place-events?
(lambda ()
(begin
(|#%app| start-atomic/no-interrupts)
(begin0
(log-level?* (unsafe-place-local-ref cell.1$4) 'debug 'place)
(log-level?* (unsafe-place-local-ref cell.1$6) 'debug 'place)
(|#%app| end-atomic/no-interrupts)))))
(define log-level?*
(lambda (logger_0 level_0 topic_0)
@ -35158,7 +35158,7 @@
(|#%app| start-atomic/no-interrupts)
(begin0
(log-message*
(unsafe-place-local-ref cell.1$4)
(unsafe-place-local-ref cell.1$6)
'debug
'future
message_0
@ -35172,7 +35172,7 @@
(|#%app| start-atomic/no-interrupts)
(begin0
(log-message*
(unsafe-place-local-ref cell.1$4)
(unsafe-place-local-ref cell.1$6)
'debug
'place
message_0
@ -35448,7 +35448,7 @@
rktio_fs_change
(unsafe-place-local-ref cell.1)
fn_0
(unsafe-place-local-ref cell.1$3))))
(unsafe-place-local-ref cell.1$5))))
(let ((rfc_0
(if (vector? file-rfc_0)
(begin
@ -35482,7 +35482,7 @@
(unsafe-place-local-ref cell.1)
base-fn_0
(unsafe-place-local-ref
cell.1$3)))))
cell.1$5)))))
(args
(raise-binding-result-arity-error
3
@ -35577,7 +35577,7 @@
(lambda (a_0 b_0)
(begin (not (eqv? 0 (bitwise-and a_0 b_0))))))))
(if (if (set?_0 props_0 16)
(eq? (unsafe-place-local-ref cell.1$3) rktio_NULL)
(eq? (unsafe-place-local-ref cell.1$5) rktio_NULL)
#f)
'#(#f #f #f #f)
(let ((app_0 (if (set?_0 props_0 1) 'supported #f)))
@ -36480,7 +36480,9 @@
(|#%app| 1/unsafe-custodian-unregister sp_0 (subprocess-cust-ref sp_0))
(set-subprocess-cust-ref! sp_0 #f))
(void))))
(define subprocess-will-executor (make-will-executor))
(define cell.1$4 (unsafe-make-place-local (make-will-executor)))
(define subprocess-init!
(lambda () (unsafe-place-local-set! cell.1$4 (make-will-executor))))
(define register-subprocess-finalizer
(letrec ((procz1
(lambda (sp_0)
@ -36495,10 +36497,11 @@
(void))
(no-custodian! sp_0)
#t))))
(lambda (sp_0) (will-register subprocess-will-executor sp_0 procz1))))
(lambda (sp_0)
(will-register (unsafe-place-local-ref cell.1$4) sp_0 procz1))))
(define poll-subprocess-finalizations
(lambda ()
(if (will-try-execute subprocess-will-executor)
(if (will-try-execute (unsafe-place-local-ref cell.1$4))
(poll-subprocess-finalizations)
(void))))
(define 1/current-subprocess-custodian-mode
@ -37251,7 +37254,7 @@
(unsafe-place-local-ref cell.1)
addr_0)))))))))))))
(loop_0)))))))))))))
(define address-will-executor (make-will-executor))
(define cell.1$3 (unsafe-make-place-local (make-will-executor)))
(define register-address-finalizer
(letrec ((procz1
(lambda (addr_0)
@ -37261,12 +37264,15 @@
(unsafe-place-local-ref cell.1)
addr_0)
#t))))
(lambda (addr_0) (will-register address-will-executor addr_0 procz1))))
(lambda (addr_0)
(will-register (unsafe-place-local-ref cell.1$3) addr_0 procz1))))
(define poll-address-finalizations
(lambda ()
(if (will-try-execute address-will-executor)
(if (will-try-execute (unsafe-place-local-ref cell.1$3))
(poll-address-finalizations)
(void))))
(define address-init!
(lambda () (unsafe-place-local-set! cell.1$3 (make-will-executor))))
(define struct:connect-progress
(make-record-type-descriptor* 'connect-progress #f #f #f #f 2 3))
(define effect_2403
@ -41169,5 +41175,7 @@
(install-error-value->string-handler!)
(init-current-directory!)
(init-current-ports! in-fd_0 out-fd_0 err-fd_0 cust_0 plumber_0)
(subprocess-init!)
(address-init!)
(sync-locale!))))
(define io-place-destroy! (lambda () (rktio-place-destroy!)))

5
racket/src/expander/extract/global.rkt
View File

@ -139,6 +139,11 @@
(loop target))
(loop key-rhs)
(loop val-rhs)]
[`(will-register ,target ,es ...)
(if (symbol? target)
(found-state! target e)
(loop target))
(for-each loop es)]
[`(,es ...)
(for ([e (in-list es)])
(loop e))]

5
racket/src/io/main.rkt
View File

@ -33,6 +33,9 @@
shared-ltps-place-init!)
(only-in "locale/cache.rkt"
convert-cache-init!)
(only-in "network/address.rkt"
address-init!)
(submod "subprocess/main.rkt" init)
(only-in "locale/parameter.rkt"
sync-locale!)
"port/place.rkt")
@ -72,6 +75,8 @@
(install-error-value->string-handler!)
(init-current-directory!)
(init-current-ports! in-fd out-fd err-fd cust plumber)
(subprocess-init!)
(address-init!)
(sync-locale!))
(define (io-place-destroy!)

9
racket/src/io/network/address.rkt
View File

@ -3,11 +3,13 @@
"../string/convert.rkt"
"../host/rktio.rkt"
"../host/thread.rkt"
"../host/place-local.rkt"
"evt.rkt"
"error.rkt")
(provide call-with-resolved-address
register-address-finalizer)
register-address-finalizer
address-init!)
;; in atomic mode
(define (call-with-resolved-address hostname port-no proc
@ -79,7 +81,7 @@
;; ----------------------------------------
(define address-will-executor (make-will-executor))
(define-place-local address-will-executor (make-will-executor))
(define (register-address-finalizer addr)
(will-register address-will-executor
@ -91,3 +93,6 @@
(define (poll-address-finalizations)
(when (will-try-execute address-will-executor)
(poll-address-finalizations)))
(define (address-init!)
(set! address-will-executor (make-will-executor)))

7
racket/src/io/subprocess/main.rkt
View File

@ -4,6 +4,7 @@
"../host/rktio.rkt"
"../host/error.rkt"
"../host/thread.rkt"
"../host/place-local.rkt"
"../path/path.rkt"
"../path/parameter.rkt"
"../port/output-port.rkt"
@ -242,7 +243,11 @@
(unsafe-custodian-unregister sp (subprocess-cust-ref sp))
(set-subprocess-cust-ref! sp #f)))
(define subprocess-will-executor (make-will-executor))
(define-place-local subprocess-will-executor (make-will-executor))
(define (subprocess-init!)
(set! subprocess-will-executor (make-will-executor)))
(module+ init (provide subprocess-init!))
(define (register-subprocess-finalizer sp)
(will-register subprocess-will-executor