From de775db48ed16aecb6cb934fcfec367f4b76733f Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Sat, 29 May 2021 23:59:08 +0100 Subject: Fix the make-chunked-output-port* implementation A broken one was committed previously. --- guix-build-coordinator/utils.scm | 36 ++++++++++++++++++++++++------------ 1 file changed, 24 insertions(+), 12 deletions(-) diff --git a/guix-build-coordinator/utils.scm b/guix-build-coordinator/utils.scm index 9887d05..0150257 100644 --- a/guix-build-coordinator/utils.scm +++ b/guix-build-coordinator/utils.scm @@ -262,32 +262,44 @@ upcoming chunk." (define* (make-chunked-output-port* port #:key (keep-alive? #f) (buffering 1200)) + (define initial-heap-size + (assq-ref (gc-stats) 'heap-size)) + (define (%put-string s) - (let ((length (string-length s))) - (unless (eq? length 0) + (unless (string-null? s) + (let* ((bv (string->bytevector s "ISO-8859-1")) + (length (bytevector-length bv))) (with-gc-protection (lambda () (put-string port (number->string length 16)) (put-string port "\r\n") - (write s port) - (put-string port "\r\n")))))) + (put-bytevector port bv) + (put-string port "\r\n"))) + + (let* ((stats (gc-stats)) + (initial-gc-times + (assq-ref stats 'gc-times))) + (while (let ((updated-stats (gc-stats))) + (and (> (assq-ref updated-stats 'heap-allocated-since-gc) + initial-heap-size) + (= initial-gc-times + (assq-ref updated-stats 'gc-times)))) + (gc) + (usleep 10)))))) + (define (%put-char c) (%put-string (list->string (list c)))) - (define (flush) - (force-output port)) - (define (safe-flush) - (with-gc-protection flush)) + (define (flush) #t) (define (close) (with-gc-protection (lambda () - (flush) - (put-string port "0\r\n\r\n") - (force-output port) + (put-string port "0\r\n") (unless keep-alive? + (force-output port) (close-port port))))) (let ((ret (make-soft-port - (vector %put-char %put-string safe-flush #f close) "w"))) + (vector %put-char %put-string flush #f close) "w"))) (setvbuf ret 'block buffering) ret)) -- cgit v1.2.3