aboutsummaryrefslogtreecommitdiff
path: root/guix-build-coordinator/utils.scm
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2023-04-30 17:59:40 +0200
committerChristopher Baines <mail@cbaines.net>2023-04-30 17:59:40 +0200
commit285ae754915c8515595a5688dab17246d081b53b (patch)
tree6feb66c89f928a599fe605a50b4be4bfe0ee512d /guix-build-coordinator/utils.scm
parent189fa1575252e714693a89fa459bb3d609a3b14b (diff)
downloadbuild-coordinator-285ae754915c8515595a5688dab17246d081b53b.tar
build-coordinator-285ae754915c8515595a5688dab17246d081b53b.tar.gz
Neaten up the make-chunked-output-port* implementation
As the comment says, this needs a bit more looking at to determine what (if any) changes should be suggested for Guile.
Diffstat (limited to 'guix-build-coordinator/utils.scm')
-rw-r--r--guix-build-coordinator/utils.scm25
1 files changed, 6 insertions, 19 deletions
diff --git a/guix-build-coordinator/utils.scm b/guix-build-coordinator/utils.scm
index e5ba5ef..363bc27 100644
--- a/guix-build-coordinator/utils.scm
+++ b/guix-build-coordinator/utils.scm
@@ -274,12 +274,12 @@
(setsockopt raw-port SOL_SOCKET SO_RCVTIMEO `(,timeout . 0))
(setsockopt raw-port SOL_SOCKET SO_SNDTIMEO `(,timeout . 0))))
+;; TODO This is a variant of make-chunked-output-port from (web http) in
+;; Guile. I think it's more efficient, at least in the guix-build-coordinator
+;; use case, but this needs some checking and then maybe this could be pushed
+;; upstream to Guile.
(define* (make-chunked-output-port* port #:key (keep-alive? #f)
- (buffering 1200)
- report-bytes-sent)
- (define heap-allocated-limit
- (expt 2 20)) ;; 1MiB
-
+ (buffering 1200))
(define (%put-string s)
(unless (string-null? s)
(let* ((bv (string->bytevector s "ISO-8859-1"))
@@ -287,20 +287,7 @@
(put-string port (number->string length 16))
(put-string port "\r\n")
(put-bytevector port bv)
- (put-string port "\r\n")
-
- (when report-bytes-sent
- (report-bytes-sent length))
- (let* ((stats (gc-stats))
- (initial-gc-times
- (assq-ref stats 'gc-times)))
- (when (> (assq-ref stats 'heap-allocated-since-gc)
- heap-allocated-limit)
- (while (let ((updated-stats (gc-stats)))
- (= (assq-ref updated-stats 'gc-times)
- initial-gc-times))
- (gc)
- (usleep 50)))))))
+ (put-string port "\r\n"))))
(define (%put-char c)
(%put-string (list->string (list c))))