summary refs log tree commit diff
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
parent09238d618a511de80de189ff3ff18bfa0f280bb9 (diff)
downloadguix-01e5d63c87b6b110f0632597e89a6a7476fc7d1c.tar.gz
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'.
-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)))