diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-03-08 03:43:03 +0100 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-03-15 01:43:12 +0100 |
commit | 02aba668c408a473067bc26b8f36077384b9c14a (patch) | |
tree | dfd8b1de9002a97bd3410d3ab3389100b8e2ff4a /module/hnh/util | |
parent | Popup created events now don't take seconds. (diff) | |
download | calp-02aba668c408a473067bc26b8f36077384b9c14a.tar.gz calp-02aba668c408a473067bc26b8f36077384b9c14a.tar.xz |
Add native UUID generator.
While not necessary, since we barely use UUID:s, it's still WAY faster,
and nice to not depend on the system providing `uuidgen'.
For comparison, number of UUID:s generated by different settups in 1
second:
65.000 :: guile native
700 :: guile shell-out
3.500.000 :: c native
100.000 :: libuuid - guile bindings
650.000 :: libuuid
Tests where run with either
(call-with-time-limit
1
(lambda ()
(let loop ()
(uuid)
(set! count (1+ count))
(loop)))
(lambda _ (display count)))
or
volatile unsigned long long count = 0;
sigaction(SIGALARM, ...);
alarm(1);
for (;;) {
uuid();
count++;
}
(let ((count 0))
(call-with-time-limit
1
(lambda ()
(let loop ()
((@ (hnh util) uuidgen))
(set! count (1+ count))
(loop)))
(lambda _ (format #t "exec count = ~:d~%" count))))
Diffstat (limited to 'module/hnh/util')
-rw-r--r-- | module/hnh/util/uuid.scm | 19 |
1 files changed, 19 insertions, 0 deletions
diff --git a/module/hnh/util/uuid.scm b/module/hnh/util/uuid.scm new file mode 100644 index 00000000..68455243 --- /dev/null +++ b/module/hnh/util/uuid.scm @@ -0,0 +1,19 @@ +(define-module (hnh util uuid) + :use-module (ice-9 format) + :export (uuid uuid-v4)) + +(define %seed (random-state-from-platform)) + +(define (uuid-v4) + (define version 4) + (define variant #b10) + (format #f "~8'0x-~4'0x-~4'0x-~4'0x-~12'0x" + (random (ash 1 (* 4 8)) %seed) + (random (ash 1 (* 4 4)) %seed) + (logior (ash version (* 4 3)) + (random (1- (ash 1 (* 4 3))) %seed)) + (logior (ash variant (+ 2 (* 4 3))) + (random (ash 1 (+ 2 (* 4 3))) %seed)) + (random (ash 1 (* 4 12)) %seed))) + +(define uuid uuid-v4) |