;;; EDIT: manually unwrapping `lookup` improves things dramatically on C5
;;;       unsure if C6 is able to do this too

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

;; more or less taken from https://base64.dev/articles/base64-c
(foreign-declare "
static const char b64_enc_table[] =
    \"ABCDEFGHIJKLMNOPQRSTUVWXYZ\"
    \"abcdefghijklmnopqrstuvwxyz\"
    \"0123456789+/\";

int base64_encode(const uint8_t *in, const int in_start, const int in_end,
		   uint8_t *out, int out_start, int out_end) {

    size_t i, j;
    for (i = in_start, j = out_start; i + 2 < in_end; i += 3) {
        uint32_t n = ((uint32_t)in[i] << 16)
                   | ((uint32_t)in[i + 1] << 8)
                   |  (uint32_t)in[i + 2];
        out[j++] = b64_enc_table[(n >> 18) & 0x3F];
        out[j++] = b64_enc_table[(n >> 12) & 0x3F];
        out[j++] = b64_enc_table[(n >>  6) & 0x3F];
        out[j++] = b64_enc_table[ n        & 0x3F];
    }
    return j;
}
")

(define base64e/c (foreign-lambda int "base64_encode"
                             u8vector int int
                             u8vector int int))
(define base64e/scheme
  (let ()

    (define alphabet/default
      (list->u8vector
       (map char->integer
            (string->list
             "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"))))    

    (lambda (in in-start in-end dest dest-start dest-end)

      (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)))))