From 0ab74ba68c57f7b16832c3549d9939a3c78d7da4 Mon Sep 17 00:00:00 2001
From: Andrew Whatson <whatson@tailcall.au>
Date: Mon, 8 May 2023 21:54:18 +1000
Subject: client: Avoid closure allocation for timeouts.

* web/socket/frame.scm (frame-reader): Removed.
(make-deadline, deadline-seconds-remaining, read-frame/deadline): New
procedures.
(read-data-frame, read-close-frame): Call deadline procedures instead of
frame-reader.
---
 web/socket/frame.scm | 61 ++++++++++++++++++++++++++--------------------------
 1 file changed, 31 insertions(+), 30 deletions(-)

diff --git a/web/socket/frame.scm b/web/socket/frame.scm
index 9319c18..4c15a09 100644
--- a/web/socket/frame.scm
+++ b/web/socket/frame.scm
@@ -342,41 +342,43 @@ Returns #t if the port is writable, or #f on timeout."
     ((#() #(port) #()) #t)
     (else #f)))
 
-(define* (frame-reader port #:key timeout)
-  "Return a generator which will read a frame from PORT on each call,
-until TIMEOUT seconds have elapsed.  This is used to implement timeouts
-over composed read operations."
-  (define timeout-at-real-time
-    (and timeout
-         (exact->inexact
-          (floor (+ (get-internal-real-time)
-                    (* internal-time-units-per-second
-                       timeout))))))
-  (define (timeout-remaining)
-    (and timeout
-         (/ (- timeout-at-real-time
-               (get-internal-real-time))
-            internal-time-units-per-second)))
-  (lambda ()
-    (cond ((port-closed? port)
-           #f)
-          ((not (port-readable? port (timeout-remaining)))
-           #f)
-          ((port-eof? port)
-           (eof-object))
-          (else
-           (read-frame port)))))
+(define (make-deadline timeout)
+  "Calculate a deadline in internal time units which will expire
+TIMEOUT seconds in the future.  Returns #f if TIMEOUT is false."
+  (and timeout (exact->inexact
+                (floor (+ (get-internal-real-time)
+                          (* internal-time-units-per-second
+                             timeout))))))
+
+(define (deadline-seconds-remaining deadline)
+  "Calculate the number of seconds remaining until DEADLINE is reached.
+Returns #f if DEADLINE is false."
+  (and deadline (/ (- deadline
+                      (get-internal-real-time))
+                   internal-time-units-per-second)))
+
+(define* (read-frame/deadline port deadline)
+  "Attempt to read a frame from PORT until either a complete frame is
+received or DEADLINE is reached.  Returns #f if PORT is closed or the
+operation times out."
+  (cond ((port-closed? port)
+         #f)
+        ((not (port-readable? port (deadline-seconds-remaining deadline)))
+         #f)
+        ((port-eof? port)
+         (eof-object))
+        (else
+         (read-frame port))))
 
 (define* (read-data-frame port #:key echo-close? timeout)
   "Read frames from PORT until a complete data frame is received or
 TIMEOUT seconds have elapsed, handling any control frames transparently.
 ECHO-CLOSE? should be #t if PORT represents the server end of a
 WebSocket connection."
-  (define next-frame
-    (frame-reader port #:timeout timeout))
+  (define deadline (make-deadline timeout))
   (let loop ((fragments '())
              (type #f))
-    (let ((frame (next-frame)))
+    (let ((frame (read-frame/deadline port deadline)))
       (cond
        ;; EOF - port is closed.
        ((eof-object? frame)
@@ -417,10 +419,9 @@ WebSocket connection."
 (define* (read-close-frame port #:key timeout)
   "Read frames from PORT until a close frame is received or TIMEOUT
 seconds have elapsed, ignoring control and data frames."
-  (define next-frame
-    (frame-reader port #:timeout timeout))
+  (define deadline (make-deadline timeout))
   (let loop ()
-    (let ((frame (next-frame)))
+    (let ((frame (read-frame/deadline port deadline)))
       (cond ((not (frame? frame))
              #f)
             ((close-frame? frame)
-- 
cgit v1.2.3