Fix hexadecimal->vector-8b for real.
authorTaylor R Campbell <campbell@mumble.net>
Sun, 3 May 2015 00:04:31 +0000 (00:04 +0000)
committerTaylor R Campbell <campbell@mumble.net>
Sun, 3 May 2015 03:05:16 +0000 (03:05 +0000)
src/runtime/string.scm

index 45afef4f902632c3bc41b785781e097f11413daf..bd9e2cba72353eda36b78293ed25fc8fba4860ee 100644 (file)
@@ -582,14 +582,17 @@ USA.
         (lambda ()
           (error:bad-range-argument string 'HEXADECIMAL->VECTOR-8B))))
     (define-integrable (hex-digit char)
-      (let ((integer (char->integer char)))
-       (let ((numeric-digit (fix:- integer (char->integer #\0)))
-             (lowercase-digit (fix:- integer (char->integer #\a)))
-             (uppercase-digit (fix:- integer (char->integer #\A))))
-         (cond ((fix:< numeric-digit #d10) numeric-digit)
-               ((fix:< lowercase-digit 6) (fix:+ lowercase-digit #d10))
-               ((fix:< uppercase-digit 6) (fix:+ uppercase-digit #d10))
-               (else (lose))))))
+      (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 ((bytes (make-vector-8b (fix:lsh end -1))))