[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
15/20: serialization: Micro-optimize string literal output in 'write-fil
From: |
guix-commits |
Subject: |
15/20: serialization: Micro-optimize string literal output in 'write-file-tree'. |
Date: |
Mon, 1 Mar 2021 09:32:11 -0500 (EST) |
civodul pushed a commit to branch wip-build-systems-gexp
in repository guix.
commit dc41ed03d86dff04b92a06123b5d7073ab96d706
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Thu Feb 25 15:46:22 2021 +0100
serialization: Micro-optimize string literal output in 'write-file-tree'.
This reduces allocations and bit twiddling in the loop.
* guix/serialization.scm (write-literal-strings): New macro.
(write-file-tree): Use it in lieu of 'write-string' calls where applicable.
---
guix/serialization.scm | 56 +++++++++++++++++++++++++++++++++++---------------
1 file changed, 40 insertions(+), 16 deletions(-)
diff --git a/guix/serialization.scm b/guix/serialization.scm
index 9d0739f..9b888a7 100644
--- a/guix/serialization.scm
+++ b/guix/serialization.scm
@@ -199,6 +199,37 @@ substitute invalid byte sequences with question marks.
This is a
(define write-store-path-list write-string-list)
(define read-store-path-list read-string-list)
+(define-syntax write-literal-strings
+ (lambda (s)
+ "Write the given literal strings to PORT in an optimized fashion, without
+any run-time allocations or computations."
+ (define (padding len)
+ (let ((m (modulo len 8)))
+ (if (zero? m)
+ 0
+ (- 8 m))))
+
+ (syntax-case s ()
+ ((_ port strings ...)
+ (let* ((bytes (map string->utf8 (syntax->datum #'(strings ...))))
+ (len (fold (lambda (bv size)
+ (+ size 8 (bytevector-length bv)
+ (padding (bytevector-length bv))))
+ 0
+ bytes))
+ (bv (make-bytevector len))
+ (zeros (make-bytevector 8 0)))
+ (fold (lambda (str offset)
+ (let ((len (bytevector-length str)))
+ (bytevector-u32-set! bv offset len (endianness little))
+ (bytevector-copy! str 0 bv (+ 8 offset) len)
+ (bytevector-copy! zeros 0 bv (+ 8 offset len)
+ (padding len))
+ (+ offset 8 len (padding len))))
+ 0
+ bytes)
+ #`(put-bytevector port #,bv))))))
+
(define-condition-type &nar-read-error &nar-error
nar-read-error?
@@ -332,14 +363,12 @@ which case you can use 'identity'."
(define-values (type size)
(file-type+size f))
- (write-string "(" p)
+ (write-literal-strings p "(")
(case type
((regular executable)
- (write-string "type" p)
- (write-string "regular" p)
+ (write-literal-strings p "type" "regular")
(when (eq? 'executable type)
- (write-string "executable" p)
- (write-string "" p))
+ (write-literal-strings p "executable" ""))
(let ((input (file-port f)))
(dynamic-wind
(const #t)
@@ -348,28 +377,23 @@ which case you can use 'identity'."
(lambda ()
(close-port input)))))
((directory)
- (write-string "type" p)
- (write-string "directory" p)
+ (write-literal-strings p "type" "directory")
(let ((entries (postprocess-entries (directory-entries f))))
(for-each (lambda (e)
(let* ((f (string-append f "/" e)))
- (write-string "entry" p)
- (write-string "(" p)
- (write-string "name" p)
+ (write-literal-strings p "entry" "(" "name")
(write-string e p)
- (write-string "node" p)
+ (write-literal-strings p "node")
(dump f)
- (write-string ")" p)))
+ (write-literal-strings p ")")))
entries)))
((symlink)
- (write-string "type" p)
- (write-string "symlink" p)
- (write-string "target" p)
+ (write-literal-strings p "type" "symlink" "target")
(write-string (symlink-target f) p))
(else
(raise (condition (&message (message "unsupported file type"))
(&nar-error (file f) (port port))))))
- (write-string ")" p)))
+ (write-literal-strings p ")")))
(define port-conversion-strategy
(fluid->parameter %default-port-conversion-strategy))
- branch wip-build-systems-gexp created (now b1da83b), guix-commits, 2021/03/01
- 02/20: packages: Turn 'bag->derivation' into a monadic procedure., guix-commits, 2021/03/01
- 05/20: gexp: Micro-optimize sexp serialization., guix-commits, 2021/03/01
- 04/20: packages: Core procedures are written in monadic style., guix-commits, 2021/03/01
- 01/20: build-system: Rewrite using gexps., guix-commits, 2021/03/01
- 07/20: gexp: 'gexp-inputs' returns both native and non-native inputs., guix-commits, 2021/03/01
- 03/20: packages: Simplify patch instantiation., guix-commits, 2021/03/01
- 09/20: gexp: Micro-optimize 'gexp->sexp' and 'lower-inputs'., guix-commits, 2021/03/01
- 12/20: grafts: Inline 'grafting?' and 'set-grafting'., guix-commits, 2021/03/01
- 15/20: serialization: Micro-optimize string literal output in 'write-file-tree'.,
guix-commits <=
- 16/20: gexp: Optimize 'with-build-variables'., guix-commits, 2021/03/01
- 17/20: packages: Default origin 'patch-flags' is a gexp., guix-commits, 2021/03/01
- 18/20: gexp: Add 'sexp->gexp'., guix-commits, 2021/03/01
- 08/20: gexp: Keep 'lower-inputs' private., guix-commits, 2021/03/01
- 10/20: store: Object cache profiling shows the number of entries., guix-commits, 2021/03/01
- 11/20: gexp: Reduce allocations while traversing lists., guix-commits, 2021/03/01
- 06/20: gexp: 'gexp-inputs' returns a list of <gexp-input> records., guix-commits, 2021/03/01
- 13/20: store: Micro-optimize object cache lookup., guix-commits, 2021/03/01
- 14/20: gexp: Reduce allocations in 'gexp-attribute'., guix-commits, 2021/03/01
- 20/20: build-system: Use 'input-tuples->gexp' and 'outputs->gexp'., guix-commits, 2021/03/01