Revision 4 Version 9.8 plus RIPEMD-160 example

New revision. Added Binary.Add() to add two or more numbers with modulo 2^32. This function needed for cryptographic functions.
This is one for RIPEMD-160, written for rosettacode.org task about it.

This implantation is for education only. We get the RIPEMD function from another function, the Prepare_RiPeMD_160() which make some arrays, and pass them as closures to the returned function. So in module TestHash we pass the lambda function and do all the tests. The last test, with 1 million "a", need more than an hour to complete. M2000 is an interpreter, with no AST yet. In my plans is a new version of M20000  to be prepared with an AST interpreter, to gain speed. The current interpreter consume source code as it runs. The AST interpreter, pass the source to a lexical analyzer, and then to a syntax analyzer. Compiling is not in my scope, but who knows, what a mind can think, sometimes.

Module Checkit {
 Function Prepare_RiPeMd_160 {
  Dim Base 0,  K(5), K1(5)
  K(0)=0x00000000, 0x5A827999, 0x6ED9EBA1, 0x8F1BBCDC, 0xA953FD4E
  K1(0)=0x50A28BE6,0x5C4DD124, 0x6D703EF3, 0x7A6D76E9, 0x00000000
  Dim Base 0,r(80), r1(80), s(80), s1(80)
  r(0)=0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15
  r(16)=7, 4, 13, 1, 10, 6, 15, 3, 12, 0, 9, 5, 2, 14, 11, 8
  r(32)= 3, 10, 14, 4, 9, 15, 8, 1, 2, 7, 0, 6, 13, 11, 5, 12
  r(48)=1, 9, 11, 10, 0, 8, 12, 4, 13, 3, 7, 15, 14, 5, 6, 2
  r(64)=4, 0, 5, 9, 7, 12, 2, 10, 14, 1, 3, 8, 11, 6, 15, 13
  k=r() : k*=4   ' k is a pointer to array. We have to multiply to make them offsets
  
  r1(0)=5, 14, 7, 0, 9, 2, 11, 4, 13, 6, 15, 8, 1, 10, 3, 12
  r1(16)=6, 11, 3, 7, 0, 13, 5, 10, 14, 15, 8, 12, 4, 9, 1, 2
  r1(32)=15, 5, 1, 3, 7, 14, 6, 9, 11, 8, 12, 2, 10, 0, 4, 13
  r1(48)=8, 6, 4, 1, 3, 11, 15, 0, 5, 12, 2, 13, 9, 7, 10, 14
  r1(64)=12, 15, 10, 4, 1, 5, 8, 7, 6, 2, 13, 14, 0, 3, 9, 11
  
  k=r1() : k*=4
  
  s(0)=11, 14, 15, 12, 5, 8, 7, 9, 11, 13, 14, 15, 6, 7, 9, 8
  s(16)=7, 6, 8, 13, 11, 9, 7, 15, 7, 12, 15, 9, 11, 7, 13, 12
  s(32)=11, 13, 6, 7, 14, 9, 13, 15, 14, 8, 13, 6, 5, 12, 7, 5
  s(48)=11, 12, 14, 15, 14, 15, 9, 8, 9, 14, 5, 6, 8, 6, 5, 12
  s(64)=9, 15, 5, 11, 6, 8, 13, 12, 5, 12, 13, 14, 11, 8, 5, 6
  
  s1(0)=8, 9, 9, 11, 13, 15, 15, 5, 7, 7, 8, 11, 14, 14, 12, 6
  s1(16)=9, 13, 15, 7, 12, 8, 9, 11, 7, 7, 12, 7, 6, 15, 13, 11
  s1(32)=9, 7, 15, 11, 8, 6, 6, 14, 12, 13, 5, 14, 13, 13, 7, 5
  s1(48)=15, 5, 8, 11, 14, 14, 6, 14, 6, 9, 12, 9, 12, 5, 15, 8
  s1(64)=8, 5, 12, 9, 12, 5, 14, 6, 8, 13, 6, 5, 15, 13, 11, 11
  
  Dim Base 0, T(5), TT(5)
  T(0)=lambda ->binary.xor(binary.xor(number,number),number)
  T(1)=lambda (B,C,D)->binary.or(binary.and(B,C), binary.and(binary.not(B), D))
  T(2)=lambda ->binary.xor(binary.or(number, binary.not(number)), number)
  T(3)=lambda (B,C,D)->binary.or(binary.and(B,D), binary.and(C,binary.not(D)))
  T(4)=lambda ->binary.xor(number, binary.or(number, binary.not(number)))
  
  \\ no need for variables we read form stack with number
  TT(0)=lambda ->binary.xor(number, binary.or(number, binary.not(number)))
  TT(1)=lambda (BB,CC,DD)->binary.or(binary.and(BB,DD), binary.and(CC,binary.not(DD))) 
  TT(2)=lambda ->binary.xor(binary.or(number, binary.not(number)), number)
  TT(3)=lambda (BB,CC,DD)->binary.or(binary.and(BB,CC), binary.and(binary.not(BB),DD)) 
  TT(4)=lambda ->binary.xor(binary.xor(number,number),number)
  
  \\ return of this function is a lambda function
  \\ all arrays are closures to this lambda
  =lambda K(),K1(),TT(), T(),r(),r1(), s(), s1() (&message$, ansi as boolean=true, ansiid=1033)-> {
   set fast!
   def h0 = 0x67452301, h1 = 0xEFCDAB89, h2 = 0x98BADCFE
   def h3 = 0x10325476, h4 = 0xC3D2E1F0
   def i, j, l, padding, l1, blocks, acc, f64 as boolean=true, oldid
   if ansi then oldid=locale : locale ansiid
   \\ we use a buffer of 64 bytes
   buffer clear message as byte*64
   l=len(message$)*if(ansi->1,2 )
   if binary.and(l,63)>55 then  padding=64 
   padding+= 64 - (l Mod 64)
   l1=padding+l+1
 
   f64=binary.and(l,63)<>0
 
   blocks=l1 div 64
rem
   Print "blocks:";blocks
   \\ now prepare the buffer
   PrepareBuffer()
   def decimal  A, B, C, D, E, AA, BB, CC, DD, EE, T, TT
   do
   A  = h0 : B  = h1 : C  = h2 : D  = h3 : E  = h4
   AA = h0 : BB = h1 : CC = h2 : DD = h3 : EE = h4
   for J=0 to 79 {
    JJ=J DIV 16
    PUSH binary.add(Binary.Rotate(binary.add(A,T(JJ)(B,C,D),eval(message ,r(j) as long),k(jj)), s(j)), e)
    A = E : E = D : D = Binary.Rotate(C, 10) : C = B : READ B 
    PUSH binary.add(Binary.Rotate(binary.add(AA,TT(JJ)(BB,CC,DD),eval(message, r1(j) as long),k1(jj)),s1(j)),EE)
    AA = EE : EE = DD : DD = Binary.Rotate(CC, 10) : CC = BB : READ BB
   }
   push binary.add(h1, C, DD)
   h1 = binary.add(h2, D, EE)
   h2 = binary.add(h3, E, AA)
   h3 = binary.add(h4, A, BB)
   h4 = binary.add(h0, B, CC)
   Read h0
   blocks--
rem
   print over $(0,8), blocks : Refresh
   if blocks=0 then exit
   PrepareBuffer()
   always
rem
   print
   buffer ans as byte*20
   \\ we put ulong (long is ulong in buffers)
   Return ans, 0:=h0 as long, 4:=h1 as long,8:=h2 as long, 12:=h3 as long, 16:=h4 as long
   =ans
   if ansi then locale oldid
   set fast
   Sub PrepareBuffer()
    
    if l-acc>=64 then
     LoadPart(64)
    else.if blocks=1 then
     return message, 0:=string$(chr$(0),32)
     if l-acc=0 and f64 then
      Return message, 56:=l*8 as long, 60 :=binary.shift(l,-29) as long
     else
      Return message, l-acc:=0x80, 56:=l*8 as long, 60 :=binary.shift(l,-29) as long
      if l>acc then LoadPart(l-acc)
     end if
    else
     Return message, l-acc:=0x80
     LoadPart(l-acc)
    end if
   End Sub
   sub LoadPart(many)
    \\ str$() convert to ansi, one byte per character
    \\ using 1033 as Ansi language
    if ansi then
     Return message, 0:=str$(mid$(message$,1+acc, many))
    else
     Return message, 0:=mid$(message$, 1+acc, many)
    end if
    acc+=many
   end sub
  }
 }
 Module TestHash (RIPEMD){
  Flush
  \\ push data to stack of values, as fifo (each entry append to end of stack)
  Data "b3be159860842cebaa7174c8fff0aa9e50a5199f","Rosetta Code"
  Data "9c1185a5c5e9fc54612808977ee8f548b2258d31",""
  Data "0bdc9d2d256b3ee9daae347be6f4dc835a467ffe","a"
  Data "8eb208f7e05d987a9b044a8e98c6b087f15a0bfc","abc"
  Data "5d0689ef49d2fae572b881b123a85ffa21595f36", "message digest"
  Data "f71c27109c692c1b56bbdceb5b9d2865b3708dbc","abcdefghijklmnopqrstuvwxyz"
  Data "b0e20b6e3116640286ed3a87a5713079b21f5189"
  Data "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
  Data "9b752e45573d4b39f4dbd3323cab82bf63326bfb", String$("1234567890",8)
rem  Data "52783243c1697bdbe16d37f97f68f08325dc1528", String$("a",1000000)
  
  While not empty
   Read check$, text$
   Print "RIPEMD160 for ";quote$(Left$(if$(len(text$)>30->left$(text$,27)+"...",  text$),30))
   \\ pass text$ by reference
   Display(RIPEMD(&text$))
  End While
  
  sub Display(ans)
   local answer$
   for i=0 to len(ans)-1
    answer$+=hex$(eval(ans,i),1)
   next i
   Print lcase$(answer$)
   Print lcase$(answer$)=check$
  end sub
 }
 TestHash Prepare_RiPeMd_160() 
}
Checkit