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

reuse the same words vector on every block, x1.5 speedup

Browse Source 
svn: r2914
This commit is contained in:
Eli Barzilay 2006-05-11 22:42:17 +00:00
parent 71ba559f96
commit 1e760c0546
1 changed files with 130 additions and 152 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

116
collects/mzlib/md5.ss
View File

@ -161,83 +161,65 @@
;; Bytes and words ;; Bytes and words
;; The least significant byte of a word is the first ;; The least significant byte of a word is the first
;; bytesl->word : (list byte*) -> word ;; Converts a byte string to words, writes the result into `result'
(define (bytesl->word bs) ;; bytes->word-vector! : vector byte-string -> void
(let loop ([akk 0] [mul 1] [bs bs]) (define (bytes->word-vector! result l-raw)
(if (null? bs) ;; assumption: always getting a byte-string with 64 places
(word akk) (unless (= 64 (bytes-length l-raw))
(loop (+ akk (* (car bs) mul)) (* 256 mul) (cdr bs))))) (error 'bytes->word-vector! "something bad happened"))
(let loop ([n 15])
;; bytesl->words : (list byte) -> (list word) (when (<= 0 n)
(define (bytesl->words bytes) (let ([w (vector-ref result n)] [n (* 4 n)])
(let loop ([bs '()] [l bytes]) (set-car! w (+ (bytes-ref l-raw (+ 2 n))
(cond (* 256 (bytes-ref l-raw (+ 3 n)))))
[(null? l) (list (bytesl->word (reverse! bs)))] (set-cdr! w (+ (bytes-ref l-raw n)
[(< (length bs) 4) (loop (cons (car l) bs) (cdr l))] (* 256 (bytes-ref l-raw (+ 1 n))))))
[else (cons (bytesl->word (reverse! bs)) (loop '() l))]))) (loop (sub1 n)))))
;; make-list : int any -> (list any)
(define (make-list n x)
(let loop ([n n] [r '()])
(if (zero? n)
r
(loop (sub1 n) (cons x r)))))
;; Converts a byte string to a more useful vector
;; vector-from-string: byte string -> (vector ...)
(define (vector-from-string l-raw)
(list->vector (bytesl->words (bytes->list l-raw))))
(define empty-port (open-input-bytes #"")) (define empty-port (open-input-bytes #""))
;; List Helper ;; List Helper
;; block/list : a-port done-n -> (values vector a-port done-n) ;; read-block! : a-port done-n (vector word) -> (values vector a-port done-n)
;; reads 512 bytes from the port, turns them into a vector of 16 32-bit words ;; reads 512 bytes from the port, writes them into the `result' vector of 16
;; when the port is exhausted it returns #f for the port and ;; 32-bit words when the port is exhausted it returns #f for the port and the
;; the last few bytes padded ;; last few bytes padded
(define (block/list a-port done) (define (read-block! a-port done result)
(define (write-words! done buf)
(bytes->word-vector! result (step2 (* 8 done) buf)))
(let ([l-raw (read-bytes 512/8 a-port)]) (let ([l-raw (read-bytes 512/8 a-port)])
(cond (cond
;; File size was a multiple of 512 bits, or we're doing one more round ;; File size was a multiple of 512 bits, or we're doing one more round
;; to add the correct padding from the short case ;; to add the correct padding from the short case
[(eof-object? l-raw) [(eof-object? l-raw)
(write-words! done
(if (zero? (modulo done 512/8)) (if (zero? (modulo done 512/8))
;; The file is a multiple of 512 or was 0, so there hasn't been a ;; The file is a multiple of 512 or was 0, so there hasn't been a
;; chance to add the 1-bit pad, so we need to do a full pad ;; chance to add the 1-bit pad, so we need to do a full pad
(values (list->vector (step2 (* 8 done) (step1 '()))) (step1 #"")
#f
done)
;; We only enter this block when the previous block didn't have ;; We only enter this block when the previous block didn't have
;; enough room to fit the 64-bit file length, so we just add 448 ;; enough room to fit the 64-bit file length, so we just add 448
;; bits of zeros and then the 64-bit file length (step2) ;; bits of zeros and then the 64-bit file length (step2)
(values (list->vector (step2 (* 8 done) (make-list 448/8 0))) (make-bytes 448/8 0)))
#f (values #f done)]
done))]
;; We read exactly 512 bits, the algorithm proceeds as usual ;; We read exactly 512 bits, the algorithm proceeds as usual
[(= (bytes-length l-raw) 512/8) [(= (bytes-length l-raw) 512/8)
(values (vector-from-string l-raw) (bytes->word-vector! result l-raw)
a-port (values a-port (+ done (bytes-length l-raw)))]
(+ done (bytes-length l-raw)))]
;; We read less than 512 bits, so the file has ended. ;; We read less than 512 bits, so the file has ended.
;; However, we don't have enough room to add the correct trailer, ;; However, we don't have enough room to add the correct trailer,
;; so we add what we can, then go for one more round which will ;; so we add what we can, then go for one more round which will
;; automatically fall into the (eof-object? case) ;; automatically fall into the (eof-object? case)
[(> (* 8 (bytes-length l-raw)) 446) [(> (* 8 (bytes-length l-raw)) 446)
(let ([done (+ done (bytes-length l-raw))]) (let ([done (+ done (bytes-length l-raw))])
(values (list->vector (step2 (* 8 done) (step1 (bytes->list l-raw)))) (write-words! done (step1 l-raw))
empty-port (values empty-port done))]
done))]
;; Returning a longer vector than we should, luckily it doesn't matter. ;; Returning a longer vector than we should, luckily it doesn't matter.
;; We read less than 512 bits and there is enough room for the correct ;; We read less than 512 bits and there is enough room for the correct
;; trailer. Add trailer and bail ;; trailer. Add trailer and bail
[else [else
(let ([done (+ done (bytes-length l-raw))]) (let ([done (+ done (bytes-length l-raw))])
(values (list->vector (step2 (* 8 done) (step1 (bytes->list l-raw)))) (write-words! done (step1 l-raw))
#f (values #f done))])))
done))])))
;; (step2 (* 8 (bytes-length str))
;; (step1 (bytes->list str)))
;; MD5 ;; MD5
@ -257,30 +239,23 @@
;; The message is padded so the length (in bits) becomes 448 modulo 512. ;; The message is padded so the length (in bits) becomes 448 modulo 512.
;; We allways append a 1 bit and then append the proper numbber of 0's. ;; We allways append a 1 bit and then append the proper numbber of 0's.
;; NB: 448 bits is 14 words and 512 bits is 16 words ;; NB: 448 bits is 14 words and 512 bits is 16 words
;; step1 : (list byte) -> (list byte) ;; step1 : bytes -> bytes
(define (step1 message) (define (step1 message)
(let* ([z-b-t-a (modulo (- 448 (* 8 (length message))) 512)] (let* ([z-b-t-a (modulo (- 448 (* 8 (bytes-length message))) 512)]
[zero-bits-to-append (if (zero? z-b-t-a) 512 z-b-t-a)]) [zero-bits-to-append (if (zero? z-b-t-a) 512 z-b-t-a)])
(append message (bytes-append message
(cons #x80 ; The byte containing the 1 bit => one less #"\x80" ; the 1 bit byte => one less 0 bytes to append
; 0 byte to append (make-bytes (quotient (- zero-bits-to-append 1) 8) 0))))
(make-list (quotient (- zero-bits-to-append 1) 8)
0)))))
;; Step 2 - Append Length ;; Step 2 - Append Length
;; A 64 bit representation of the bit length b of the message before ;; A 64 bit representation of the bit length b of the message before
;; the padding of step 1 is appended. Lower word first. ;; the padding of step 1 is appended. Lower word first.
;; step2 : number (list byte) -> (list word) ;; step2 : number bytes -> bytes
;; org-len is the length of the original message in number of bits ;; org-len is the length of the original message in number of bits
(define (step2 original-length padded-message) (define (step2 len padded-message)
(let* ([b original-length] (bytes-append padded-message (integer->integer-bytes len 8 #f #f)))
[lo (remainder b #x100000000)]
[hi (remainder (quotient b #x100000000) #x100000000)])
(bytesl->words (append padded-message
(word->bytesl (word lo))
(word->bytesl (word hi))))))
;; Step 3 - Initialize MD Buffer ;; Step 3 - Initialize MD Buffer
;; These magic constants are used to initialize the loop ;; These magic constants are used to initialize the loop
@ -297,6 +272,11 @@
;; Step 3 :-) (magic constants) ;; Step 3 :-) (magic constants)
(define (step4 a-port) (define (step4 a-port)
;; X is always a vector of 16 words (it changes in read-block!)
(define X
(vector (cons 0 0) (cons 0 0) (cons 0 0) (cons 0 0) (cons 0 0) (cons 0 0)
(cons 0 0) (cons 0 0) (cons 0 0) (cons 0 0) (cons 0 0) (cons 0 0)
(cons 0 0) (cons 0 0) (cons 0 0) (cons 0 0)))
(let loop ([A (word #x67452301)] (let loop ([A (word #x67452301)]
[B (word #xefcdab89)] [B (word #xefcdab89)]
[C (word #x98badcfe)] [C (word #x98badcfe)]
@ -305,10 +285,8 @@
[done 0]) [done 0])
(if (not a-port) (if (not a-port)
(list A B C D) (list A B C D)
(let-values ([(X b-port done) (block/list a-port done)]) (let-values ([(b-port done) (read-block! a-port done X)]
(if (not X) [(AA) A] [(BB) B] [(CC) C] [(DD) D])
(list A B C D)
(let ([AA A] [BB B] [CC C] [DD D])
(define-syntax step (define-syntax step
(syntax-rules () (syntax-rules ()
[(_ a b c d e f g h) [(_ a b c d e f g h)
@ -386,7 +364,7 @@
(step B C D A II 9 3951481745 21) (step B C D A II 9 3951481745 21)
;;--- ;;---
(loop (word+ A AA) (word+ B BB) (word+ C CC) (word+ D DD) (loop (word+ A AA) (word+ B BB) (word+ C CC) (word+ D DD)
b-port done))))))) b-port done)))))
;; Each round consists of the application of the following ;; Each round consists of the application of the following
;; basic functions. They functions on a word bitwise, as follows. ;; basic functions. They functions on a word bitwise, as follows.