summaryrefslogtreecommitdiff
path: root/guix/serialization.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2020-01-24 22:39:47 +0100
committerLudovic Courtès <ludo@gnu.org>2020-01-24 23:56:43 +0100
commit01e5d63c87b6b110f0632597e89a6a7476fc7d1c (patch)
treeb8fbe04b4bd36eee94cd802ddc401aa94b3b185b /guix/serialization.scm
parent09238d618a511de80de189ff3ff18bfa0f280bb9 (diff)
serialization: 'read-byte-string' makes a single read(2) call.
On "guix build libreoffice -nd", this reduces the number of read(2) system calls from 10,434 to 8092. * guix/serialization.scm (sub-bytevector): New procedure. (read-byte-string): Make a single 'get-bytevector-n*' call and use 'sub-bytevector'.
Diffstat (limited to 'guix/serialization.scm')
-rw-r--r--guix/serialization.scm19
1 files changed, 15 insertions, 4 deletions
diff --git a/guix/serialization.scm b/guix/serialization.scm
index 9452303730..836ad06caf 100644
--- a/guix/serialization.scm
+++ b/guix/serialization.scm
@@ -27,6 +27,7 @@
#:use-module ((ice-9 rdelim) #:prefix rdelim:)
#:use-module (ice-9 match)
#:use-module (ice-9 ftw)
+ #:use-module (system foreign)
#:export (write-int read-int
write-long-long read-long-long
write-padding
@@ -80,6 +81,17 @@
(port port)))))
bv))
+(define (sub-bytevector bv len)
+ "Return a bytevector that aliases the first LEN bytes of BV."
+ (define max (bytevector-length bv))
+ (cond ((= len max) bv)
+ ((< len max)
+ ;; Yes, this is safe because the result of each conversion procedure
+ ;; has its life cycle synchronized with that of its argument.
+ (pointer->bytevector (bytevector->pointer bv) len))
+ (else
+ (error "sub-bytevector called to get a super bytevector"))))
+
(define (write-int n p)
(let ((b (make-bytevector 8 0)))
(bytevector-u32-set! b 0 n (endianness little))
@@ -119,10 +131,9 @@
(define (read-byte-string p)
(let* ((len (read-int p))
(m (modulo len 8))
- (bv (get-bytevector-n* p len)))
- (or (zero? m)
- (get-bytevector-n* p (- 8 m)))
- bv))
+ (pad (if (zero? m) 0 (- 8 m)))
+ (bv (get-bytevector-n* p (+ len pad))))
+ (sub-bytevector bv len)))
(define (read-string p)
(utf8->string (read-byte-string p)))