unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
* [bug#50456] Optimise bytevector->nix-base32-string and bytevector->base16-string.
@ 2021-09-07 15:34 Maxime Devos
  2021-09-07 15:36 ` [bug#50456] Base16 and base32 optimisations split off Maxime Devos
                   ` (2 more replies)
  0 siblings, 3 replies; 7+ messages in thread
From: Maxime Devos @ 2021-09-07 15:34 UTC (permalink / raw)
  To: 50456


[-- Attachment #1.1: Type: text/plain, Size: 559 bytes --]

Hi guix,

The two atached patches optimise bytevector->nix-base32-string and
bytevector->base16-string, making them about 20% and two times
faster respectively, by reducing allocations.  They are called
from 'output-path', 'fixed-output-path' and 'store-path'
in (guix store).

Unfortunately, this does not decrease timings to a noticable degree,
but it does decrease the allocated memory by 2.3% (*), and it does not
seem to increase timings.  (See perf-numbers.txt.)

(*) GUIX_PROFILING=gc guix build -d pigx --no-grafts

Greetings,
Maxime.

[-- Attachment #1.2: 0001-base32-Reduce-GC-pressure-in-make-bytevector-base32-.patch --]
[-- Type: text/x-patch, Size: 2261 bytes --]

From a93bad629e2746c77446cacddb9986506ce9ba88 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Sun, 5 Sep 2021 16:28:33 +0200
Subject: [PATCH 1/2] base32: Reduce GC pressure in
 make-bytevector->base32-string.

The following code has been used to compare performance:

;; first 20 bytes of sha256 of #vu8(#xde #xad #xbe #xef)
(define bv #vu8(95 120 195 50 116 228 63 169 222 86 89 38 92 29 145 126 37 192 55 34))
,profile
(let loop ((n 0))
  (when (< n #e1e6)
     ((@ (guix base32) bytevector->nix-base32-string) bv)
     (loop (+ n 1))))

Before this change, the output was:

[...]
Sample count: 1140
Total time: 27.465560018 seconds (10.659331433 seconds in GC)

After this change, the output was:

[...]
Sample count: 957
Total time: 20.478847143 seconds (6.139721189 seconds in GC)

* guix/base32.scm
  (make-bytevector->base32-string): Eliminate 'reverse', use mutation instead.
---
 guix/base32.scm | 18 ++++++++++++------
 1 file changed, 12 insertions(+), 6 deletions(-)

diff --git a/guix/base32.scm b/guix/base32.scm
index 49f191ba26..e76bf35ecc 100644
--- a/guix/base32.scm
+++ b/guix/base32.scm
@@ -141,12 +141,18 @@ the previous application or INIT."
 (define (make-bytevector->base32-string quintet-fold base32-chars)
   (lambda (bv)
     "Return a base32 encoding of BV using BASE32-CHARS as the alphabet."
-    (let ((chars (quintet-fold (lambda (q r)
-                                 (cons (vector-ref base32-chars q)
-                                       r))
-                               '()
-                               bv)))
-      (list->string (reverse chars)))))
+    ;; Mutation can be avoided with 'reverse'.  However, that would
+    ;; make this procedure about 30% slower due to the extra GC pressure.
+    (let* ((start (cons #f #f))
+           (end (quintet-fold (lambda (q r)
+                                (define pair
+                                  (cons (vector-ref base32-chars q) #f))
+                                (set-cdr! r pair)
+                                pair)
+                              start
+                              bv)))
+      (set-cdr! end '())
+      (list->string (cdr start)))))
 
 (define %nix-base32-chars
   ;; See `libutil/hash.cc'.
-- 
2.33.0


[-- Attachment #1.3: 0002-base16-Reduce-GC-pressure-in-bytevector-base16-strin.patch --]
[-- Type: text/x-patch, Size: 2832 bytes --]

From dfd9b7557e31823320fcbd7abed77de295b7dce1 Mon Sep 17 00:00:00 2001
From: Maxime Devos <maximedevos@telenet.be>
Date: Mon, 6 Sep 2021 00:46:17 +0200
Subject: [PATCH 2/2] 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.
---
 guix/base16.scm | 44 +++++++++++++++++++++++---------------------
 1 file 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)
-- 
2.33.0


[-- Attachment #1.4: perf-numbers.txt --]
[-- Type: text/plain, Size: 4018 bytes --]

while true; do time GUIX_PROFILING=gc ./the-unoptimised-baseN-guix/bin/guix build -d pigx --no-grafts; done

# First run removed
/gnu/store/fq6x8d2vcm6sbjkimg7g8kcgb4c5xv1b-pigx-0.0.3.drv
Garbage collection statistics:
  heap size:        93.85 MiB
  allocated:        325.20 MiB
  GC times:         18
  time spent in GC: 3.69 seconds (24% of user time)

real	0m15,066s
user	0m15,149s
sys	0m0,709s
/gnu/store/fq6x8d2vcm6sbjkimg7g8kcgb4c5xv1b-pigx-0.0.3.drv
Garbage collection statistics:
  heap size:        93.85 MiB
  allocated:        325.19 MiB
  GC times:         18
  time spent in GC: 3.70 seconds (24% of user time)

real	0m15,924s
user	0m15,695s
sys	0m0,836s
/gnu/store/fq6x8d2vcm6sbjkimg7g8kcgb4c5xv1b-pigx-0.0.3.drv
Garbage collection statistics:
  heap size:        93.85 MiB
  allocated:        325.20 MiB
  GC times:         18
  time spent in GC: 3.66 seconds (24% of user time)

real	0m15,369s
user	0m15,339s
sys	0m0,704s
/gnu/store/fq6x8d2vcm6sbjkimg7g8kcgb4c5xv1b-pigx-0.0.3.drv
Garbage collection statistics:
  heap size:        93.85 MiB
  allocated:        325.20 MiB
  GC times:         18
  time spent in GC: 3.69 seconds (25% of user time)

real	0m14,889s
user	0m15,066s
sys	0m0,679s

Summary.

(define (avg . r) (/ (apply + r) (length r)))
(define (stddev . r) (* (/ (length r) (- (length r) 1)) (sqrt (apply avg (map (lambda (x) (expt (- x (apply avg r)) 2)) r)))))

(define  %time/gc '(3.69 3.70 3.66 3.69))
(values (apply avg %time/gc) (apply stddev %time/gc))
$7 = 3.685
$8 = 0.01999999999999997

(define  %real '(15.066 15.924 15.369 14.889))
(define  %user '(15.149 15.695 15.339 15.066))
(define  %sys  '(0.709 0.836 0.704 0.679))

(values (apply avg %real) (apply stddev %real))
$1 = 15.312000000000001
$2 = 0.5237633053202561

(values (apply avg %user) (apply stddev %user))
$3 = 15.31225
$4 = 0.32283655995634153

(values (apply avg %sys) (apply stddev %sys))
$5 = 0.732
$6 = 0.08148074073737369

while true; do time GUIX_PROFILING=gc ./the-optimised-baseN-guix/bin/guix build -d pigx --no-grafts; done

/gnu/store/jfjfg7dnis7v6947a0rncxdn3y1nz0ad-pigx-0.0.3.drv
Garbage collection statistics:
  heap size:        93.85 MiB
  allocated:        317.83 MiB
  GC times:         18
  time spent in GC: 3.71 seconds (22% of user time)

real	0m17,646s
user	0m16,539s
sys	0m0,705s
/gnu/store/jfjfg7dnis7v6947a0rncxdn3y1nz0ad-pigx-0.0.3.drv
Garbage collection statistics:
  heap size:        93.85 MiB
  allocated:        317.83 MiB
  GC times:         18
  time spent in GC: 3.63 seconds (22% of user time)

real	0m18,733s
user	0m16,698s
sys	0m0,691s
/gnu/store/jfjfg7dnis7v6947a0rncxdn3y1nz0ad-pigx-0.0.3.drv
Garbage collection statistics:
  heap size:        93.85 MiB
  allocated:        317.82 MiB
  GC times:         18
  time spent in GC: 3.72 seconds (24% of user time)

real	0m15,429s
user	0m15,448s
sys	0m0,696s
/gnu/store/jfjfg7dnis7v6947a0rncxdn3y1nz0ad-pigx-0.0.3.drv
Garbage collection statistics:
  heap size:        93.85 MiB
  allocated:        317.82 MiB
  GC times:         18
  time spent in GC: 3.70 seconds (24% of user time)

real	0m15,292s
user	0m15,315s
sys	0m0,635s

(define %time/gc '(3.71 3.63 3.72 3.70))
(define %time/real '(17.646 18.733 15.429 15.292))
(define %time/user '(16.539 16.698 15.448 15.315))
(define %time/sys '(0.705 0.691 0.696 0.635))

(values (apply avg %time/gc) (apply stddev %time/gc))
$17 = 3.6900000000000004
$18 = 0.04714045207910329
(values (apply avg %time/real) (apply stddev %time/real))
$19 = 16.775000000000002
$20 = 1.9554380015172506
(values (apply avg %time/user) (apply stddev %time/user))
$21 = 16.0
$22 = 0.8304360300468671
(values (apply avg %time/sys) (apply stddev %time/sys))
$23 = 0.6817499999999999
$24 = 0.03660449274186007


Tests show neither a decrease nor an increase in timings.
Now looking at the allocation count:

The heap size before:
  heap size:        93.85 MiB
  allocated:        325.20 MiB

The heap size after:
  heap size:        93.85 MiB
  allocated:        317.82 MiB

A small improvement (-2.3%).

[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]

^ permalink raw reply related	[flat|nested] 7+ messages in thread

* [bug#50456] Base16 and base32 optimisations split off
  2021-09-07 15:34 [bug#50456] Optimise bytevector->nix-base32-string and bytevector->base16-string Maxime Devos
@ 2021-09-07 15:36 ` Maxime Devos
       [not found] ` <handler.50456.B.16310288933583.ack@debbugs.gnu.org>
  2021-09-09 14:29 ` [bug#50456] Optimise bytevector->nix-base32-string and bytevector->base16-string Ludovic Courtès
  2 siblings, 0 replies; 7+ messages in thread
From: Maxime Devos @ 2021-09-07 15:36 UTC (permalink / raw)
  To: 50456, 50384

[-- Attachment #1: Type: text/plain, Size: 103 bytes --]

I split off the base16 and base32 optimisations
to a separate patch series: 50456@debbugs.gnu.org.


[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]

^ permalink raw reply	[flat|nested] 7+ messages in thread

* [bug#50456] Acknowledgement (Optimise bytevector->nix-base32-string and bytevector->base16-string.)
       [not found] ` <handler.50456.B.16310288933583.ack@debbugs.gnu.org>
@ 2021-09-07 15:37   ` Maxime Devos
  2021-09-11 15:54   ` bug#50456: " Maxime Devos
  1 sibling, 0 replies; 7+ messages in thread
From: Maxime Devos @ 2021-09-07 15:37 UTC (permalink / raw)
  To: 50456

retitle [PATCH] Optimise bytevector->nix-base32-string and bytevector->base16-string.
thanks





^ permalink raw reply	[flat|nested] 7+ messages in thread

* [bug#50456] Optimise bytevector->nix-base32-string and bytevector->base16-string.
  2021-09-07 15:34 [bug#50456] Optimise bytevector->nix-base32-string and bytevector->base16-string Maxime Devos
  2021-09-07 15:36 ` [bug#50456] Base16 and base32 optimisations split off Maxime Devos
       [not found] ` <handler.50456.B.16310288933583.ack@debbugs.gnu.org>
@ 2021-09-09 14:29 ` Ludovic Courtès
  2021-09-09 14:42   ` Maxime Devos
  2021-09-09 15:15   ` Maxime Devos
  2 siblings, 2 replies; 7+ messages in thread
From: Ludovic Courtès @ 2021-09-09 14:29 UTC (permalink / raw)
  To: Maxime Devos; +Cc: 50456

Hello,

Maxime Devos <maximedevos@telenet.be> skribis:

> The two atached patches optimise bytevector->nix-base32-string and
> bytevector->base16-string, making them about 20% and two times
> faster respectively, by reducing allocations.  They are called
> from 'output-path', 'fixed-output-path' and 'store-path'
> in (guix store).

Thanks a lot for looking into this!

> Unfortunately, this does not decrease timings to a noticable degree,
> but it does decrease the allocated memory by 2.3% (*), and it does not
> seem to increase timings.  (See perf-numbers.txt.)

Yeah, base32 code is usually pretty low in profiles of calls to
‘package-derivation’.

> From a93bad629e2746c77446cacddb9986506ce9ba88 Mon Sep 17 00:00:00 2001
> From: Maxime Devos <maximedevos@telenet.be>
> Date: Sun, 5 Sep 2021 16:28:33 +0200
> Subject: [PATCH 1/2] base32: Reduce GC pressure in
>  make-bytevector->base32-string.
>
> The following code has been used to compare performance:
>
> ;; first 20 bytes of sha256 of #vu8(#xde #xad #xbe #xef)
> (define bv #vu8(95 120 195 50 116 228 63 169 222 86 89 38 92 29 145 126 37 192 55 34))
> ,profile
> (let loop ((n 0))
>   (when (< n #e1e6)
>      ((@ (guix base32) bytevector->nix-base32-string) bv)
>      (loop (+ n 1))))
>
> Before this change, the output was:
>
> [...]
> Sample count: 1140
> Total time: 27.465560018 seconds (10.659331433 seconds in GC)
>
> After this change, the output was:
>
> [...]
> Sample count: 957
> Total time: 20.478847143 seconds (6.139721189 seconds in GC)

Note that ,profile (statprof) is intrusive; additional, the REPL uses
the “debug” VM engine, which is slightly slower than the “regular” one
(info "(guile) Command-line Options").

To measure “actual” performance, it’s best to write the code down in a
file and then run:

  time guile -l that-file.scm

or, alternatively, use (ice-9 time) and wrap the body of the relevant
code in (time …), which is a bit more accurate than using the shell’s
‘time’ command since it allows you to dismiss Guile startup time.

(You also need to make sure that the loop counter remains below
‘most-positive-fixnum’, otherwise you’ll end up measuring GC activity
due to the use of bignums, but 10⁶ is definitely OK.)

> * guix/base32.scm
>   (make-bytevector->base32-string): Eliminate 'reverse', use mutation instead.

[...]

> +    (let* ((start (cons #f #f))
> +           (end (quintet-fold (lambda (q r)
> +                                (define pair
> +                                  (cons (vector-ref base32-chars q) #f))
> +                                (set-cdr! r pair)
> +                                pair)
> +                              start
> +                              bv)))
> +      (set-cdr! end '())
> +      (list->string (cdr start)))))

Does replacing (reverse chars) with (reverse! chars) has the same
effect?

I’m reluctant to resorting to micro-optimizations like the one above
since they make code harder to reason about.

> From dfd9b7557e31823320fcbd7abed77de295b7dce1 Mon Sep 17 00:00:00 2001
> From: Maxime Devos <maximedevos@telenet.be>
> Date: Mon, 6 Sep 2021 00:46:17 +0200
> Subject: [PATCH 2/2] 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.

LGTM.  How did you measure performance for this one?

Thanks,
Ludo’.




^ permalink raw reply	[flat|nested] 7+ messages in thread

* [bug#50456] Optimise bytevector->nix-base32-string and bytevector->base16-string.
  2021-09-09 14:29 ` [bug#50456] Optimise bytevector->nix-base32-string and bytevector->base16-string Ludovic Courtès
@ 2021-09-09 14:42   ` Maxime Devos
  2021-09-09 15:15   ` Maxime Devos
  1 sibling, 0 replies; 7+ messages in thread
From: Maxime Devos @ 2021-09-09 14:42 UTC (permalink / raw)
  To: Ludovic Courtès; +Cc: 50456

[-- Attachment #1: Type: text/plain, Size: 4037 bytes --]

Ludovic Courtès schreef op do 09-09-2021 om 16:29 [+0200]:
> Hello,
> 
> Maxime Devos <maximedevos@telenet.be> skribis:
> 
> > The two atached patches optimise bytevector->nix-base32-string and
> > bytevector->base16-string, making them about 20% and two times
> > faster respectively, by reducing allocations.  They are called
> > from 'output-path', 'fixed-output-path' and 'store-path'
> > in (guix store).
> 
> Thanks a lot for looking into this!
> 
> > Unfortunately, this does not decrease timings to a noticable degree,
> > but it does decrease the allocated memory by 2.3% (*), and it does not
> > seem to increase timings.  (See perf-numbers.txt.)
> 
> Yeah, base32 code is usually pretty low in profiles of calls to
> ‘package-derivation’.
> 
> > From a93bad629e2746c77446cacddb9986506ce9ba88 Mon Sep 17 00:00:00 2001
> > From: Maxime Devos <maximedevos@telenet.be>
> > Date: Sun, 5 Sep 2021 16:28:33 +0200
> > Subject: [PATCH 1/2] base32: Reduce GC pressure in
> >  make-bytevector->base32-string.
> > 
> > The following code has been used to compare performance:
> > 
> > ;; first 20 bytes of sha256 of #vu8(#xde #xad #xbe #xef)
> > (define bv #vu8(95 120 195 50 116 228 63 169 222 86 89 38 92 29 145 126 37 192 55 34))
> > ,profile
> > (let loop ((n 0))
> >   (when (< n #e1e6)
> >      ((@ (guix base32) bytevector->nix-base32-string) bv)
> >      (loop (+ n 1))))
> > 
> > Before this change, the output was:
> > 
> > [...]
> > Sample count: 1140
> > Total time: 27.465560018 seconds (10.659331433 seconds in GC)
> > 
> > After this change, the output was:
> > 
> > [...]
> > Sample count: 957
> > Total time: 20.478847143 seconds (6.139721189 seconds in GC)
> 
> Note that ,profile (statprof) is intrusive; additional, the REPL uses
> the “debug” VM engine, which is slightly slower than the “regular” one
> (info "(guile) Command-line Options").
> 
> To measure “actual” performance, it’s best to write the code down in a
> file and then run:
> 
>   time guile -l that-file.scm
> 
> or, alternatively, use (ice-9 time) and wrap the body of the relevant
> code in (time …), which is a bit more accurate than using the shell’s
> ‘time’ command since it allows you to dismiss Guile startup time.

I'll test with ((@ (ice-9 time) ...).

> (You also need to make sure that the loop counter remains below
> ‘most-positive-fixnum’, otherwise you’ll end up measuring GC activity
> due to the use of bignums, but 10⁶ is definitely OK.)
> 
> > * guix/base32.scm
> >   (make-bytevector->base32-string): Eliminate 'reverse', use mutation instead.
> 
> [...]
> 
> > +    (let* ((start (cons #f #f))
> > +           (end (quintet-fold (lambda (q r)
> > +                                (define pair
> > +                                  (cons (vector-ref base32-chars q) #f))
> > +                                (set-cdr! r pair)
> > +                                pair)
> > +                              start
> > +                              bv)))
> > +      (set-cdr! end '())
> > +      (list->string (cdr start)))))
> 
> Does replacing (reverse chars) with (reverse! chars) has the same
> effect?

Not tested.

> I’m reluctant to resorting to micro-optimizations like the one above
> since they make code harder to reason about.

Agreed, let's drop that patch.

> > From dfd9b7557e31823320fcbd7abed77de295b7dce1 Mon Sep 17 00:00:00 2001
> > From: Maxime Devos <maximedevos@telenet.be>
> > Date: Mon, 6 Sep 2021 00:46:17 +0200
> > Subject: [PATCH 2/2] 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.
> 
> LGTM.  How did you measure performance for this one?

IIRC, the same way as with bytevector->base32-string.  I'll retest
with (ice-9 time).

Greetings,
Maxime.

[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]

^ permalink raw reply	[flat|nested] 7+ messages in thread

* [bug#50456] Optimise bytevector->nix-base32-string and bytevector->base16-string.
  2021-09-09 14:29 ` [bug#50456] Optimise bytevector->nix-base32-string and bytevector->base16-string Ludovic Courtès
  2021-09-09 14:42   ` Maxime Devos
@ 2021-09-09 15:15   ` Maxime Devos
  1 sibling, 0 replies; 7+ messages in thread
From: Maxime Devos @ 2021-09-09 15:15 UTC (permalink / raw)
  To: Ludovic Courtès; +Cc: 50456


[-- Attachment #1.1: Type: text/plain, Size: 838 bytes --]

Hi,

Here are the test results using (ice-9 time) with
the attached "time.scm" and guix/base16.scm,
to be run with ‘make && ./pre-inst-env guix repl time.scm’:

old:
clock utime stime cutime cstime gctime
 3.93  6.32  0.03   0.00   0.00   3.59
clock utime stime cutime cstime gctime
 3.92  6.32  0.03   0.00   0.00   3.59
clock utime stime cutime cstime gctime
 3.86  6.24  0.02   0.00   0.00   3.54
new:
clock utime stime cutime cstime gctime
 2.43  3.60  0.02   0.00   0.00   1.76
clock utime stime cutime cstime gctime
 2.49  3.67  0.01   0.00   0.00   1.77
clock utime stime cutime cstime gctime
 2.64  3.77  0.01   0.00   0.00   1.77

About half as much time is spent in GC.
The ‘utime’ is also half as much.  Not sure
what ‘clock’ means exactly, but it is reduced
as well.

Greetings,
Maxime

[-- Attachment #1.2: time.scm --]
[-- Type: text/x-scheme, Size: 914 bytes --]

(define bv #vu8(95 120 195 50 116 227 63 169 222 86 89 38 92 145 126 37 192 55 34))
(define (the-test p)
  (let loop ((n 0))
    (when (< n #e1e6)
      (p bv)
      (loop (+ n 1)))))

(display "old:\n")
;; Warm up the JIT
(the-test (@ (guix base16) bytevector->base16-string/old))
;; And time the procedure
((@ (ice-9 time) time) (the-test (@ (guix base16) bytevector->base16-string/old)))
((@ (ice-9 time) time) (the-test (@ (guix base16) bytevector->base16-string/old)))
((@ (ice-9 time) time) (the-test (@ (guix base16) bytevector->base16-string/old)))

(display "new:\n")
;; Warm up the JIT
(the-test (@ (guix base16) bytevector->base16-string))
;; And time the procedure
((@ (ice-9 time) time) (the-test (@ (guix base16) bytevector->base16-string)))
((@ (ice-9 time) time) (the-test (@ (guix base16) bytevector->base16-string)))
((@ (ice-9 time) time) (the-test (@ (guix base16) bytevector->base16-string)))

[-- Attachment #1.3: base16.scm --]
[-- Type: text/x-scheme, Size: 4272 bytes --]

;;; 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.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (guix base16)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)
  #:use-module (srfi srfi-60)
  #:use-module (rnrs bytevectors)
  #:use-module (ice-9 vlist)
  #:use-module (ice-9 format)
  #:export (bytevector->base16-string
            bytevector->base16-string/old
            base16-string->bytevector))
\f
;;;
;;; Base 16.
;;;

(define (bytevector->base16-string/old 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 (bytevector->base16-string bv)
  "Return the hexadecimal representation of BV's contents."
  (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)
                              (vhash-consv (string-ref (number->string i 16)
                                                       0)
                                           i r))
                            vlist-null
                            (iota 16))))
    (lambda (s)
      "Return the bytevector whose hexadecimal representation is string S."
      (define bv
        (make-bytevector (quotient (string-length s) 2) 0))

      (string-fold (lambda (chr i)
                     (let ((j (quotient i 2))
                           (v (and=> (vhash-assv chr chars->value) cdr)))
                       (if v
                           (if (zero? (logand i 1))
                               (bytevector-u8-set! bv j
                                                   (arithmetic-shift v 4))
                               (let ((w (bytevector-u8-ref bv j)))
                                 (bytevector-u8-set! bv j (logior v w))))
                           (error "invalid hexadecimal character" chr)))
                     (+ i 1))
                   0
                   s)
      bv)))


[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]

^ permalink raw reply	[flat|nested] 7+ messages in thread

* bug#50456: Acknowledgement (Optimise bytevector->nix-base32-string and bytevector->base16-string.)
       [not found] ` <handler.50456.B.16310288933583.ack@debbugs.gnu.org>
  2021-09-07 15:37   ` [bug#50456] Acknowledgement (Optimise bytevector->nix-base32-string and bytevector->base16-string.) Maxime Devos
@ 2021-09-11 15:54   ` Maxime Devos
  1 sibling, 0 replies; 7+ messages in thread
From: Maxime Devos @ 2021-09-11 15:54 UTC (permalink / raw)
  To: 50456-done

Partially merged with a87d8c912d64382d8d7489c156249bc2b2638df0.
Closing.






^ permalink raw reply	[flat|nested] 7+ messages in thread

end of thread, other threads:[~2021-09-11 15:55 UTC | newest]

Thread overview: 7+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-09-07 15:34 [bug#50456] Optimise bytevector->nix-base32-string and bytevector->base16-string Maxime Devos
2021-09-07 15:36 ` [bug#50456] Base16 and base32 optimisations split off Maxime Devos
     [not found] ` <handler.50456.B.16310288933583.ack@debbugs.gnu.org>
2021-09-07 15:37   ` [bug#50456] Acknowledgement (Optimise bytevector->nix-base32-string and bytevector->base16-string.) Maxime Devos
2021-09-11 15:54   ` bug#50456: " Maxime Devos
2021-09-09 14:29 ` [bug#50456] Optimise bytevector->nix-base32-string and bytevector->base16-string Ludovic Courtès
2021-09-09 14:42   ` Maxime Devos
2021-09-09 15:15   ` Maxime Devos

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).