1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00

Merge from stable-2.2

This commit is contained in:
Andy Wingo 2019-08-02 15:02:31 +02:00
commit 11475e0f84

View file

@ -1,5 +1,5 @@
;;; Ports, implemented in Scheme ;;; 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 ;;; This library is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU Lesser General Public License as ;;; 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)) ((< (- count pos) (port-read-buffering port)) (buffer-and-fill pos))
(else (fill-directly 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) (define (put-u8 port byte)
(let* ((buf (port-write-buffer port)) (let* ((buf (port-write-buffer port))
(bv (port-buffer-bytevector buf)) (bv (port-buffer-bytevector buf))
@ -703,6 +731,7 @@
accept connect) accept connect)
((ice-9 binary-ports) ((ice-9 binary-ports)
get-u8 lookahead-u8 get-bytevector-n get-u8 lookahead-u8 get-bytevector-n
get-bytevector-some get-bytevector-some!
put-u8 put-bytevector) put-u8 put-bytevector)
((ice-9 textual-ports) ((ice-9 textual-ports)
put-char put-string) put-char put-string)