0 [IF]

OK, I'll get into this .. :-)

This is my VERY 1ST CUT, which just refactors the original code.
I keep the basic concept intact, but code it more efficiently.
I do this by eliminating the FF()..II() words, which primarily
do stack management, and then create M[]+. Then I perform each
sub-round as the algorithm literally describes. I also made two
versions: one that compiles F()..I(), M[]+ as standard colon
defined words, and a second version which compiles them as
MACROS, which SwiftForth will inline compile directly.

The colon word compiled version runs about 17% faster than the
original code, and the MACRO version is about 27% faster on my
machine (600 MHz K-7 w/PC100 SDRAM) and SwiftForth V 2.00.3.
But since this is ANS FORTH code, which I also verifed runs on
Win32Forth, it will run on any ANS FORTH system.

The really nice aspect of the origal design model, which I tried
to impove on, is that I think (at this point) that it is the
"best approach" to structure the problem, by using the stack to
hold the hash values A - D.  The modified refactoring I've done
makes a Pentium optimized version a breeze to do as it is modeled
right now, but I think I can get even better modeling efficiences
by taking the approach I did for SHA-1 optimization.  Stay tuned..

If someone (Marcel ??) could post the test suite you are using to
get the times I see being posted I will run it with those tests,
and/or people (Marcel) can take my code and just run a version of
the test with it. Everthing in the original code has remained the
same (except I did change the name of 'lroll' to 'rol') so it
should be an easy mod.


Jabar1 Zakiya

[THEN]

\ MD5 routine in ANS FORTH
\ Original code posted by Frederick W. Warren 02Nov2000
\ in comp.lang.forth.
\ Modified by Jabari Zakiya 14Dec2000 (jzakiya@mail.com)
\ Verifed in Win32Forth and SwiftForth (speed tested also).

VARIABLE A   VARIABLE B   VARIABLE C   VARIABLE D
1 A !  \  for endian testing

VARIABLE MD5LEN

CREATE BUF[] 64 ALLOT
CREATE PART[] 64 ALLOT
CREATE MD5PAD 64 ALLOT  MD5PAD 64 0 FILL  128 MD5PAD C!

: ROL ( n1 s1 -- res ) \ roll left with c/o to bit 0
  2DUP 32 SWAP - RSHIFT  ROT ROT LSHIFT OR ;

A C@ [IF] \ if little ENDIAN cpu
: ENDIAN@  ( a1 - n1 )  S" @" EVALUATE ; IMMEDIATE
: ENDIAN!  ( n a1 -- )  S" !" EVALUATE ; IMMEDIATE

[ELSE] \ big ENDIAN cpus (e.g. MACs)
: ENDIAN  ( a1 -- n1 )
  >R  R@  3  +  C@  8 LSHIFT R@  2  +  C@  +  8 LSHIFT
  R@  1+  C@  +  8 LSHIFT  R>  C@  +
;

: ENDIAN!  ( n1 a1 - )
  >R  256 /MOD  SWAP  R@  C!  256 /MOD  SWAP  R@  1+  C!
  256 /MOD  SWAP  R@  2  +  C!  3  +  C!
;
[THEN]

0 [IF]  \ Compile colon defined words

: F() ( n1 n2 n3 -- n4 )
 ROT DUP INVERT ROT AND ROT ROT AND OR ;

: G() ( n1 n2 n3 -- n4 )
  SWAP OVER INVERT AND ROT ROT AND OR ;

: H() ( n1 n2 n3 -- n4 )  XOR XOR ;

: I() ( n1 n2 n3 -- n4 )  INVERT ROT OR XOR ;

: M[]+ ( x i -- n )  CELLS BUF[] + ENDIAN@ + ;

[ELSE]  \ Compile functions as MACROS

: F() ( n1 n2 n3 -- n4 )
  S" ROT DUP INVERT ROT AND ROT ROT AND OR " EVALUATE ; IMMEDIATE

: G() ( n1 n2 n3 -- n4 )
  S" SWAP OVER INVERT AND ROT ROT AND OR "  EVALUATE  ; IMMEDIATE

