mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-12 06:41:13 +02:00
Code Activity

Speed golf on Scheme put-u8, put-bytevector

Browse source 
* module/ice-9/sports.scm (put-u8, put-bytevector): Speed hack.
This commit is contained in:
Andy Wingo 2016-05-24 08:37:57 +02:00
parent 7c8b80e076
commit 48dbadd8e6
1 changed files with 4 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -309,13 +309,13 @@
(else (fill-directly pos)))))) (else (fill-directly pos))))))
(define (put-u8 port byte) (define (put-u8 port byte)
(when (port-random-access? port)
(flush-input port))
(let* ((buf (port-write-buffer port)) (let* ((buf (port-write-buffer port))
(bv (port-buffer-bytevector buf)) (bv (port-buffer-bytevector buf))
(end (port-buffer-end buf))) (end (port-buffer-end buf)))
(unless (<= 0 end (bytevector-length bv)) (unless (<= 0 end (bytevector-length bv))
(error "not an output port" port)) (error "not an output port" port))
(when (and (eq? (port-buffer-cur buf) end) (port-random-access? port))
(flush-input port))
(bytevector-u8-set! bv end byte) (bytevector-u8-set! bv end byte)
(set-port-buffer-end! buf (1+ end)) (set-port-buffer-end! buf (1+ end))
(when (= (1+ end) (bytevector-length bv)) (flush-output port)))) (when (= (1+ end) (bytevector-length bv)) (flush-output port))))
@ -324,14 +324,14 @@
(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))
(error "invalid start/count" start count)) (error "invalid start/count" start count))
(when (port-random-access? port)
(flush-input port))
(let* ((buf (port-write-buffer port)) (let* ((buf (port-write-buffer port))
(bv (port-buffer-bytevector buf)) (bv (port-buffer-bytevector buf))
(size (bytevector-length bv)) (size (bytevector-length bv))
(cur (port-buffer-cur buf)) (cur (port-buffer-cur buf))
(end (port-buffer-end buf)) (end (port-buffer-end buf))
(buffered (- end cur))) (buffered (- end cur)))
(when (and (eq? cur end) (port-random-access? port))
(flush-input port))
(cond (cond
((<= size count) ((<= size count)
;; The write won't fit in the buffer at all; write directly. ;; The write won't fit in the buffer at all; write directly.