aliens/tekuti
1
0
Fork 0
Code Activity

base64 efficiency hacks

Browse source 
* tekuti/base64.scm (bytevector-map-n-to-m): Use multiple values.
  (base64-encode): Inline the map-3-to-4 definition, and use multiple
  values.
  (base64-decode): Likewise, with map-4-to-3.
This commit is contained in:
Andy Wingo 2010-10-14 12:03:39 +02:00
parent 1b9e370805
commit d3cf39b5c0
1 changed files with 19 additions and 17 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

34
tekuti/base64.scm
View file

@ -60,28 +60,27 @@
(lambda (stx) (lambda (stx)
(syntax-case stx () (syntax-case stx ()
((_ n m) ((_ n m)
(with-syntax (((byte-arg ...) (with-syntax (((byte-in ...)
(map (lambda (x) (map (lambda (x)
#`(bytevector-u8-ref s (+ i #,x))) #`(bytevector-u8-ref s (+ i #,x)))
(iota (syntax->datum #'n))))) (iota (syntax->datum #'n))))
((byte-out ...)
(generate-temporaries (iota (syntax->datum #'m))))
((byte-out-idx ...)
(iota (syntax->datum #'m))))
#'(lambda (proc s) #'(lambda (proc s)
(let* ((len (bytevector-length s)) (let* ((len (bytevector-length s))
(out (make-bytevector (* len (/ m n))))) (out (make-bytevector (* len (/ m n)))))
(let lp ((i 0) (j 0)) (let lp ((i 0) (j 0))
(cond (cond
((< i len) ((< i len)
(let inner ((k 0) (bytes (proc byte-arg ...))) (call-with-values (lambda () (proc byte-in ...))
(if (not (null? bytes)) (lambda (byte-out ...)
(begin (bytevector-u8-set! out (+ j k) (car bytes)) (bytevector-u8-set! out (+ j byte-out-idx) byte-out)
(inner (+ k 1) (cdr bytes))))) ...))
(lp (+ i n) (+ j m))) (lp (+ i n) (+ j m)))
(else out)))))))))) (else out))))))))))
(define bytevector-map-3-to-4
(bytevector-map-n-to-m 3 4))
(define bytevector-map-4-to-3
(bytevector-map-n-to-m 4 3))
(define (bytevector-fill-range! bv start end u8) (define (bytevector-fill-range! bv start end u8)
(do ((i (- end 1) (- i 1))) (do ((i (- end 1) (- i 1)))
((< i start)) ((< i start))
@ -95,11 +94,13 @@
(define (base64-encode bv) (define (base64-encode bv)
(let* ((npad (remainder (- 3 (remainder (bytevector-length bv) 3)) 3)) (let* ((npad (remainder (- 3 (remainder (bytevector-length bv) 3)) 3))
(out (bytevector-map-3-to-4 (out ((bytevector-map-n-to-m 3 4)
(lambda (x y z) (lambda (x y z)
(let ((n (logior (ash x 16) (ash y 8) z))) (let ((n (logior (ash x 16) (ash y 8) z)))
(map int->b64-byte (values (int->b64-byte (ash n -18))
(list (ash n -18) (ash n -12) (ash n -6) n)))) (int->b64-byte (ash n -12))
(int->b64-byte (ash n -6))
(int->b64-byte n))))
(bytevector-pad bv (+ (bytevector-length bv) npad) 0)))) (bytevector-pad bv (+ (bytevector-length bv) npad) 0))))
(bytevector-fill-range! out (bytevector-fill-range! out
(- (bytevector-length out) npad) (- (bytevector-length out) npad)
@ -124,13 +125,14 @@
(define (base64-decode str) (define (base64-decode str)
(let* ((bv (string->utf8 str)) (let* ((bv (string->utf8 str))
(npad (b64-bv-npad bv)) (npad (b64-bv-npad bv))
(out (bytevector-map-4-to-3 (out ((bytevector-map-n-to-m 4 3)
(lambda (w x y z) (lambda (w x y z)
(let ((n (logior (ash (b64-byte->int w) 18) (let ((n (logior (ash (b64-byte->int w) 18)
(ash (b64-byte->int x) 12) (ash (b64-byte->int x) 12)
(ash (b64-byte->int y) 6) (ash (b64-byte->int y) 6)
(b64-byte->int z)))) (b64-byte->int z))))
(list (ash n -16) (logand (ash n -8) 255) (values (ash n -16)
(logand (ash n -8) 255)
(logand n 255)))) (logand n 255))))
(bytevector-copy/padding bv npad (char->integer #\A)))) (bytevector-copy/padding bv npad (char->integer #\A))))
(result (make-bytevector (- (bytevector-length out) npad)))) (result (make-bytevector (- (bytevector-length out) npad))))