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
;; The least significant byte of a word is the first
;; bytesl->word : (list byte*) -> word
(define (bytesl->word bs)
(let loop ([akk 0] [mul 1] [bs bs])
(if (null? bs)
(word akk)
(loop (+ akk (* (car bs) mul)) (* 256 mul) (cdr bs)))))
;; bytesl->words : (list byte) -> (list word)
(define (bytesl->words bytes)
(let loop ([bs '()] [l bytes])
(cond
[(null? l) (list (bytesl->word (reverse! bs)))]
[(< (length bs) 4) (loop (cons (car l) bs) (cdr l))]
[else (cons (bytesl->word (reverse! bs)) (loop '() l))])))
;; 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))))
;; Converts a byte string to words, writes the result into `result'
;; bytes->word-vector! : vector byte-string -> void
(define (bytes->word-vector! result l-raw)
;; assumption: always getting a byte-string with 64 places
(unless (= 64 (bytes-length l-raw))
(error 'bytes->word-vector! "something bad happened"))
(let loop ([n 15])
(when (<= 0 n)
(let ([w (vector-ref result n)] [n (* 4 n)])
(set-car! w (+ (bytes-ref l-raw (+ 2 n))
(* 256 (bytes-ref l-raw (+ 3 n)))))
(set-cdr! w (+ (bytes-ref l-raw n)
(* 256 (bytes-ref l-raw (+ 1 n))))))
(loop (sub1 n)))))
(define empty-port (open-input-bytes #""))
;; List Helper
;; block/list : a-port done-n -> (values vector a-port done-n)
;; reads 512 bytes from the port, turns them into a vector of 16 32-bit words
;; when the port is exhausted it returns #f for the port and
;; the last few bytes padded
(define (block/list a-port done)
;; read-block! : a-port done-n (vector word) -> (values vector a-port done-n)
;; reads 512 bytes from the port, writes them into the `result' vector of 16
;; 32-bit words when the port is exhausted it returns #f for the port and the
;; last few bytes padded
(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)])
(cond
;; File size was a multiple of 512 bits, or we're doing one more round
;; to add the correct padding from the short case
[(eof-object? l-raw)
(write-words! done
(if (zero? (modulo done 512/8))
;; 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
(values (list->vector (step2 (* 8 done) (step1 '())))
#f
done)
(step1 #"")
;; 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
;; bits of zeros and then the 64-bit file length (step2)
(values (list->vector (step2 (* 8 done) (make-list 448/8 0)))
#f
done))]
(make-bytes 448/8 0)))
(values #f done)]
;; We read exactly 512 bits, the algorithm proceeds as usual
[(= (bytes-length l-raw) 512/8)
(values (vector-from-string l-raw)
a-port
(+ done (bytes-length l-raw)))]
(bytes->word-vector! result l-raw)
(values a-port (+ done (bytes-length l-raw)))]
;; We read less than 512 bits, so the file has ended.
;; 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
;; automatically fall into the (eof-object? case)
[(> (* 8 (bytes-length l-raw)) 446)
(let ([done (+ done (bytes-length l-raw))])
(values (list->vector (step2 (* 8 done) (step1 (bytes->list l-raw))))
empty-port
done))]
(write-words! done (step1 l-raw))
(values empty-port done))]
;; 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
;; trailer. Add trailer and bail
[else
(let ([done (+ done (bytes-length l-raw))])
(values (list->vector (step2 (* 8 done) (step1 (bytes->list l-raw))))
#f
done))])))
;; (step2 (* 8 (bytes-length str))
;; (step1 (bytes->list str)))
(write-words! done (step1 l-raw))
(values #f done))])))
;; MD5
@ -257,30 +239,23 @@
;; 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.
;; NB: 448 bits is 14 words and 512 bits is 16 words
;; step1 : (list byte) -> (list byte)
;; step1 : bytes -> bytes
(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)])
(append message
(cons #x80 ; The byte containing the 1 bit => one less
; 0 byte to append
(make-list (quotient (- zero-bits-to-append 1) 8)
0)))))
(bytes-append message
#"\x80" ; the 1 bit byte => one less 0 bytes to append
(make-bytes (quotient (- zero-bits-to-append 1) 8) 0))))
;; Step 2 - Append Length
;; A 64 bit representation of the bit length b of the message before
;; 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
(define (step2 original-length padded-message)
(let* ([b original-length]
[lo (remainder b #x100000000)]
[hi (remainder (quotient b #x100000000) #x100000000)])
(bytesl->words (append padded-message
(word->bytesl (word lo))
(word->bytesl (word hi))))))
(define (step2 len padded-message)
(bytes-append padded-message (integer->integer-bytes len 8 #f #f)))
;; Step 3 - Initialize MD Buffer
;; These magic constants are used to initialize the loop
@ -297,6 +272,11 @@
;; Step 3 :-) (magic constants)
(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)]
[B (word #xefcdab89)]
[C (word #x98badcfe)]
@ -305,10 +285,8 @@
[done 0])
(if (not a-port)
(list A B C D)
(let-values ([(X b-port done) (block/list a-port done)])
(if (not X)
(list A B C D)
(let ([AA A] [BB B] [CC C] [DD D])
(let-values ([(b-port done) (read-block! a-port done X)]
[(AA) A] [(BB) B] [(CC) C] [(DD) D])
(define-syntax step
(syntax-rules ()
[(_ a b c d e f g h)
@ -386,7 +364,7 @@
(step B C D A II 9 3951481745 21)
;;---
(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
;; basic functions. They functions on a word bitwise, as follows.