(defvar +base64-chars+
  (concatenate 'string
               "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
               "abcdefghijklmnopqrstuvwxyz"
               "0123456789"
               "+/"))

(defun base64-encode (object)
  ;; Three octets yield 24 bits, which is four characters encoding 6
  ;; bit each. We have atmost 76 characters a line, which is 57
  ;; octets. The tricky part comes at the end of the sequence, as we
  ;; need to pad.
  ;;
  ;; If the sequence is /n/ octets, we have floor(/n/, 57) full lines
  ;; of 76 characters plus the newline.
  (check-type object (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)))
  (let ((base64-chars +base64-chars+))
    (declare (optimize (speed 3) (safety 0))
             (type (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) object))
    (declare (type simple-string base64-chars))
    (multiple-value-bind (nlines rest) (floor (length object) 57)
      (multiple-value-bind (nfin npad) (floor rest 3)
        (let ((res (make-array (+ (* nlines 77) (* 4 nfin) (* (if (> npad 0) 4 0)))
                               :element-type '#.(array-element-type ""))))
          (declare (type (simple-array #.(array-element-type "") (*)) res))
          (let ((p 0) (d 0))
            (declare (type fixnum p d))
            (macrolet ((put-3 ()
                         '(let ((w (logior (ash (aref object p) 16)
                                           (ash (aref object (incf p)) 8)
                                           (ash (aref object (incf p)) 0))))
                           (declare (type fixnum w))
                           (incf p)
                           (setf
                            (aref res d) (schar base64-chars (ldb (byte 6 18) w))
                            (aref res (incf d)) (schar base64-chars (ldb (byte 6 12) w))
                            (aref res (incf d)) (schar base64-chars (ldb (byte 6 6) w))
                            (aref res (incf d)) (schar base64-chars (ldb (byte 6 0) w)))
                           (incf d))))
              (loop repeat nlines do
                    (loop repeat 57/3 do (put-3))
                    (setf (aref res d) #\newline)
                    (incf d))
              (loop for i below nfin do
                    (put-3)))
            ;; final, with padding
            (case npad
              (0 nil)
              (1
               (let ((w (logior (ash (aref object p) 16))))
                 (incf p)
                 (setf
                  (aref res d) (schar base64-chars (ldb (byte 6 18) w))
                  (aref res (incf d)) (schar base64-chars (ldb (byte 6 12) w))
                  (aref res (incf d)) #\=
                  (aref res (incf d)) #\=)
                 (incf d)))
              (2
               (let ((w (logior (ash (aref object p) 16)
                                (ash (aref object (incf p)) 8))))
                 (incf p)
                 (setf
                  (aref res d) (schar base64-chars (ldb (byte 6 18) w))
                  (aref res (incf d)) (schar base64-chars (ldb (byte 6 12) w))
                  (aref res (incf d)) (schar base64-chars (ldb (byte 6 6) w))
                  (aref res (incf d)) #\=)
                 (incf d)))))
          res)))))