[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 08/08: Make 'get-bytevector-some' and 'get-bytevector-so
From: |
Mark H. Weaver |
Subject: |
[Guile-commits] 08/08: Make 'get-bytevector-some' and 'get-bytevector-some!' suspendable. |
Date: |
Tue, 18 Jun 2019 02:08:20 -0400 (EDT) |
mhw pushed a commit to branch stable-2.2
in repository guile.
commit 8150823fc87b837a4db3d7690a920dc2484aa1d7
Author: Mark H Weaver <address@hidden>
Date: Tue Apr 16 23:13:37 2019 -0400
Make 'get-bytevector-some' and 'get-bytevector-some!' suspendable.
* module/ice-9/suspendable-ports.scm (get-bytevector-some)
(get-bytevector-some!): New procedures.
(port-bindings): Add them.
---
module/ice-9/suspendable-ports.scm | 31 ++++++++++++++++++++++++++++++-
1 file changed, 30 insertions(+), 1 deletion(-)
diff --git a/module/ice-9/suspendable-ports.scm
b/module/ice-9/suspendable-ports.scm
index a366c8b..91c5c76 100644
--- a/module/ice-9/suspendable-ports.scm
+++ b/module/ice-9/suspendable-ports.scm
@@ -1,5 +1,5 @@
;;; Ports, implemented in Scheme
-;;; Copyright (C) 2016 Free Software Foundation, Inc.
+;;; Copyright (C) 2016, 2019 Free Software Foundation, Inc.
;;;
;;; This library is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU Lesser General Public License as
@@ -292,6 +292,34 @@
((< (- count pos) (port-read-buffering port)) (buffer-and-fill pos))
(else (fill-directly pos))))))
+(define (get-bytevector-some port)
+ (call-with-values (lambda () (fill-input port 1 'binary))
+ (lambda (buf cur buffered)
+ (if (zero? buffered)
+ (begin
+ (set-port-buffer-has-eof?! buf #f)
+ the-eof-object)
+ (let ((result (make-bytevector buffered)))
+ (bytevector-copy! (port-buffer-bytevector buf) cur
+ result 0 buffered)
+ (set-port-buffer-cur! buf (+ cur buffered))
+ result)))))
+
+(define (get-bytevector-some! port bv start count)
+ (if (zero? count)
+ 0
+ (call-with-values (lambda () (fill-input port 1 'binary))
+ (lambda (buf cur buffered)
+ (if (zero? buffered)
+ (begin
+ (set-port-buffer-has-eof?! buf #f)
+ the-eof-object)
+ (let ((transfer-size (min count buffered)))
+ (bytevector-copy! (port-buffer-bytevector buf) cur
+ transfer-size start buffered)
+ (set-port-buffer-cur! buf (+ cur transfer-size))
+ transfer-size))))))
+
(define (put-u8 port byte)
(let* ((buf (port-write-buffer port))
(bv (port-buffer-bytevector buf))
@@ -703,6 +731,7 @@
accept connect)
((ice-9 binary-ports)
get-u8 lookahead-u8 get-bytevector-n
+ get-bytevector-some get-bytevector-some!
put-u8 put-bytevector)
((ice-9 textual-ports)
put-char put-string)
- [Guile-commits] branch stable-2.2 updated (420c263 -> 8150823), Mark H. Weaver, 2019/06/18
- [Guile-commits] 01/08: Improve overflow checks in bytevector, string, and I/O operations., Mark H. Weaver, 2019/06/18
- [Guile-commits] 03/08: Fix typo in tags.h comment., Mark H. Weaver, 2019/06/18
- [Guile-commits] 05/08: scm_to_stringn: Avoid passing NULL to c_strcasecmp., Mark H. Weaver, 2019/06/18
- [Guile-commits] 02/08: Save and restore errno in the signal handler., Mark H. Weaver, 2019/06/18
- [Guile-commits] 04/08: time.test: Use 'pass-if-equal' in more tests., Mark H. Weaver, 2019/06/18
- [Guile-commits] 07/08: open-pipe*: Improve performance of OPEN_BOTH mode., Mark H. Weaver, 2019/06/18
- [Guile-commits] 06/08: Add get-bytevector-some!., Mark H. Weaver, 2019/06/18
- [Guile-commits] 08/08: Make 'get-bytevector-some' and 'get-bytevector-some!' suspendable.,
Mark H. Weaver <=