r11859: Canonicalize whitespace

diff --git a/decode.lisp b/decode.lisp
index 6503b78ff49ac3e2be729d31e4344b32fc6337f9..1649daa6f73ea9d9baf92ed36c62ad98a8cf1971 100644 (file)
--- a/decode.lisp
+++ b/decode.lisp
@@ -34,84 +34,84 @@
 #+ignore
 (defmacro def-base64-stream-to-* (output-type)
   `(defun ,(intern (concatenate 'string (symbol-name :base64-stream-to-)
 #+ignore
 (defmacro def-base64-stream-to-* (output-type)
   `(defun ,(intern (concatenate 'string (symbol-name :base64-stream-to-)

-                               (symbol-name output-type)))
+                                (symbol-name output-type)))

     (input &key (uri nil)
     (input &key (uri nil)

-       ,@(when (eq output-type :stream)
-               '(stream)))
+        ,@(when (eq output-type :stream)
+                '(stream)))

      ,(concatenate 'string "Decode base64 stream to " (string-downcase
      ,(concatenate 'string "Decode base64 stream to " (string-downcase

-                                                      (symbol-name output-type)))
+                                                       (symbol-name output-type)))

      (declare (stream input)
      (declare (stream input)

-             (optimize (speed 3) (space 0) (safety 0)))
+              (optimize (speed 3) (space 0) (safety 0)))

      (let ((pad (if uri *uri-pad-char* *pad-char*))
      (let ((pad (if uri *uri-pad-char* *pad-char*))

-          (decode-table (if uri *uri-decode-table* *decode-table*)))
+           (decode-table (if uri *uri-decode-table* *decode-table*)))

        (declare (type decode-table decode-table)
        (declare (type decode-table decode-table)

-               (type character pad))
+                (type character pad))

        (let (,@(case output-type
        (let (,@(case output-type

-                    (:string
-                     '((result (make-string (* 3 (truncate (length string) 4))))))
-                    (:usb8-array
-                     '((result (make-array (* 3 (truncate (length string) 4))
-                                :element-type '(unsigned-byte 8)
-                                :fill-pointer nil
-                                :adjustable nil)))))
-              (ridx 0))
-        (declare ,@(case output-type
-                         (:string
-                          '((simple-string result)))
-                         (:usb8-array
-                          '((type (simple-array (usigned-byte 8) (*)) result))))
-                 (fixnum ridx))
-        (do* ((bitstore 0)
-              (bitcount 0)
-              (char (read-char stream nil #\null)
-                    (read-char stream nil #\null)))
-             ((eq char #\null)
-              ,(case output-type
-                     (:stream
-                      'stream)
-                     ((:string :usb8-array)
-                      'result)
-                     ;; ((:stream :string)
-                     ;; '(subseq result 0 ridx))))
-                     ))
-          (declare (fixnum bitstore bitcount)
-                   (character char))
-          (let ((svalue (aref decode-table (the fixnum (char-code char)))))
-            (declare (fixnum svalue))
-            (cond
-              ((>= svalue 0)
-               (setf bitstore (logior
-                               (the fixnum (ash bitstore 6))
-                               svalue))
-               (incf bitcount 6)
-               (when (>= bitcount 8)
-                 (decf bitcount 8)
-                 (let ((ovalue (the fixnum
-                                 (logand
-                                  (the fixnum
-                                    (ash bitstore
-                                         (the fixnum (- bitcount))))
-                                  #xFF))))
-                   (declare (fixnum ovalue))
-                   ,(case output-type
-                          (:string
-                           '(setf (char result ridx) (code-char ovalue)))
-                          (:usb8-array
-                           '(setf (aref result ridx) ovalue))
-                          (:stream
-                           '(write-char (code-char ovalue) stream)))
-                   (incf ridx)
-                   (setf bitstore (the fixnum (logand bitstore #xFF))))))
-              ((char= char pad)
-               ;; Could add checks to make sure padding is correct
-               ;; Currently, padding is ignored
-               )
-              ((whitespace-p char)
-               ;; Ignore whitespace
-               )
-              ((minusp svalue)
-               (warn "Bad character ~W in base64 decode" char))
-              )))))))
+                     (:string
+                      '((result (make-string (* 3 (truncate (length string) 4))))))
+                     (:usb8-array
+                      '((result (make-array (* 3 (truncate (length string) 4))
+                                 :element-type '(unsigned-byte 8)
+                                 :fill-pointer nil
+                                 :adjustable nil)))))
+               (ridx 0))
+         (declare ,@(case output-type
+                          (:string
+                           '((simple-string result)))
+                          (:usb8-array
+                           '((type (simple-array (usigned-byte 8) (*)) result))))
+                  (fixnum ridx))
+         (do* ((bitstore 0)
+               (bitcount 0)
+               (char (read-char stream nil #\null)
+                     (read-char stream nil #\null)))
+              ((eq char #\null)
+               ,(case output-type
+                      (:stream
+                       'stream)
+                      ((:string :usb8-array)
+                       'result)
+                      ;; ((:stream :string)
+                      ;; '(subseq result 0 ridx))))
+                      ))
+           (declare (fixnum bitstore bitcount)
+                    (character char))
+           (let ((svalue (aref decode-table (the fixnum (char-code char)))))
+             (declare (fixnum svalue))
+             (cond
+               ((>= svalue 0)
+                (setf bitstore (logior
+                                (the fixnum (ash bitstore 6))
+                                svalue))
+                (incf bitcount 6)
+                (when (>= bitcount 8)
+                  (decf bitcount 8)
+                  (let ((ovalue (the fixnum
+                                  (logand
+                                   (the fixnum
+                                     (ash bitstore
+                                          (the fixnum (- bitcount))))
+                                   #xFF))))
+                    (declare (fixnum ovalue))
+                    ,(case output-type
+                           (:string
+                            '(setf (char result ridx) (code-char ovalue)))
+                           (:usb8-array
+                            '(setf (aref result ridx) ovalue))
+                           (:stream
+                            '(write-char (code-char ovalue) stream)))
+                    (incf ridx)
+                    (setf bitstore (the fixnum (logand bitstore #xFF))))))
+               ((char= char pad)
+                ;; Could add checks to make sure padding is correct
+                ;; Currently, padding is ignored
+                )
+               ((whitespace-p char)
+                ;; Ignore whitespace
+                )
+               ((minusp svalue)
+                (warn "Bad character ~W in base64 decode" char))
+               )))))))

 
 ;;(def-base64-stream-to-* :string)
 ;;(def-base64-stream-to-* :stream)
 
 ;;(def-base64-stream-to-* :string)
 ;;(def-base64-stream-to-* :stream)


@@ -119,79 +119,79 @@
 
 (defmacro def-base64-string-to-* (output-type)
   `(defun ,(intern (concatenate 'string (symbol-name :base64-string-to-)
 
 (defmacro def-base64-string-to-* (output-type)
   `(defun ,(intern (concatenate 'string (symbol-name :base64-string-to-)

-                               (symbol-name output-type)))
+                                (symbol-name output-type)))

     (input &key (uri nil)
     (input &key (uri nil)

-       ,@(when (eq output-type :stream)
-               '(stream)))
+        ,@(when (eq output-type :stream)
+                '(stream)))

      ,(concatenate 'string "Decode base64 string to " (string-downcase
      ,(concatenate 'string "Decode base64 string to " (string-downcase

-                                                      (symbol-name output-type)))
+                                                       (symbol-name output-type)))

      (declare (string input)
      (declare (string input)

-             (optimize (speed 3) (safety 0) (space 0)))
+              (optimize (speed 3) (safety 0) (space 0)))

      (let ((pad (if uri *uri-pad-char* *pad-char*))
      (let ((pad (if uri *uri-pad-char* *pad-char*))

-          (decode-table (if uri *uri-decode-table* *decode-table*)))
+           (decode-table (if uri *uri-decode-table* *decode-table*)))

        (declare (type decode-table decode-table)
        (declare (type decode-table decode-table)

-               (type character pad))
+                (type character pad))

        (let (,@(case output-type
        (let (,@(case output-type

-                    (:string
-                     '((result (make-string (* 3 (truncate (length input) 4))))))
-                    (:usb8-array
-                     '((result (make-array (* 3 (truncate (length input) 4))
-                                :element-type '(unsigned-byte 8)
-                                :fill-pointer nil
-                                :adjustable nil)))))
-              (ridx 0))
-        (declare ,@(case output-type
-                         (:string
-                          '((simple-string result)))
-                         (:usb8-array
-                          '((type (simple-array (unsigned-byte 8) (*)) result))))
-                 (fixnum ridx))
-        (loop 
-           for char of-type character across input
-           for svalue of-type fixnum = (aref decode-table
-                                             (the fixnum (char-code char)))
-           with bitstore of-type fixnum = 0
-           with bitcount of-type fixnum = 0
-           do
-             (cond
-               ((>= svalue 0)
-                (setf bitstore (logior
-                                (the fixnum (ash bitstore 6))
-                                svalue))
-                (incf bitcount 6)
-                (when (>= bitcount 8)
-                  (decf bitcount 8)
-                  (let ((ovalue (the fixnum
-                                  (logand
-                                   (the fixnum
-                                     (ash bitstore
-                                          (the fixnum (- bitcount))))
-                                   #xFF))))
-                    (declare (fixnum ovalue))
-                    ,(case output-type
-                           (:string
-                            '(setf (char result ridx) (code-char ovalue)))
-                           (:usb8-array
-                            '(setf (aref result ridx) ovalue))
-                           (:stream
-                            '(write-char (code-char ovalue) stream)))
-                    (incf ridx)
-                    (setf bitstore (the fixnum (logand bitstore #xFF))))))
-                ((char= char pad)
-                 ;; Could add checks to make sure padding is correct
-                 ;; Currently, padding is ignored
-                 )
-                ((whitespace-p char)
-                 ;; Ignore whitespace
-                 )
-                ((minusp svalue)
-                 (warn "Bad character ~W in base64 decode" char))
-                ))
-        ,(case output-type
-               (:stream
-                'stream)
-               ((:usb8-array :string)
-                '(subseq result 0 ridx)))))))
+                     (:string
+                      '((result (make-string (* 3 (truncate (length input) 4))))))
+                     (:usb8-array
+                      '((result (make-array (* 3 (truncate (length input) 4))
+                                 :element-type '(unsigned-byte 8)
+                                 :fill-pointer nil
+                                 :adjustable nil)))))
+               (ridx 0))
+         (declare ,@(case output-type
+                          (:string
+                           '((simple-string result)))
+                          (:usb8-array
+                           '((type (simple-array (unsigned-byte 8) (*)) result))))
+                  (fixnum ridx))
+         (loop
+            for char of-type character across input
+            for svalue of-type fixnum = (aref decode-table
+                                              (the fixnum (char-code char)))
+            with bitstore of-type fixnum = 0
+            with bitcount of-type fixnum = 0
+            do
+              (cond
+                ((>= svalue 0)
+                 (setf bitstore (logior
+                                 (the fixnum (ash bitstore 6))
+                                 svalue))
+                 (incf bitcount 6)
+                 (when (>= bitcount 8)
+                   (decf bitcount 8)
+                   (let ((ovalue (the fixnum
+                                   (logand
+                                    (the fixnum
+                                      (ash bitstore
+                                           (the fixnum (- bitcount))))
+                                    #xFF))))
+                     (declare (fixnum ovalue))
+                     ,(case output-type
+                            (:string
+                             '(setf (char result ridx) (code-char ovalue)))
+                            (:usb8-array
+                             '(setf (aref result ridx) ovalue))
+                            (:stream
+                             '(write-char (code-char ovalue) stream)))
+                     (incf ridx)
+                     (setf bitstore (the fixnum (logand bitstore #xFF))))))
+                 ((char= char pad)
+                  ;; Could add checks to make sure padding is correct
+                  ;; Currently, padding is ignored
+                  )
+                 ((whitespace-p char)
+                  ;; Ignore whitespace
+                  )
+                 ((minusp svalue)
+                  (warn "Bad character ~W in base64 decode" char))
+                 ))
+         ,(case output-type
+                (:stream
+                 'stream)
+                ((:usb8-array :string)
+                 '(subseq result 0 ridx)))))))

 
 (def-base64-string-to-* :string)
 (def-base64-string-to-* :stream)
 
 (def-base64-string-to-* :string)
 (def-base64-string-to-* :stream)


@@ -203,54 +203,54 @@
 (defun base64-string-to-integer (string &key (uri nil))
   "Decodes a base64 string to an integer"
   (declare (string string)
 (defun base64-string-to-integer (string &key (uri nil))
   "Decodes a base64 string to an integer"
   (declare (string string)

-          (optimize (speed 3) (safety 0) (space 0)))
+           (optimize (speed 3) (safety 0) (space 0)))

   (let ((pad (if uri *uri-pad-char* *pad-char*))
   (let ((pad (if uri *uri-pad-char* *pad-char*))

-       (decode-table (if uri *uri-decode-table* *decode-table*)))
+        (decode-table (if uri *uri-decode-table* *decode-table*)))

     (declare (type decode-table decode-table)
     (declare (type decode-table decode-table)

-            (character pad))
+             (character pad))

     (let ((value 0))
       (declare (integer value))
       (loop
     (let ((value 0))
       (declare (integer value))
       (loop

-        for char of-type character across string
-        for svalue of-type fixnum =
-          (aref decode-table (the fixnum (char-code char)))
-        do
-          (cond
-            ((>= svalue 0)
-             (setq value (+ svalue (ash value 6))))
-            ((char= char pad)
-             (setq value (ash value -2)))
-            ((whitespace-p char)
-             ; ignore whitespace
-             )
-            ((minusp svalue)
-             (warn "Bad character ~W in base64 decode" char))))
+         for char of-type character across string
+         for svalue of-type fixnum =
+           (aref decode-table (the fixnum (char-code char)))
+         do
+           (cond
+             ((>= svalue 0)
+              (setq value (+ svalue (ash value 6))))
+             ((char= char pad)
+              (setq value (ash value -2)))
+             ((whitespace-p char)
+              ; ignore whitespace
+              )
+             ((minusp svalue)
+              (warn "Bad character ~W in base64 decode" char))))

       value)))
 
 
 (defun base64-stream-to-integer (stream &key (uri nil))
   "Decodes a base64 string to an integer"
   (declare (stream stream)
       value)))
 
 
 (defun base64-stream-to-integer (stream &key (uri nil))
   "Decodes a base64 string to an integer"
   (declare (stream stream)

-          (optimize (speed 3) (space 0) (safety 0)))
+           (optimize (speed 3) (space 0) (safety 0)))

   (let ((pad (if uri *uri-pad-char* *pad-char*))
   (let ((pad (if uri *uri-pad-char* *pad-char*))

-       (decode-table (if uri *uri-decode-table* *decode-table*)))
+        (decode-table (if uri *uri-decode-table* *decode-table*)))

     (declare (type decode-table decode-table)
     (declare (type decode-table decode-table)

-            (character pad))
+             (character pad))

     (do* ((value 0)
     (do* ((value 0)

-         (char (read-char stream nil #\null)
-               (read-char stream nil #\null)))
-        ((eq char #\null)
-         value)
+          (char (read-char stream nil #\null)
+                (read-char stream nil #\null)))
+         ((eq char #\null)
+          value)

       (declare (integer value)
       (declare (integer value)

-              (character char))
+               (character char))

       (let ((svalue (aref decode-table (the fixnum (char-code char)))))
       (let ((svalue (aref decode-table (the fixnum (char-code char)))))

-          (declare (fixnum svalue))
-          (cond
-            ((>= svalue 0)
-             (setq value (+ svalue (ash value 6))))
-            ((char= char pad)
-             (setq value (ash value -2)))
-            ((whitespace-p char)               ; ignore whitespace
-             )
-            ((minusp svalue)
-             (warn "Bad character ~W in base64 decode" char)))))))
+           (declare (fixnum svalue))
+           (cond
+             ((>= svalue 0)
+              (setq value (+ svalue (ash value 6))))
+             ((char= char pad)
+              (setq value (ash value -2)))
+             ((whitespace-p char)               ; ignore whitespace
+              )
+             ((minusp svalue)
+              (warn "Bad character ~W in base64 decode" char)))))))

diff --git a/encode.lisp b/encode.lisp
index f5276a885faff2e81da6f5dee272818d36a02aa4..dcddc1ad4bef1f2a1c11af08f4cd8f5468e3b068 100644 (file)
--- a/encode.lisp
+++ b/encode.lisp
@@ -33,174 +33,174 @@
 (defun round-next-multiple (x n)
   "Round x up to the next highest multiple of n."
   (declare (fixnum n)
 (defun round-next-multiple (x n)
   "Round x up to the next highest multiple of n."
   (declare (fixnum n)

-          (optimize (speed 3) (safety 0) (space 0)))
+           (optimize (speed 3) (safety 0) (space 0)))

   (let ((remainder (mod x n)))
     (declare (fixnum remainder))
     (if (zerop remainder)
   (let ((remainder (mod x n)))
     (declare (fixnum remainder))
     (if (zerop remainder)

-       x
-       (the fixnum (+ x (the fixnum (- n remainder)))))))
+        x
+        (the fixnum (+ x (the fixnum (- n remainder)))))))

 
 (defmacro def-*-to-base64-* (input-type output-type)
   `(defun ,(intern (concatenate 'string (symbol-name input-type)
 
 (defmacro def-*-to-base64-* (input-type output-type)
   `(defun ,(intern (concatenate 'string (symbol-name input-type)

-                               (symbol-name :-to-base64-)
-                               (symbol-name output-type)))
+                                (symbol-name :-to-base64-)
+                                (symbol-name output-type)))

     (input
     (input

-       ,@(when (eq output-type :stream)
-               '(output))
-       &key (uri nil) (columns 0))
+        ,@(when (eq output-type :stream)
+                '(output))
+        &key (uri nil) (columns 0))

      "Encode a string array to base64. If columns is > 0, designates
 maximum number of columns in a line and the string will be terminated
 with a #\Newline."
      (declare ,@(case input-type
      "Encode a string array to base64. If columns is > 0, designates
 maximum number of columns in a line and the string will be terminated
 with a #\Newline."
      (declare ,@(case input-type

-                     (:string
-                      '((string input)))
-                     (:usb8-array
-                      '((type (array (unsigned-byte 8) (*)) input))))
-             (fixnum columns)
-             (optimize (speed 3) (safety 0) (space 0)))
+                      (:string
+                       '((string input)))
+                      (:usb8-array
+                       '((type (array (unsigned-byte 8) (*)) input))))
+              (fixnum columns)
+              (optimize (speed 3) (safety 0) (space 0)))

      (let ((pad (if uri *uri-pad-char* *pad-char*))
      (let ((pad (if uri *uri-pad-char* *pad-char*))

-          (encode-table (if uri *uri-encode-table* *encode-table*)))
+           (encode-table (if uri *uri-encode-table* *encode-table*)))

        (declare (simple-string encode-table)
        (declare (simple-string encode-table)

-               (character pad))
+                (character pad))

        (let* ((string-length (length input))
        (let* ((string-length (length input))

-             (complete-group-count (truncate string-length 3))
-             (remainder (nth-value 1 (truncate string-length 3)))
-             (padded-length (* 4 (truncate (+ string-length 2) 3)))
-             ,@(when (eq output-type :string)
-                     '((num-lines (if (plusp columns)
-                                      (truncate (+ padded-length (1- columns)) columns)
-                                      0))
-                       (num-breaks (if (plusp num-lines)
-                                       (1- num-lines)
-                                       0))
-                       (strlen (+ padded-length num-breaks))
-                       (result (make-string strlen))
-                       (ioutput 0)))
-             (col (if (plusp columns)
-                      0
-                      (the fixnum (1+ padded-length)))))
-        (declare (fixnum string-length padded-length col
-                         ,@(when (eq output-type :string)
-                                 '(ioutput)))
-                 ,@(when (eq output-type :string)
-                         '((simple-string result))))
-        (labels ((output-char (ch)
-                   (if (= col columns)
-                       (progn
-                         ,@(case output-type
-                                 (:stream
-                                  '((write-char #\Newline output)))
-                                (:string
-                                 '((setf (schar result ioutput) #\Newline)
-                                   (incf ioutput))))
-                         (setq col 1))
-                    (incf col))
-                ,@(case output-type
-                        (:stream
-                         '((write-char ch output)))
-                        (:string
-                         '((setf (schar result ioutput) ch)
-                           (incf ioutput)))))
-              (output-group (svalue chars)
-                (declare (fixnum svalue chars))
-                (output-char
-                 (schar encode-table
-                        (the fixnum
-                          (logand #x3f
-                                  (the fixnum (ash svalue -18))))))
-                (output-char
-                 (schar encode-table
-                        (the fixnum
-                          (logand #x3f
-                                       (the fixnum (ash svalue -12))))))
-                (if (> chars 2)
-                    (output-char
-                     (schar encode-table
-                            (the fixnum
-                              (logand #x3f
-                                      (the fixnum (ash svalue -6))))))
-                    (output-char pad))
-                  (if (> chars 3)
-                      (output-char
-                       (schar encode-table
-                              (the fixnum
-                                (logand #x3f svalue))))
-                      (output-char pad))))
-       (do ((igroup 0 (the fixnum (1+ igroup)))
-            (isource 0 (the fixnum (+ isource 3))))
-           ((= igroup complete-group-count)
-            (cond
-              ((= remainder 2)
-               (output-group
-                (the fixnum
-                    (+
-                     (the fixnum
-                       (ash
-                        ,(case input-type
-                               (:string
-                                '(char-code (the character (char input isource))))
-                               (:usb8-array
-                                '(the fixnum (aref input isource))))
-                        16))
-                     (the fixnum
-                       (ash
-                        ,(case input-type
-                               (:string
-                                '(char-code (the character (char input
-                                                                 (the fixnum (1+ isource))))))
-                               (:usb8-array
-                                '(the fixnum (aref input (the fixnum
-                                                           (1+ isource))))))
-                        8))))
-                3))
-              ((= remainder 1)
-               (output-group
-                (the fixnum
-                  (ash
-                   ,(case input-type
-                          (:string
-                           '(char-code (the character (char input isource))))
-                          (:usb8-array
-                           '(the fixnum (aref input isource))))
-                   16))
-                2)))
-            ,(case output-type
-                   (:string
-                    'result)
-                   (:stream
-                    'output)))
-         (declare (fixnum igroup isource))
-         (output-group 
-          (the fixnum
-            (+
-             (the fixnum
-               (ash
-                (the fixnum
-                ,(case input-type
-                       (:string
-                        '(char-code (the character (char input isource))))
-                       (:usb8-array
-                        '(aref input isource))))
-                16))
-             (the fixnum
-               (ash
-                (the fixnum
-                  ,(case input-type
-                         (:string
-                          '(char-code (the character (char input
-                                                           (the fixnum (1+ isource))))))
-                       (:usb8-array
-                        '(aref input (1+ isource)))))
-                8))
-             (the fixnum
-               ,(case input-type
-                      (:string
-                       '(char-code (the character (char input
-                                                        (the fixnum (+ 2 isource))))))
-                      (:usb8-array
-                       '(aref input (+ 2 isource))))
-               )))
-          4)))))))
+              (complete-group-count (truncate string-length 3))
+              (remainder (nth-value 1 (truncate string-length 3)))
+              (padded-length (* 4 (truncate (+ string-length 2) 3)))
+              ,@(when (eq output-type :string)
+                      '((num-lines (if (plusp columns)
+                                       (truncate (+ padded-length (1- columns)) columns)
+                                       0))
+                        (num-breaks (if (plusp num-lines)
+                                        (1- num-lines)
+                                        0))
+                        (strlen (+ padded-length num-breaks))
+                        (result (make-string strlen))
+                        (ioutput 0)))
+              (col (if (plusp columns)
+                       0
+                       (the fixnum (1+ padded-length)))))
+         (declare (fixnum string-length padded-length col
+                          ,@(when (eq output-type :string)
+                                  '(ioutput)))
+                  ,@(when (eq output-type :string)
+                          '((simple-string result))))
+         (labels ((output-char (ch)
+                    (if (= col columns)
+                        (progn
+                          ,@(case output-type
+                                  (:stream
+                                   '((write-char #\Newline output)))
+                                 (:string
+                                  '((setf (schar result ioutput) #\Newline)
+                                    (incf ioutput))))
+                          (setq col 1))
+                     (incf col))
+                 ,@(case output-type
+                         (:stream
+                          '((write-char ch output)))
+                         (:string
+                          '((setf (schar result ioutput) ch)
+                            (incf ioutput)))))
+               (output-group (svalue chars)
+                 (declare (fixnum svalue chars))
+                 (output-char
+                  (schar encode-table
+                         (the fixnum
+                           (logand #x3f
+                                   (the fixnum (ash svalue -18))))))
+                 (output-char
+                  (schar encode-table
+                         (the fixnum
+                           (logand #x3f
+                                        (the fixnum (ash svalue -12))))))
+                 (if (> chars 2)
+                     (output-char
+                      (schar encode-table
+                             (the fixnum
+                               (logand #x3f
+                                       (the fixnum (ash svalue -6))))))
+                     (output-char pad))
+                   (if (> chars 3)
+                       (output-char
+                        (schar encode-table
+                               (the fixnum
+                                 (logand #x3f svalue))))
+                       (output-char pad))))
+        (do ((igroup 0 (the fixnum (1+ igroup)))
+             (isource 0 (the fixnum (+ isource 3))))
+            ((= igroup complete-group-count)
+             (cond
+               ((= remainder 2)
+                (output-group
+                 (the fixnum
+                     (+
+                      (the fixnum
+                        (ash
+                         ,(case input-type
+                                (:string
+                                 '(char-code (the character (char input isource))))
+                                (:usb8-array
+                                 '(the fixnum (aref input isource))))
+                         16))
+                      (the fixnum
+                        (ash
+                         ,(case input-type
+                                (:string
+                                 '(char-code (the character (char input
+                                                                  (the fixnum (1+ isource))))))
+                                (:usb8-array
+                                 '(the fixnum (aref input (the fixnum
+                                                            (1+ isource))))))
+                         8))))
+                 3))
+               ((= remainder 1)
+                (output-group
+                 (the fixnum
+                   (ash
+                    ,(case input-type
+                           (:string
+                            '(char-code (the character (char input isource))))
+                           (:usb8-array
+                            '(the fixnum (aref input isource))))
+                    16))
+                 2)))
+             ,(case output-type
+                    (:string
+                     'result)
+                    (:stream
+                     'output)))
+          (declare (fixnum igroup isource))
+          (output-group
+           (the fixnum
+             (+
+              (the fixnum
+                (ash
+                 (the fixnum
+                 ,(case input-type
+                        (:string
+                         '(char-code (the character (char input isource))))
+                        (:usb8-array
+                         '(aref input isource))))
+                 16))
+              (the fixnum
+                (ash
+                 (the fixnum
+                   ,(case input-type
+                          (:string
+                           '(char-code (the character (char input
+                                                            (the fixnum (1+ isource))))))
+                        (:usb8-array
+                         '(aref input (1+ isource)))))
+                 8))
+              (the fixnum
+                ,(case input-type
+                       (:string
+                        '(char-code (the character (char input
+                                                         (the fixnum (+ 2 isource))))))
+                       (:usb8-array
+                        '(aref input (+ 2 isource))))
+                )))
+           4)))))))

 
 (def-*-to-base64-* :string :string)
 (def-*-to-base64-* :string :stream)
 
 (def-*-to-base64-* :string :string)
 (def-*-to-base64-* :string :stream)


@@ -211,112 +211,112 @@ with a #\Newline."
 (defun integer-to-base64-string (input &key (uri nil) (columns 0))
   "Encode an integer to base64 format."
   (declare (integer input)
 (defun integer-to-base64-string (input &key (uri nil) (columns 0))
   "Encode an integer to base64 format."
   (declare (integer input)

-          (fixnum columns)
-          (optimize (speed 3) (space 0) (safety 0)))
+           (fixnum columns)
+           (optimize (speed 3) (space 0) (safety 0)))

   (let ((pad (if uri *uri-pad-char* *pad-char*))
   (let ((pad (if uri *uri-pad-char* *pad-char*))

-       (encode-table (if uri *uri-encode-table* *encode-table*)))
+        (encode-table (if uri *uri-encode-table* *encode-table*)))

     (declare (simple-string encode-table)
     (declare (simple-string encode-table)

-            (character pad))
+             (character pad))

     (let* ((input-bits (integer-length input))
     (let* ((input-bits (integer-length input))

-          (byte-bits (round-next-multiple input-bits 8))
-          (padded-bits (round-next-multiple byte-bits 6))
-          (remainder-padding (mod padded-bits 24))
-          (padding-bits (if (zerop remainder-padding)
-                            0
-                            (- 24 remainder-padding)))
-          (padding-chars (/ padding-bits 6))
-          (padded-length (/ (+ padded-bits padding-bits) 6))
-          (last-line-len (if (plusp columns)
-                             (- padded-length (* columns
-                                                 (truncate
-                                                  padded-length columns)))
-                             0))
-          (num-lines (if (plusp columns)
-                         (truncate (+ padded-length (1- columns)) columns)
-                         0))
-          (num-breaks (if (plusp num-lines)
-                          (1- num-lines)
-                          0))
-          (strlen (+ padded-length num-breaks))
-          (last-char (1- strlen))
-          (str (make-string strlen))
-          (col (if (zerop last-line-len)
-                    columns
-                   last-line-len)))
+           (byte-bits (round-next-multiple input-bits 8))
+           (padded-bits (round-next-multiple byte-bits 6))
+           (remainder-padding (mod padded-bits 24))
+           (padding-bits (if (zerop remainder-padding)
+                             0
+                             (- 24 remainder-padding)))
+           (padding-chars (/ padding-bits 6))
+           (padded-length (/ (+ padded-bits padding-bits) 6))
+           (last-line-len (if (plusp columns)
+                              (- padded-length (* columns
+                                                  (truncate
+                                                   padded-length columns)))
+                              0))
+           (num-lines (if (plusp columns)
+                          (truncate (+ padded-length (1- columns)) columns)
+                          0))
+           (num-breaks (if (plusp num-lines)
+                           (1- num-lines)
+                           0))
+           (strlen (+ padded-length num-breaks))
+           (last-char (1- strlen))
+           (str (make-string strlen))
+           (col (if (zerop last-line-len)
+                     columns
+                    last-line-len)))

       (declare (fixnum padded-length num-lines col last-char
       (declare (fixnum padded-length num-lines col last-char

-                      padding-chars last-line-len))
+                       padding-chars last-line-len))

       (unless (plusp columns)
       (unless (plusp columns)

-       (setq col -1)) ;; set to flag to optimize in loop
-      
+        (setq col -1)) ;; set to flag to optimize in loop
+

       (dotimes (i padding-chars)
       (dotimes (i padding-chars)

-       (declare (fixnum i))
-       (setf (schar str (the fixnum (- last-char i))) pad))
+        (declare (fixnum i))
+        (setf (schar str (the fixnum (- last-char i))) pad))

 
       (do* ((strpos (- last-char padding-chars) (1- strpos))
 
       (do* ((strpos (- last-char padding-chars) (1- strpos))

-           (int (ash input (/ padding-bits 3))))
-          ((minusp strpos)
-           str)
-       (declare (fixnum strpos) (integer int))
-       (cond
-         ((zerop col)
-          (setf (schar str strpos) #\Newline)
-          (setq col columns))
-         (t
-          (setf (schar str strpos)
-                (schar encode-table (the fixnum (logand int #x3f))))
-          (setq int (ash int -6))
-          (decf col)))))))
+            (int (ash input (/ padding-bits 3))))
+           ((minusp strpos)
+            str)
+        (declare (fixnum strpos) (integer int))
+        (cond
+          ((zerop col)
+           (setf (schar str strpos) #\Newline)
+           (setq col columns))
+          (t
+           (setf (schar str strpos)
+                 (schar encode-table (the fixnum (logand int #x3f))))
+           (setq int (ash int -6))
+           (decf col)))))))

 
 (defun integer-to-base64-stream (input stream &key (uri nil) (columns 0))
   "Encode an integer to base64 format."
   (declare (integer input)
 
 (defun integer-to-base64-stream (input stream &key (uri nil) (columns 0))
   "Encode an integer to base64 format."
   (declare (integer input)

-          (fixnum columns)
-          (optimize (speed 3) (space 0) (safety 0)))
+           (fixnum columns)
+           (optimize (speed 3) (space 0) (safety 0)))

   (let ((pad (if uri *uri-pad-char* *pad-char*))
   (let ((pad (if uri *uri-pad-char* *pad-char*))

-       (encode-table (if uri *uri-encode-table* *encode-table*)))
+        (encode-table (if uri *uri-encode-table* *encode-table*)))

     (declare (simple-string encode-table)
     (declare (simple-string encode-table)

-            (character pad))
+             (character pad))

     (let* ((input-bits (integer-length input))
     (let* ((input-bits (integer-length input))

-          (byte-bits (round-next-multiple input-bits 8))
-          (padded-bits (round-next-multiple byte-bits 6))
-          (remainder-padding (mod padded-bits 24))
-          (padding-bits (if (zerop remainder-padding)
-                            0
-                            (- 24 remainder-padding)))
-          (padding-chars (/ padding-bits 6))
-          (padded-length (/ (+ padded-bits padding-bits) 6))
-          (strlen padded-length)
-          (nonpad-chars (- strlen padding-chars))
-          (last-nonpad-char (1- nonpad-chars))
-          (str (make-string strlen)))
+           (byte-bits (round-next-multiple input-bits 8))
+           (padded-bits (round-next-multiple byte-bits 6))
+           (remainder-padding (mod padded-bits 24))
+           (padding-bits (if (zerop remainder-padding)
+                             0
+                             (- 24 remainder-padding)))
+           (padding-chars (/ padding-bits 6))
+           (padded-length (/ (+ padded-bits padding-bits) 6))
+           (strlen padded-length)
+           (nonpad-chars (- strlen padding-chars))
+           (last-nonpad-char (1- nonpad-chars))
+           (str (make-string strlen)))

       (declare (fixnum padded-length last-nonpad-char))
       (do* ((strpos 0 (the fixnum (1+ strpos)))
       (declare (fixnum padded-length last-nonpad-char))
       (do* ((strpos 0 (the fixnum (1+ strpos)))

-           (int (ash input (/ padding-bits 3)) (ash int -6))
-           (6bit-value (the fixnum (logand int #x3f))
-                       (the fixnum (logand int #x3f))))
-          ((= strpos nonpad-chars)
-           (let ((col 0))
-             (declare (fixnum col))
-             (dotimes (i nonpad-chars)
-               (declare (fixnum i))
-               (write-char (schar str i) stream)
-               (when (plusp columns)
-                 (incf col)
-                 (when (= col columns)
-                   (write-char #\Newline stream)
-                   (setq col 0))))
-             (dotimes (ipad padding-chars)
-               (declare (fixnum ipad))
-               (write-char pad stream)
-               (when (plusp columns)
-                 (incf col)
-                 (when (= col columns)
-                   (write-char #\Newline stream)
-                   (setq col 0)))))
-           stream)
-       (declare (fixnum 6bit-value strpos)
-                (integer int))
-       (setf (schar str (- last-nonpad-char strpos))
-             (schar encode-table 6bit-value))
-       ))))
+            (int (ash input (/ padding-bits 3)) (ash int -6))
+            (6bit-value (the fixnum (logand int #x3f))
+                        (the fixnum (logand int #x3f))))
+           ((= strpos nonpad-chars)
+            (let ((col 0))
+              (declare (fixnum col))
+              (dotimes (i nonpad-chars)
+                (declare (fixnum i))
+                (write-char (schar str i) stream)
+                (when (plusp columns)
+                  (incf col)
+                  (when (= col columns)
+                    (write-char #\Newline stream)
+                    (setq col 0))))
+              (dotimes (ipad padding-chars)
+                (declare (fixnum ipad))
+                (write-char pad stream)
+                (when (plusp columns)
+                  (incf col)
+                  (when (= col columns)
+                    (write-char #\Newline stream)
+                    (setq col 0)))))
+            stream)
+        (declare (fixnum 6bit-value strpos)
+                 (integer int))
+        (setf (schar str (- last-nonpad-char strpos))
+              (schar encode-table 6bit-value))
+        ))))

 
 

diff --git a/package.lisp b/package.lisp
index 6f4fa2c9c7bce0390655b44331c9556551ff4303..5eac24111e5430a80ac41ebf410d46356def62a3 100644 (file)
--- a/package.lisp
+++ b/package.lisp
@@ -15,29 +15,29 @@
   (:nicknames #:base64)
   (:use #:cl)
   (:export #:base64-stream-to-integer
   (:nicknames #:base64)
   (:use #:cl)
   (:export #:base64-stream-to-integer

-          #:base64-string-to-integer
-          #:base64-string-to-string
-          #:base64-stream-to-string
-          #:base64-string-to-stream
-          #:base64-stream-to-stream
-          #:base64-string-to-usb8-array
-          #:base64-stream-to-usb8-array
-          #:string-to-base64-string
-          #:string-to-base64-stream
-          #:usb8-array-to-base64-string
-          #:usb8-array-to-base64-stream
-          #:stream-to-base64-string
-          #:stream-to-base64-stream
-          #:integer-to-base64-string
-          #:integer-to-base64-stream
+           #:base64-string-to-integer
+           #:base64-string-to-string
+           #:base64-stream-to-string
+           #:base64-string-to-stream
+           #:base64-stream-to-stream
+           #:base64-string-to-usb8-array
+           #:base64-stream-to-usb8-array
+           #:string-to-base64-string
+           #:string-to-base64-stream
+           #:usb8-array-to-base64-string
+           #:usb8-array-to-base64-stream
+           #:stream-to-base64-string
+           #:stream-to-base64-stream
+           #:integer-to-base64-string
+           #:integer-to-base64-stream

 
 

-          ;; For creating custom encode/decode tables
-          #:*uri-encode-table*
-          #:*uri-decode-table*
-          #:make-decode-table
+           ;; For creating custom encode/decode tables
+           #:*uri-encode-table*
+           #:*uri-decode-table*
+           #:make-decode-table

 
 

-          #:test-base64
-          ))
+           #:test-base64
+           ))

 
 (in-package #:cl-base64)
 
 
 (in-package #:cl-base64)
 


@@ -54,18 +54,18 @@
 
 (defun make-decode-table (encode-table)
   (let ((dt (make-array 256 :adjustable nil :fill-pointer nil
 
 (defun make-decode-table (encode-table)
   (let ((dt (make-array 256 :adjustable nil :fill-pointer nil

-                       :element-type 'fixnum
-                       :initial-element -1)))
+                        :element-type 'fixnum
+                        :initial-element -1)))

     (declare (type decode-table dt))
     (loop for char of-type character across encode-table
        for index of-type fixnum from 0 below 64
        do (setf (aref dt (the fixnum (char-code char))) index))
     dt))
     (declare (type decode-table dt))
     (loop for char of-type character across encode-table
        for index of-type fixnum from 0 below 64
        do (setf (aref dt (the fixnum (char-code char))) index))
     dt))

-    
+

 (defvar *decode-table* (make-decode-table *encode-table*))
 (defvar *decode-table* (make-decode-table *encode-table*))

-  
+

 (defvar *uri-decode-table* (make-decode-table *uri-encode-table*))
 (defvar *uri-decode-table* (make-decode-table *uri-encode-table*))

-  
+

 (defvar *pad-char* #\=)
 (defvar *uri-pad-char* #\.)
 (declaim (type character *pad-char* *uri-pad-char*))
 (defvar *pad-char* #\=)
 (defvar *uri-pad-char* #\.)
 (declaim (type character *pad-char* *uri-pad-char*))

diff --git a/tests.lisp b/tests.lisp
index 7e5d3ff656ecfae14f13b573336c581bf56be2e5..927e4b8c606c4bd270e58f236b3b42137d394068 100644 (file)
--- a/tests.lisp
+++ b/tests.lisp
@@ -21,53 +21,53 @@
   (with-tests (:name "cl-base64 tests")
     (let ((*break-on-test-failures* t))
       (do* ((length 0 (+ 3 length))
   (with-tests (:name "cl-base64 tests")
     (let ((*break-on-test-failures* t))
       (do* ((length 0 (+ 3 length))

-           (string (make-string length) (make-string length))
-           (usb8 (make-usb8-array length) (make-usb8-array length))
-           (integer (random (expt 10 length)) (random (expt 10 length))))
-          ((>= length 300))
-       (dotimes (i length)
-         (declare (fixnum i))
-         (let ((code (random 256)))
-           (setf (schar string i) (code-char code))
-       (setf (aref usb8 i) code)))
-       
-       (do* ((columns 0 (+ columns 4)))
-            ((> columns length))
-         ;; Test against cl-base64 routines
-         (test integer (base64-string-to-integer
-                        (integer-to-base64-string integer :columns columns)))
-         (test string (base64-string-to-string
-                       (string-to-base64-string string :columns columns))
-               :test #'string=)
-         
-         ;; Test against AllegroCL built-in routines
-         #+allegro
-         (progn
-         (test integer (excl:base64-string-to-integer
-                        (integer-to-base64-string integer :columns columns)))
-         (test integer (base64-string-to-integer
-                        (excl:integer-to-base64-string integer)))
-         (test (string-to-base64-string string :columns columns)
-               (excl:usb8-array-to-base64-string usb8
-                                                 (if (zerop columns)
-                                                     nil
-                                                     columns))
-               :test #'string=)
-         (test string (base64-string-to-string
-                       (excl:usb8-array-to-base64-string
-                        usb8
-                        (if (zerop columns)
-                            nil
-                            columns)))
-               :test #'string=))))))
+            (string (make-string length) (make-string length))
+            (usb8 (make-usb8-array length) (make-usb8-array length))
+            (integer (random (expt 10 length)) (random (expt 10 length))))
+           ((>= length 300))
+        (dotimes (i length)
+          (declare (fixnum i))
+          (let ((code (random 256)))
+            (setf (schar string i) (code-char code))
+        (setf (aref usb8 i) code)))
+
+        (do* ((columns 0 (+ columns 4)))
+             ((> columns length))
+          ;; Test against cl-base64 routines
+          (test integer (base64-string-to-integer
+                         (integer-to-base64-string integer :columns columns)))
+          (test string (base64-string-to-string
+                        (string-to-base64-string string :columns columns))
+                :test #'string=)
+
+          ;; Test against AllegroCL built-in routines
+          #+allegro
+          (progn
+          (test integer (excl:base64-string-to-integer
+                         (integer-to-base64-string integer :columns columns)))
+          (test integer (base64-string-to-integer
+                         (excl:integer-to-base64-string integer)))
+          (test (string-to-base64-string string :columns columns)
+                (excl:usb8-array-to-base64-string usb8
+                                                  (if (zerop columns)
+                                                      nil
+                                                      columns))
+                :test #'string=)
+          (test string (base64-string-to-string
+                        (excl:usb8-array-to-base64-string
+                         usb8
+                         (if (zerop columns)
+                             nil
+                             columns)))
+                :test #'string=))))))

   t)
 
 
 (defun time-routines ()
   (let* ((str "abcdefghijklmnopqwertyu1234589jhwf2ff")
   t)
 
 
 (defun time-routines ()
   (let* ((str "abcdefghijklmnopqwertyu1234589jhwf2ff")

-        (usb8 (string-to-usb8-array str))
-        (int 12345678901234567890)
-        (n 50000))
+         (usb8 (string-to-usb8-array str))
+         (int 12345678901234567890)
+         (n 50000))

     (time-iterations n (integer-to-base64-string int))
     (time-iterations n (string-to-base64-string str))
     #+allego
     (time-iterations n (integer-to-base64-string int))
     (time-iterations n (string-to-base64-string str))
     #+allego


@@ -75,5 +75,5 @@
       (time-iterations n (excl:integer-to-base64-string int))
       (time-iterations n (excl:usb8-array-to-base64-string usb8)))))
 
       (time-iterations n (excl:integer-to-base64-string int))
       (time-iterations n (excl:usb8-array-to-base64-string usb8)))))
 

-      
+

 ;;#+run-test (test-base64)
 ;;#+run-test (test-base64)