;;; sjaman pointed out: alphabet inside a let is faster than define

;; and as crzcrz pointed out, chicken has had
;; recent improvements on u8vector things, so
;; we need to stay on the very master tip.
;;
;; this gets me 1200MB/s on C6 which is the
;; fastest combination so far. pretty good
;; considering C can do 2000MB/s. but
;; I still can't use my convenient 
;; `lookup` function without a 50% performance
;; loss.

(import chicken.bitwise srfi-4 scheme.base
        chicken.fixnum chicken.foreign chicken.io
        srfi-4 chicken.number-vector)

(define base64e/scheme
  (let* ((alphabet/default (list->u8vector
                            (map char->integer
                                 (string->list
                                  "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"))))
         (lookup (lambda (i) (u8vector-ref alphabet/default i))))
      
    (lambda (in in-start in-end dest dest-start dest-end
                #!key )

      (let ((stop (- in-end 2)))
        (let myloop123 ((in-pos in-start)
                        (dest-pos dest-start))
          (if (fx<= in-pos stop)
              (let ((w (fx+      (fxshl (u8vector-ref in (fx+ in-pos 0)) 16)
                                 (fx+ (fxshl (u8vector-ref in (fx+ in-pos 1))  8)
                                      (fxshl (u8vector-ref in (fx+ in-pos 2))  0)))))
                (u8vector-set! dest (fx+ dest-pos 0) (u8vector-ref alphabet/default (fxand (fxshr w -18) #x3F)))
                (u8vector-set! dest (fx+ dest-pos 1) (u8vector-ref alphabet/default (fxand (fxshr w -12) #x3F)))
                (u8vector-set! dest (fx+ dest-pos 2) (u8vector-ref alphabet/default (fxand (fxshr w  -6) #x3F)))
                (u8vector-set! dest (fx+ dest-pos 3) (u8vector-ref alphabet/default (fxand (fxshr w  -0) #x3F)))

                (myloop123 (fx+ in-pos 3) (fx+ dest-pos 4)))
              dest-pos))))))

(let ((in  (make-u8vector 4096 0))
      (out (make-u8vector (* (quotient (+ 2 4096) 3) 4))))
  (let loop ()
    (let* ((in-read (cond-expand (chicken-6 (read-bytevector! in))
                                 (chicken-5 (read-u8vector! #f in))
                                 (else (error "bad bad no 6"))))
           (dest-read
            (base64e/scheme
             ;; base64e/c ;; <--- replace with this procedure to try the faster C version
             in 0 in-read  out 0 (u8vector-length out))))
      (unless (zero? in-read)
        (cond-expand
         (chicken-6 (write-bytevector out (current-output-port) 0 dest-read))
         (chicken-5 (write-u8vector   out (current-output-port) 0 dest-read)))
        (loop)))))