: H() ( n1 n2 n3 -- n4 )  S" XOR XOR" EVALUATE ; IMMEDIATE

: I() ( n1 n2 n3 -- n4 )  S" INVERT ROT OR XOR" EVALUATE ; IMMEDIATE

: M[]+ ( x i -- n )  S" CELLS BUF[] + ENDIAN@ + " EVALUATE ; IMMEDIATE
[THEN]

HEX

: ROUND1 ( -- )
  b @ a @ over c @ d @ F() + 0d76aa478 + 00 M[]+ 07 rol + a ! \ 1
  a @ d @ over b @ c @ F() + 0e8c7b756 + 01 M[]+ 0C rol + d ! \ 2
  d @ c @ over a @ b @ F() + 0242070db + 02 M[]+ 11 rol + c ! \ 3
  c @ b @ over d @ a @ F() + 0c1bdceee + 03 M[]+ 16 rol + b ! \ 4
  b @ a @ over c @ d @ F() + 0f57c0faf + 04 M[]+ 07 rol + a ! \ 5
  a @ d @ over b @ c @ F() + 04787c62a + 05 M[]+ 0C rol + d ! \ 6
  d @ c @ over a @ b @ F() + 0a8304613 + 06 M[]+ 11 rol + c ! \ 7
  c @ b @ over d @ a @ F() + 0fd469501 + 07 M[]+ 16 rol + b ! \ 8
  b @ a @ over c @ d @ F() + 0698098d8 + 08 M[]+ 07 rol + a ! \ 9
  a @ d @ over b @ c @ F() + 08b44f7af + 09 M[]+ 0C rol + d ! \ 10
  d @ c @ over a @ b @ F() + 0ffff5bb1 + 0A M[]+ 11 rol + c ! \ 11
  c @ b @ over d @ a @ F() + 0895cd7be + 0B M[]+ 16 rol + b ! \ 12
  b @ a @ over c @ d @ F() + 06b901122 + 0C M[]+ 07 rol + a ! \ 13
  a @ d @ over b @ c @ F() + 0fd987193 + 0D M[]+ 0C rol + d ! \ 14
  d @ c @ over a @ b @ F() + 0a679438e + 0E M[]+ 11 rol + c ! \ 15
  c @ b @ over d @ a @ F() + 049b40821 + 0F M[]+ 16 rol + b ! \ 16
;

: ROUND2 ( -- )
  b @ a @ over c @ d @ G() + 0f61e2562 + 01 M[]+ 05 rol + a ! \ 1
  a @ d @ over b @ c @ G() + 0c040b340 + 06 M[]+ 09 rol + d ! \ 2
  d @ c @ over a @ b @ G() + 0265E5A51 + 0B M[]+ 0E rol + c ! \ 3
  c @ b @ over d @ a @ G() + 0e9b6c7aa + 00 M[]+ 14 rol + b ! \ 4
  b @ a @ over c @ d @ G() + 0d62f105d + 05 M[]+ 05 rol + a ! \ 5
  a @ d @ over b @ c @ G() +  02441453 + 0A M[]+ 09 rol + d ! \ 6
  d @ c @ over a @ b @ G() + 0d8a1e681 + 0F M[]+ 0E rol + c ! \ 7
  c @ b @ over d @ a @ G() + 0e7d3fbc8 + 04 M[]+ 14 rol + b ! \ 8
  b @ a @ over c @ d @ G() + 021e1cde6 + 09 M[]+ 05 rol + a ! \ 9
  a @ d @ over b @ c @ G() + 0c33707d6 + 0E M[]+ 09 rol + d ! \ 10
  d @ c @ over a @ b @ G() + 0f4d50d87 + 03 M[]+ 0E rol + c ! \ 11
  c @ b @ over d @ a @ G() + 0455a14ed + 08 M[]+ 14 rol + b ! \ 12
  b @ a @ over c @ d @ G() + 0a9e3e905 + 0D M[]+ 05 rol + a ! \ 13
  a @ d @ over b @ c @ G() + 0fcefa3f8 + 02 M[]+ 09 rol + d ! \ 14
  d @ c @ over a @ b @ G() + 0676f02d9 + 07 M[]+ 0E rol + c ! \ 15
  c @ b @ over d @ a @ G() + 08d2a4c8a + 0C M[]+ 14 rol + b ! \ 16
