suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

* Improved precomputed vector genaration

Browse Source 
* Removed `base64-filename-safe'
* Much simplified code in ``base64-encode-stream''

svn: r11446
This commit is contained in:
Eli Barzilay 2008-08-27 03:54:57 +00:00
parent 2e8d5ed971
commit 0f1ac966f6
2 changed files with 55 additions and 109 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
collects/net/base64-sig.ss
View File

@ -1,6 +1,5 @@
#lang scheme/signature #lang scheme/signature
base64-filename-safe
base64-encode-stream base64-encode-stream
base64-decode-stream base64-decode-stream
base64-encode base64-encode

103
collects/net/base64-unit.ss
View File

@ -5,40 +5,18 @@
(import) (import)
(export base64^) (export base64^)
(define base64-digit (make-vector 256)) (define ranges '([#"AZ" 0] [#"az" 26] [#"09" 52] [#"++" 62] [#"//" 63]))
(let loop ([n 0])
(unless (= n 256)
(cond [(<= (char->integer #\A) n (char->integer #\Z))
(vector-set! base64-digit n (- n (char->integer #\A)))]
[(<= (char->integer #\a) n (char->integer #\z))
(vector-set! base64-digit n (+ 26 (- n (char->integer #\a))))]
[(<= (char->integer #\0) n (char->integer #\9))
(vector-set! base64-digit n (+ 52 (- n (char->integer #\0))))]
[(= (char->integer #\+) n)
(vector-set! base64-digit n 62)]
[(= (char->integer #\/) n)
(vector-set! base64-digit n 63)]
[else
(vector-set! base64-digit n #f)])
(loop (add1 n))))
(define digit-base64 (make-vector 64)) (define-values (base64-digit digit-base64)
(define (each-char s e pos) (let ([bd (make-vector 256 #f)] [db (make-vector 64 #f)])
(let loop ([i (char->integer s)][pos pos]) (for ([r ranges] #:when #t
(unless (> i (char->integer e)) [i (in-range (bytes-ref (car r) 0) (add1 (bytes-ref (car r) 1)))]
(vector-set! digit-base64 pos i) [n (in-naturals (cadr r))])
(loop (add1 i) (add1 pos))))) (vector-set! bd i n)
(each-char #\A #\Z 0) (vector-set! db n i))
(each-char #\a #\z 26) (values (vector->immutable-vector bd) (vector->immutable-vector db))))
(each-char #\0 #\9 52)
(each-char #\+ #\+ 62)
(each-char #\/ #\/ 63)
(define (base64-filename-safe) (define =byte (bytes-ref #"=" 0))
(vector-set! base64-digit (char->integer #\-) 62)
(vector-set! base64-digit (char->integer #\_) 63)
(each-char #\- #\- 62)
(each-char #\_ #\_ 63))
(define (base64-decode-stream in out) (define (base64-decode-stream in out)
(let loop ([waiting 0] [waiting-bits 0]) (let loop ([waiting 0] [waiting-bits 0])
@ -48,12 +26,12 @@
(let ([waiting-bits (- waiting-bits 8)]) (let ([waiting-bits (- waiting-bits 8)])
(loop (bitwise-and waiting (sub1 (arithmetic-shift 1 waiting-bits))) (loop (bitwise-and waiting (sub1 (arithmetic-shift 1 waiting-bits)))
waiting-bits))) waiting-bits)))
(let* ([c0 (read-byte in)] (let* ([c (read-byte in)]
[c (if (eof-object? c0) (char->integer #\=) c0)] [c (if (eof-object? c) =byte c)]
[v (vector-ref base64-digit c)]) [v (vector-ref base64-digit c)])
(cond [v (loop (+ (arithmetic-shift waiting 6) v) (cond [v (loop (+ (arithmetic-shift waiting 6) v)
(+ waiting-bits 6))] (+ waiting-bits 6))]
[(eq? c (char->integer #\=)) (void)] ; done [(eq? c =byte) (void)] ; done
[else (loop waiting waiting-bits)]))))) [else (loop waiting waiting-bits)])))))
(define base64-encode-stream (define base64-encode-stream
@ -67,61 +45,30 @@
[outc (lambda (n) [outc (lambda (n)
(write-byte (vector-ref digit-base64 n) out))] (write-byte (vector-ref digit-base64 n) out))]
[done (lambda (fill) [done (lambda (fill)
(let loop ([fill fill]) (for ([i (in-range 0 fill)]) (write-byte =byte out))
(unless (zero? fill)
(write-byte (char->integer #\=) out)
(loop (sub1 fill))))
(display linesep out))]) (display linesep out))])
(let loop ([pos 0]) (let loop ([pos 0])
(if (= pos 72) (if (= pos 72)
;; Insert newline ;; Insert newline
(begin (begin (display linesep out) (loop 0))
(display linesep out)
(loop 0))
;; Next group of 3 ;; Next group of 3
(let ([n (read-bytes-avail! three in)]) (let ([n (read-bytes! three in)])
(cond (if (eof-object? n)
[(eof-object? n) (unless (= pos 0) (done 0))
(unless (= pos 0) (done 0))]
[(= n 3)
;; Easy case:
(let ([a (bytes-ref three 0)] (let ([a (bytes-ref three 0)]
[b (bytes-ref three 1)] [b (if (n . >= . 2) (bytes-ref three 1) 0)]
[c (bytes-ref three 2)]) [c (if (n . >= . 3) (bytes-ref three 2) 0)])
(outc (arithmetic-shift a -2)) (outc (arithmetic-shift a -2))
(outc (+ (bitwise-and #x3f (arithmetic-shift a 4)) (outc (+ (bitwise-and #x3f (arithmetic-shift a 4))
(arithmetic-shift b -4))) (arithmetic-shift b -4)))
(outc (+ (bitwise-and #x3f (arithmetic-shift b 2)) (if (n . < . 2)
(arithmetic-shift c -6)))
(outc (bitwise-and #x3f c))
(loop (+ pos 4)))]
[else
;; Hard case: n is 1 or 2
(let ([a (bytes-ref three 0)])
(outc (arithmetic-shift a -2))
(let* ([next (if (= n 2)
(bytes-ref three 1)
(read-byte in))]
[b (if (eof-object? next)
0
next)])
(outc (+ (bitwise-and #x3f (arithmetic-shift a 4))
(arithmetic-shift b -4)))
(if (eof-object? next)
(done 2) (done 2)
;; More to go (begin (outc (+ (bitwise-and #x3f (arithmetic-shift b 2))
(let* ([next (read-byte in)]
[c (if (eof-object? next)
0
next)])
(outc (+ (bitwise-and #x3f (arithmetic-shift b 2))
(arithmetic-shift c -6))) (arithmetic-shift c -6)))
(if (eof-object? next) (if (n . < . 3)
(done 1) (done 1)
;; Finish c, loop (begin (outc (bitwise-and #x3f c))
(begin (loop (+ pos 4))))))))))))]))
(outc (bitwise-and #x3f c))
(loop (+ pos 4))))))))])))))]))
(define (base64-decode src) (define (base64-decode src)
(let ([s (open-output-bytes)]) (let ([s (open-output-bytes)])