Implement bytevector->hexadecimal and hexadecimal->bytevector.

diff --git a/src/runtime/bytevector.scm b/src/runtime/bytevector.scm
index 4a984a8575c160fa293e7495973b3f19142964d8..fd0e55ebce199bf2d75ce7795c9d90084ed41b25 100644 (file)
--- a/src/runtime/bytevector.scm
+++ b/src/runtime/bytevector.scm
@@ -374,4 +374,44 @@ USA.
    (set! utf32le->string
         (bytes-decoder bytevector-u32le-ref initial-u32->utf32-char-length
                        decode-utf32le-char 1 "UTF-32LE" 'utf32le->string))
-   unspecific))
\ No newline at end of file
+   unspecific))
+\f
+(define (bytevector->hexadecimal bytes)
+  (define-integrable (hex-char k)
+    (string-ref "0123456789ABCDEF" (fix:and k #x0F)))
+  (guarantee string? bytes 'bytevector->hexadecimal)
+  (let ((n (bytevector-length bytes))
+       (builder (string-builder)))
+    (do ((i 0 (fix:+ i 1)))
+       ((not (fix:< i n)))
+      (builder (hex-char (fix:lsh (bytevector-u8-ref bytes i) -4)))
+      (builder (hex-char (bytevector-u8-ref bytes i))))
+    (builder)))
+
+(define (hexadecimal->bytevector string)
+  (guarantee string? string 'hexadecimal->bytevector)
+  (let ((end (string-length string))
+       (lose
+        (lambda ()
+          (error:bad-range-argument string 'hexadecimal->bytevector))))
+    (define-integrable (hex-digit char)
+      (let ((i (char->integer char))
+           (d0 (char->integer #\0))
+           (d9 (char->integer #\9))
+           (la (char->integer #\a))
+           (lf (char->integer #\f))
+           (UA (char->integer #\A))
+           (UF (char->integer #\F)))
+       (cond ((and (fix:<= d0 i) (fix:<= i d9)) (fix:- i d0))
+             ((and (fix:<= la i) (fix:<= i lf)) (fix:+ #xa (fix:- i la)))
+             ((and (fix:<= UA i) (fix:<= i UF)) (fix:+ #xA (fix:- i UA)))
+             (else (lose)))))
+    (if (not (fix:= (fix:and end 1) 0))
+       (lose))
+    (let ((builder (bytevector-builder)))
+      (do ((i 0 (fix:+ i 2)))
+         ((not (fix:< i end)))
+       (builder
+        (fix:+ (fix:lsh (hex-digit (string-ref string i)) 4)
+               (hex-digit (string-ref string (fix:+ i 1))))))
+      (builder))))
\ No newline at end of file

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 5fdac0ab2cb96735b0af39ea23bb622b5c56f989..c4475fd38a8475b633766a14b8524a744be13a1a 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -1179,6 +1179,7 @@ USA.
   (export ()
          (byte? u8?)
          bytevector
+         bytevector->hexadecimal
          bytevector-append
          bytevector-builder
          bytevector-copy
@@ -1198,6 +1199,7 @@ USA.
          bytevector-u8-set!
          bytevector=?
          bytevector?
+         hexadecimal->bytevector
          make-bytevector
          string->utf16be
          string->utf16le