? patch
? modules/sha1
? modules/base64/mytest.tcl
Index: modules/base64/ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/base64/ChangeLog,v
retrieving revision 1.7
diff -r1.7 ChangeLog
0a1,10
> 2001-06-02 Miguel Sofer <[email protected]>
>
> * base64.tcl: Greatly increased speed, obtained by: using lists
> instead of arrays, splitting the input with [binary scan], taking
> the bytes to be encoded three at a time, and reformulting the
> decoding algorithm to be purely arithmetic. Improved backwards
> compatibility, now runs with Tcl8.0.
>
> Nudged version to 2.2
>
Index: modules/base64/base64.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/base64/base64.tcl,v
retrieving revision 1.8
diff -r1.8 base64.tcl
15a16
> # Version 2.2 is much faster, Tcl8.0 compatible
18,21c19,24
< variable i 0
< variable char
< variable base64
< variable base64_en
---
> variable base64 {}
> variable base64_en {}
>
> # We create the auxiliary array base64_tmp, it will be unset later.
>
> set i 0
23,26c26,29
< a b c d e f g h i j k l m n o p q r s t u v w x y z \
< 0 1 2 3 4 5 6 7 8 9 + /} {
< set base64($char) $i
< set base64_en($i) $char
---
> a b c d e f g h i j k l m n o p q r s t u v w x y z \
> 0 1 2 3 4 5 6 7 8 9 + /} {
> set base64_tmp($char) $i
> lappend base64_en $char
29a33,59
> #
> # Create base64 as list: to code for instance C<->3, specify
> # that [lindex $base64 67] be 3 (C is 67 in ascii); non-coded
> # ascii chars get a {}. we later use the fact that lindex on a
> # non-existing index returns {}, and that [expr {} < 0] is true
> #
>
> # the last ascii char is 'z'
> scan z %c len
> for {set i 0} {$i <= $len} {incr i} {
> set char [format %c $i]
> set val {}
> if {[info exists base64_tmp($char)]} {
> set val $base64_tmp($char)
> } else {
> set val {}
> }
> lappend base64 $val
> }
>
> # code the character "=" as -1; used to signal end of message
> scan = %c i
> set base64 [lreplace $base64 $i $i -1]
>
> # remove unneeded variables
> unset base64_tmp i char len val
>
47c77
< variable base64_en
---
> set base64_en $::base64::base64_en
76c106,107
< if { ![string is integer -strict $maxlen] } {
---
> # [string is] requires Tcl8.2; this works with 8.0 too
> if {[catch {expr {$maxlen % 2}}]} {
85c116,121
< foreach {c} [split $string {}] {
---
>
>
> # Process the input bytes 3-by-3
>
> binary scan $string c* X
> foreach {x y z} $X {
92,110c128,149
< scan $c %c x
< switch [incr state] {
< 1 { append result $base64_en([expr {($x >>2) & 0x3F}]) }
< 2 { append result \
< $base64_en([expr {(($old << 4) & 0x30) | (($x >> 4) & 0xF)}]) }
< 3 { append result \
< $base64_en([expr {(($old << 2) & 0x3C) | (($x >> 6) & 0x3)}])
< append result $base64_en([expr {($x & 0x3F)}])
< incr length
< set state 0}
< }
< set old $x
< incr length
< }
< set x 0
< switch $state {
< 0 { # OK }
< 1 { append result $base64_en([expr {(($old << 4) & 0x30)}])== }
< 2 { append result $base64_en([expr {(($old << 2) & 0x3C)}])= }
---
>
> append result [lindex $base64_en [expr {($x >>2) & 0x3F}]]
> if {$y != {}} {
> append result [lindex $base64_en [expr {(($x << 4) & 0x30) | (($y >> 4) & 0xF)}]]
> if {$z != {}} {
> append result \
> [lindex $base64_en [expr {(($y << 2) & 0x3C) | (($z >> 6) & 0x3)}]]
> append result [lindex $base64_en [expr {($z & 0x3F)}]]
> } else {
> set state 2
> break
> }
> } else {
> set state 1
> break
> }
> incr length 4
> }
> if {$state == 1} {
> append result [lindex $base64_en [expr {(($x << 4) & 0x30)}]]==
> } elseif {$state == 2} {
> append result [lindex $base64_en [expr {(($y << 2) & 0x3C)}]]=
127,137c166
< variable base64
<
< set output {}
< set group 0
< set j 18
< foreach char [split $string {}] {
< if {[string compare $char "="]} {
< # RFC 2045 says that line breaks and other characters not part
< # of the Base64 alphabet must be ignored, and that the decoder
< # can optionally emit a warning or reject the message. We opt
< # not to do so, but to just ignore the character.
---
> set base64 $::base64::base64
139,150c168,180
< if { ![info exists base64($char)] } {
< continue
< }
< set bits $base64($char)
< set group [expr {$group | ($bits << $j)}]
< if {[incr j -6] < 0} {
< scan [format %06x $group] %2x%2x%2x a b c
< append output [format %c%c%c $a $b $c]
< set group 0
< set j 18
< }
< } else {
---
> binary scan $string c* X
> foreach x $X {
> set bits [lindex $base64 $x]
> if {$bits >= 0} {
> if {[llength [lappend nums $bits]] == 4} {
> foreach {v w x y} $nums break
> set a [expr {($v << 2) | ($w >> 4)}]
> set b [expr {(($w & 0xF) << 4) | ($x >> 2)}]
> set c [expr {(($x & 0x3) << 6) | $y}]
> append output [binary format ccc $a $b $c]
> set nums {}
> }
> } elseif {$bits == -1} {
153,154c183,184
< # padding characters. If j is 6, we have 12 bits of input
< # (enough for 1 8-bit output). If j is 0, we have 18 bits of
---
> # padding characters. If x=={}, we have 12 bits of input
> # (enough for 1 8-bit output). If x!={}, we have 18 bits of
156,166c186,195
< # It is crucial to scan three hex digits even though we
< # discard c - older code used %04x and scanned 2 hex digits
< # but really ended up generating 5 or 6 (not 4!) digits and
< # resulted in alignment errors.
<
< scan [format %06x $group] %2x%2x%2x a b c
< if {$j == 6} {
< append output [format %c $a]
< } elseif {$j == 0} {
< append output [format %c%c $a $b]
< }
---
>
> foreach {v w x} $nums break
> set a [expr {($v << 2) | (($w & 0x30) >> 4)}]
>
> if {$x == {}} {
> append output [binary format c $a ]
> } else {
> set b [expr {(($w & 0xF) << 4) | (($x & 0x3C) >> 2)}]
> append output [binary format cc $a $b]
> }
167a197,202
> } else {
> # RFC 2045 says that line breaks and other characters not part
> # of the Base64 alphabet must be ignored, and that the decoder
> # can optionally emit a warning or reject the message. We opt
> # not to do so, but to just ignore the character.
> continue
173c208
< package provide base64 2.1
---
> package provide base64 2.2
Index: modules/md5/ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/md5/ChangeLog,v
retrieving revision 1.2
diff -r1.2 ChangeLog
0a1,8
> 2001-06-02 Miguel Sofer <[email protected]>
>
> * md5.tcl: modified the pure Tcl code to run almost 5 times
> faster, by inlining (via regsub) function calls and using local
> variables instead of arrays.
>
> Bumped version number to 1.4
>
Index: modules/md5/md5.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/md5/md5.tcl,v
retrieving revision 1.2
diff -r1.2 md5.tcl
20a21,22
> #
> # Modified by Miguel Sofer to use inlines and simple variables
81,85c83
< variable i
< variable t
< variable T
<
< set i 0
---
> variable T {}
107,108c105
< incr i
< set T($i) [expr {$t}]
---
> lappend T [expr $t]
159,161c156,172
< proc ::md5::md5 {msg} {
< variable T
<
---
> #
> # We just define the body of md5pure::md5 here; later we
> # regsub to inline a few function calls for speed
> #
>
> set ::md5::md5body {
>
> # put the Ts into local variables for speed
>
> foreach {T01 T02 T03 T04 T05 T06 T07 T08 T09 T10
> T11 T12 T13 T14 T15 T16 T17 T18 T19 T20
> T21 T22 T23 T24 T25 T26 T27 T28 T29 T30
> T31 T32 T33 T34 T35 T36 T37 T38 T39 T40
> T41 T42 T43 T44 T45 T46 T47 T48 T49 T50
> T51 T52 T53 T54 T55 T56 T57 T58 T59 T60
> T61 T62 T63 T64 } $::md5::T break
>
180c191
<
---
>
189c200
<
---
>
194,197c205,208
< set A [expr {0x67452301}]
< set B [expr {0xefcdab89}]
< set C [expr {0x98badcfe}]
< set D [expr {0x10325476}]
---
> set A [expr 0x67452301]
> set B [expr 0xefcdab89]
> set C [expr 0x98badcfe]
> set D [expr 0x10325476]
207,211c218
< set i 0
< foreach b $blocks {
< set M($i) $b
< incr i
< }
---
> set len [llength $blocks]
213,219c220,222
< set blockLen [array size M]
<
< for {set i 0} {$i < $blockLen/16} {incr i} {
< # copy block i into X
< for {set j 0} {$j<16} {incr j} {
< set X($j) $M([expr {$i*16+$j}])
< }
---
> # loop over the message taking 16 blocks at a time
>
> foreach {X0 X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 X15} $blocks {
231,234c234,237
< set A [expr {$B + [<<< [expr {$A + [F $B $C $D] + $X(0) + $T(1) }] 7]}]
< set D [expr {$A + [<<< [expr {$D + [F $A $B $C] + $X(1) + $T(2) }] 12]}]
< set C [expr {$D + [<<< [expr {$C + [F $D $A $B] + $X(2) + $T(3) }] 17]}]
< set B [expr {$C + [<<< [expr {$B + [F $C $D $A] + $X(3) + $T(4) }] 22]}]
---
> set A [expr {$B + [<<< [expr {$A + [F $B $C $D] + $X0 + $T01}] 7]}]
> set D [expr {$A + [<<< [expr {$D + [F $A $B $C] + $X1 + $T02}] 12]}]
> set C [expr {$D + [<<< [expr {$C + [F $D $A $B] + $X2 + $T03}] 17]}]
> set B [expr {$C + [<<< [expr {$B + [F $C $D $A] + $X3 + $T04}] 22]}]
236,239c239,242
< set A [expr {$B + [<<< [expr {$A + [F $B $C $D] + $X(4) + $T(5) }] 7]}]
< set D [expr {$A + [<<< [expr {$D + [F $A $B $C] + $X(5) + $T(6) }] 12]}]
< set C [expr {$D + [<<< [expr {$C + [F $D $A $B] + $X(6) + $T(7) }] 17]}]
< set B [expr {$C + [<<< [expr {$B + [F $C $D $A] + $X(7) + $T(8) }] 22]}]
---
> set A [expr {$B + [<<< [expr {$A + [F $B $C $D] + $X4 + $T05}] 7]}]
> set D [expr {$A + [<<< [expr {$D + [F $A $B $C] + $X5 + $T06}] 12]}]
> set C [expr {$D + [<<< [expr {$C + [F $D $A $B] + $X6 + $T07}] 17]}]
> set B [expr {$C + [<<< [expr {$B + [F $C $D $A] + $X7 + $T08}] 22]}]
241,244c244,247
< set A [expr {$B + [<<< [expr {$A + [F $B $C $D] + $X(8) + $T(9) }] 7]}]
< set D [expr {$A + [<<< [expr {$D + [F $A $B $C] + $X(9) + $T(10)}] 12]}]
< set C [expr {$D + [<<< [expr {$C + [F $D $A $B] + $X(10) + $T(11)}] 17]}]
< set B [expr {$C + [<<< [expr {$B + [F $C $D $A] + $X(11) + $T(12)}] 22]}]
---
> set A [expr {$B + [<<< [expr {$A + [F $B $C $D] + $X8 + $T09}] 7]}]
> set D [expr {$A + [<<< [expr {$D + [F $A $B $C] + $X9 + $T10}] 12]}]
> set C [expr {$D + [<<< [expr {$C + [F $D $A $B] + $X10 + $T11}] 17]}]
> set B [expr {$C + [<<< [expr {$B + [F $C $D $A] + $X11 + $T12}] 22]}]
246,249c249,252
< set A [expr {$B + [<<< [expr {$A + [F $B $C $D] + $X(12) + $T(13)}] 7]}]
< set D [expr {$A + [<<< [expr {$D + [F $A $B $C] + $X(13) + $T(14)}] 12]}]
< set C [expr {$D + [<<< [expr {$C + [F $D $A $B] + $X(14) + $T(15)}] 17]}]
< set B [expr {$C + [<<< [expr {$B + [F $C $D $A] + $X(15) + $T(16)}] 22]}]
---
> set A [expr {$B + [<<< [expr {$A + [F $B $C $D] + $X12 + $T13}] 7]}]
> set D [expr {$A + [<<< [expr {$D + [F $A $B $C] + $X13 + $T14}] 12]}]
> set C [expr {$D + [<<< [expr {$C + [F $D $A $B] + $X14 + $T15}] 17]}]
> set B [expr {$C + [<<< [expr {$B + [F $C $D $A] + $X15 + $T16}] 22]}]
256,259c259,262
< set A [expr {$B + [<<< [expr {$A + [G $B $C $D] + $X(1) + $T(17)}] 5]}]
< set D [expr {$A + [<<< [expr {$D + [G $A $B $C] + $X(6) + $T(18)}] 9]}]
< set C [expr {$D + [<<< [expr {$C + [G $D $A $B] + $X(11) + $T(19)}] 14]}]
< set B [expr {$C + [<<< [expr {$B + [G $C $D $A] + $X(0) + $T(20)}] 20]}]
---
> set A [expr {$B + [<<< [expr {$A + [G $B $C $D] + $X1 + $T17}] 5]}]
> set D [expr {$A + [<<< [expr {$D + [G $A $B $C] + $X6 + $T18}] 9]}]
> set C [expr {$D + [<<< [expr {$C + [G $D $A $B] + $X11 + $T19}] 14]}]
> set B [expr {$C + [<<< [expr {$B + [G $C $D $A] + $X0 + $T20}] 20]}]
261,264c264,267
< set A [expr {$B + [<<< [expr {$A + [G $B $C $D] + $X(5) + $T(21)}] 5]}]
< set D [expr {$A + [<<< [expr {$D + [G $A $B $C] + $X(10) + $T(22)}] 9]}]
< set C [expr {$D + [<<< [expr {$C + [G $D $A $B] + $X(15) + $T(23)}] 14]}]
< set B [expr {$C + [<<< [expr {$B + [G $C $D $A] + $X(4) + $T(24)}] 20]}]
---
> set A [expr {$B + [<<< [expr {$A + [G $B $C $D] + $X5 + $T21}] 5]}]
> set D [expr {$A + [<<< [expr {$D + [G $A $B $C] + $X10 + $T22}] 9]}]
> set C [expr {$D + [<<< [expr {$C + [G $D $A $B] + $X15 + $T23}] 14]}]
> set B [expr {$C + [<<< [expr {$B + [G $C $D $A] + $X4 + $T24}] 20]}]
266,269c269,272
< set A [expr {$B + [<<< [expr {$A + [G $B $C $D] + $X(9) + $T(25)}] 5]}]
< set D [expr {$A + [<<< [expr {$D + [G $A $B $C] + $X(14) + $T(26)}] 9]}]
< set C [expr {$D + [<<< [expr {$C + [G $D $A $B] + $X(3) + $T(27)}] 14]}]
< set B [expr {$C + [<<< [expr {$B + [G $C $D $A] + $X(8) + $T(28)}] 20]}]
---
> set A [expr {$B + [<<< [expr {$A + [G $B $C $D] + $X9 + $T25}] 5]}]
> set D [expr {$A + [<<< [expr {$D + [G $A $B $C] + $X14 + $T26}] 9]}]
> set C [expr {$D + [<<< [expr {$C + [G $D $A $B] + $X3 + $T27}] 14]}]
> set B [expr {$C + [<<< [expr {$B + [G $C $D $A] + $X8 + $T28}] 20]}]
271,274c274,277
< set A [expr {$B + [<<< [expr {$A + [G $B $C $D] + $X(13) + $T(29)}] 5]}]
< set D [expr {$A + [<<< [expr {$D + [G $A $B $C] + $X(2) + $T(30)}] 9]}]
< set C [expr {$D + [<<< [expr {$C + [G $D $A $B] + $X(7) + $T(31)}] 14]}]
< set B [expr {$C + [<<< [expr {$B + [G $C $D $A] + $X(12) + $T(32)}] 20]}]
---
> set A [expr {$B + [<<< [expr {$A + [G $B $C $D] + $X13 + $T29}] 5]}]
> set D [expr {$A + [<<< [expr {$D + [G $A $B $C] + $X2 + $T30}] 9]}]
> set C [expr {$D + [<<< [expr {$C + [G $D $A $B] + $X7 + $T31}] 14]}]
> set B [expr {$C + [<<< [expr {$B + [G $C $D $A] + $X12 + $T32}] 20]}]
281,289c284,292
< set A [expr {$B + [<<< [expr {$A + [H $B $C $D] + $X(5) + $T(33)}] 4]}]
< set D [expr {$A + [<<< [expr {$D + [H $A $B $C] + $X(8) + $T(34)}] 11]}]
< set C [expr {$D + [<<< [expr {$C + [H $D $A $B] + $X(11) + $T(35)}] 16]}]
< set B [expr {$C + [<<< [expr {$B + [H $C $D $A] + $X(14) + $T(36)}] 23]}]
< # [ABCD 1 4 37] [DABC 4 11 38] [CDAB 7 16 39] [BCDA 10 23 40]
< set A [expr {$B + [<<< [expr {$A + [H $B $C $D] + $X(1) + $T(37)}] 4]}]
< set D [expr {$A + [<<< [expr {$D + [H $A $B $C] + $X(4) + $T(38)}] 11]}]
< set C [expr {$D + [<<< [expr {$C + [H $D $A $B] + $X(7) + $T(39)}] 16]}]
< set B [expr {$C + [<<< [expr {$B + [H $C $D $A] + $X(10) + $T(40)}] 23]}]
---
> set A [expr {$B + [<<< [expr {$A + [H $B $C $D] + $X5 + $T33}] 4]}]
> set D [expr {$A + [<<< [expr {$D + [H $A $B $C] + $X8 + $T34}] 11]}]
> set C [expr {$D + [<<< [expr {$C + [H $D $A $B] + $X11 + $T35}] 16]}]
> set B [expr {$C + [<<< [expr {$B + [H $C $D $A] + $X14 + $T36}] 23]}]
> # [ABCD 1 4 37] [DABC 4 11 38] [CDAB 7 16 39] [BCDA 10 23 40]
> set A [expr {$B + [<<< [expr {$A + [H $B $C $D] + $X1 + $T37}] 4]}]
> set D [expr {$A + [<<< [expr {$D + [H $A $B $C] + $X4 + $T38}] 11]}]
> set C [expr {$D + [<<< [expr {$C + [H $D $A $B] + $X7 + $T39}] 16]}]
> set B [expr {$C + [<<< [expr {$B + [H $C $D $A] + $X10 + $T40}] 23]}]
291,294c294,297
< set A [expr {$B + [<<< [expr {$A + [H $B $C $D] + $X(13) + $T(41)}] 4]}]
< set D [expr {$A + [<<< [expr {$D + [H $A $B $C] + $X(0) + $T(42)}] 11]}]
< set C [expr {$D + [<<< [expr {$C + [H $D $A $B] + $X(3) + $T(43)}] 16]}]
< set B [expr {$C + [<<< [expr {$B + [H $C $D $A] + $X(6) + $T(44)}] 23]}]
---
> set A [expr {$B + [<<< [expr {$A + [H $B $C $D] + $X13 + $T41}] 4]}]
> set D [expr {$A + [<<< [expr {$D + [H $A $B $C] + $X0 + $T42}] 11]}]
> set C [expr {$D + [<<< [expr {$C + [H $D $A $B] + $X3 + $T43}] 16]}]
> set B [expr {$C + [<<< [expr {$B + [H $C $D $A] + $X6 + $T44}] 23]}]
296,300c299,303
< set A [expr {$B + [<<< [expr {$A + [H $B $C $D] + $X(9) + $T(45)}] 4]}]
< set D [expr {$A + [<<< [expr {$D + [H $A $B $C] + $X(12) + $T(46)}] 11]}]
< set C [expr {$D + [<<< [expr {$C + [H $D $A $B] + $X(15) + $T(47)}] 16]}]
< set B [expr {$C + [<<< [expr {$B + [H $C $D $A] + $X(2) + $T(48)}] 23]}]
<
---
> set A [expr {$B + [<<< [expr {$A + [H $B $C $D] + $X9 + $T45}] 4]}]
> set D [expr {$A + [<<< [expr {$D + [H $A $B $C] + $X12 + $T46}] 11]}]
> set C [expr {$D + [<<< [expr {$C + [H $D $A $B] + $X15 + $T47}] 16]}]
> set B [expr {$C + [<<< [expr {$B + [H $C $D $A] + $X2 + $T48}] 23]}]
>
306,309c309,312
< set A [expr {$B + [<<< [expr {$A + [I $B $C $D] + $X(0) + $T(49)}] 6]}]
< set D [expr {$A + [<<< [expr {$D + [I $A $B $C] + $X(7) + $T(50)}] 10]}]
< set C [expr {$D + [<<< [expr {$C + [I $D $A $B] + $X(14) + $T(51)}] 15]}]
< set B [expr {$C + [<<< [expr {$B + [I $C $D $A] + $X(5) + $T(52)}] 21]}]
---
> set A [expr {$B + [<<< [expr {$A + [I $B $C $D] + $X0 + $T49}] 6]}]
> set D [expr {$A + [<<< [expr {$D + [I $A $B $C] + $X7 + $T50}] 10]}]
> set C [expr {$D + [<<< [expr {$C + [I $D $A $B] + $X14 + $T51}] 15]}]
> set B [expr {$C + [<<< [expr {$B + [I $C $D $A] + $X5 + $T52}] 21]}]
311,314c314,317
< set A [expr {$B + [<<< [expr {$A + [I $B $C $D] + $X(12) + $T(53)}] 6]}]
< set D [expr {$A + [<<< [expr {$D + [I $A $B $C] + $X(3) + $T(54)}] 10]}]
< set C [expr {$D + [<<< [expr {$C + [I $D $A $B] + $X(10) + $T(55)}] 15]}]
< set B [expr {$C + [<<< [expr {$B + [I $C $D $A] + $X(1) + $T(56)}] 21]}]
---
> set A [expr {$B + [<<< [expr {$A + [I $B $C $D] + $X12 + $T53}] 6]}]
> set D [expr {$A + [<<< [expr {$D + [I $A $B $C] + $X3 + $T54}] 10]}]
> set C [expr {$D + [<<< [expr {$C + [I $D $A $B] + $X10 + $T55}] 15]}]
> set B [expr {$C + [<<< [expr {$B + [I $C $D $A] + $X1 + $T56}] 21]}]
316,319c319,322
< set A [expr {$B + [<<< [expr {$A + [I $B $C $D] + $X(8) + $T(57)}] 6]}]
< set D [expr {$A + [<<< [expr {$D + [I $A $B $C] + $X(15) + $T(58)}] 10]}]
< set C [expr {$D + [<<< [expr {$C + [I $D $A $B] + $X(6) + $T(59)}] 15]}]
< set B [expr {$C + [<<< [expr {$B + [I $C $D $A] + $X(13) + $T(60)}] 21]}]
---
> set A [expr {$B + [<<< [expr {$A + [I $B $C $D] + $X8 + $T57}] 6]}]
> set D [expr {$A + [<<< [expr {$D + [I $A $B $C] + $X15 + $T58}] 10]}]
> set C [expr {$D + [<<< [expr {$C + [I $D $A $B] + $X6 + $T59}] 15]}]
> set B [expr {$C + [<<< [expr {$B + [I $C $D $A] + $X13 + $T60}] 21]}]
321,324c324,327
< set A [expr {$B + [<<< [expr {$A + [I $B $C $D] + $X(4) + $T(61)}] 6]}]
< set D [expr {$A + [<<< [expr {$D + [I $A $B $C] + $X(11) + $T(62)}] 10]}]
< set C [expr {$D + [<<< [expr {$C + [I $D $A $B] + $X(2) + $T(63)}] 15]}]
< set B [expr {$C + [<<< [expr {$B + [I $C $D $A] + $X(9) + $T(64)}] 21]}]
---
> set A [expr {$B + [<<< [expr {$A + [I $B $C $D] + $X4 + $T61}] 6]}]
> set D [expr {$A + [<<< [expr {$D + [I $A $B $C] + $X11 + $T62}] 10]}]
> set C [expr {$D + [<<< [expr {$C + [I $D $A $B] + $X2 + $T63}] 15]}]
> set B [expr {$C + [<<< [expr {$B + [I $C $D $A] + $X9 + $T64}] 21]}]
335c338
<
---
>
338c341
<
---
>
341a345,347
> #
> # Here we inline/regsub the functions F, G, H, I and <<<
> #
343,355c349,384
< # bitwise left-rotate
< proc ::md5::<<< {x i} {
< # This works by bitwise-ORing together right piece and left
< # piece so that the (original) right piece becomes the left
< # piece and vice versa.
< #
< # The (original) right piece is a simple left shift.
< # The (original) left piece should be a simple right shift
< # but Tcl does sign extension on right shifts so we
< # shift it 1 bit, mask off the sign, and finally shift
< # it the rest of the way.
<
< expr {($x << $i) | ((($x >> 1) & 0x7fffffff) >> (31-$i))}
---
> namespace eval ::md5 {
> #proc md5pure::F {x y z} {expr {(($x & $y) | ((~$x) & $z))}}
> regsub -all {\[ *F +(\$.) +(\$.) +(\$.) *\]} $md5body {((\1 \& \2) | ((~\1) \& \3))} md5body
>
> #proc md5pure::G {x y z} {expr {(($x & $z) | ($y & (~$z)))}}
> regsub -all {\[ *G +(\$.) +(\$.) +(\$.) *\]} $md5body {((\1 \& \3) | (\2 \& (~\3)))} md5body
>
> #proc md5pure::H {x y z} {expr {$x ^ $y ^ $z}}
> regsub -all {\[ *H +(\$.) +(\$.) +(\$.) *\]} $md5body {(\1 ^ \2 ^ \3)} md5body
>
> #proc md5pure::I {x y z} {expr {$y ^ ($x | (~$z))}}
> regsub -all {\[ *I +(\$.) +(\$.) +(\$.) *\]} $md5body {(\2 ^ (\1 | (~\3)))} md5body
>
> # bitwise left-rotate
> if 0 {
> proc md5pure::<<< {x i} {
> # This works by bitwise-ORing together right piece and left
> # piece so that the (original) right piece becomes the left
> # piece and vice versa.
> #
> # The (original) right piece is a simple left shift.
> # The (original) left piece should be a simple right shift
> # but Tcl does sign extension on right shifts so we
> # shift it 1 bit, mask off the sign, and finally shift
> # it the rest of the way.
>
> expr {($x << $i) | ((($x >> 1) & 0x7fffffff) >> (31-$i))}
> }
> }
> # inline <<<
> regsub -all {\[ *<<< +\[ *expr +({[^\}]*})\] +([0-9]+) *\]} $md5body {(([set x [expr \1]] << \2) | ((($x >> 1) \& 0x7fffffff) >> (31-\2)))} md5body
>
> # Finally, define the proc
> proc md5 {msg} $md5body
>
> unset md5body
357,362c386
<
< proc ::md5::F {x y z} {expr {(($x & $y) | ((~$x) & $z))}}
< proc ::md5::G {x y z} {expr {(($x & $z) | ($y & (~$z)))}}
< proc ::md5::H {x y z} {expr {$x ^ $y ^ $z}}
< proc ::md5::I {x y z} {expr {$y ^ ($x | (~$z))}}
<
---
>
406c430
< package provide md5 1.3
---
> package provide md5 1.4
Index: modules/md5/pkgIndex.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/md5/pkgIndex.tcl,v
retrieving revision 1.2
diff -r1.2 pkgIndex.tcl
11c11
< package ifneeded md5 1.3 [list source [file join $dir md5.tcl]]
---
> package ifneeded md5 1.4 [list source [file join $dir md5.tcl]]
