mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-09 23:30:21 +02:00
Code Activity

Add put-u8 implementation in Scheme

Browse source 
* module/ice-9/sports.scm (put-u8): Add implementation.
  (port-bindings): Add put-u8.
This commit is contained in:
Andy Wingo 2016-05-24 08:24:38 +02:00
parent ba91741063
commit 7c8b80e076
1 changed files with 16 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

17
module/ice-9/sports.scm
View file

@ -62,6 +62,7 @@
lookahead-u8 lookahead-u8
get-u8 get-u8
get-bytevector-n get-bytevector-n
put-u8
put-bytevector put-bytevector
%read-line %read-line
@ -307,6 +308,18 @@
((< (- 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 (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) (define* (put-bytevector port src #:optional (start 0)
(count (- (bytevector-length src) start))) (count (- (bytevector-length src) start)))
(unless (<= 0 start (+ start count) (bytevector-length src)) (unless (<= 0 start (+ start count) (bytevector-length src))
@ -643,7 +656,9 @@
(define saved-port-bindings #f) (define saved-port-bindings #f)
(define port-bindings (define port-bindings
'(((guile) read-char peek-char force-output close-port) '(((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))) ((ice-9 rdelim) %read-line read-line read-delimited)))
(define (install-sports!) (define (install-sports!)
(unless saved-port-bindings (unless saved-port-bindings