mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-09 15:10:29 +02:00
Add put-u8 implementation in Scheme
* module/ice-9/sports.scm (put-u8): Add implementation. (port-bindings): Add put-u8.
This commit is contained in:
parent
ba91741063
commit
7c8b80e076
1 changed files with 16 additions and 1 deletions
|
@ -62,6 +62,7 @@
|
|||
lookahead-u8
|
||||
get-u8
|
||||
get-bytevector-n
|
||||
put-u8
|
||||
put-bytevector
|
||||
|
||||
%read-line
|
||||
|
@ -307,6 +308,18 @@
|
|||
((< (- count pos) (port-read-buffering port)) (buffer-and-fill pos))
|
||||
(else (fill-directly pos))))))
|
||||
|
||||
(define (put-u8 port byte)
|
||||
(when (port-random-access? port)
|
||||
(flush-input port))
|
||||
(let* ((buf (port-write-buffer port))
|
||||
(bv (port-buffer-bytevector buf))
|
||||
(end (port-buffer-end buf)))
|
||||
(unless (<= 0 end (bytevector-length bv))
|
||||
(error "not an output port" port))
|
||||
(bytevector-u8-set! bv end byte)
|
||||
(set-port-buffer-end! buf (1+ end))
|
||||
(when (= (1+ end) (bytevector-length bv)) (flush-output port))))
|
||||
|
||||
(define* (put-bytevector port src #:optional (start 0)
|
||||
(count (- (bytevector-length src) start)))
|
||||
(unless (<= 0 start (+ start count) (bytevector-length src))
|
||||
|
@ -643,7 +656,9 @@
|
|||
(define saved-port-bindings #f)
|
||||
(define port-bindings
|
||||
'(((guile) read-char peek-char force-output close-port)
|
||||
((ice-9 binary-ports) get-u8 lookahead-u8 get-bytevector-n put-bytevector)
|
||||
((ice-9 binary-ports)
|
||||
get-u8 lookahead-u8 get-bytevector-n
|
||||
put-u8 put-bytevector)
|
||||
((ice-9 rdelim) %read-line read-line read-delimited)))
|
||||
(define (install-sports!)
|
||||
(unless saved-port-bindings
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue