Merge pull request #7 from guicho271828/remove-ironclad

Remove ironclad

.gitignore

@@ -1,3 +1,5 @@
 *.FASL
 *.fasl
 *.lisp-temp
+*~
+#*

bit-smasher.asd

@@ -25,6 +25,7 @@
                :ironclad)
   :components ((:file "packages")
                (:file "core")
+               (:file "from-ironclad")
                (:file "conversion")
                (:file "arithmetic")
                (:file "aliases")

src/arithmetic.lisp

@@ -5,6 +5,14 @@
 
 (in-package :bit-smasher)
 
+;; from comp.lang.lisp
+(defun bit-vector-integer-value-and-place (bit-vector)
+  "Returns the bits of BIT-VECTOR as an integer as the primary value, number of bits as the secondary value.
+SLOW!! Consult Hackers-Delight"
+  (let ((place -1))
+    (values (reduce #'+ (reverse bit-vector) :key (lambda (digit) (ash digit (incf place))))
+            (incf place))))
+
 (defun bit-sum (&rest rest)
   "Addition for bit-vectors.  Return result SUM forced to absolute ceiling value."
   (let* ((intlist (loop for i in rest collect (int<- i)))

src/conversion.lisp

@@ -19,32 +19,41 @@
 
 (defun hex->bits (x)
   "Return the bit-vector for hexadecimal string X."
-  (let ((binlist (loop for c across x collect (hex-to-bit-lookup/unsafe c))))
-    (apply #'concatenate 'bit-vector binlist)))
+  (let ((result (make-array (* 4 (length x)) :element-type 'bit)))
+    (declare (type (simple-array bit) result)
+             (type string x))
+    (loop for c across x
+          for i from 0 by 4
+          for bv = (hex-to-bit-lookup/unsafe c)
+          do
+       (locally
+           (declare (optimize (safety 0)))
+         (replace result bv :start1 i)))
+    result))
 
 (defun hex->octets (x)
   "Return the octet-vector for hexadecimal string X."
-  (ironclad:hex-string-to-byte-array x))
+  (hex-string-to-byte-array x))
 
 (defun hex->int (x)
   "Return the integer value for hexadecimal string X."
   (octets->int (hex->octets x)))
 
 (defun octets->hex (o)
   "Return the hexadecimal string for octet-vector O."
-  (ironclad:byte-array-to-hex-string o))
+  (byte-array-to-hex-string o))
 
 (defun octets->int (o)
   "Return the integer value for octet-vector O."
-  (ironclad:octets-to-integer o))
+  (octets-to-integer o))
 
 (defun octets->bits (o)
   "Return the bit-vector for octet-vector O."
   (hex->bits (octets->hex o)))
 
 (defun int->octets (n)
   "Return the octet-vector for integer N."
-  (ironclad:integer-to-octets n))
+  (integer-to-octets n))
 
 (defun int->hex (n)
   "Return the hexadecimal string for integer N."
@@ -64,7 +73,7 @@
 
 (defun bits->octets (data)
   "Return the octet-vector for bit-vector DATA."
-  (ironclad:integer-to-octets (bits->int data)))
+  (integer-to-octets (bits->int data)))
 
 ;;;; generalized
 

src/core.lisp

@@ -23,33 +23,30 @@
                     #*1110
                     #*1111))
 
-(declaim (ftype (function ((member #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9
-                                   #\a #\b #\c #\d #\e #\f
-                                   #\A #\B #\C #\D #\E #\F))
-                          (simple-bit-vector 4))
-                hex-to-bit-lookup/unsafe))
-(defun hex-to-bit-lookup/unsafe (char)
+(deftype hex-char ()
+  `(member #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9
+           #\a #\b #\c #\d #\e #\f
+           #\A #\B #\C #\D #\E #\F))
+
+(declaim (ftype (function (hex-char) (integer 0 16)) hexchar->int)
+         (inline hexchar->int))
+(defun hexchar->int (char)
   "Return the bit vector associated with a hex-value character CHAR from *bit-map*."
   (declare (optimize (speed 2) (safety 0)))
-  (cond ((char<= #\0 char #\9)
-         (aref *bit-map* (- (char-code char) #.(char-code #\0))))
-        ((char<= #\a char #\f)
-         (aref *bit-map* (- (char-code char) #.(- (char-code #\a) 10))))
-        (t
+  (cond ((char<= #\0 char #\9) (- (char-code char) #.(char-code #\0)))
+        ((char<= #\a char #\f) (- (char-code char) #.(- (char-code #\a) 10)))
+        (t                     (- (char-code char) #.(- (char-code #\A) 10))
          ;; always return these results
-         #+nil (char<= #\A char #\F)
-         (aref *bit-map* (- (char-code char) #.(- (char-code #\A) 10))))))
+         #+nil (char<= #\A char #\F))))
+
+(declaim (ftype (function (hex-char) (simple-bit-vector 4)) hex-to-bit-lookup/unsafe))
+(defun hex-to-bit-lookup/unsafe (char)
+  "Return the bit vector associated with a hex-value character CHAR from *bit-map*."
+  (declare (optimize (speed 2) (safety 0)))
+  (aref *bit-map* (hexchar->int char)))
 
 (defun hex-to-bit-lookup (char)
   "Return the bit vector associated with a hex-value character CHAR from *bit-map*."
   (declare (optimize (speed 2) (safety 0)))
   (copy-seq (hex-to-bit-lookup/unsafe char)))
 
-;; from comp.lang.lisp
-(defun bit-vector-integer-value-and-place (bit-vector)
-  "Returns the bits of BIT-VECTOR as an integer as the primary value, number of bits as the secondary value.
-SLOW!! Consult Hackers-Delight"
-  (let ((place -1))
-    (values (reduce #'+ (reverse bit-vector) :key (lambda (digit) (ash digit (incf place))))
-            (incf place))))
-

src/from-ironclad.lisp

@@ -0,0 +1,59 @@
+(in-package :bit-smasher)
+
+(declaim (inline hex-string-to-byte-array
+                 byte-array-to-hex-string
+                 octets-to-integer
+                 integer-to-octets))
+
+;; since these functions are inlined, optimization settings follows the one in the inlined context
+
+
+(defun hex-string-to-byte-array (string &aux (start 0) (end (length string)))
+  "Parses a substring of STRING delimited by START and END of
+hexadecimal digits into a byte array."
+  (declare (type string string))
+  (let* ((length
+          (ash (- end start) -1)
+           #+nil (/ (- end start) 2))
+         (key (make-array length :element-type '(unsigned-byte 8))))
+    (declare (type (simple-array (unsigned-byte 8)) key))
+    (loop for i from 0
+          for j from start below end by 2
+          do (setf (aref key i)
+                   (+ (* (hexchar->int (char string j)) 16)
+                      (hexchar->int (char string (1+ j)))))
+          finally (return key))))
+
+(defun byte-array-to-hex-string (vector)
+  "Return a string containing the hexadecimal representation of the
+subsequence of VECTOR between START and END.  ELEMENT-TYPE controls
+the element-type of the returned string."
+  (declare (type (vector (unsigned-byte 8)) vector))
+  (let* ((length (length vector))
+         (hexdigits #.(coerce "0123456789abcdef" 'simple-base-string)))
+    (loop with string = (make-string (* length 2) :element-type 'base-char)
+       for i from 0 below length
+       for j from 0 by 2
+       do (let ((byte (aref vector i)))
+            (declare (optimize (safety 0)))
+            (setf (aref string j)
+                  (aref hexdigits (ldb (byte 4 4) byte))
+                  (aref string (1+ j))
+                  (aref hexdigits (ldb (byte 4 0) byte))))
+       finally (return string))))
+
+(defun octets-to-integer (octet-vec &aux (end (length octet-vec)))
+  (declare (type (simple-array (unsigned-byte 8)) octet-vec))
+  (do ((j 0 (1+ j))
+       (sum 0))
+      ((>= j end) sum)
+    (setf sum (+ (aref octet-vec j) (ash sum 8)))))
+
+(defun integer-to-octets (bignum &aux (n-bits (integer-length bignum)))
+  (let* ((n-bytes (ceiling n-bits 8))
+         (octet-vec (make-array n-bytes :element-type '(unsigned-byte 8))))
+    (declare (type (simple-array (unsigned-byte 8)) octet-vec))
+    (loop for i from (1- n-bytes) downto 0
+          for index from 0
+          do (setf (aref octet-vec index) (ldb (byte 8 (* i 8)) bignum))
+          finally (return octet-vec))))

src/packages.lisp

@@ -7,7 +7,7 @@
 
 (defpackage #:bit-smasher
   (:nicknames #:bitsmash)
-  (:use :cl :cl-user :ironclad)
+  (:use :cl :cl-user)
   (:shadowing-import-from :cl-user #:null)
   (:export #:*bit-smasher-version*
            #:hex<- #:hex->bits #:hex->octets #:hex->int