@@ 24,22 24,51 @@
hexstr->bin))
-(define hex-chars (vector 48 49 50 51 52 53 54 55 56 57 97 98 99 100 101 102))
+
+;; This trick is stolen (with permisison) from Andrew Gierth (RhodiumToad on freenode)
+;; Instead of getting each char, we use bytevector-u16-ref/set! to set a complete byte.
+;; This saves one lookup and some bit-fiddling.
-(define (bin->hex bin)
- (let* ([bin-len (bytevector-length bin)]
- [hex (make-bytevector (* bin-len 2) 0)])
- (let loop ([i 0])
+(define hexstr
+ "\
+000102030405060708090a0b0c0d0e0f\
+101112131415161718191a1b1c1d1e1f\
+202122232425262728292a2b2c2d2e2f\
+303132333435363738393a3b3c3d3e3f\
+404142434445464748494a4b4c4d4e4f\
+505152535455565758595a5b5c5d5e5f\
+606162636465666768696a6b6c6d6e6f\
+707172737475767778797a7b7c7d7e7f\
+808182838485868788898a8b8c8d8e8f\
+909192939495969798999a9b9c9d9e9f\
+a0a1a2a3a4a5a6a7a8a9aaabacadaeaf\
+b0b1b2b3b4b5b6b7b8b9babbbcbdbebf\
+c0c1c2c3c4c5c6c7c8c9cacbcccdcecf\
+d0d1d2d3d4d5d6d7d8d9dadbdcdddedf\
+e0e1e2e3e4e5e6e7e8e9eaebecedeeef\
+f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff")
+
+(define hex-chars
+ (string->utf8 hexstr))
+
+(define hex-chars/upper
+ (string->utf8 (string-upcase hexstr)))
+
+
+(define* (bin->hex bin #:optional upper-case?)
+ (let* ((bin-len (bytevector-length bin))
+ (hex (make-bytevector (ash bin-len 1) 0))
+ (table (if upper-case? hex-chars/upper hex-chars)))
+ (let loop ((i 0))
(when (< i bin-len)
(let ([b (bytevector-u8-ref bin i)]
- [index (* i 2)])
- (bytevector-u8-set! hex index (vector-ref hex-chars (logand (ash b -4) 15)))
- (bytevector-u8-set! hex (+ 1 index) (vector-ref hex-chars (logand b 15))))
- (loop (+ 1 i))))
+ (index (ash i 1)))
+ (bytevector-u16-native-set!
+ hex index (bytevector-u16-native-ref hex-chars (ash b 1)))
+ (loop (+ 1 i)))))
hex))
-
;; 256 elements. No byte will read out of bounds.
(define char-hexs (vector #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
#f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
@@ 68,11 97,12 @@
[bin (make-bytevector bin-len 0)])
(let loop ([i 0])
(when (< i bin-len)
- (let ([fst (vector-ref char-hexs (bytevector-u8-ref hex (* i 2)))]
- [snd (vector-ref char-hexs (bytevector-u8-ref hex (+ (* i 2) 1)))])
+ (let ([fst (vector-ref char-hexs (bytevector-u8-ref hex (ash i 1)))]
+ [snd (vector-ref char-hexs (bytevector-u8-ref hex (+ (ash i 1) 1)))])
(unless (and fst snd)
(error 'hex->bin "non-hex byte in bytevector hex"))
- (bytevector-u8-set! bin i (+ (* fst 16) snd))
+ (bytevector-u8-set! bin i (+ (ash fst 4
+ ) snd))
(loop (+ 1 i)))))
bin)))