0 [if] hi all, here is a working copy of md5, the not/invert problem has been corrected as well as the little endian(pc)/big endian(mac) problem has been corrected. i do not program in c, but i can "read" c well enough to translate it to forth. the original program typecats all data in such a manner that byte order is taken care of so that endianness does not matter. move works ok, the bytes stay ordered properly ! does not work ok to store the length of data in bits, because the bytes need to be reordered. @ does not work ok to fetch cells of data to process, because the bytes are ordered wrong. the code now determines if the system is little endian an uses endian@ and endian! as alias for @ and !. on a big endian system, endian@ and endian! reverse byte order before fetching or storing data. anyways, here is the code, now tested on 4 different ans forth and on both little endian and big endian platforms. back to my original post. now that the code works, would anyone care to provide constructive criticism on improvements to the code or the factoring? thanks [then] \ md5 routine in ans forth by fredrick w warren 02nov2000 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! : lroll ( n1 s1 -- res ) \ roll left with c/o to bit 0 2dup 32 swap - rshift rot rot lshift or ; a c@ [if] \ little endian (pc's) : endian@ ( a1 -- n1 ) @ ; : endian! ( n1 a1 -- ) ! ; [else] \ big endian (mac's and such) : 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! r> 3 + c! ; [then] : f() rot dup invert rot and rot rot and or ; : g() swap over invert and rot rot and or ; : h() xor xor ; : i() invert rot or xor ; : ff() >r cells buf[] + endian@ + >r 2over nip >r f() + r> swap r> + r> lroll + ; : gg() >r cells buf[] + endian@ + >r 2over nip >r g() + r> swap r> + r> lroll + ; : hh() >r cells buf[] + endian@ + >r 2over nip >r h() + r> swap r> + r> lroll + ; : ii() >r cells buf[] + endian@ + >r 2over nip >r i() + r> swap r> + r> lroll + ; hex : round1 a @ b @ c @ d @ 0d76aa478 00 07 ff() a ! \ 1 d @ a @ b @ c @ 0e8c7b756 01 0c ff() d ! \ 2 c @ d @ a @ b @ 0242070db 02 11 ff() c ! \ 3 b @ c @ d @ a @ 0c1bdceee 03 16 ff() b ! \ 4 a @ b @ c @ d @ 0f57c0faf 04 07 ff() a ! \ 5 d @ a @ b @ c @ 04787c62a 05 0c ff() d ! \ 6 c @ d @ a @ b @ 0a8304613 06 11 ff() c ! \ 7 b @ c @ d @ a @ 0fd469501 07 16 ff() b ! \ 8 a @ b @ c @ d @ 0698098d8 08 07 ff() a ! \ 9 d @ a @ b @ c @ 08b44f7af 09 0c ff() d ! \ 10 c @ d @ a @ b @ 0ffff5bb1 0a 11 ff() c ! \ 11 b @ c @ d @ a @ 0895cd7be 0b 16 ff() b ! \ 12 a @ b @ c @ d @ 06b901122 0c 07 ff() a ! \ 13 d @ a @ b @ c @ 0fd987193 0d 0c ff() d ! \ 14 c @ d @ a @ b @ 0a679438e 0e 11 ff() c ! \ 15 b @ c @ d @ a @ 049b40821 0f 16 ff() b ! \ 16 ; : round2 a @ b @ c @ d @ 0f61e2562 01 05 gg() a ! \ 1 d @ a @ b @ c @ 0c040b340 06 09 gg() d ! \ 2 c @ d @ a @ b @ 0265e5a51 0b 0e gg() c ! \ 3 b @ c @ d @ a @ 0e9b6c7aa 00 14 gg() b ! \ 4 a @ b @ c @ d @ 0d62f105d 05 05 gg() a ! \ 5 d @ a @ b @ c @ 02441453 0a 09 gg() d ! \ 6 c @ d @ a @ b @ 0d8a1e681 0f 0e gg() c ! \ 7 b @ c @ d @ a @ 0e7d3fbc8 04 14 gg() b ! \ 8 a @ b @ c @ d @ 021e1cde6 09 05 gg() a ! \ 9 d @ a @ b @ c @ 0c33707d6 0e 09 gg() d ! \ 10 c @ d @ a @ b @ 0f4d50d87 03 0e gg() c ! \ 11 b @ c @ d @ a @ 0455a14ed 08 14 gg() b ! \ 12 a @ b @ c @ d @ 0a9e3e905 0d 05 gg() a ! \ 13 d @ a @ b @ c @ 0fcefa3f8 02 09 gg() d ! \ 14 c @ d @ a @ b @ 0676f02d9 07 0e gg() c ! \ 15 b @ c @ d @ a @ 08d2a4c8a 0c 14 gg() b ! \ 16 ; : round3 a @ b @ c @ d @ 0fffa3942 05 04 hh() a ! \ 1 d @ a @ b @ c @ 08771f681 08 0b hh() d ! \ 2 c @ d @ a @ b @ 06d9d6122 0b 10 hh() c ! \ 3 b @ c @ d @ a @ 0fde5380c 0e 17 hh() b ! \ 4 a @ b @ c @ d @ 0a4beea44 01 04 hh() a ! \ 5 d @ a @ b @ c @ 04bdecfa9 04 0b hh() d ! \ 6 c @ d @ a @ b @ 0f6bb4b60 07 10 hh() c ! \ 7 b @ c @ d @ a @ 0bebfbc70 0a 17 hh() b ! \ 8 a @ b @ c @ d @ 0289b7ec6 0d 04 hh() a ! \ 9 d @ a @ b @ c @ 0eaa127fa 00 0b hh() d ! \ 10 c @ d @ a @ b @ 0d4ef3085 03 10 hh() c ! \ 11 b @ c @ d @ a @ 04881d05 06 17 hh() b ! \ 12 a @ b @ c @ d @ 0d9d4d039 09 04 hh() a ! \ 13 d @ a @ b @ c @ 0e6db99e5 0c 0b hh() d ! \ 14 c @ d @ a @ b @ 01fa27cf8 0f 10 hh() c ! \ 15 b @ c @ d @ a @ 0c4ac5665 02 17 hh() b ! \ 16 ; : round4 a @ b @ c @ d @ 0f4292244 00 06 ii() a ! \ 1 d @ a @ b @ c @ 0432aff97 07 0a ii() d ! \ 2 c @ d @ a @ b @ 0ab9423a7 0e 0f ii() c ! \ 3 b @ c @ d @ a @ 0fc93a039 05 15 ii() b ! \ 4 a @ b @ c @ d @ 0655b59c3 0c 06 ii() a ! \ 5 d @ a @ b @ c @ 08f0ccc92 03 0a ii() d ! \ 6 c @ d @ a @ b @ 0ffeff47d 0a 0f ii() c ! \ 7 b @ c @ d @ a @ 085845dd1 01 15 ii() b ! \ 8 a @ b @ c @ d @ 06fa87e4f 08 06 ii() a ! \ 9 d @ a @ b @ c @ 0fe2ce6e0 0f 0a ii() d ! \ 10 c @ d @ a @ b @ 0a3014314 06 0f ii() c ! \ 11 b @ c @ d @ a @ 04e0811a1 0d 15 ii() b ! \ 12 a @ b @ c @ d @ 0f7537e82 04 06 ii() a ! \ 13 d @ a @ b @ c @ 0bd3af235 0b 0a ii() d ! \ 14 c @ d @ a @ b @ 02ad7d2bb 02 0f ii() c ! \ 15 b @ c @ d @ a @ 0eb86d391 09 15 ii() 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 move 64 + swap transform repeat ; : movepartial ( addr count -- ) swap over buf[] swap move md5pad over buf[] + rot 64 swap - move ; : 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 move else 2drop then ; : movepart ( adr1 count1 partindex -- adr2 count2 ) \ add to part[] 2dup 64 swap - min >r part[] + >r over r> r@ move 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 ! ; : savedigit ( n -- ) \ output digit at pad 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] \ big endian : 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" message digest" .md5 s" abcdefghijklmnopqrstuvwxyz" .md5 s" abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz0123456789" .md5 s" 12345678901234567890123456789012345678901234567890123456789012345678901234567890" .md5 ( foo ) cr cr ;