- (do* ((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)))
- (strlen (/ (+ padded-bits padding-bits) 6))
- (padding-chars (/ padding-bits 6))
- (nonpad-chars (- strlen padding-chars))
- (last-nonpad-char (1- nonpad-chars))
- (str (make-string strlen))
- (strpos 0 (1+ strpos))
- (int (ash input (/ padding-bits 3)) (ash int -6))
- (6bit-value (logand int #x3f) (logand int #x3f)))
- ((= strpos nonpad-chars)
- (dotimes (ipad padding-chars)
- (setf (schar str strpos) pad)
- (incf strpos))
- str)
- (declare (fixnum 6bit-value strpos strlen last-nonpad-char)
- (integer int))
- (setf (schar str (the fixnum (- last-nonpad-char strpos)))
- (schar encode-table 6bit-value)))))
+ (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)
+ (1- columns)
+ (1- last-line-len))))
+ (declare (fixnum padded-length num-lines col last-char
+ padding-chars last-line-len))
+ (unless (plusp columns)
+ (setq col -1)) ;; set to flag to optimize in loop
+
+ (dotimes (i padding-chars)
+ (declare (fixnum i))
+ (setf (schar str (the fixnum (- last-char i))) pad))
+
+ (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)))))))
+
+(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)))
+ (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* ((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)))
+ (declare (fixnum padded-length last-nonpad-char))
+ (do* ((strpos 0 (1+ strpos))
+ (int (ash input (/ padding-bits 3)) (ash int -6))
+ (6bit-value (logand int #x3f) (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))
+ ))))