;

: ROUND3 ( -- )
  b @ a @ over c @ d @ H() + 0fffa3942 + 05 M[]+ 04 rol + a ! \ 1
  a @ d @ over b @ c @ H() + 08771f681 + 08 M[]+ 0B rol + d ! \ 2
  d @ c @ over a @ b @ H() + 06d9d6122 + 0B M[]+ 10 rol + c ! \ 3
  c @ b @ over d @ a @ H() + 0fde5380c + 0E M[]+ 17 rol + b ! \ 4
  b @ a @ over c @ d @ H() + 0a4beea44 + 01 M[]+ 04 rol + a ! \ 5
  a @ d @ over b @ c @ H() + 04bdecfa9 + 04 M[]+ 0B rol + d ! \ 6
  d @ c @ over a @ b @ H() + 0f6bb4b60 + 07 M[]+ 10 rol + c ! \ 7
  c @ b @ over d @ a @ H() + 0bebfbc70 + 0A M[]+ 17 rol + b ! \ 8
  b @ a @ over c @ d @ H() + 0289b7ec6 + 0D M[]+ 04 rol + a ! \ 9
  a @ d @ over b @ c @ H() + 0eaa127fa + 00 M[]+ 0B rol + d ! \ 10
  d @ c @ over a @ b @ H() + 0d4ef3085 + 03 M[]+ 10 rol + c ! \ 11
  c @ b @ over d @ a @ H() +  04881d05 + 06 M[]+ 17 rol + b ! \ 12
  b @ a @ over c @ d @ H() + 0d9d4d039 + 09 M[]+ 04 rol + a ! \ 13
  a @ d @ over b @ c @ H() + 0e6db99e5 + 0C M[]+ 0B rol + d ! \ 14
  d @ c @ over a @ b @ H() + 01fa27cf8 + 0F M[]+ 10 rol + c ! \ 15
  c @ b @ over d @ a @ H() + 0c4ac5665 + 02 M[]+ 17 rol + b ! \ 16
;

: ROUND4 ( -- )
  b @ a @ over c @ d @ I() + 0f4292244 + 00 M[]+ 06 rol + a ! \ 1
  a @ d @ over b @ c @ I() + 0432aff97 + 07 M[]+ 0A rol + d ! \ 2
  d @ c @ over a @ b @ I() + 0ab9423a7 + 0E M[]+ 0F rol + c ! \ 3
  c @ b @ over d @ a @ I() + 0fc93a039 + 05 M[]+ 15 rol + b ! \ 4
  b @ a @ over c @ d @ I() + 0655b59c3 + 0C M[]+ 06 rol + a ! \ 5
  a @ d @ over b @ c @ I() + 08f0ccc92 + 03 M[]+ 0A rol + d ! \ 6
  d @ c @ over a @ b @ I() + 0ffeff47d + 0A M[]+ 0F rol + c ! \ 7
  c @ b @ over d @ a @ I() + 085845dd1 + 01 M[]+ 15 rol + b ! \ 8
  b @ a @ over c @ d @ I() + 06fa87e4f + 08 M[]+ 06 rol + a ! \ 9
  a @ d @ over b @ c @ I() + 0fe2ce6e0 + 0F M[]+ 0A rol + d ! \ 10
  d @ c @ over a @ b @ I() + 0a3014314 + 06 M[]+ 0F rol + c ! \ 11
  c @ b @ over d @ a @ I() + 04e0811a1 + 0D M[]+ 15 rol + b ! \ 12
  b @ a @ over c @ d @ I() + 0f7537e82 + 04 M[]+ 06 rol + a ! \ 13
  a @ d @ over b @ c @ I() + 0bd3af235 + 0B M[]+ 0A rol + d ! \ 14
  d @ c @ over a @ b @ I() + 02ad7d2bb + 02 M[]+ 0F rol + c ! \ 15
  c @ b @ over d @ a @ I() + 0eb86d391 + 09 M[]+ 15 rol + b ! \ 16
