From 0f1ac966f63de1aed54d7d4d8ee0651fded75178 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Wed, 27 Aug 2008 03:54:57 +0000 Subject: [PATCH] * Improved precomputed vector genaration * Removed `base64-filename-safe' * Much simplified code in ``base64-encode-stream'' svn: r11446 --- collects/net/base64-sig.ss | 1 - collects/net/base64-unit.ss | 163 ++++++++++++------------------------ 2 files changed, 55 insertions(+), 109 deletions(-) diff --git a/collects/net/base64-sig.ss b/collects/net/base64-sig.ss index 4dcb01d8c4..11fa936844 100644 --- a/collects/net/base64-sig.ss +++ b/collects/net/base64-sig.ss @@ -1,6 +1,5 @@ #lang scheme/signature -base64-filename-safe base64-encode-stream base64-decode-stream base64-encode diff --git a/collects/net/base64-unit.ss b/collects/net/base64-unit.ss index 55cecc63c7..126ca0b4df 100644 --- a/collects/net/base64-unit.ss +++ b/collects/net/base64-unit.ss @@ -5,123 +5,70 @@ (import) (export base64^) -(define base64-digit (make-vector 256)) -(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 ranges '([#"AZ" 0] [#"az" 26] [#"09" 52] [#"++" 62] [#"//" 63])) -(define digit-base64 (make-vector 64)) -(define (each-char s e pos) - (let loop ([i (char->integer s)][pos pos]) - (unless (> i (char->integer e)) - (vector-set! digit-base64 pos i) - (loop (add1 i) (add1 pos))))) -(each-char #\A #\Z 0) -(each-char #\a #\z 26) -(each-char #\0 #\9 52) -(each-char #\+ #\+ 62) -(each-char #\/ #\/ 63) +(define-values (base64-digit digit-base64) + (let ([bd (make-vector 256 #f)] [db (make-vector 64 #f)]) + (for ([r ranges] #:when #t + [i (in-range (bytes-ref (car r) 0) (add1 (bytes-ref (car r) 1)))] + [n (in-naturals (cadr r))]) + (vector-set! bd i n) + (vector-set! db n i)) + (values (vector->immutable-vector bd) (vector->immutable-vector db)))) -(define (base64-filename-safe) - (vector-set! base64-digit (char->integer #\-) 62) - (vector-set! base64-digit (char->integer #\_) 63) - (each-char #\- #\- 62) - (each-char #\_ #\_ 63)) +(define =byte (bytes-ref #"=" 0)) (define (base64-decode-stream in out) - (let loop ([waiting 0][waiting-bits 0]) + (let loop ([waiting 0] [waiting-bits 0]) (if (>= waiting-bits 8) - (begin - (write-byte (arithmetic-shift waiting (- 8 waiting-bits)) out) - (let ([waiting-bits (- waiting-bits 8)]) - (loop (bitwise-and waiting (sub1 (arithmetic-shift 1 waiting-bits))) - waiting-bits))) - (let* ([c0 (read-byte in)] - [c (if (eof-object? c0) (char->integer #\=) c0)] - [v (vector-ref base64-digit c)]) - (cond [v (loop (+ (arithmetic-shift waiting 6) v) - (+ waiting-bits 6))] - [(eq? c (char->integer #\=)) (void)] ; done - [else (loop waiting waiting-bits)]))))) + (begin + (write-byte (arithmetic-shift waiting (- 8 waiting-bits)) out) + (let ([waiting-bits (- waiting-bits 8)]) + (loop (bitwise-and waiting (sub1 (arithmetic-shift 1 waiting-bits))) + waiting-bits))) + (let* ([c (read-byte in)] + [c (if (eof-object? c) =byte c)] + [v (vector-ref base64-digit c)]) + (cond [v (loop (+ (arithmetic-shift waiting 6) v) + (+ waiting-bits 6))] + [(eq? c =byte) (void)] ; done + [else (loop waiting waiting-bits)]))))) (define base64-encode-stream (case-lambda - [(in out) (base64-encode-stream in out #"\n")] - [(in out linesep) - ;; Process input 3 characters at a time, because 18 bits - ;; is divisible by both 6 and 8, and 72 (the line length) - ;; is divisible by 3. - (let ([three (make-bytes 3)] - [outc (lambda (n) - (write-byte (vector-ref digit-base64 n) out))] - [done (lambda (fill) - (let loop ([fill fill]) - (unless (zero? fill) - (write-byte (char->integer #\=) out) - (loop (sub1 fill)))) - (display linesep out))]) - (let loop ([pos 0]) - (if (= pos 72) - ;; Insert newline - (begin - (display linesep out) - (loop 0)) - ;; Next group of 3 - (let ([n (read-bytes-avail! three in)]) - (cond - [(eof-object? n) - (unless (= pos 0) (done 0))] - [(= n 3) - ;; Easy case: - (let ([a (bytes-ref three 0)] - [b (bytes-ref three 1)] - [c (bytes-ref three 2)]) - (outc (arithmetic-shift a -2)) - (outc (+ (bitwise-and #x3f (arithmetic-shift a 4)) - (arithmetic-shift b -4))) - (outc (+ (bitwise-and #x3f (arithmetic-shift b 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) - ;; More to go - (let* ([next (read-byte in)] - [c (if (eof-object? next) - 0 - next)]) - (outc (+ (bitwise-and #x3f (arithmetic-shift b 2)) + [(in out) (base64-encode-stream in out #"\n")] + [(in out linesep) + ;; Process input 3 characters at a time, because 18 bits + ;; is divisible by both 6 and 8, and 72 (the line length) + ;; is divisible by 3. + (let ([three (make-bytes 3)] + [outc (lambda (n) + (write-byte (vector-ref digit-base64 n) out))] + [done (lambda (fill) + (for ([i (in-range 0 fill)]) (write-byte =byte out)) + (display linesep out))]) + (let loop ([pos 0]) + (if (= pos 72) + ;; Insert newline + (begin (display linesep out) (loop 0)) + ;; Next group of 3 + (let ([n (read-bytes! three in)]) + (if (eof-object? n) + (unless (= pos 0) (done 0)) + (let ([a (bytes-ref three 0)] + [b (if (n . >= . 2) (bytes-ref three 1) 0)] + [c (if (n . >= . 3) (bytes-ref three 2) 0)]) + (outc (arithmetic-shift a -2)) + (outc (+ (bitwise-and #x3f (arithmetic-shift a 4)) + (arithmetic-shift b -4))) + (if (n . < . 2) + (done 2) + (begin (outc (+ (bitwise-and #x3f (arithmetic-shift b 2)) (arithmetic-shift c -6))) - (if (eof-object? next) - (done 1) - ;; Finish c, loop - (begin - (outc (bitwise-and #x3f c)) - (loop (+ pos 4))))))))])))))])) + (if (n . < . 3) + (done 1) + (begin (outc (bitwise-and #x3f c)) + (loop (+ pos 4))))))))))))])) (define (base64-decode src) (let ([s (open-output-bytes)])