projects
/
cl-base64.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
r11052: Automated commit for Debian build of cl-base64 upstream-version-3.3.2
[cl-base64.git]
/
encode.lisp
diff --git
a/encode.lisp
b/encode.lisp
index 4bca7a3d352ab7cc2f077dc21dd2d61dad84fd07..f5276a885faff2e81da6f5dee272818d36a02aa4 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.4 2003/01/14 11:43:10 kevin Exp
$
+;;;; $Id$
;;;;
;;;; 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.
@@
-19,8
+19,6
@@
;;;; Permission to use with BSD-style license included in the COPYING file
;;;; *************************************************************************
;;;; Permission to use with BSD-style license included in the COPYING file
;;;; *************************************************************************
-(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
-
;;;; Extended by Kevin M. Rosenberg <kevin@rosenberg.net>:
;;;; - .asd file
;;;; - numerous speed optimizations
;;;; Extended by Kevin M. Rosenberg <kevin@rosenberg.net>:
;;;; - .asd file
;;;; - numerous speed optimizations
@@
-28,15
+26,14
@@
;;;; - 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.4 2003/01/14 11:43:10 kevin Exp
$
+;;;; $Id$
(in-package #:cl-base64)
(in-package #:cl-base64)
-
(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)))
+ (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)
@@
-47,7
+44,7
@@
`(defun ,(intern (concatenate 'string (symbol-name input-type)
(symbol-name :-to-base64-)
(symbol-name output-type)))
`(defun ,(intern (concatenate 'string (symbol-name input-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))
@@
-60,7
+57,7
@@
with a #\Newline."
(:usb8-array
'((type (array (unsigned-byte 8) (*)) input))))
(fixnum columns)
(:usb8-array
'((type (array (unsigned-byte 8) (*)) input))))
(fixnum columns)
- (optimize (speed 3)))
+ (optimize (speed 3)
(safety 0) (space 0)
))
(let ((pad (if uri *uri-pad-char* *pad-char*))
(encode-table (if uri *uri-encode-table* *encode-table*)))
(declare (simple-string encode-table)
(let ((pad (if uri *uri-pad-char* *pad-char*))
(encode-table (if uri *uri-encode-table* *encode-table*)))
(declare (simple-string encode-table)
@@
-81,7
+78,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)))
@@
-129,8
+126,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)
@@
-149,9
+146,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)
@@
-188,14
+187,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))))
)))
@@
-211,7
+212,7
@@
with a #\Newline."
"Encode an integer to base64 format."
(declare (integer input)
(fixnum columns)
"Encode an integer to base64 format."
(declare (integer input)
(fixnum columns)
- (optimize (speed 3)))
+ (optimize (speed 3)
(space 0) (safety 0)
))
(let ((pad (if uri *uri-pad-char* *pad-char*))
(encode-table (if uri *uri-encode-table* *encode-table*)))
(declare (simple-string encode-table)
(let ((pad (if uri *uri-pad-char* *pad-char*))
(encode-table (if uri *uri-encode-table* *encode-table*)))
(declare (simple-string encode-table)
@@
-270,7
+271,7
@@
with a #\Newline."
"Encode an integer to base64 format."
(declare (integer input)
(fixnum columns)
"Encode an integer to base64 format."
(declare (integer input)
(fixnum columns)
- (optimize (speed 3)))
+ (optimize (speed 3)
(space 0) (safety 0)
))
(let ((pad (if uri *uri-pad-char* *pad-char*))
(encode-table (if uri *uri-encode-table* *encode-table*)))
(declare (simple-string encode-table)
(let ((pad (if uri *uri-pad-char* *pad-char*))
(encode-table (if uri *uri-encode-table* *encode-table*)))
(declare (simple-string encode-table)
@@
-289,9
+290,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))