;

DECIMAL
: Transform ( -- )
  a @ b @  c @ d @  ROUND1 ROUND2 ROUND3 ROUND4
  d @ + d !   c @ + c !   b @ + b !   a @ + a !
;
 HEX
: MD5INT ( -- )
  067452301 a !  0efcdab89 b !
  098badcfe c !  010325476 d !
  0 MD5LEN !  ;
DECIMAL

-1 VALUE MD5INT?

: SETLEN ( count -- )
  MD5LEN @ 8 M*  BUF[] 60 + ! BUF[] 56 + ! ;

\ Do all 64 byte blocks leaving remainder block
: DOFULLBLOCKS ( adr1 count1 --  adr2 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 -- )
  MD5INT DUP MD5LEN +!  DOFULLBLOCKS DOFINAL ;

: SAVEPART ( adr count -- )
  MD5LEN @ 64 MOD IF  PART[] SWAP CMOVE  ELSE  2DROP  THEN  ;

: MOVEPART ( adr1 count1 partindex -- adr2 count2 ) \ add to PART[]
  2DUP 64 SWAP - MIN >R  PART[] + >R OVER R> R@ CMOVE
  SWAP R@ + SWAP R> - ;

: MD5Update ( adr count -- )
  MD5INT? IF MD5INT FALSE TO MD5INT? THEN
  MD5LEN @ 64 MOD OVER MD5LEN +! ( adr 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 MD5INT FALSE TO MD5INT? THEN
  MD5LEN @ 64 MOD OVER MD5LEN +! ( adr 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
CREATE DIGIT$
  48 c, 49 c, 50 c, 51 c, 52 c, 53 c, 54 c, 55 c, 56 c, 57 c,
  97 c, 98 c, 99 c, 100 c, 101 c, 102 c,

: INTDIGITS ( -- )  0 PAD ! ;

\ output digit at pad
: SAVEDIGIT ( n -- )  PAD C@ 1+ DUP PAD C! PAD + C! ;

: BYTEDIGITS ( n1 -- )
  DUP 4 RSHIFT DIGIT$ + C@ SAVEDIGIT  15 AND DIGIT$ + C@ SAVEDIGIT ;

A C@ [IF] \ little ENDIAN
: CELLDIGITS ( a1 -- )  DUP 4 + SWAP DO I C@ BYTEDIGITS LOOP ;
[ELSE]
: CELLDIGITS ( a1 -- )  DUP 3 + DO I C@ BYTEDIGITS -1  +LOOP ;
[THEN]

: MD5STRING ( -- adr count ) \ return address of counted MD5 string
  INTDIGITS A CELLDIGITS B CELLDIGITS C CELLDIGITS D CELLDIGITS PAD
COUNT
  TRUE TO MD5INT? ;

\ Test Suite
: QuoteString ( adr count -- )
  34 EMIT TYPE  34 EMIT ;

: .MD5 ( adr count -- )
  CR CR 2DUP MD5Full MD5String TYPE SPACE QuoteString ;

: FOO ( -- )
  S" foo" r/o OPEN-FILE 0=
  IF  BEGIN  DUP PAD 1024 ROT READ-FILE DROP DUP 1024 =
      WHILE  PAD SWAP MD5Update
      REPEAT PAD SWAP MD5Final
      CLOSE-FILE DROP CR CR MD5String TYPE ."  foo"
  ELSE DROP
  THEN ;

: MD5Test ( -- )
  ." MD5 test suite results:"
  S" "  .MD5
  S" a" .MD5
  S" abc" .MD5
  S" abcdefghijklmnopqrstuvwxyz" .MD5
  S" ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
.MD5
  S" 12345678901234567890123456789012345678901234567890123456789012345678901234567890"
  .MD5
  FOO CR CR ;

\ SwiftForth specific performance test

  1000000 VALUE N#  ( 1 million iterations)

: [TEST]  S" abcdefghijklmnopqrstuvwxyz" MD5Full ;
: TEST  [ decimal ]
  cr ." MD5 test for " N# . ." loops in microseconds is "
  ucounter  N# 0 DO [TEST] LOOP  utimer
;