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:
commit
11475e0f84
1 changed files with 30 additions and 1 deletions
|
@ -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)
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue