r3731: *** empty log message ***

[cl-base64.git] / src.lisp

diff --git a/src.lisp b/src.lisp
index 35746ec71c7e8170a93220c63f2bdc82ddfab3bd..48cde5b6d64fadd243644eb0f4ba93d28e255386 100644 (file)
--- a/src.lisp
+++ b/src.lisp
@@ -14,7 +14,7 @@
 ;;;; Copyright 2002-2003 Kevin M. Rosenberg
 ;;;; Permission to use with BSD-style license included in the COPYING file
 ;;;;
 ;;;; Copyright 2002-2003 Kevin M. Rosenberg
 ;;;; Permission to use with BSD-style license included in the COPYING file
 ;;;;

-;;;; $Id: src.lisp,v 1.3 2003/01/04 06:13:53 kevin Exp $
+;;;; $Id: src.lisp,v 1.6 2003/01/04 13:43:27 kevin Exp $

 
 (defpackage #:base64
   (:use #:cl)
 
 (defpackage #:base64
   (:use #:cl)


@@ -98,17 +98,17 @@ with a #\Newline."
     (let* ((string-length (length string))
           (complete-group-count (truncate string-length 3))
           (remainder (nth-value 1 (truncate string-length 3)))
     (let* ((string-length (length string))
           (complete-group-count (truncate string-length 3))
           (remainder (nth-value 1 (truncate string-length 3)))

-          (padded-length (+ remainder
-                            (* 4 complete-group-count)))
+          (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))
           (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 (unless stream
-                    (make-string strlen)))
+          (strlen (if stream
+                      0
+                      (+ padded-length num-breaks)))
+          (result (make-string strlen))

           (col (if (plusp columns)
                    0
                    (1+ padded-length)))
           (col (if (plusp columns)
                    0
                    (1+ padded-length)))


@@ -118,18 +118,19 @@ with a #\Newline."
       (labels ((output-char (ch)
                 (when (= col columns)
                   (if stream
       (labels ((output-char (ch)
                 (when (= col columns)
                   (if stream

-                      (write #\Newline stream)
+                      (write-char #\Newline stream)

                       (progn
                         (setf (schar result ioutput) #\Newline)
                         (incf ioutput)))
                   (setq col 0))
                 (incf col)
                 (if stream
                       (progn
                         (setf (schar result ioutput) #\Newline)
                         (incf ioutput)))
                   (setq col 0))
                 (incf col)
                 (if stream

-                    (write ch stream)
+                    (write-char ch stream)

                     (progn
                       (setf (schar result ioutput) ch)
                       (incf ioutput))))
             (output-group (svalue chars)
                     (progn
                       (setf (schar result ioutput) ch)
                       (incf ioutput))))
             (output-group (svalue chars)

+              (declare (fixnum svalue chars))

               (output-char
                (schar encode-table
                       (the fixnum
               (output-char
                (schar encode-table
                       (the fixnum


@@ -146,51 +147,46 @@ with a #\Newline."
                           (the fixnum
                             (logand #x3f
                                     (the fixnum (ash svalue -6))))))
                           (the fixnum
                             (logand #x3f
                                     (the fixnum (ash svalue -6))))))

-                  (output-char pad))
+                (output-char pad))

               (if (> chars 3)
                   (output-char
                    (schar encode-table
                           (the fixnum
                             (logand #x3f svalue))))
               (if (> chars 3)
                   (output-char
                    (schar encode-table
                           (the fixnum
                             (logand #x3f svalue))))

-                  (output-char pad))))
+                (output-char pad))))

        (do ((igroup 0 (1+ igroup))
        (do ((igroup 0 (1+ igroup))

-            (isource 0 (+ isource 3))
-            svalue)
+            (isource 0 (+ isource 3)))

            ((= igroup complete-group-count)
            ((= igroup complete-group-count)

-            (case remainder
-              (2
-               (setq svalue
-                     (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)))))
-               (output-group svalue 3))
-              (1
-               (setq svalue
-                     (the fixnum
-                       (char-code (the character
-                                    (char string isource)))))
-               (output-group svalue 2)))
+            (cond
+              ((= remainder 2)
+               (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))))
+                3))
+              ((= remainder 1)
+               (output-group
+                (the fixnum
+                  (ash (char-code (the character (char string isource))) 16))
+                2)))

             result)
             result)

-         (declare (fixnum igroup isource svalue))
-         (setq svalue
-               (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))))))))
-         (output-group svalue 4))))))
-  
+         (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))))))

   
 (defun integer-to-base64 (input &key (uri nil) (columns 0) (stream nil))
   (if stream
   
 (defun integer-to-base64 (input &key (uri nil) (columns 0) (stream nil))
   (if stream