net: make threaded response writes reliable

ober

3694b0c9a4ded5942303f0f4e62d6f365ed9dfd9

diff --git a/lib/std/net/thread-httpd.ss b/lib/std/net/thread-httpd.ss
index 0baf27a..4ad8b7d 100644
--- a/lib/std/net/thread-httpd.ss
+++ b/lib/std/net/thread-httpd.ss
@@ -692,7 +692,9 @@
         (bytevector-copy! bv start out 0 len))
       out))
 
-  (def (write-response fd resp)
+  (def *response-write-mutex* (make-mutex))
+
+  (def (write-response-unlocked fd resp)
     (let* ([status (response-status resp)]
            [headers (response-headers resp)]
            [body (response-body resp)]
@@ -736,6 +738,13 @@
         [(> body-len 0)
          (write-all fd body-bv)])))
 
+  (def (write-response fd resp)
+    ;; Chez's collect-safe raw socket writes are not reliable when several
+    ;; Scheme threads enter write(2) concurrently. Request handlers still run
+    ;; in parallel; serialize only the final bounded header/body emission.
+    (with-mutex *response-write-mutex*
+      (write-response-unlocked fd resp)))
+
   (def (write-all fd bv)
     (let ([len (bytevector-length bv)])
       (let loop ([offset 0])
@@ -748,10 +757,13 @@
                 [else (loop (+ offset n))]))]))))
 
   (def (write-chunk fd bv offset count)
-    ;; FFI requires u8* starting at offset zero, so stage a slice.
-    (let ([stage (make-bytevector count)])
-      (bytevector-copy! bv offset stage 0 count)
-      (c-write fd stage count)))
+    ;; FFI requires u8* starting at offset zero. Keep writes small so one
+    ;; large response cannot monopolize a worker or exhaust the socket send
+    ;; timeout under concurrent load.
+    (let* ([actual (min count 65536)]
+           [stage (make-bytevector actual)])
+      (bytevector-copy! bv offset stage 0 actual)
+      (c-write fd stage actual)))
 
   ;; ========== Server ==========