;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Dec 2002
;;;;
-;;;; $Id: encode.lisp,v 1.4 2003/01/14 11:43:10 kevin Exp $
+;;;; $Id: encode.lisp,v 1.7 2003/06/12 14:05:11 kevin Exp $
;;;;
;;;; This file implements the Base64 transfer encoding algorithm as
;;;; defined in RFC 1521 by Borensten & Freed, September 1993.
;;;; 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
;;;; - 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: encode.lisp,v 1.7 2003/06/12 14:05:11 kevin Exp $
(in-package #:cl-base64)
-
(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)
`(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))
(: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)
(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)))
(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)
(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
- '(the fixnum (aref input (1+ isource)))))
+ '(the fixnum (aref input (the fixnum
+ (1+ isource))))))
8))))
3))
((= remainder 1)
(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
- '(char-code (the character (char input (+ 2 isource)))))
+ '(char-code (the character (char input
+ (the fixnum (+ 2 isource))))))
(:usb8-array
'(aref input (+ 2 isource))))
)))
"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)
"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)
(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))
- (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))