cs: repair shared poll set initialization

Esspecially affects filesystem change events on Mac OS and BSDs.

pkgs/racket-test/tests/racket/stress/fs-change.rkt

@@ -0,0 +1,26 @@
+#lang racket/base
+(require racket/place
+         racket/file)
+
+(define (go)
+  (place
+   pch
+   (define path (make-temporary-file))
+   (call-with-output-file* path #:exists 'append void)
+   (for ([i (in-range 50)])
+     (define c (make-custodian))
+     (parameterize ([current-custodian c])
+       (define fcs
+         (for/list ([j (in-range 100)])
+           (define fc (filesystem-change-evt path))
+           (sync/timeout 0 fc)
+           (if (even? j)
+               (call-with-output-file* path #:exists 'append (lambda (o) (write-byte 48 o)))
+               (filesystem-change-evt-cancel fc))
+           fc))
+       (map sync fcs))
+     (custodian-shutdown-all c))
+   (delete-file path)))
+
+(module+ main
+  (map place-wait (for/list ([i 4]) (go))))

racket/src/io/main.rkt

@@ -28,6 +28,8 @@
                   rktio-place-init!)
          (submod "error/main.rkt"
                  place-init)
+         (only-in "sandman/ltps.rkt"
+                  shared-ltps-place-init!)
          "port/place.rkt")
 
 (provide (all-from-out "port/main.rkt")
@@ -60,6 +62,7 @@
   (sandman-place-init!)
   (rktio-place-init!)
   (logger-init!)
+  (shared-ltps-place-init!)
   (install-error-value->string-handler!)
   (init-current-directory!)
   (init-current-ports! in-fd out-fd err-fd cust plumber))

racket/src/io/sandman/ltps.rkt

@@ -31,7 +31,7 @@
 (define-place-local shared-ltps (make-ltps))
 
 (define (shared-ltps-place-init!)
-  (make-ltps))
+  (set! shared-ltps (make-ltps)))
 
 ;; ----------------------------------------
 

racket/src/io/sandman/main.rkt

@@ -62,8 +62,7 @@
 (define-place-local awoken-threads '())
 
 (define (sandman-place-init!)
-  (set! lock (make-lock))
+  (set! lock (make-lock)))
-  (shared-ltps-place-init!))
 
 (void
  (current-sandman