r4487: Auto commit for Debian build

[cl-base64.git] / encode.lisp

diff --git a/encode.lisp b/encode.lisp
index 803c9ce532293c9aa7816c2609c35c843cfbe805..f3791aad7867651a608f65fb96a2280f7bdc1dce 100644 (file)
--- a/encode.lisp
+++ b/encode.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Dec 2002
 ;;;;
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Dec 2002
 ;;;;

-;;;; $Id: encode.lisp,v 1.3 2003/01/13 21:38:01 kevin Exp $
+;;;; $Id: encode.lisp,v 1.5 2003/01/14 11:59:44 kevin Exp $

 ;;;;
 ;;;; This file implements the Base64 transfer encoding algorithm as
 ;;;; defined in RFC 1521 by Borensten & Freed, September 1993.
 ;;;;
 ;;;; This file implements the Base64 transfer encoding algorithm as
 ;;;; defined in RFC 1521 by Borensten & Freed, September 1993.


@@ -28,7 +28,7 @@
 ;;;;   - Renamed functions now that supporting integer conversions
 ;;;;   - URI-compatible encoding using :uri key
 ;;;;
 ;;;;   - Renamed functions now that supporting integer conversions
 ;;;;   - URI-compatible encoding using :uri key
 ;;;;

-;;;; $Id: encode.lisp,v 1.3 2003/01/13 21:38:01 kevin Exp $
+;;;; $Id: encode.lisp,v 1.5 2003/01/14 11:59:44 kevin Exp $

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


@@ -43,118 +43,6 @@
        x
        (the fixnum (+ x (the fixnum (- n remainder)))))))
 
        x
        (the fixnum (+ x (the fixnum (- n remainder)))))))
 

