From d0a6135b7d9ebfe8d048952fd5312d544f3ce144 Mon Sep 17 00:00:00 2001 From: Taylor R Campbell Date: Sun, 3 May 2015 00:04:31 +0000 Subject: [PATCH] Fix hexadecimal->vector-8b for real. --- src/runtime/string.scm | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/src/runtime/string.scm b/src/runtime/string.scm index 45afef4f9..bd9e2cba7 100644 --- a/src/runtime/string.scm +++ b/src/runtime/string.scm @@ -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)))) -- 2.25.1