\ MD5 routine in ANS Forth, Marcel Hendrix, December 13, 2000 \ Parts by Fredrick W. Warren \ Little/BigEndian patches aren't implemented. \ Uses ROL . \ [DEFINED] is from Wil's Toolbelt [DEFINED] -work [IF] -work [THEN] MARKER -work DECIMAL \ Constants for MD5Transform routine. 7 CONSTANT S11 12 CONSTANT S12 17 CONSTANT S13 22 CONSTANT S14 5 CONSTANT S21 9 CONSTANT S22 14 CONSTANT S23 20 CONSTANT S24 4 CONSTANT S31 11 CONSTANT S32 16 CONSTANT S33 23 CONSTANT S34 6 CONSTANT S41 10 CONSTANT S42 15 CONSTANT S43 21 CONSTANT S44 1 [IF] \ This is slow. A good Forth will have the "ROL/ROR" intrinsic. \ With MPE's VFX this is FASTER than using inline CODE! 32 CONSTANT BITS/CELL : ROL ( n # -- u ) S" 2DUP LSHIFT -ROT BITS/CELL - NEGATE RSHIFT OR " EVALUATE ; IMMEDIATE [THEN] 0 VALUE a 0 VALUE b 0 VALUE c 0 VALUE d 0 VALUE md5len -1 VALUE md5int? CREATE buf[] 16 CELLS ALLOT CREATE part[] 16 CELLS ALLOT CREATE md5pad 16 CELLS ALLOT md5pad 16 CELLS ERASE 128 md5pad C! : CREATE IMMEDIATE , DOES> @ POSTPONE LITERAL S" @ + " EVALUATE ; : +X[]= 16 0 DO I CELLS buf[] + LOOP ; +X[]= +x[0] +x[1] +x[2] +x[3] +x[4] +x[5] +x[6] +x[7] +x[8] +x[9] +x[10] +x[11] +x[12] +x[13] +x[14] +x[15] : F() S" INVERT AND OR + + " EVALUATE ; IMMEDIATE : G() S" INVERT AND OR + + " EVALUATE ; IMMEDIATE : H() S" XOR XOR + + " EVALUATE ; IMMEDIATE : I() S" INVERT OR XOR + + " EVALUATE ; IMMEDIATE HEX : Transform ( -- ) a b c d \ ROUND1 F(x, y, z) = (x & y) | (~x & z) D76AA478 +x[0] a b c AND d b F() S11 ROL b + TO a E8C7B756 +x[1] d a b AND c a F() S12 ROL a + TO d 242070DB +x[2] c d a AND b d F() S13 ROL d + TO c C1BDCEEE +x[3] b c d AND a c F() S14 ROL c + TO b F57C0FAF +x[4] a b c AND d b F() S11 ROL b + TO a 4787C62A +x[5] d a b AND c a F() S12 ROL a + TO d A8304613 +x[6] c d a AND b d F() S13 ROL d + TO c FD469501 +x[7] b c d AND a c F() S14 ROL c + TO b 698098D8 +x[8] a b c AND d b F() S11 ROL b + TO a 8B44F7AF +x[9] d a b AND c a F() S12 ROL a + TO d FFFF5BB1 +x[10] c d a AND b d F() S13 ROL d + TO c 895CD7BE +x[11] b c d AND a c F() S14 ROL c + TO b 6B901122 +x[12] a b c AND d b F() S11 ROL b + TO a FD987193 +x[13] d a b AND c a F() S12 ROL a + TO d A679438E +x[14] c d a AND b d F() S13 ROL d + TO c 49B40821 +x[15] b c d AND a c F() S14 ROL c + TO b \ ROUND2 G(x, y, z) = (x & z) | (y & ~z) F61E2562 +x[1] a b d AND c d G() S21 ROL b + TO a C040B340 +x[6] d a c AND b c G() S22 ROL a + TO d 265E5A51 +x[11] c d b AND a b G() S23 ROL d + TO c E9B6C7AA +x[0] b c a AND d a G() S24 ROL c + TO b D62F105D +x[5] a b d AND c d G() S21 ROL b + TO a 02441453 +x[10] d a c AND b c G() S22 ROL a + TO d D8A1E681 +x[15] c d b AND a b G() S23 ROL d + TO c E7D3FBC8 +x[4] b c a AND d a G() S24 ROL c + TO b 21E1CDE6 +x[9] a b d AND c d G() S21 ROL b + TO a C33707D6 +x[14] d a c AND b c G() S22 ROL a + TO d F4D50D87 +x[3] c d b AND a b G() S23 ROL d + TO c 455A14ED +x[8] b c a AND d a G() S24 ROL c + TO b A9E3E905 +x[13] a b d AND c d G() S21 ROL b + TO a FCEFA3F8 +x[2] d a c AND b c G() S22 ROL a + TO d 676F02D9 +x[7] c d b AND a b G() S23 ROL d + TO c 8D2A4C8A +x[12] b c a AND d a G() S24 ROL c + TO b \ ROUND3 H(x, y, z) = x ^ y ^ z FFFA3942 +x[5] a b c d H() S31 ROL b + TO a 8771F681 +x[8] d a b c H() S32 ROL a + TO d 6D9D6122 +x[11] c d a b H() S33 ROL d + TO c FDE5380C +x[14] b c d a H() S34 ROL c + TO b A4BEEA44 +x[1] a b c d H() S31 ROL b + TO a 4BDECFA9 +x[4] d a b c H() S32 ROL a + TO d F6BB4B60 +x[7] c d a b H() S33 ROL d + TO c BEBFBC70 +x[10] b c d a H() S34 ROL c + TO b 289B7EC6 +x[13] a b c d H() S31 ROL b + TO a EAA127FA +x[0] d a b c H() S32 ROL a + TO d D4EF3085 +x[3] c d a b H() S33 ROL d + TO c 04881D05 +x[6] b c d a H() S34 ROL c + TO b D9D4D039 +x[9] a b c d H() S31 ROL b + TO a E6DB99E5 +x[12] d a b c H() S32 ROL a + TO d 1FA27CF8 +x[15] c d a b H() S33 ROL d + TO c C4AC5665 +x[2] b c d a H() S34 ROL c + TO b \ ROUND4 I(x, y, z) = y ^ (x | ~z) F4292244 +x[0] a c b d I() S41 ROL b + TO a 432AFF97 +x[7] d b a c I() S42 ROL a + TO d AB9423A7 +x[14] c a d b I() S43 ROL d + TO c FC93A039 +x[5] b d c a I() S44 ROL c + TO b 655B59C3 +x[12] a c b d I() S41 ROL b + TO a 8F0CCC92 +x[3] d b a c I() S42 ROL a + TO d FFEFF47D +x[10] c a d b I() S43 ROL d + TO c 85845DD1 +x[1] b d c a I() S44 ROL c + TO b 6FA87E4F +x[8] a c b d I() S41 ROL b + TO a FE2CE6E0 +x[15] d b a c I() S42 ROL a + TO d A3014314 +x[6] c a d b I() S43 ROL d + TO c 4E0811A1 +x[13] b d c a I() S44 ROL c + TO b F7537E82 +x[4] a c b d I() S41 ROL b + TO a BD3AF235 +x[11] d b a c I() S42 ROL a + TO d 2AD7D2BB +x[2] c a d b I() S43 ROL d + TO c EB86D391 +x[9] b d c a I() S44 ROL c + TO b d + TO d c + TO c b + TO b a + TO a ; : MD5INIT ( -- ) 67452301 TO a EFCDAB89 TO b 98BADCFE TO c 10325476 TO d 0 TO md5len ; DECIMAL \ ------------------------------------------------------------* \ * \ Didn't look at this yet. Could become important bottleneck. * \ * \ ------------------------------------------------------------/ : SETLEN ( -- ) md5len 8 M* buf[] 60 + ! buf[] 56 + ! ; \ Do all 64 byte blocks leaving remainder block : DOFULLBLOCKS ( addr1 count1 -- addr2 count2 ) BEGIN DUP 63 > WHILE 64 - SWAP DUP buf[] 64 CMOVE 64 + SWAP Transform REPEAT ; : MOVEPARTIAL ( addr count -- ) SWAP OVER buf[] SWAP CMOVE md5pad OVER buf[] + ROT 64 SWAP - CMOVE ; : DOFINAL ( addr count -- ) 2DUP MOVEPARTIAL DUP 55 > IF Transform buf[] 64 0 FILL THEN 2DROP SETLEN Transform ; \ compute MD5 from a counted buffer of text : MD5Full ( addr count -- ) MD5INIT DUP md5len + TO md5len DOFULLBLOCKS DOFINAL ; : SAVEPART ( addr count -- ) md5len 64 MOD IF part[] SWAP CMOVE ELSE 2DROP THEN ; : MOVEPART ( addr1 count1 partindex -- addr2 count2 ) \ add to part[] 2DUP 64 SWAP - MIN >R part[] + >R OVER R> R@ CMOVE SWAP R@ + SWAP R> - ; : MD5Update ( adr count -- ) md5int? IF MD5INIT FALSE TO md5int? THEN md5len 64 MOD OVER md5len + TO md5len ( addr count partindex -- ) DUP IF 2DUP + 63 > IF MOVEPART part[] 64 DOFULLBLOCKS DOFULLBLOCKS SAVEPART CR ELSE MOVEPART 2DROP THEN ELSE DROP DOFULLBLOCKS SAVEPART THEN ; : MD5Final ( adr count -- ) md5int? IF MD5INIT FALSE TO md5int? THEN md5len 64 MOD OVER md5len + TO md5len ( addr count partindex -- ) DUP IF 2DUP + 63 > IF MOVEPART part[] 64 DOFULLBLOCKS DOFULLBLOCKS DOFINAL ELSE MOVEPART 2DROP part[] md5len 64 MOD DOFINAL THEN ELSE DROP DOFULLBLOCKS DOFINAL THEN ; \ Functions for creating output string : >DIGIT ( ix -- char ) CHARS S" 0123456789abcdef" DROP + C@ ; : initdigits ( -- ) 0 PAD C! ; : savedigit ( c -- ) PAD C@ 1+ DUP PAD C! CHARS PAD + C! ; : bytedigits ( n -- ) DUP 4 RSHIFT >DIGIT savedigit 15 AND >DIGIT savedigit ; : celldigits ( n -- ) 4 0 DO DUP 255 AND bytedigits 8 RSHIFT LOOP DROP ; : MD5string ( -- addr count ) \ return address of counted MD5 string initdigits a celldigits b celldigits c celldigits d celldigits PAD COUNT TRUE TO md5int? ; \ Test Suite : QuoteString ( addr count -- ) [CHAR] " EMIT TYPE [CHAR] " EMIT ; : .MD5 ( addr count -- ) CR 2DUP MD5Full MD5string TYPE SPACE QuoteString ; : .### ( -- ) BASE @ >R DECIMAL MS? 0 <# # # # [CHAR] . HOLD #S #> R> BASE ! TYPE ; CREATE testspace 10000 ALLOT testspace 10000 BL FILL \ System-dependent timer words. : SPEED-TEST CR ." 1000 times 10,000 spaces ... " TIMER-RESET 1000 0 DO testspace 10000 MD5Full LOOP .### ." ms/iteration, result: " MD5string TYPE ; : MD5Test ( -- ) ." MD5 test suite results:" CR CR ." ( d41d8cd98f00b204e9800998ecf8427e ''" CR ." 0cc175b9c0f1b6a831c399e269772661 'a'" CR ." 900150983cd24fb0d6963f7d28e17f72 'abc'" CR ." c3fcd3d76192e4007dfb496cca67e13b 'abcdefghijklmnopqrstuvwxyz'" CR ." d174ab98d277d9f5a5611c2c9f419d9f 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789'" CR ." 57edf4a22be3c955ac49da2e2107b67a '12345678901234567890123456789012345678901234567890123456789012345678901234567890' )" CR S" " .MD5 S" a" .MD5 S" abc" .MD5 S" abcdefghijklmnopqrstuvwxyz" .MD5 S" ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" .MD5 S" 12345678901234567890123456789012345678901234567890123456789012345678901234567890" .MD5 SPEED-TEST CR CR ; : ABOUT CR ." Try: MD5Test" CR ." SPEED-TEST" ; \ FORTH> speed-test ( P54C 166 MHz, iForth 1.11d ) \ 1000 times 10,000 spaces ... 1.351 ms/iteration, result: f38898bb69bb02bccb9594dfe471c5c0 \ speed-test ( P54C 166 MHz, VFX ) \ 1000 times 10,000 spaces ... 1.132 ms/iteration, result: f38898bb69bb02bccb9594dfe471c5c0 \ FORTH> speed-test ( Athlon 900 MHz, iForth ) \ 1000 times 10,000 spaces ... 0.250 ms/iteration, result: f38898bb69bb02bccb9594dfe471c5c0 \ speed-test ( Athlon 900 MHz, VFX ) \ 1000 times 10,000 spaces ... 0.160 ms/iteration, result: f38898bb69bb02bccb9594dfe471c5c0 \ End of file