summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorMaxime Devos <maximedevos@telenet.be>2021-09-06 00:46:17 +0200
committerLudovic Courtès <ludo@gnu.org>2021-09-10 17:30:54 +0200
commita87d8c912d64382d8d7489c156249bc2b2638df0 (patch)
treef3ecfa35ae3854971c9234a56ea0a0d7b908958a /guix
parente11830d36e557dd7ab48733c679267f238db597b (diff)
base16: Reduce GC pressure in bytevector->base16-string.
This makes bytevector->base16-string two times faster. * guix/base16.scm (bytevector->base16-string): Use utf8->string and iteration instead of string-concatenate and named let. Signed-off-by: Ludovic Courtès <ludo@gnu.org>
Diffstat (limited to 'guix')
-rw-r--r--guix/base16.scm44
1 files changed, 23 insertions, 21 deletions
diff --git a/guix/base16.scm b/guix/base16.scm
index 6c15a9f588..9ac964dff0 100644
--- a/guix/base16.scm
+++ b/guix/base16.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2014, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -32,27 +33,28 @@
(define (bytevector->base16-string bv)
"Return the hexadecimal representation of BV's contents."
- (define len
- (bytevector-length bv))
-
- (let-syntax ((base16-chars (lambda (s)
- (syntax-case s ()
- (_
- (let ((v (list->vector
- (unfold (cut > <> 255)
- (lambda (n)
- (format #f "~2,'0x" n))
- 1+
- 0))))
- v))))))
- (define chars base16-chars)
- (let loop ((i len)
- (r '()))
- (if (zero? i)
- (string-concatenate r)
- (let ((i (- i 1)))
- (loop i
- (cons (vector-ref chars (bytevector-u8-ref bv i)) r)))))))
+ (define len (bytevector-length bv))
+ (define utf8 (make-bytevector (* len 2)))
+ (let-syntax ((base16-octet-pairs
+ (lambda (s)
+ (syntax-case s ()
+ (_
+ (string->utf8
+ (string-concatenate
+ (unfold (cut > <> 255)
+ (lambda (n)
+ (format #f "~2,'0x" n))
+ 1+
+ 0))))))))
+ (define octet-pairs base16-octet-pairs)
+ (let loop ((i 0))
+ (when (< i len)
+ (bytevector-u16-native-set!
+ utf8 (* 2 i)
+ (bytevector-u16-native-ref octet-pairs
+ (* 2 (bytevector-u8-ref bv i))))
+ (loop (+ i 1))))
+ (utf8->string utf8)))
(define base16-string->bytevector
(let ((chars->value (fold (lambda (i r)