Removed dependency on external data files for tests.

Pascal J. Bourguignon [2012-04-13 08:05]
Removed dependency on external data files for tests.
Ran around a bug in ccl-1.5.
Filename
common-lisp/rfc3548/rfc3548.lisp
diff --git a/common-lisp/rfc3548/rfc3548.lisp b/common-lisp/rfc3548/rfc3548.lisp
index 2a555e6..b68f404 100644
--- a/common-lisp/rfc3548/rfc3548.lisp
+++ b/common-lisp/rfc3548/rfc3548.lisp
@@ -79,13 +79,15 @@
 ;;;;AUTHORS
 ;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
 ;;;;MODIFICATIONS
+;;;;    2012-04-13 <PJB> Removed dependency on external data files for tests.
+;;;;                     Ran around a bug in ccl-1.5.
 ;;;;    2004-08-18 <PJB> Added base16, base32 and filebase64.
 ;;;;    2004-08-17 <PJB> Created (extracted from antispam.lisp).
 ;;;;BUGS
 ;;;;LEGAL
 ;;;;    GPL
 ;;;;
-;;;;    Copyright Pascal J. Bourguignon 2004 - 2004
+;;;;    Copyright Pascal J. Bourguignon 2004 - 2012
 ;;;;
 ;;;;    This program is free software; you can redistribute it and/or
 ;;;;    modify it under the terms of the GNU General Public License
@@ -103,87 +105,89 @@
 ;;;;    Boston, MA 02111-1307 USA
 ;;;;****************************************************************************

