On Thu, 17 Nov 2022 19:08:56 -0000 (UTC)
Spiros Bousbouras <
spi...@gmail.com> wrote:
> The function encode-3-octets below
> takes as argument 3 octets and returns a string with 4 characters which is
> the BASE64 encoding of the octets as defined in RFC 2045.
>
>
> (defconstant base64-alphabet
> "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
> "See RFC 2045.
> For simplicity , I have written the characters explicitly as opposed
> to their ASCII values which is what should be transmitted over the
> wire. For most or all Common Lisp implementations , it would make no
> difference."
> )
>
> (declaim (ftype (function ((unsigned-byte 8) (unsigned-byte 8) (unsigned-byte 8))
> string)
> encode-3-octets))
>
> (defun encode-3-octets (a b c &aux (i 0)
> (res (make-array 4 :element-type 'character)))
> (declare (type (unsigned-byte 6) i))
> (setf (aref res 0) (aref base64-alphabet (ldb (byte 6 2) a)))
> (setq i (dpb (ldb (byte 2 0) a) (byte 2 4) 0))
> (setq i (dpb (ldb (byte 4 4) b) (byte 4 0) i))
> (setf (aref res 1) (aref base64-alphabet i))
> (setq i (dpb (ldb (byte 4 0) b) (byte 4 2) 0))
> (setq i (dpb (ldb (byte 2 6) c) (byte 2 0) i))
> (setf (aref res 2) (aref base64-alphabet i))
> (setf (aref res 3) (aref base64-alphabet (ldb (byte 6 0) c)))
> res
> )
Here is a version which I find easier to understand :
(defun copy-bit-range (source start1 end
&optional (dest 0) (start2 0)
&aux (len (+ 1 (- end start1))))
"The function copies the bits from position start1 to end
[inclusive] of integer source to integer dest starting from
position start2 and returns the integer thus constructed."
(dpb (ldb (byte len start1) source) (byte len start2) dest))
(declaim (ftype (function ((unsigned-byte 8) (unsigned-byte 8) (unsigned-byte 8))
string)
encode-3-octets-2))
(defun encode-3-octets-2 (a b c &aux (i 0)
(res (make-array 4 :element-type 'character)))
(declare (type (unsigned-byte 6) i))
(setf (aref res 0) (aref base64-alphabet (copy-bit-range a 2 7)))
(setq i (copy-bit-range a 0 1 0 4))
(setf (aref res 1) (aref base64-alphabet (copy-bit-range b 4 7 i 0)))
(setq i (copy-bit-range b 0 3 0 2))
(setf (aref res 2) (aref base64-alphabet (copy-bit-range c 6 7 i 0)))
(setf (aref res 3) (aref base64-alphabet (copy-bit-range c 0 5)))
res
)
And if you want to test that they do the same
(defun test-function2 ()
(dotimes (i1 256)
(dotimes (i2 256)
(dotimes (i3 256)
(unless (equalp (encode-3-octets i1 i2 i3)
(encode-3-octets-2 i1 i2 i3))
(error "~A ~A ~A~%" i1 i2 i3))))))
SBCL takes 21 seconds to run test-function2 , ECL and clisp much longer.
But I didn't pay any attention to optimisation settings.
--
My university's administration tended in the past to express skepticism
about the value of this ranking, which typically put us tied for 8/9 or
8/9/10. This year however, everyone here agrees that there has been a
dramatic improvement in methodology, since we're at number 4.
http://www.math.columbia.edu/~woit/wordpress/?p=3197