-(defun string-to-base64 (string &key (uri nil) (columns 0) (stream nil))
-  "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 (string string)
-          (fixnum columns)
-          (optimize (speed 3)))
-  (let ((pad (if uri *uri-pad-char* *pad-char*))
-       (encode-table (if uri *uri-encode-table* *encode-table*)))
-    (declare (simple-string encode-table)
-            (character pad))
-    (let* ((string-length (length string))
-          (complete-group-count (truncate string-length 3))
-          (remainder (nth-value 1 (truncate string-length 3)))
-          (padded-length (* 4 (truncate (+ string-length 2) 3)))
-          (num-lines (if (plusp columns)
-                         (truncate (+ padded-length (1- columns)) columns)
-                         0))
-          (num-breaks (if (plusp num-lines)
-                          (1- num-lines)
-                          0))
-          (strlen (if stream
-                      0
-                      (+ padded-length num-breaks)))
-          (result (make-string strlen))
-          (col (if (plusp columns)
-                   0
-                   (1+ padded-length)))
-          (ioutput 0))
-      (declare (fixnum string-length padded-length col ioutput)
-              (simple-string result))
-      (labels ((output-char (ch)
-                (if (= col columns)
-                    (progn
-                      (if stream
-                          (write-char #\Newline stream)
-                          (progn
-                            (setf (schar result ioutput) #\Newline)
-                            (incf ioutput)))
-                      (setq col 1))
-                    (incf col))
-                (if stream
-                    (write-char ch stream)
-                    (progn
-                      (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 (1+ igroup))
-            (isource 0 (+ isource 3)))
-           ((= igroup complete-group-count)
-            (cond
-              ((= remainder 2)
-               (output-group
-                (the fixnum
-                  (+
-                   (the fixnum
-                     (ash (the fixnum
-                            (char-code (the character
-                                         (char string isource))))
-                          16))
-                   (the fixnum
-                     (ash (the fixnum
-                            (char-code (the character
-                                         (char string (1+ isource)))))
-                          8))))
-                3))
-              ((= remainder 1)
-               (output-group
-                (the fixnum
-                  (ash
-                   (the fixnum
-                     (char-code (the character (char string isource))))
-                   16))
-                2)))
-            result)
-         (declare (fixnum igroup isource))
-         (output-group 
-          (the fixnum
-            (+
-             (the fixnum
-               (ash (char-code (the character
-                                 (char string isource))) 16))
-             (the fixnum
-               (ash (char-code (the character (char string (1+ isource)))) 8))
-             (the fixnum
-               (char-code (the character (char string (+ 2 isource)))))))
-          4))))))
-

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


@@ -170,7 +58,7 @@ with a #\Newline."
                      (:string
                       '((string input)))
                      (:usb8-array
                      (:string
                       '((string input)))
                      (:usb8-array

-                      '((type (array fixnum (*)) input))))
+                      '((type (array (unsigned-byte 8) (*)) input))))

              (fixnum columns)
              (optimize (speed 3)))
      (let ((pad (if uri *uri-pad-char* *pad-char*))
              (fixnum columns)
              (optimize (speed 3)))
      (let ((pad (if uri *uri-pad-char* *pad-char*))


@@ -193,7 +81,7 @@ with a #\Newline."
                        (ioutput 0)))
              (col (if (plusp columns)
                       0
                        (ioutput 0)))
              (col (if (plusp columns)
                       0

-                      (1+ padded-length))))
+                      (the fixnum (1+ padded-length)))))

         (declare (fixnum string-length padded-length col
                          ,@(when (eq output-type :string)
                                  '(ioutput)))
         (declare (fixnum string-length padded-length col
                          ,@(when (eq output-type :string)
                                  '(ioutput)))


@@ -241,8 +129,8 @@ with a #\Newline."
                               (the fixnum
                                 (logand #x3f svalue))))
                       (output-char pad))))
                               (the fixnum
                                 (logand #x3f svalue))))
                       (output-char pad))))

-       (do ((igroup 0 (1+ igroup))
-            (isource 0 (+ isource 3)))
+       (do ((igroup 0 (the fixnum (1+ igroup)))
+            (isource 0 (the fixnum (+ isource 3))))

            ((= igroup complete-group-count)
             (cond
               ((= remainder 2)
            ((= igroup complete-group-count)
             (cond
               ((= remainder 2)


@@ -261,9 +149,11 @@ with a #\Newline."
                        (ash
                         ,(case input-type
                                (:string
                        (ash
                         ,(case input-type
                                (:string

-                                '(char-code (the character (char input (1+ isource)))))
+                                '(char-code (the character (char input
+                                                                 (the fixnum (1+ isource))))))

                                (:usb8-array
                                (:usb8-array

-                                '(the fixnum (aref input (1+ isource)))))
+                                '(the fixnum (aref input (the fixnum
+                                                           (1+ isource))))))

                         8))))
                 3))
               ((= remainder 1)
                         8))))
                 3))
               ((= remainder 1)


@@ -300,14 +190,16 @@ with a #\Newline."
                 (the fixnum
                   ,(case input-type
                          (:string
                 (the fixnum
                   ,(case input-type
                          (:string

-                          '(char-code (the character (char input (1+ isource)))))
+                          '(char-code (the character (char input
+                                                           (the fixnum (1+ isource))))))

                        (:usb8-array
                         '(aref input (1+ isource)))))
                 8))
              (the fixnum
                ,(case input-type
                       (:string
                        (:usb8-array
                         '(aref input (1+ isource)))))
                 8))
              (the fixnum
                ,(case input-type
                       (:string

-                       '(char-code (the character (char input (+ 2 isource)))))
+                       '(char-code (the character (char input
+                                                        (the fixnum (+ 2 isource))))))

                       (:usb8-array
                        '(aref input (+ 2 isource))))
                )))
                       (:usb8-array
                        '(aref input (+ 2 isource))))
                )))


@@ -401,9 +293,10 @@ with a #\Newline."
           (last-nonpad-char (1- nonpad-chars))
           (str (make-string strlen)))
       (declare (fixnum padded-length last-nonpad-char))
           (last-nonpad-char (1- nonpad-chars))
           (str (make-string strlen)))
       (declare (fixnum padded-length last-nonpad-char))

-      (do* ((strpos 0 (1+ strpos))
+      (do* ((strpos 0 (the fixnum (1+ strpos)))

            (int (ash input (/ padding-bits 3)) (ash int -6))
            (int (ash input (/ padding-bits 3)) (ash int -6))

-           (6bit-value (logand int #x3f) (logand int #x3f)))
+           (6bit-value (the fixnum (logand int #x3f))
+                       (the fixnum (logand int #x3f))))

           ((= strpos nonpad-chars)
            (let ((col 0))
              (declare (fixnum col))
           ((= strpos nonpad-chars)
            (let ((col 0))
              (declare (fixnum col))