net: pin buffers during collect-safe socket IO

ober

796d034c11e8f255f7dd97ec0dafdaac73535b86

diff --git a/lib/std/net/thread-httpd.ss b/lib/std/net/thread-httpd.ss
index 4ad8b7d..1e65605 100644
--- a/lib/std/net/thread-httpd.ss
+++ b/lib/std/net/thread-httpd.ss
@@ -441,13 +441,23 @@
   ;; bytevector pointers safely.  Use a staging buffer instead.
   (def *stage-size* 4096)
 
+  (def (call-with-locked-bytevector bytes thunk)
+    ;; Collect-safe FFI calls allow the collector to run while libc is using
+    ;; the bytevector address. Pin the object for the complete syscall.
+    (lock-object bytes)
+    (try
+      (thunk)
+      (finally (unlock-object bytes))))
+
   (def (read-bytes fd n deadline-ms)
     ;; Read up to n bytes; return bytevector or #f on EOF/error.
     (cond
       [(>= (monotonic-ms) deadline-ms) #f]
       [else
        (let ([stage (make-bytevector (min n *stage-size*))])
-         (let ([got (c-read fd stage (bytevector-length stage))])
+         (let ([got (call-with-locked-bytevector
+                      stage
+                      (lambda () (c-read fd stage (bytevector-length stage))))])
            (cond
              [(or (<= got 0) (> (monotonic-ms) deadline-ms)) #f]
              [else
@@ -763,7 +773,9 @@
     (let* ([actual (min count 65536)]
            [stage (make-bytevector actual)])
       (bytevector-copy! bv offset stage 0 actual)
-      (c-write fd stage actual)))
+      (call-with-locked-bytevector
+        stage
+        (lambda () (c-write fd stage actual)))))
 
   ;; ========== Server ==========