-(IN-PACKAGE "COMMON-LISP-USER")
-(DEFPACKAGE "COM.INFORMATIMAGO.COMMON-LISP.RFC3548.RFC3548"
-  (:USE "COMMON-LISP"
+(in-package "COMMON-LISP-USER")
+(defpackage "COM.INFORMATIMAGO.COMMON-LISP.RFC3548.RFC3548"
+  (:use "COMMON-LISP"
         "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.STREAM")
-  (:EXPORT
+  (:export
    "BASE16-DECODE-BYTES" "BASE16-ENCODE-BYTES" "BASE32-DECODE-BYTES"
    "BASE32-ENCODE-BYTES" "FILEBASE64-DECODE-BYTES" "FILEBASE64-ENCODE-BYTES"
    "BASE64-DECODE-BYTES" "BASE64-ENCODE-BYTES" "BASE16-DECODE" "BASE16-ENCODE"
    "BASE32-DECODE" "BASE32-ENCODE" "FILEBASE64-DECODE" "FILEBASE64-ENCODE"
    "BASE64-DECODE" "BASE64-ENCODE")
-  (:IMPORT-FROM "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.STREAM"
+  (:import-from "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.STREAM"
                 "BVSTREAM-WRITE-BYTE" "BVSTREAM-READ-BYTE"
                 "WITH-INPUT-FROM-BYTE-VECTOR" "WITH-OUTPUT-TO-BYTE-VECTOR")
-  (:DOCUMENTATION
+  (:documentation
    "This packages exports functions to encode an decode text blocks
     according to the encoding described in:
       RFC3548: The Base16, Base32, and Base64 Data Encodings

-    Copyright Pascal J. Bourguignon 2004 - 2004
+    Copyright Pascal J. Bourguignon 2004 - 2012
     This package is provided under the GNU General Public License.
     See the source file for details."))
-(IN-PACKAGE "COM.INFORMATIMAGO.COMMON-LISP.RFC3548.RFC3548")
+(in-package "COM.INFORMATIMAGO.COMMON-LISP.RFC3548.RFC3548")




-(DEFUN MAKE-DECODE-TABLE (CODE &KEY (CASE-SENSITIVE T))
+(defun make-decode-table (code &key (case-sensitive t))
   "
 CODE:        A string of length (1+ (expt 2 n)).
 RETURN:      An array A:[0..255] --> [-1..(expt 2 n)]
              character-code --> encoding-value
 "
-  (DO* ((TABLE (MAKE-ARRAY '(256)
-                           :ELEMENT-TYPE `(INTEGER -1 ,(1- (LENGTH CODE)))
-                           :INITIAL-ELEMENT -1))
-        (INDEX 0                (1+ INDEX))
-        (CHAR  (AREF CODE INDEX) (AREF CODE INDEX)))
-       ((<= (1- (LENGTH CODE)) INDEX) TABLE)
-    (IF CASE-SENSITIVE
-        (SETF (AREF TABLE (CHAR-CODE CHAR)) INDEX)
-        (SETF (AREF TABLE (CHAR-CODE (CHAR-DOWNCASE CHAR))) INDEX
-              (AREF TABLE (CHAR-CODE (CHAR-UPCASE   CHAR))) INDEX)))
-  ) ;;MAKE-DECODE-TABLE
+  (do* ((table (make-array '(256)
+                           :element-type
+                           ;; There's a bug in ccl-1.5 :-(
+                           #+(and ccl (not ccl-1.6)) t
+                           #-(and ccl (not ccl-1.6)) `(integer -1 ,(1- (length code)))
+                           :initial-element -1))
+        (index 0                (1+ index))
+        (char  (aref code index) (aref code index)))
+       ((<= (1- (length code)) index) table)
+    (if case-sensitive
+        (setf (aref table (char-code char)) index)
+        (setf (aref table (char-code (char-downcase char))) index
+              (aref table (char-code (char-upcase   char))) index))))


-(DEFPARAMETER +BASE64-ENCODE+
+(defparameter +base64-encode+
   "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="
   "An array A[0..64] --> character  giving the character used to encode
    the values from 0 to 63, and the padding character in slot 64.")


-(DEFPARAMETER +BASE64-DECODE+ (MAKE-DECODE-TABLE +BASE64-ENCODE+)
+(defparameter +base64-decode+ (make-decode-table +base64-encode+)
   "An array A:[0..255] |--> [-1..63]
         character-code ---> encoding-value")


-(DEFPARAMETER +FILEBASE64-ENCODE+
+(defparameter +filebase64-encode+
   "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_="
   "An array A[0..64] --> character  giving the character used to encode
    the values from 0 to 63, and the padding character in slot 64.")


-(DEFPARAMETER +FILEBASE64-DECODE+ (MAKE-DECODE-TABLE +FILEBASE64-ENCODE+)
+(defparameter +filebase64-decode+ (make-decode-table +filebase64-encode+)
   "An array A:[0..255] |--> [-1..63]
         character-code ---> encoding-value")


-(DEFPARAMETER +BASE32-ENCODE+
+(defparameter +base32-encode+
   "ABCDEFGHIJKLMNOPQRSTUVWXYZ234567="
   "An array A[0..32] --> character  giving the character used to encode
    the values from 0 to 31, and the padding character in slot 32.")


-(DEFPARAMETER +BASE32-DECODE+ (MAKE-DECODE-TABLE +BASE32-ENCODE+ :CASE-SENSITIVE NIL)
+(defparameter +base32-decode+ (make-decode-table +base32-encode+ :case-sensitive nil)
   "An array A:[0..255] |--> [-1..31]
         character-code ---> encoding-value")


-(DEFUN PADDING-CODE (CODE)
+(defun padding-code (code)
   "The position of the padding character in code (the last one)."
-  (1- (LENGTH CODE)))
+  (1- (length code)))


 ;; encode:
@@ -192,92 +196,92 @@ RETURN:      An array A:[0..255] --> [-1..(expt 2 n)]
 ;;     base16:   1*8 --> 2*4


-(DEFUN ENCODE64 (ENCODE READ-BYTE WRITE-CHAR)
-  (MACROLET ((OUT (CODE) `(FUNCALL WRITE-CHAR (AREF ENCODE ,CODE))))
-    (DO ((I1 (FUNCALL READ-BYTE) (FUNCALL READ-BYTE))
-         (I2 (FUNCALL READ-BYTE) (FUNCALL READ-BYTE))
-         (I3 (FUNCALL READ-BYTE) (FUNCALL READ-BYTE))
-         (PADDING (PADDING-CODE ENCODE)))
-        ((NULL I3)
-         (COND
-           ((NULL I1))
-           ((NULL I2)
-            (OUT (LDB (BYTE 6 2) I1))
-            (OUT (DPB (LDB (BYTE 2 0) I1) (BYTE 2 4) 0))
-            (OUT PADDING)
-            (OUT PADDING))
-           (T
-            (OUT (LDB (BYTE 6 2) I1))
-            (OUT (DPB (LDB (BYTE 2 0) I1) (BYTE 2 4) (LDB (BYTE 4 4) I2)))
-            (OUT (DPB (LDB (BYTE 4 0) I2) (BYTE 4 2) 0))
-            (OUT  PADDING)))
-         (VALUES))
+(defun encode64 (encode read-byte write-char)
+  (macrolet ((out (code) `(funcall write-char (aref encode ,code))))
+    (do ((i1 (funcall read-byte) (funcall read-byte))
+         (i2 (funcall read-byte) (funcall read-byte))
+         (i3 (funcall read-byte) (funcall read-byte))
+         (padding (padding-code encode)))
+        ((null i3)
+         (cond
+           ((null i1))
+           ((null i2)
+            (out (ldb (byte 6 2) i1))
+            (out (dpb (ldb (byte 2 0) i1) (byte 2 4) 0))
+            (out padding)
+            (out padding))
+           (t
+            (out (ldb (byte 6 2) i1))
+            (out (dpb (ldb (byte 2 0) i1) (byte 2 4) (ldb (byte 4 4) i2)))
+            (out (dpb (ldb (byte 4 0) i2) (byte 4 2) 0))
+            (out  padding)))
+         (values))
       ;; aaaaaaaa  bbbbbbbb cccccccc
       ;; aaaaaa aabbbb bbbbcc cccccc
-      (OUT (LDB (BYTE 6 2) I1))
-      (OUT (DPB (LDB (BYTE 2 0) I1) (BYTE 2 4) (LDB (BYTE 4 4) I2)))
-      (OUT (DPB (LDB (BYTE 4 0) I2) (BYTE 4 2) (LDB (BYTE 2 6) I3)))
-      (OUT (LDB (BYTE 6 0) I3))))) ;;ENCODE64
-
-
-(DEFUN ENCODE32 (ENCODE READ-BYTE WRITE-CHAR)
-  (MACROLET ((OUT (CODE) `(FUNCALL WRITE-CHAR (AREF ENCODE ,CODE))))
-    (DO ((I1 (FUNCALL READ-BYTE) (FUNCALL READ-BYTE))
-         (I2 (FUNCALL READ-BYTE) (FUNCALL READ-BYTE))
-         (I3 (FUNCALL READ-BYTE) (FUNCALL READ-BYTE))
-         (I4 (FUNCALL READ-BYTE) (FUNCALL READ-BYTE))
-         (I5 (FUNCALL READ-BYTE) (FUNCALL READ-BYTE))
-         (PADDING (PADDING-CODE ENCODE)))
-        ((NULL I5)
-         (COND
-           ((NULL I1))
-           ((NULL I2)
-            (OUT (LDB (BYTE 5 3) I1))
-            (OUT (DPB (LDB (BYTE 3 0) I1) (BYTE 3 2) 0))
-            (OUT PADDING)
-            (OUT PADDING)
-            (OUT PADDING)
-            (OUT PADDING)
-            (OUT PADDING)
-            (OUT PADDING))
-           ((NULL I3)
-            (OUT (LDB (BYTE 5 3) I1))
-            (OUT (DPB (LDB (BYTE 3 0) I1) (BYTE 3 2) (LDB (BYTE 2 6) I2)))
-            (OUT (LDB (BYTE 5 1) I2))
-            (OUT (DPB (LDB (BYTE 1 0) I2) (BYTE 1 4) 0))
-            (OUT PADDING)
-            (OUT PADDING)
-            (OUT PADDING)
-            (OUT PADDING))
-           ((NULL I4)
-            (OUT (LDB (BYTE 5 3) I1))
-            (OUT (DPB (LDB (BYTE 3 0) I1) (BYTE 3 2) (LDB (BYTE 2 6) I2)))
-            (OUT (LDB (BYTE 5 1) I2))
-            (OUT (DPB (LDB (BYTE 1 0) I2) (BYTE 1 4) (LDB (BYTE 4 4) I3)))
-            (OUT (DPB (LDB (BYTE 4 0) I3) (BYTE 4 1) 0))
-            (OUT PADDING)
-            (OUT PADDING)
-            (OUT PADDING))
-           (T
-            (OUT (LDB (BYTE 5 3) I1))
-            (OUT (DPB (LDB (BYTE 3 0) I1) (BYTE 3 2) (LDB (BYTE 2 6) I2)))
-            (OUT (LDB (BYTE 5 1) I2))
-            (OUT (DPB (LDB (BYTE 1 0) I2) (BYTE 1 4) (LDB (BYTE 4 4) I3)))
-            (OUT (DPB (LDB (BYTE 4 0) I3) (BYTE 4 1) (LDB (BYTE 1 7) I4)))
-            (OUT (LDB (BYTE 5 2) I4))
-            (OUT (DPB (LDB (BYTE 2 0) I4) (BYTE 2 3) 0))
-            (OUT PADDING)))
-         (VALUES))
+      (out (ldb (byte 6 2) i1))
+      (out (dpb (ldb (byte 2 0) i1) (byte 2 4) (ldb (byte 4 4) i2)))
+      (out (dpb (ldb (byte 4 0) i2) (byte 4 2) (ldb (byte 2 6) i3)))
+      (out (ldb (byte 6 0) i3)))))
+
+
+(defun encode32 (encode read-byte write-char)
+  (macrolet ((out (code) `(funcall write-char (aref encode ,code))))
+    (do ((i1 (funcall read-byte) (funcall read-byte))
+         (i2 (funcall read-byte) (funcall read-byte))
+         (i3 (funcall read-byte) (funcall read-byte))
+         (i4 (funcall read-byte) (funcall read-byte))
+         (i5 (funcall read-byte) (funcall read-byte))
+         (padding (padding-code encode)))
+        ((null i5)
+         (cond
+           ((null i1))
+           ((null i2)
+            (out (ldb (byte 5 3) i1))
+            (out (dpb (ldb (byte 3 0) i1) (byte 3 2) 0))
+            (out padding)
+            (out padding)
+            (out padding)
+            (out padding)
+            (out padding)
+            (out padding))
+           ((null i3)
+            (out (ldb (byte 5 3) i1))
+            (out (dpb (ldb (byte 3 0) i1) (byte 3 2) (ldb (byte 2 6) i2)))
+            (out (ldb (byte 5 1) i2))
+            (out (dpb (ldb (byte 1 0) i2) (byte 1 4) 0))
+            (out padding)
+            (out padding)
+            (out padding)
+            (out padding))
+           ((null i4)
+            (out (ldb (byte 5 3) i1))
+            (out (dpb (ldb (byte 3 0) i1) (byte 3 2) (ldb (byte 2 6) i2)))
+            (out (ldb (byte 5 1) i2))
+            (out (dpb (ldb (byte 1 0) i2) (byte 1 4) (ldb (byte 4 4) i3)))
+            (out (dpb (ldb (byte 4 0) i3) (byte 4 1) 0))
+            (out padding)
+            (out padding)
+            (out padding))
+           (t
+            (out (ldb (byte 5 3) i1))
+            (out (dpb (ldb (byte 3 0) i1) (byte 3 2) (ldb (byte 2 6) i2)))
+            (out (ldb (byte 5 1) i2))
+            (out (dpb (ldb (byte 1 0) i2) (byte 1 4) (ldb (byte 4 4) i3)))
+            (out (dpb (ldb (byte 4 0) i3) (byte 4 1) (ldb (byte 1 7) i4)))
+            (out (ldb (byte 5 2) i4))
+            (out (dpb (ldb (byte 2 0) i4) (byte 2 3) 0))
+            (out padding)))
+         (values))
       ;; aaaaaaaa  bbbbbbbb  cccccccc dddddddd  eeeeeeee
       ;; aaaaa aaabb bbbbb bcccc ccccd ddddd ddeee eeeee
-      (OUT (LDB (BYTE 5 3) I1))
-      (OUT (DPB (LDB (BYTE 3 0) I1) (BYTE 3 2) (LDB (BYTE 2 6) I2)))
-      (OUT (LDB (BYTE 5 1) I2))
-      (OUT (DPB (LDB (BYTE 1 0) I2) (BYTE 1 4) (LDB (BYTE 4 4) I3)))
-      (OUT (DPB (LDB (BYTE 4 0) I3) (BYTE 4 1) (LDB (BYTE 1 7) I4)))
-      (OUT (LDB (BYTE 5 2) I4))
-      (OUT (DPB (LDB (BYTE 2 0) I4) (BYTE 2 3) (LDB (BYTE 3 5) I5)))
-      (OUT (LDB (BYTE 5 0) I5))))) ;;ENCODE32
+      (out (ldb (byte 5 3) i1))
+      (out (dpb (ldb (byte 3 0) i1) (byte 3 2) (ldb (byte 2 6) i2)))
+      (out (ldb (byte 5 1) i2))
+      (out (dpb (ldb (byte 1 0) i2) (byte 1 4) (ldb (byte 4 4) i3)))
+      (out (dpb (ldb (byte 4 0) i3) (byte 4 1) (ldb (byte 1 7) i4)))
+      (out (ldb (byte 5 2) i4))
+      (out (dpb (ldb (byte 2 0) i4) (byte 2 3) (ldb (byte 3 5) i5)))
+      (out (ldb (byte 5 0) i5)))))


 ;; decode:
@@ -286,294 +290,321 @@ RETURN:      An array A:[0..255] --> [-1..(expt 2 n)]
 ;;     base16:   1*8 <-- 2*4


-(DEFMACRO WITH-IO ((IN OUT) (DECODE PADCHAR PADCODE READ-CHAR WRITE-BYTE
-                                    IGNORE-INVALID-INPUT)
-                   &BODY BODY)
-  `(LET ((STATE 0))
-     (FLET
-         ((,IN  () (CASE STATE
-                     ((0) (DO* ((CH   (FUNCALL ,READ-CHAR)
-                                      (FUNCALL ,READ-CHAR))
-                                (CODE (WHEN CH (AREF ,DECODE (CHAR-CODE CH)))
-                                      (WHEN CH (AREF ,DECODE (CHAR-CODE CH)))))
-                               ((OR (NULL CH) (CHAR= ,PADCHAR CH) (<= 0 CODE))
-                                (COND ((NULL CH) (SETF STATE 2) ,PADCODE)
-                                      ((CHAR= ,PADCHAR CH) (SETF STATE 1) ,PADCODE)
-                                      (T CODE)))
-                            (UNLESS ,IGNORE-INVALID-INPUT
-                              (ERROR "RFC3548::DECODE got an invalid input ~
-                                    character: ~C" CH))))
-                     ((1) (DO* ((CH   (FUNCALL ,READ-CHAR)
-                                      (FUNCALL ,READ-CHAR)))
-                               ((OR (NULL CH) (CHAR= ,PADCHAR CH))
-                                (WHEN (NULL CH) (SETF STATE 2))
-                                ,PADCODE)
-                            (UNLESS ,IGNORE-INVALID-INPUT
-                              (ERROR "RFC3548::DECODE got an invalid input ~
-                                character: ~C, after ,pad character." CH))))
-                     ((2) ,PADCODE)))
-          (,OUT (CODE) (FUNCALL ,WRITE-BYTE CODE)))
-       ,@BODY))) ;;WITH-IO
-
-
-(DEFUN DECODE64 (DECODE PADCHAR PADCODE READ-CHAR WRITE-BYTE
-                 IGNORE-INVALID-INPUT)
-  (WITH-IO (IN OUT)
-      (DECODE PADCHAR PADCODE READ-CHAR WRITE-BYTE IGNORE-INVALID-INPUT)
-    (DO ((I1 (IN) (IN))
-         (I2 (IN) (IN))
-         (I3 (IN) (IN))
-         (I4 (IN) (IN)))
-        ((= I4 PADCODE)
-         (COND
-           ((= I1 PADCODE))
-           ((= I2 PADCODE) ;; should not occur
-            (UNLESS IGNORE-INVALID-INPUT
-              (ERROR "DECODE64 got an invalid padcode sequence."))
-            (OUT (DPB (LDB (BYTE 6 0) I1) (BYTE 6 2) 0)))
-           ((= I3 PADCODE)
-            (OUT (DPB (LDB (BYTE 6 0) I1) (BYTE 6 2) (LDB (BYTE 2 4) I2))))
-           (T
-            (OUT (DPB (LDB (BYTE 6 0) I1) (BYTE 6 2) (LDB (BYTE 2 4) I2)))
-            (OUT (DPB (LDB (BYTE 4 0) I2) (BYTE 4 4) (LDB (BYTE 4 2) I3)))))
-         (VALUES))
+(defmacro with-io ((in out) (decode padchar padcode read-char write-byte
+                                    ignore-invalid-input)
+                   &body body)
+  `(let ((state 0))
+     (flet
+         ((,in  () (case state
+                     ((0) (do* ((ch   (funcall ,read-char)
+                                      (funcall ,read-char))
+                                (code (when ch (aref ,decode (char-code ch)))
+                                      (when ch (aref ,decode (char-code ch)))))
+                               ((or (null ch) (char= ,padchar ch) (<= 0 code))
+                                (cond ((null ch) (setf state 2) ,padcode)
+                                      ((char= ,padchar ch) (setf state 1) ,padcode)
+                                      (t code)))
+                            (unless ,ignore-invalid-input
+                              (error "RFC3548::DECODE got an invalid input ~
+                                    character: ~C" ch))))
+                     ((1) (do* ((ch   (funcall ,read-char)
+                                      (funcall ,read-char)))
+                               ((or (null ch) (char= ,padchar ch))
+                                (when (null ch) (setf state 2))
+                                ,padcode)
+                            (unless ,ignore-invalid-input
+                              (error "RFC3548::DECODE got an invalid input ~
+                                character: ~C, after ,pad character." ch))))
+                     ((2) ,padcode)))
+          (,out (code) (funcall ,write-byte code)))
+       ,@body)))
+
+
+(defun decode64 (decode padchar padcode read-char write-byte
+                 ignore-invalid-input)
+  (with-io (in out)
+      (decode padchar padcode read-char write-byte ignore-invalid-input)
+    (do ((i1 (in) (in))
+         (i2 (in) (in))
+         (i3 (in) (in))
+         (i4 (in) (in)))
+        ((= i4 padcode)
+         (cond
+           ((= i1 padcode))
+           ((= i2 padcode) ;; should not occur
+            (unless ignore-invalid-input
+              (error "DECODE64 got an invalid padcode sequence."))
+            (out (dpb (ldb (byte 6 0) i1) (byte 6 2) 0)))
+           ((= i3 padcode)
+            (out (dpb (ldb (byte 6 0) i1) (byte 6 2) (ldb (byte 2 4) i2))))
+           (t
+            (out (dpb (ldb (byte 6 0) i1) (byte 6 2) (ldb (byte 2 4) i2)))
+            (out (dpb (ldb (byte 4 0) i2) (byte 4 4) (ldb (byte 4 2) i3)))))
+         (values))
       ;; aaaaaa aabbbb bbbbcc cccccc
       ;; aaaaaaaa  bbbbbbbb cccccccc
-      (OUT (DPB (LDB (BYTE 6 0) I1) (BYTE 6 2) (LDB (BYTE 2 4) I2)))
-      (OUT (DPB (LDB (BYTE 4 0) I2) (BYTE 4 4) (LDB (BYTE 4 2) I3)))
-      (OUT (DPB (LDB (BYTE 2 0) I3) (BYTE 2 6) (LDB (BYTE 6 0) I4)))
-      ))) ;;DECODE64
-
-
-(DEFUN DECODE32 (DECODE PADCHAR PADCODE READ-CHAR WRITE-BYTE
-                 IGNORE-INVALID-INPUT)
-  (WITH-IO (IN OUT)
-      (DECODE PADCHAR PADCODE READ-CHAR WRITE-BYTE IGNORE-INVALID-INPUT)
-    (DO ((I1 (IN) (IN))
-         (I2 (IN) (IN))
-         (I3 (IN) (IN))
-         (I4 (IN) (IN))
-         (I5 (IN) (IN))
-         (I6 (IN) (IN))
-         (I7 (IN) (IN))
-         (I8 (IN) (IN)))
-        ((= I8 PADCODE)
-         (COND
-           ((= I1 PADCODE))
-           ((= I3 PADCODE)
-            (OUT (DPB (LDB (BYTE 5 0) I1) (BYTE 5 3) (LDB (BYTE 3 2) I2))))
-           ((= I5 PADCODE)
-            (OUT (DPB (LDB (BYTE 5 0) I1) (BYTE 5 3) (LDB (BYTE 3 2) I2)))
-            (OUT (DPB (LDB (BYTE 2 0) I2) (BYTE 2 6)
-                      (DPB (LDB (BYTE 5 0) I3) (BYTE 5 1) (LDB (BYTE 1 4) I4)))))
-           ((= I6 PADCODE)
-            (OUT (DPB (LDB (BYTE 5 0) I1) (BYTE 5 3) (LDB (BYTE 3 2) I2)))
-            (OUT (DPB (LDB (BYTE 2 0) I2) (BYTE 2 6)
-                      (DPB (LDB (BYTE 5 0) I3) (BYTE 5 1) (LDB (BYTE 1 4) I4))))
-            (OUT (DPB (LDB (BYTE 4 0) I4) (BYTE 4 4) (LDB (BYTE 4 1) I5))))
-           (T
-            (OUT (DPB (LDB (BYTE 5 0) I1) (BYTE 5 3) (LDB (BYTE 3 2) I2)))
-            (OUT (DPB (LDB (BYTE 2 0) I2) (BYTE 2 6)
-                      (DPB (LDB (BYTE 5 0) I3) (BYTE 5 1) (LDB (BYTE 1 4) I4))))
-            (OUT (DPB (LDB (BYTE 4 0) I4) (BYTE 4 4) (LDB (BYTE 4 1) I5)))
-            (OUT (DPB (LDB (BYTE 1 0) I5) (BYTE 1 7)
-                      (DPB (LDB (BYTE 5 0) I6) (BYTE 5 2)
-                           (LDB (BYTE 2 3) I7))))))
-         (VALUES))
+      (out (dpb (ldb (byte 6 0) i1) (byte 6 2) (ldb (byte 2 4) i2)))
+      (out (dpb (ldb (byte 4 0) i2) (byte 4 4) (ldb (byte 4 2) i3)))
+      (out (dpb (ldb (byte 2 0) i3) (byte 2 6) (ldb (byte 6 0) i4))))))
+
+
+(defun decode32 (decode padchar padcode read-char write-byte
+                 ignore-invalid-input)
+  (with-io (in out)
+      (decode padchar padcode read-char write-byte ignore-invalid-input)
+    (do ((i1 (in) (in))
+         (i2 (in) (in))
+         (i3 (in) (in))
+         (i4 (in) (in))
+         (i5 (in) (in))
+         (i6 (in) (in))
+         (i7 (in) (in))
+         (i8 (in) (in)))
+        ((= i8 padcode)
+         (cond
+           ((= i1 padcode))
+           ((= i3 padcode)
+            (out (dpb (ldb (byte 5 0) i1) (byte 5 3) (ldb (byte 3 2) i2))))
+           ((= i5 padcode)
+            (out (dpb (ldb (byte 5 0) i1) (byte 5 3) (ldb (byte 3 2) i2)))
+            (out (dpb (ldb (byte 2 0) i2) (byte 2 6)
+                      (dpb (ldb (byte 5 0) i3) (byte 5 1) (ldb (byte 1 4) i4)))))
+           ((= i6 padcode)
+            (out (dpb (ldb (byte 5 0) i1) (byte 5 3) (ldb (byte 3 2) i2)))
+            (out (dpb (ldb (byte 2 0) i2) (byte 2 6)
+                      (dpb (ldb (byte 5 0) i3) (byte 5 1) (ldb (byte 1 4) i4))))
+            (out (dpb (ldb (byte 4 0) i4) (byte 4 4) (ldb (byte 4 1) i5))))
+           (t
+            (out (dpb (ldb (byte 5 0) i1) (byte 5 3) (ldb (byte 3 2) i2)))
+            (out (dpb (ldb (byte 2 0) i2) (byte 2 6)
+                      (dpb (ldb (byte 5 0) i3) (byte 5 1) (ldb (byte 1 4) i4))))
+            (out (dpb (ldb (byte 4 0) i4) (byte 4 4) (ldb (byte 4 1) i5)))
+            (out (dpb (ldb (byte 1 0) i5) (byte 1 7)
+                      (dpb (ldb (byte 5 0) i6) (byte 5 2)
+                           (ldb (byte 2 3) i7))))))
+         (values))
       ;; aaaaa aaabb bbbbb bcccc ccccd ddddd ddeee eeeee
       ;; aaaaaaaa  bbbbbbbb  cccccccc dddddddd  eeeeeeee
-      (OUT (DPB (LDB (BYTE 5 0) I1) (BYTE 5 3) (LDB (BYTE 3 2) I2)))
-      (OUT (DPB (LDB (BYTE 2 0) I2) (BYTE 2 6)
-                (DPB (LDB (BYTE 5 0) I3) (BYTE 5 1) (LDB (BYTE 1 4) I4))))
-      (OUT (DPB (LDB (BYTE 4 0) I4) (BYTE 4 4) (LDB (BYTE 4 1) I5)))
-      (OUT (DPB (LDB (BYTE 1 0) I5) (BYTE 1 7)
-                (DPB (LDB (BYTE 5 0) I6) (BYTE 5 2) (LDB (BYTE 2 3) I7))))
-      (OUT (DPB (LDB (BYTE 3 0) I7) (BYTE 3 5) (LDB (BYTE 5 0) I8)))
-      ))) ;;DECODE32
-
-
-(DEFUN BASE64-ENCODE     (READ-BYTE WRITE-CHAR)
-  (ENCODE64 +BASE64-ENCODE+ READ-BYTE WRITE-CHAR))
-
-
-(DEFUN BASE64-DECODE     (READ-CHAR WRITE-BYTE &KEY (IGNORE-INVALID-INPUT NIL))
-  (DECODE64 +BASE64-DECODE+
-            (AREF +BASE64-ENCODE+ (PADDING-CODE +BASE64-ENCODE+))
-            (PADDING-CODE +BASE64-ENCODE+)
-            READ-CHAR WRITE-BYTE IGNORE-INVALID-INPUT)) ;;BASE64-DECODE
-
-
-(DEFUN FILEBASE64-ENCODE (READ-BYTE WRITE-CHAR)
-  (ENCODE64 +FILEBASE64-ENCODE+ READ-BYTE WRITE-CHAR))
-
-
-(DEFUN FILEBASE64-DECODE (READ-CHAR WRITE-BYTE &KEY (IGNORE-INVALID-INPUT NIL))
-  (DECODE64 +FILEBASE64-DECODE+
-            (AREF +FILEBASE64-ENCODE+ (PADDING-CODE +FILEBASE64-ENCODE+))
-            (PADDING-CODE +FILEBASE64-ENCODE+)
-            READ-CHAR WRITE-BYTE IGNORE-INVALID-INPUT)) ;;FILEBASE64-DECODE
-
-
-(DEFUN BASE32-ENCODE     (READ-BYTE WRITE-CHAR)
-  (ENCODE32 +BASE32-ENCODE+ READ-BYTE WRITE-CHAR))
-
-
-(DEFUN BASE32-DECODE     (READ-CHAR WRITE-BYTE &KEY (IGNORE-INVALID-INPUT NIL))
-  (DECODE32 +BASE32-DECODE+
-            (AREF +BASE32-ENCODE+ (PADDING-CODE +BASE32-ENCODE+))
-            (PADDING-CODE +BASE32-ENCODE+)
-            READ-CHAR WRITE-BYTE IGNORE-INVALID-INPUT)) ;;BASE32-DECODE
-
-
-(DEFUN BASE16-ENCODE     (READ-BYTE WRITE-CHAR)
-  (LOOP FOR BYTE = (FUNCALL READ-BYTE)
-     WHILE BYTE
-     DO (PROGN
-          (FUNCALL WRITE-CHAR
-                   (AREF "0123456789ABCDEF" (LDB (BYTE 4 4) BYTE)))
-          (FUNCALL WRITE-CHAR
-                   (AREF "0123456789ABCDEF" (LDB (BYTE 4 0) BYTE)))))
-  ) ;;BASE16-ENCODE
-
-
-(DEFUN BASE16-DECODE     (READ-CHAR WRITE-BYTE &KEY (IGNORE-INVALID-INPUT NIL))
-  (LOOP
-     WITH HIGH = NIL
-     FOR  CH   = (FUNCALL READ-CHAR)
-     WHILE CH
-     DO (LET ((LOW (POSITION CH "0123456789ABCDEF"
-                             :TEST (FUNCTION CHAR-EQUAL))))
-          (IF LOW
-              (IF HIGH
-                  (PROGN (FUNCALL WRITE-BYTE (DPB HIGH (BYTE 4 4) LOW))
-                         (SETF HIGH NIL))
-                  (SETF HIGH LOW))
-              (UNLESS IGNORE-INVALID-INPUT
-                (ERROR "BASE16-DECODE got an invalid input character: ~C" CH))))
-     FINALLY (WHEN (AND HIGH (NOT IGNORE-INVALID-INPUT))
-               (ERROR "BASE16-DECODE got an odd byte number.")))
-  ) ;;BASE16-DECODE
-
-
-(DEFMACRO ENCODE-BYTES (ENCODE BYTES LINE-WIDTH NEW-LINE)
-  `(WITH-OUTPUT-TO-STRING (OUT)
-     (WITH-INPUT-FROM-BYTE-VECTOR (IN ,BYTES)
-       (LET ((COLUMN 0))
-         (,ENCODE
+      (out (dpb (ldb (byte 5 0) i1) (byte 5 3) (ldb (byte 3 2) i2)))
+      (out (dpb (ldb (byte 2 0) i2) (byte 2 6)
+                (dpb (ldb (byte 5 0) i3) (byte 5 1) (ldb (byte 1 4) i4))))
+      (out (dpb (ldb (byte 4 0) i4) (byte 4 4) (ldb (byte 4 1) i5)))
+      (out (dpb (ldb (byte 1 0) i5) (byte 1 7)
+                (dpb (ldb (byte 5 0) i6) (byte 5 2) (ldb (byte 2 3) i7))))
+      (out (dpb (ldb (byte 3 0) i7) (byte 3 5) (ldb (byte 5 0) i8))))))
+
+
+(defun base64-encode     (read-byte write-char)
+  (encode64 +base64-encode+ read-byte write-char))
+
+
+(defun base64-decode     (read-char write-byte &key (ignore-invalid-input nil))
+  (decode64 +base64-decode+
+            (aref +base64-encode+ (padding-code +base64-encode+))
+            (padding-code +base64-encode+)
+            read-char write-byte ignore-invalid-input))
+
+
+(defun filebase64-encode (read-byte write-char)
+  (encode64 +filebase64-encode+ read-byte write-char))
+
+
+(defun filebase64-decode (read-char write-byte &key (ignore-invalid-input nil))
+  (decode64 +filebase64-decode+
+            (aref +filebase64-encode+ (padding-code +filebase64-encode+))
+            (padding-code +filebase64-encode+)
+            read-char write-byte ignore-invalid-input))
+
+
+(defun base32-encode     (read-byte write-char)
+  (encode32 +base32-encode+ read-byte write-char))
+
+
+(defun base32-decode     (read-char write-byte &key (ignore-invalid-input nil))
+  (decode32 +base32-decode+
+            (aref +base32-encode+ (padding-code +base32-encode+))
+            (padding-code +base32-encode+)
+            read-char write-byte ignore-invalid-input))
+
+
+(defun base16-encode     (read-byte write-char)
+  (loop
+     :for byte = (funcall read-byte)
+     :while byte
+     :do (progn
+          (funcall write-char
+                   (aref "0123456789ABCDEF" (ldb (byte 4 4) byte)))
+          (funcall write-char
+                   (aref "0123456789ABCDEF" (ldb (byte 4 0) byte))))))
+
+
+(defun base16-decode     (read-char write-byte &key (ignore-invalid-input nil))
+  (loop
+     :with high = nil
+     :for  ch   = (funcall read-char)
+     :while ch
+     :do (let ((low (position ch "0123456789ABCDEF"
+                             :test (function char-equal))))
+          (if low
+              (if high
+                  (progn (funcall write-byte (dpb high (byte 4 4) low))
+                         (setf high nil))
+                  (setf high low))
+              (unless ignore-invalid-input
+                (error "BASE16-DECODE got an invalid input character: ~C" ch))))
+     :finally (when (and high (not ignore-invalid-input))
+               (error "BASE16-DECODE got an odd byte number."))))
+
+
+(defmacro encode-bytes (encode bytes line-width new-line)
+  `(with-output-to-string (out)
+     (with-input-from-byte-vector (in ,bytes)
+       (let ((column 0))
+         (,encode
           ;; read-byte:
-          (LAMBDA () (LET ((BYTE (BVSTREAM-READ-BYTE IN)))
-                       (IF (EQ :EOF BYTE) NIL BYTE)))
+          (lambda () (let ((byte (bvstream-read-byte in)))
+                       (if (eq :eof byte) nil byte)))
           ;; write-char
-          (IF ,LINE-WIDTH
-              (LAMBDA (CH)
-                (WRITE-CHAR CH OUT)
-                (INCF COLUMN)
-                (WHEN (<= ,LINE-WIDTH COLUMN)
-                  (SETF COLUMN 0)
-                  (PRINC ,NEW-LINE OUT)))
-              (LAMBDA (CH)
-                (WRITE-CHAR CH OUT))))
-         (WHEN (AND ,LINE-WIDTH (/= 0 COLUMN))
-           (PRINC ,NEW-LINE OUT)))))) ;;ENCODE-BYTES
-
-
-(DEFMACRO DECODE-BYTES (DECODE ENCODED IGNORE-CRLF IGNORE-INVALID-INPUT)
-  `(WITH-OUTPUT-TO-BYTE-VECTOR (OUT)
-     (WITH-INPUT-FROM-STRING (IN ,ENCODED)
-       (,DECODE
+          (if ,line-width
+              (lambda (ch)
+                (write-char ch out)
+                (incf column)
+                (when (<= ,line-width column)
+                  (setf column 0)
+                  (princ ,new-line out)))
+              (lambda (ch)
+                (write-char ch out))))
+         (when (and ,line-width (/= 0 column))
+           (princ ,new-line out))))))
+
+
+(defmacro decode-bytes (decode encoded ignore-crlf ignore-invalid-input)
+  `(with-output-to-byte-vector (out)
+     (with-input-from-string (in ,encoded)
+       (,decode
         ;; read-char
-        (IF ,IGNORE-CRLF
-            (LAMBDA () (DO ((CH (READ-CHAR IN NIL NIL)(READ-CHAR IN NIL NIL)))
-                           ((OR (NULL CH) (NOT (MEMBER (CHAR-CODE CH) '(10 13))))
-                            CH)))
-            (LAMBDA () (READ-CHAR IN NIL NIL)))
+        (if ,ignore-crlf
+            (lambda () (do ((ch (read-char in nil nil)(read-char in nil nil)))
+                           ((or (null ch) (not (member (char-code ch) '(10 13))))
+                            ch)))
+            (lambda () (read-char in nil nil)))
         ;; write-byte
-        (LAMBDA (BYTE) (BVSTREAM-WRITE-BYTE OUT BYTE))
-        :IGNORE-INVALID-INPUT ,IGNORE-INVALID-INPUT)))) ;;DECODE-BYTES
+        (lambda (byte) (bvstream-write-byte out byte))
+        :ignore-invalid-input ,ignore-invalid-input))))


-(DEFPARAMETER +NEW-LINE+ (FORMAT NIL "~%"))
+(defparameter +new-line+ (format nil "~%"))


-(DEFUN BASE64-ENCODE-BYTES     (BYTES   &KEY LINE-WIDTH (NEW-LINE +NEW-LINE+))
-  (ENCODE-BYTES BASE64-ENCODE BYTES LINE-WIDTH NEW-LINE))
+(defun base64-encode-bytes     (bytes   &key line-width (new-line +new-line+))
+  (encode-bytes base64-encode bytes line-width new-line))


-(DEFUN BASE64-DECODE-BYTES     (ENCODED &KEY IGNORE-CRLF IGNORE-INVALID-INPUT)
-  (DECODE-BYTES BASE64-DECODE ENCODED IGNORE-CRLF IGNORE-INVALID-INPUT))
+(defun base64-decode-bytes     (encoded &key ignore-crlf ignore-invalid-input)
+  (decode-bytes base64-decode encoded ignore-crlf ignore-invalid-input))


-(DEFUN FILEBASE64-ENCODE-BYTES (BYTES   &KEY LINE-WIDTH (NEW-LINE +NEW-LINE+))
-  (ENCODE-BYTES FILEBASE64-ENCODE BYTES LINE-WIDTH NEW-LINE))
+(defun filebase64-encode-bytes (bytes   &key line-width (new-line +new-line+))
+  (encode-bytes filebase64-encode bytes line-width new-line))


-(DEFUN FILEBASE64-DECODE-BYTES (ENCODED &KEY IGNORE-CRLF IGNORE-INVALID-INPUT)
-  (DECODE-BYTES FILEBASE64-DECODE ENCODED IGNORE-CRLF IGNORE-INVALID-INPUT))
+(defun filebase64-decode-bytes (encoded &key ignore-crlf ignore-invalid-input)
+  (decode-bytes filebase64-decode encoded ignore-crlf ignore-invalid-input))


-(DEFUN BASE32-ENCODE-BYTES     (BYTES   &KEY LINE-WIDTH (NEW-LINE +NEW-LINE+))
-  (ENCODE-BYTES BASE32-ENCODE BYTES LINE-WIDTH NEW-LINE))
+(defun base32-encode-bytes     (bytes   &key line-width (new-line +new-line+))
+  (encode-bytes base32-encode bytes line-width new-line))


-(DEFUN BASE32-DECODE-BYTES     (ENCODED &KEY IGNORE-CRLF IGNORE-INVALID-INPUT)
-  (DECODE-BYTES BASE32-DECODE ENCODED IGNORE-CRLF IGNORE-INVALID-INPUT))
+(defun base32-decode-bytes     (encoded &key ignore-crlf ignore-invalid-input)
+  (decode-bytes base32-decode encoded ignore-crlf ignore-invalid-input))


-(DEFUN BASE16-ENCODE-BYTES     (BYTES   &KEY LINE-WIDTH (NEW-LINE +NEW-LINE+))
-  (ENCODE-BYTES BASE16-ENCODE BYTES LINE-WIDTH NEW-LINE))
+(defun base16-encode-bytes     (bytes   &key line-width (new-line +new-line+))
+  (encode-bytes base16-encode bytes line-width new-line))


-(DEFUN BASE16-DECODE-BYTES     (ENCODED &KEY IGNORE-CRLF IGNORE-INVALID-INPUT)
-  (DECODE-BYTES BASE16-DECODE ENCODED IGNORE-CRLF IGNORE-INVALID-INPUT))
+(defun base16-decode-bytes     (encoded &key ignore-crlf ignore-invalid-input)
+  (decode-bytes base16-decode encoded ignore-crlf ignore-invalid-input))


-(DEFUN TEST-ENCODING (ENCODING &KEY LINE-WIDTH IGNORE-CRLF)
-  (LET (ENC DEC DATA ENCODED DECODED)
-    (CASE ENCODING
-      ((:BASE16)     (SETF ENC (FUNCTION BASE16-ENCODE-BYTES)
-                           DEC (FUNCTION BASE16-DECODE-BYTES)))
-      ((:BASE32)     (SETF ENC (FUNCTION BASE32-ENCODE-BYTES)
-                           DEC (FUNCTION BASE32-DECODE-BYTES)))
-      ((:BASE64)     (SETF ENC (FUNCTION BASE64-ENCODE-BYTES)
-                           DEC (FUNCTION BASE64-DECODE-BYTES)))
-      ((:FILEBASE64) (SETF ENC (FUNCTION FILEBASE64-ENCODE-BYTES)
-                           DEC (FUNCTION FILEBASE64-DECODE-BYTES)))
-      (:OTHERWISE (ERROR "Unknown encoding ~S~%" ENCODING)))
-    (SETF DATA (MAP 'VECTOR (FUNCTION CHAR-CODE)
-                    (WITH-OPEN-FILE (IN "/home/pascal/tmp/misc/wang.accented"
-                                        :DIRECTION :INPUT
-                                        :IF-DOES-NOT-EXIST :ERROR)
-                      (LOOP FOR CH = (READ-CHAR IN NIL NIL)
-                         WHILE CH
-                         COLLECT CH INTO RESULT
-                         FINALLY (RETURN RESULT)))))
-    (DOTIMES (I 8)
-      (SETF ENCODED (FUNCALL ENC DATA :LINE-WIDTH LINE-WIDTH))
+(defun test-encoding (encoding &key line-width ignore-crlf)
+  (let (enc dec data encoded decoded)
+    (case encoding
+      ((:base16)     (setf enc (function base16-encode-bytes)
+                           dec (function base16-decode-bytes)))
+      ((:base32)     (setf enc (function base32-encode-bytes)
+                           dec (function base32-decode-bytes)))
+      ((:base64)     (setf enc (function base64-encode-bytes)
+                           dec (function base64-decode-bytes)))
+      ((:filebase64) (setf enc (function filebase64-encode-bytes)
+                           dec (function filebase64-decode-bytes)))
+      (:otherwise (error "Unknown encoding ~S~%" encoding)))
+    (setf data (map 'vector (function char-code)
+                    "
+Hao Wang, logicien americain.
+
+L'algorithme en  question  a  été  publié  en  1960  dans l'IBM Journal,
+article intitule \"Toward  Mechanical Mathematics\", avec des variantes et
+une  extension au calcul  des  prédicats.  Il  s'agit  ici  du  \"premier
+programme\" de Wang, systeme \"P\".
+
+L'article a été écrit en 1958, et les expériences effectuées sur IBM 704
+­ machine à lampes, 32 k  mots  de 36 bits, celle­là même qui vit naître
+LISP à la même époque. Le programme  a  été écrit en assembleur (Fortran
+existait, mais il ne s'était pas encore imposé)  et  l'auteur estime que
+\"there is very little in the program that is not straightforward\".
+
+Il observe que les preuves engendrées sont \"essentiellement des arbres\",
+et  annonce  que  la  machine  a  démontre 220 théorèmes du  calcul  des
+propositions  (tautologies)  en  3  minutes. Il en tire argument pour la
+supériorité  d'une  approche  algorithmique  par  rapport à une approche
+heuristique comme celle du \"Logic Theorist\" de Newell, Shaw et  Simon (à
+partir de 1956 sur la machine JOHNNIAC de la Rand Corporation): un débat
+qui dure encore...
+
+Cet  algorithme  a  été popularisé par J. McCarthy, comme exemple­fanion
+d'application  de LISP. Il figure dans le manuel de la première  version
+de  LISP  (LISP  1,  sur IBM 704 justement, le manuel est daté  de  Mars
+1960), et il a été repris dans le celebre \"LISP 1.5 Programmer's Manual\"
+publié en 1962 par MIT Press, un des maîtres­livres de l'Informatique.
+"
+                    #-(and)
+                    (with-open-file (in "/home/pascal/tmp/misc/wang.accented"
+                                        :direction :input
+                                        :if-does-not-exist :error)
+                      (loop
+                         :for ch = (read-char in nil nil)
+                         :while ch
+                         :collect ch into result
+                         :finally (return result)))))
+    (dotimes (i 8)
+      (setf encoded (funcall enc data :line-width line-width))
       ;; (print encoded)
-      (SETF DECODED (FUNCALL DEC ENCODED :IGNORE-CRLF IGNORE-CRLF))
-      (ASSERT (EQUALP DATA DECODED))
-      (SETF DATA (SUBSEQ DATA 0 (1- (LENGTH DATA))))))) ;;TEST-ENCODING
-
-
-(DEFUN TEST ()
-  (DOLIST (ENC '(:BASE16 :BASE32 :BASE64 :FILEBASE64))
-    (DOLIST (LINE '(NIL T))
-      (FORMAT T "~&TESTING ~A ~:[~;with lines~]" ENC LINE)
-      (FINISH-OUTPUT)
-      (TEST-ENCODING ENC :LINE-WIDTH (WHEN LINE 40) :IGNORE-CRLF LINE)
-      (FORMAT T "~40TPASSED.~%")
-      (FINISH-OUTPUT)))) ;;TEST
+      (setf decoded (funcall dec encoded :ignore-crlf ignore-crlf))
+      (assert (equalp data decoded))
+      (setf data (subseq data 0 (1- (length data)))))))
+
+
+(defun test ()
+  (dolist (enc '(:base16 :base32 :base64 :filebase64))
+    (dolist (line '(nil t))
+      (format t "~&TESTING ~A ~:[~;with lines~]" enc line)
+      (finish-output)
+      (test-encoding enc :line-width (when line 40) :ignore-crlf line)
+      (format t "~40TPASSED.~%")
+      (finish-output))))


-(DEFUN TEST-BASE16-ENCODE ()
-  (BASE16-ENCODE
-   (LAMBDA () (LET ((CH (READ-CHAR))) (IF (CHAR= #\NEWLINE CH) NIL (CHAR-CODE CH))))
-   (FUNCTION WRITE-CHAR)))
+(defun test-base16-encode ()
+  (base16-encode
+   (lambda () (let ((ch (read-char))) (if (char= #\newline ch) nil (char-code ch))))
+   (function write-char)))


-(DEFUN TEST-BASE16-DECODE ()
-  (BASE16-DECODE
-   (LAMBDA () (LET ((CH (READ-CHAR))) (IF (CHAR= #\NEWLINE CH) NIL CH)))
-   (LAMBDA (BYTE) (WRITE-CHAR (CODE-CHAR BYTE)))))
+(defun test-base16-decode ()
+  (base16-decode
+   (lambda () (let ((ch (read-char))) (if (char= #\newline ch) nil ch)))
+   (lambda (byte) (write-char (code-char byte)))))

 ;;;; THE END ;;;;
ViewGit