From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Christopher Baines Newsgroups: gmane.lisp.guile.devel Subject: [PATCH] Make get-bytevector-all suspendable. Date: Thu, 20 Jul 2023 15:01:03 +0100 Message-ID: <20230720140103.23221-1-mail@cbaines.net> Mime-Version: 1.0 Content-Transfer-Encoding: 8bit Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="30340"; mail-complaints-to="usenet@ciao.gmane.io" To: guile-devel@gnu.org Original-X-From: guile-devel-bounces+guile-devel=m.gmane-mx.org@gnu.org Thu Jul 20 16:02:22 2023 Return-path: Envelope-to: guile-devel@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1qMUEX-0007lk-Od for guile-devel@m.gmane-mx.org; Thu, 20 Jul 2023 16:02:21 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1qMUDz-0001gy-MW; Thu, 20 Jul 2023 10:01:47 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1qMUDo-0001da-TG for guile-devel@gnu.org; Thu, 20 Jul 2023 10:01:38 -0400 Original-Received: from mira.cbaines.net ([212.71.252.8]) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1qMUDL-0005e0-7n for guile-devel@gnu.org; Thu, 20 Jul 2023 10:01:24 -0400 Original-Received: from localhost (unknown [IPv6:2a02:8010:68c1:0:54d1:d5d4:280e:f699]) by mira.cbaines.net (Postfix) with ESMTPSA id F1BF627BBE2 for ; Thu, 20 Jul 2023 15:01:03 +0100 (BST) Original-Received: from localhost (localhost [local]) by localhost (OpenSMTPD) with ESMTPA id b2749e5c for ; Thu, 20 Jul 2023 14:01:03 +0000 (UTC) X-Mailer: git-send-email 2.41.0 Received-SPF: pass client-ip=212.71.252.8; envelope-from=mail@cbaines.net; helo=mira.cbaines.net X-Spam_score_int: -18 X-Spam_score: -1.9 X-Spam_bar: - X-Spam_report: (-1.9 / 5.0 requ) BAYES_00=-1.9, SPF_HELO_PASS=-0.001, SPF_PASS=-0.001, T_SCC_BODY_TEXT_LINE=-0.01, UNPARSEABLE_RELAY=0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-devel-bounces+guile-devel=m.gmane-mx.org@gnu.org Original-Sender: guile-devel-bounces+guile-devel=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.lisp.guile.devel:21902 Archived-At: I'm looking at this since it's used in (web response) read-response-body. * module/ice-9/suspendable-ports.scm (get-bytevector-all): New procedure. (port-bindings): Add it. --- module/ice-9/suspendable-ports.scm | 36 ++++++++++++++++++++++++++++++ 1 file changed, 36 insertions(+) diff --git a/module/ice-9/suspendable-ports.scm b/module/ice-9/suspendable-ports.scm index 9fac1df62..e5b3de982 100644 --- a/module/ice-9/suspendable-ports.scm +++ b/module/ice-9/suspendable-ports.scm @@ -50,6 +50,7 @@ (define-module (ice-9 suspendable-ports) #:use-module (rnrs bytevectors) + #:use-module (rnrs bytevectors gnu) #:use-module (ice-9 ports internal) #:use-module (ice-9 match) #:export (current-read-waiter @@ -342,6 +343,40 @@ (set-port-buffer-cur! buf (+ cur transfer-size)) transfer-size)))))) +(define (get-bytevector-all port) + (define %initial-length 4096) + + (let read-loop ((total 0) + (result-length %initial-length) + (result (make-bytevector %initial-length))) + (call-with-values (lambda () (fill-input port 1 'binary)) + (lambda (buf cur buffered) + (if (zero? buffered) + (begin + (set-port-buffer-has-eof?! buf #f) + (if (= total 0) + the-eof-object + (bytevector-slice result 0 total))) + (let* ((new-total (+ total buffered)) + (new-result-length + (let loop ((new-result-length result-length)) + (if (< new-total new-result-length) + new-result-length + (loop (* 2 new-result-length))))) + (new-result + (if (= new-result-length result-length) + result + (let ((new-result (make-bytevector new-result-length))) + (bytevector-copy! result 0 new-result 0 total) + new-result)))) + (bytevector-copy! (port-buffer-bytevector buf) cur + new-result total + buffered) + (set-port-buffer-cur! buf (+ cur buffered)) + (read-loop new-total + new-result-length + new-result))))))) + (define (put-u8 port byte) (let* ((buf (port-write-buffer port)) (bv (port-buffer-bytevector buf)) @@ -754,6 +789,7 @@ ((ice-9 binary-ports) get-u8 lookahead-u8 get-bytevector-n get-bytevector-n! get-bytevector-some get-bytevector-some! + get-bytevector-all put-u8 put-bytevector) ((ice-9 textual-ports) put-char put-string) -- 2.41.0