Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]


Groups > comp.lang.forth > #17951

Re: SHA-512

From mhx@iae.nl (Marcel Hendrix)
Subject Re: SHA-512
Newsgroups comp.lang.forth
Message-ID <58951395918435@frunobulax.edu> (permalink)
Date 2012-12-08 22:08 +0200
References <997566ed-42e5-4677-9ab5-6e7bc9daa911@googlegroups.com>
Organization Wanadoo

Show all headers | View raw


jzakiya@gmail.com writes Re: SHA-512

[..]
> I've corrected the SHA-256 code, and written a SHA-512 version for 64-bit cpus/OSs. 
> Since I don't have a 64-bit forth I haven't run it but I'm pretty 
> sure it works, as the architecture is the same as SHA-256, with just different 
> sized constants and shifts/rotates.

It runs with minor edits (see below). I removed ]L and EVALUATE as it is unnecessary
and slows down the code.

Unfortunately, the results are wrong.
The speed is OK, 2Mbytes*1000/14.417s/2.67GHz = 51.9 MB/s/GHz

FORTH> SHAtest
SHA-512 test suite:
1ca51eba68fd0ca4284ec2b2bd024de70a231b14b914411996269e0f5c61ec7f02a2054b467965def1d526c52c525a1103c8c3aea8cc5e406f60e740bcd05969 ""
3e9e4c5b0b4eacc5f38516a9afb1c79ea5a959679b9bc6e5de04eedbaa41a198b227138994715fa52fdcb64b3689061926496b9b9d197613c0d35eafc269a023 "abc"
914d0fc46d27cabc63a868fba6b8eb0a4996553265854a33344481c3a0e00536b36c2bf0df78eb059fcaadcc25687d7eb95cbaa07591fa9e6f08839f0e7bc626 "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu"
7e4256b1fcf2c09b867e71bc8189f631999302f27f8c5c2c27ef6c39e1d3016afd6b1bdfa452847695ca18905429a365fa19d071f30a440b0c548a4d4f99fe49 2 million copies of ASCII 'a' (61h)
f4568c36ddc5a2fa022a5af467ba59b25bde16a098ea3fb83c879104c9473795a18df1e4d407379f0fe7d266dc7cfcb3d205770c35c90e8d174d4c7ed1dc0f37 400,000 copies of ASCII BL (20h)
 ok
FORTH> test1 test2 test3
SHA-512 test for EX1 for 1000 loops in milliseconds is 2
SHA-512 test for EX2 for 1000 loops in milliseconds is 4
SHA-512 test for EX3 for 1000 loops in milliseconds is 14417  ok

-marcel

--
ANEW -sha-512

\ Forth code for Secure Hash Algorithm 512 (SHA-512)
\ NIST spec at:  http://csrc.nist.gov/encryption/tkhash.html
\ For Little/Big Endian byte addressable CPUs, e.g. Intel/Power PC
\ DEPENDENCIES: CORE EXT WORDSET ; COMMON USAGE 3DROP ?DO CELL-
\ Use of this code is free subject to acknowledgment of copyright.
\ Copyright (c) 2012 Jabari Zakiya -- jzakiya@mail.com  12/07/2012

\ ======================= MACRO Wordset ========================
\ MACRO wordset from Wil Baden's Tool Belt series in
\ Forth Dimensions (FD) Vol. 19, No. 2, July/August 1997
\ Original code has been modified to make more efficient
\ MACRO allows insertion of parameters following the macro
\ "\" represents place where parameter is inserted
\ Example:  MACRO  ??  " IF  \  THEN "
\ : FOO .. ?? EXIT .... ;  ?? compiles to -- IF EXIT THEN

\ PLACE and STRING for system if needed
\ Not needed for SwiftForth v 2.00.3, needed for Win32Forth V 4.10
\ : PLACE  ( caddr n addr -)  2DUP  C!  CHAR+  SWAP  CHARS  MOVE ;
: SSTRING ( char "ccc" -) WORD COUNT HERE OVER 1+ CHARS ALLOT PACK DROP ;

\ Versions of /STRING and ANEW if system doesn't have them
\ : /STRING ( a n k - a+k n-k) ( OVER MIN) TUCK - >R CHARS + R> ;
\ : ANEW  >IN @ BL WORD FIND IF EXECUTE ELSE DROP THEN >IN ! MARKER ;

\ : split-at-char  ( a  n  char  -  a  k  a+k  n-k)
\  >R  2DUP  BEGIN  DUP  WHILE  OVER  C@  R@  -
\            WHILE  1 /STRING  REPEAT  THEN
\            R> DROP  TUCK  2>R  -  2R>
\ ;

: DOES>MACRO  \ Compile the macro, including external parameters
  DOES> COUNT  BEGIN [CHAR]  \ split-at-char  2>R  EVALUATE  R@
               WHILE BL WORD COUNT EVALUATE 2R>  1 /STRING REPEAT
               R> DROP   R> DROP
;

\ Macro creation word which allows parameter insertion
: MACRO  CREATE  IMMEDIATE  CHAR  SSTRING  DOES>MACRO  ;

\ ====================  Start SHA-256 Code ====================
  DECIMAL
  64 CONSTANT CELLSIZE          \ CPU bitsize

  2VARIABLE  SHAlen             \ Holds byte length of string < 2^128 bits|2^125 bytes
  CREATE SHAval  8 CELLS ALLOT  \ Holds hash after each block
  CREATE SHAsh  88 CELLS ALLOT  \ Fully extended hash array
  CREATE W      16 CELLS ALLOT  \ Holds message block
  1 W !                         \ For compile time endian testing

  HEX

\ SHA-512 round constants
428a2f98d728ae22  CONSTANT  K0    7137449123ef65cd  CONSTANT  K1
b5c0fbcfec4d3b2f  CONSTANT  K2    e9b5dba58189dbbc  CONSTANT  K3
3956c25bf348b538  CONSTANT  K4    59f111f1b605d019  CONSTANT  K5
923f82a4af194f9b  CONSTANT  K6    ab1c5ed5da6d8118  CONSTANT  K7
d807aa98a3030242  CONSTANT  K8    12835b0145706fbe  CONSTANT  K9
243185be4ee4b28c  CONSTANT  K10   550c7dc3d5ffb4e2  CONSTANT  K11
72be5d74f27b896f  CONSTANT  K12   80deb1fe3b1696b1  CONSTANT  K13
9bdc06a725c71235  CONSTANT  K14   c19bf174cf692694  CONSTANT  K15
e49b69c19ef14ad2  CONSTANT  K16   efbe4786384f25e3  CONSTANT  K17
0fc19dc68b8cd5b5  CONSTANT  K18   240ca1cc77ac9c65  CONSTANT  K19
2de92c6f592b0275  CONSTANT  K20   4a7484aa6ea6e483  CONSTANT  K21
5cb0a9dcbd41fbd4  CONSTANT  K22   76f988da831153b5  CONSTANT  K23
983e5152ee66dfab  CONSTANT  K24   a831c66d2db43210  CONSTANT  K25
b00327c898fb213f  CONSTANT  K26   bf597fc7beef0ee4  CONSTANT  K27
c6e00bf33da88fc2  CONSTANT  K28   d5a79147930aa725  CONSTANT  K29
06ca6351e003826f  CONSTANT  K30   142929670a0e6e70  CONSTANT  K31
27b70a8546d22ffc  CONSTANT  K32   2e1b21385c26c926  CONSTANT  K33
4d2c6dfc5ac42aed  CONSTANT  K34   53380d139d95b3df  CONSTANT  K35
650a73548baf63de  CONSTANT  K36   766a0abb3c77b2a8  CONSTANT  K37
81c2c92e47edaee6  CONSTANT  K38   92722c851482353b  CONSTANT  K39
a2bfe8a14cf10364  CONSTANT  K40   a81a664bbc423001  CONSTANT  K41
c24b8b70d0f89791  CONSTANT  K42   c76c51a30654be30  CONSTANT  K43
d192e819d6ef5218  CONSTANT  K44   d69906245565a910  CONSTANT  K45
f40e35855771202a  CONSTANT  K46   106aa07032bbd1b8  CONSTANT  K47
19a4c116b8d2d0c8  CONSTANT  K48   1e376c085141ab53  CONSTANT  K49
2748774cdf8eeb99  CONSTANT  K50   34b0bcb5e19b48a8  CONSTANT  K51
391c0cb3c5c95a63  CONSTANT  K52   4ed8aa4ae3418acb  CONSTANT  K53
5b9cca4f7763e373  CONSTANT  K54   682e6ff3d6b2b8a3  CONSTANT  K55
748f82ee5defb2fc  CONSTANT  K56   78a5636f43172f60  CONSTANT  K57
84c87814a1f0ab72  CONSTANT  K58   8cc702081a6438ec  CONSTANT  K59
90befffa23631e28  CONSTANT  K60   a4506cebde82bde9  CONSTANT  K61
bef9a3f7b2c67915  CONSTANT  K62   c67178f2e372532b  CONSTANT  K63
ca273eceea26619c  CONSTANT  K64   d186b8c721c0c207  CONSTANT  K65
eada7dd6cde0eb1e  CONSTANT  K66   f57d4f7fee6ed178  CONSTANT  K67
06f067aa72176fba  CONSTANT  K68   0a637dc5a2c898a6  CONSTANT  K69
113f9804bef90dae  CONSTANT  K70   1b710b35131c471b  CONSTANT  K71
28db77f523047d84  CONSTANT  K72   32caab7b40c72493  CONSTANT  K73
3c9ebe0a15c9bebc  CONSTANT  K74   431d67c49c100d4c  CONSTANT  K75
4cc5d4becb3e42b6  CONSTANT  K76   597f299cfc657e2a  CONSTANT  K77
5fcb6fab3ad6faec  CONSTANT  K78   6c44198c4a475817  CONSTANT  K79

  DECIMAL

  0 VALUE H[H]  \ Pointer to addr of hash value H for each round

: H[G]  H[H]  1 CELLS + ; \ Return G adr
: H[F]  H[H]  2 CELLS + ; \ Return F adr
: H[E]  H[H]  3 CELLS + ; \ Return E adr
: H[D]  H[H]  4 CELLS + ; \ Return D adr
: H[C]  H[H]  5 CELLS + ; \ Return C adr
: H[A]  H[H]  7 CELLS + ; \ Return A adr

: SHAinit ( -)  \ Load initial hash values H0 - H7
  [ HEX ] 6a09e667f3bcc908 ( H0)  bb67ae8584caa73b ( H1)
          3c6ef372fe94f82b ( H2)  a54ff53a5f1d36f1 ( H3)
          510e527fade682d1 ( H4)  9b05688c2b3e6c1f ( H5)
          1f83d9abfb41bd6b ( H6)  5be0cd19137e2179 ( H7)
  [ DECIMAL ]
  SHAsh  7 0 DO  TUCK  !  CELL+  LOOP  !   \ Put initial hash in SHAsh array
  SHAsh  SHAval  8 CELLS  CMOVE            \ Put copy in SHAval array
  SHAsh  TO  H[H]                          \ Init pointer to last hash value
;

: UpDateHash ( -)  \ Update hash values and load arrays with new values
  SHAsh  SHAval  H[H]                                  \ Place array addresses on stack
  8 0 DO  DUP >R   @   SWAP  DUP >R  @  +  DUP         \ Compute updated hash subvalue
          R@  !  OVER  !  CELL+  R>  CELL+  R>  CELL+  \ Store updated hash subvalue
  LOOP  3DROP                                          \ Clear stack when done
  SHAsh  TO  H[H]                                      \ Init pointer to last subvalue
;

\ ( - n )  n = (E AND F) XOR (~E AND G)
: Ch  H[F] 2@  OVER  AND  SWAP  INVERT  H[G]  @  AND  XOR ; 

\ ( - n )  n = (A AND B) XOR (A AND C) XOR (B AND C)
: Maj H[C]  DUP >R  CELL+  2@  OVER  AND  SWAP  R@ @  AND XOR  R> 2@ AND  XOR ; 

\ ( - n )  T1x = Ch(e,f,g) + Sig1(e) + h
: T1x  Ch  H[E] @  DUP >R  14 ror  R@  18 ror  XOR  R>  41 ror  XOR  +  H[H] @  +  ;

\ ( - n )  T2 = Maj(a,b,c) + Sig0(a)
: T2  Maj  H[A] @  DUP >R  28 ror  R@  34 ror  XOR  R>  39 ror  XOR  +  ;

\ ( x - n )  n = ROR1(X)   XOR  ROR8(X)  XOR  SHR7(X)
: sig0  ( x - n )  DUP  DUP   1 ROR  SWAP  8 ROR  XOR  SWAP  7 RSHIFT  XOR  ;

\ ( x - n )  n = ROR19(X)  XOR  ROR61(X)  XOR  SHR6(X)
: sig1  ( x - n )  DUP  DUP  19 ROR  SWAP  61 ROR  XOR  SWAP 6 RSHIFT  XOR  ;

\ Put two copies of original Wi on stack, keep its address
: Wi@ ( [Wi] - wi [Wi] wi) DUP  @  TUCK ; 

\ Create 2 copies of new Wi' from Wi on stack  ( ..Wi -..Wi' Wi')
: Wi  15 PICK  15 PICK  sig0  +  7 PICK  +  2 PICK  sig1  +  DUP ;

\ Drop 80 Wi cells from stack ( W0..W79 - )
: WiDROP  5 0 DO  2DROP 2DROP 2DROP 2DROP 2DROP 2DROP 2DROP 2DROP LOOP ;

: subrnd  DUP  H[D]  +!  T2  +  H[G] TO H[H]  H[A] !  ;

MACRO rndi\  " Wi@  T1x  +  \  +  subrnd  CELL+"
MACRO rndn\  " Wi   T1x  +  \  +  subrnd "

: SHA512  ( Wadr - )
  rndi\  K0    rndi\  K1    rndi\  K2    rndi\  K3   \ Wi = Mi for 1st 16 rounds
  rndi\  K4    rndi\  K5    rndi\  K6    rndi\  K7
  rndi\  K8    rndi\  K9    rndi\  K10   rndi\  K11
  rndi\  K12   rndi\  K13   rndi\  K14   rndi\  K15  DROP  ( W0..W15 )
  rndn\  K16   rndn\  K17   rndn\  K18   rndn\  K19  \ Wj now function of Wi
  rndn\  K20   rndn\  K21   rndn\  K22   rndn\  K23
  rndn\  K24   rndn\  K25   rndn\  K26   rndn\  K27
  rndn\  K28   rndn\  K29   rndn\  K30   rndn\  K31
  rndn\  K32   rndn\  K33   rndn\  K34   rndn\  K35
  rndn\  K36   rndn\  K37   rndn\  K38   rndn\  K39
  rndn\  K40   rndn\  K41   rndn\  K42   rndn\  K43
  rndn\  K44   rndn\  K45   rndn\  K46   rndn\  K47
  rndn\  K48   rndn\  K49   rndn\  K50   rndn\  K51
  rndn\  K52   rndn\  K53   rndn\  K54   rndn\  K55
  rndn\  K56   rndn\  K57   rndn\  K58   rndn\  K59
  rndn\  K60   rndn\  K61   rndn\  K62   rndn\  K63
  rndn\  K64   rndn\  K65   rndn\  K66   rndn\  K67
  rndn\  K68   rndn\  K69   rndn\  K70   rndn\  K71
  rndn\  K72   rndn\  K73   rndn\  K74   rndn\  K75
  rndn\  K76   rndn\  K77   rndn\  K78   rndn\  K79  WiDROP  ( - )
  UpDateHash
;

: setlen  ( -- )  \ Store bit count into last two cells
  SHAlen 2@  D2* D2* D2* ( bytes->bits) W 112 CHARS + !  W 120 CHARS + ! ;

: bytes>< ( m -- w )  \ Reverse cell bytes: 1234567890abcdef <-> efcdab9078563412
  [ HEX ]  DUP >R  38 LSHIFT  R@ FF00 AND  28 LSHIFT OR
  R@ FF0000 AND 18 LSHIFT OR  R@ FF000000 AND 8 LSHIFT OR
  R@ 20 RSHIFT FF AND OR   R@ 18 RSHIFT FF00 AND OR   R@  10 RSHIFT FF0000 AND OR
  R>  8 RSHIFT FF000000 AND OR [ DECIMAL ]
;

: cellsreverse  ( adr n -- )  \ Reverse bytes of n cells in array
  0 DO  DUP  @  bytes><  OVER !  CELL+  LOOP  DROP
;

W C@ [IF]  \ if little ENDIAN, e.g. Intel/AMD
      : endian16 ( adr -- adr ) DUP  16  cellsreverse ;
      : endian14 ( adr -- adr ) DUP  14  cellsreverse ;
[ELSE]      \ if big ENDIAN, e.g. Macs
      : endian16 ( adr -- adr ) ; \ Do nothing
      : endian14 ( adr -- adr ) ; \ Do nothing
[THEN]

\ Do all 128 byte blocks leaving remainder block
: hashfullblocks ( adr1 dcount -- adr2 count )         \ dcount is double number: lo hi
  SWAP  DUP >R  7 RSHIFT               ( adr1 hi lo* ) \ Store lo on return, do lo*=lo/128
  OVER CELLSIZE 7 - LSHIFT OR >R       ( adr1 hi     ) \ Return is now: :R lo lo'
  ( hi) 7 RSHIFT 0 ?DO                 ( adr1        ) \ Do if hi'= hi/128 > 0
    0 0 DO DUP endian16 SHA512 128 + LOOP ( lo' adr' ) \ Hash for 2^cellsize full blocks
  LOOP                                 ( adr'        ) \ Hash for hi'*2^cellsize full blocks
  R> 0 ?DO DUP endian16 SHA512 128 + LOOP ( adr'     ) \ Hash block for lo count full 128 byte blocks
  R> ( lo) 127 AND                    ( adr2 cnt2    ) \ Leave address and count for partial block
;

: hashfinal ( addr count -- )  \ Hash partial and/or last block
  DUP >R  W  SWAP  CMOVE                \ Move bytes into block W array
  W  R@ +  128  OVER  C!   ( adr     )  \ Put 80h after last message byte
  CHAR+  111 R@ -          ( adr #   )  \ Compute tentative 0 byte FILL count
  R> 111 >                 ( adr # ? )  \ Is partial block byte count > 111 ?
  IF    16 + 0  FILL            ( -- )  \ If yes, FILL rest of block w/zeroes
        W  endian16  SHA512     ( -- )  \ Endian adjust block if required, then hash
        W  112             ( adr 112 )  \ Now setup last block containing bit count
  THEN                     ( adr #   )
  0 FILL  setlen  W  endian14  SHA512   \ Zero FILL last block, set message bit count
;                               ( -- )  \ Endian adjust, except bit count, then hash

\ Compute SHA512 from a counted buffer of text
: SHAbuffer ( addr dcount -- )
  SHAinit  2DUP  SHAlen 2!  hashfullblocks  hashfinal ;

\ ===============  Hash string display wordset  ===============
  DECIMAL

\ Array of digits 0123456789abcdef
: digit$  ( -- adr )  S" 0123456789abcdef"  DROP  ;

: intdigits ( -- )  0 PAD  ! ;
: savedigit ( n -- )  PAD  C@  1+  DUP  PAD  C!  PAD  +  C!  ;
: bytedigits ( n1 -- )
  DUP 4 RSHIFT digit$ + C@ savedigit 15 AND digit$ + C@ savedigit
;

  W C@ [IF] \ little ENDIAN
: celldigits ( a1 -- )  DUP 7 + DO I C@ bytedigits  -1 +LOOP ;
  [ELSE]    \ big ENDIAN
: celldigits ( a1 -- )  DUP 8 + SWAP DO I C@ bytedigits LOOP ;
  [THEN]

: SHAstring ( -- adr count )  \ Return counted SHA-512 string array
  intdigits  SHAval 7 CELLS +  8 0 DO  DUP  celldigits  CELL-  LOOP  DROP  PAD  COUNT ;

\ Display SHA-512 hash value in hex ( A B C D E F G H )
: HASH. CR  SHAstring  TYPE  SPACE  ;

: QuoteString ( adr cnt --)  [CHAR] " EMIT  TYPE  [CHAR] " EMIT ;


\ ====================  File hash wordset  ====================
  VARIABLE  rfileid     \ Holds fileid number of input file

: InputFileName  ( -- ior)
  CR  CR  ." Filename: "  PAD  DUP  80  ACCEPT ( adr #)
  R/O  OPEN-FILE  SWAP  rfileid !  ( ior)
;

: TryAgain?  ( -- ?)
  CR  CR ." Invalid iput file, try again? (Y/N)"
  KEY  DUP  EMIT  DUP [CHAR] N =  SWAP [CHAR] n = OR
;

\ Read n bytes from input file, store at addr array
: bytes@  ( adr n - )  rfileid @  READ-FILE  2DROP ;

: storelen  ( lo hi - )  \ Store bit count into last two cells
  D2* D2* D2* ( bytes->bits) W 112 CHARS +  !  W 120 CHARS + !
;

: getpartial ( cnt  -- W'  cnt2 ?)
  W  2DUP  SWAP  DUP >R  bytes@          ( cnt1 adr1  )
  + 128 OVER C! CHAR+ 111 R@ - R> 111 >  ( adr2 cnt2 ?)
;

: block@  W 128 bytes@ ;

: SHAfile ( -- )
  BEGIN  InputFileName  ( ior)                  \ Enter filename
  WHILE  TryAgain? IF  EXIT  THEN               \ Not valid, try (not) again
  REPEAT SHAinit                                \ Valid file, init transform
  rfileid @  FILE-SIZE  DROP  ( ud )            \ Get bytesize of input file
  2 0  D-                                       \ Dec cnt by 2 for CR|LF EOF
  CR ." Bytesize: " 2DUP  D.                    \ Display filesize to screen
  2DUP  2>R                                     \ ( lo  hi ) Save file byte cnt on RETURN
  OVER  7 RSHIFT OVER                           \ ( lo  hi lo* hi )
  CELLSIZE 7 - LSHIFT OR  SWAP  7 RSHIFT        \ ( lo  lo' hi') full block count
  0 ?DO 0 0 DO block@  W endian16 SHA512 LOOP LOOP  \ Hash hi*2^cellsize full blocks
  0 ?DO block@  W endian16 SHA512 LOOP          \ Hash lo count full 128 byte blocks
  ( lo) 127 AND ( rembytes) getpartial ( adr cnt ?) \ Read remaining bytes
  IF 16 + 0 FILL  W endian16 SHA512  W 112 THEN \ Do if rembytes > 111
  0 FILL  2R> storelen  W endian14  SHA512      \ Do last block
  CR  ." SHA-512 : "  SHAstring  TYPE  CR       \ Show SHA-512 hash for file
  rfileid @  CLOSE-FILE  DROP                   \ Close the input file
;

\ ====================  SHA-512 Test Suite  =====================
  DECIMAL

\ Load W array with data on stack
: WLoad ( d0..d15 -- )  W 15 CELLS + ( d0..d15 W[15] )
  16 0 DO  TUCK  !  CELL-  LOOP  DROP
;

\ -------------------------------------------------------------
\ EXAMPLE 1: from FIPS PUB
\ Message: ASCII string 'abc'
\ Hash = DDAF35A1 93617ABA CC417349 AE204131 12E6FA4E 89A97EA2 0A9EEEE6 4B55D39A
\        2192992A 274FC1A8 36BA3C23 A3FEEBBD 454D4423 643CE80E 2A9AC94F A54CA49F

\ Compute and display hash for ASCII string 'abc'
: EX1  S" abc" U>D ( adr dcount) SHAbuffer  HASH.  ;

\ -------------------------------------------------------------
\ EXAMPLE 2: from FIPS PUB
\ Message:"abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu"
\ Hash = 8E959B75 DAE313DA 8CF4F728 14FC143F 8F7779C6 EB9F7FA1 7299AEAD B6889018
\        501D289E 4900F7E4 331B99DE C4B5433A C7D329EE B6DD2654 5E96E55B 874BE909

: EX2a S" abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu" U>D ( adr dcount) ;
: EX2  EX2a  SHAbuffer  HASH.  ;

\ -------------------------------------------------------------
\ EXAMPLE 3:
\ Message: 2 million copies of 'a' (61h), (16 million bits)
\ Hash =

\ Load block of all 'a's (61h), must hash 15,625 times
: EX3a  W  128  [CHAR] a  FILL  ;

\ Last message block: 1st bit a '1', bit-count = 16 million
: EX3b  [ HEX ] 8000000000000000 0 0 0 0 0 0 0 0 0 0 0 0 0
        [ DECIMAL ] 0 16000000 WLoad
;
\ Do hash for message of 2 million copies of ASCII 'a' (61h)
: EX3  SHAinit  EX3a  15625 0 DO W SHA512 LOOP  EX3b  W SHA512 HASH. ;

\ -------------------------------------------------------------
\ EXAMPLE 4:
\ Message: 400,000 SPACES 'BL' (20h), (3,200,000 bits)
\ Hash =

\ Load block of all "BL' (20h), hash 156 full blocks + 16 bytes
: EX4a  W  128  BL  FILL  ;

\ Last message block: 1st bit a '1', bit-count = 3,200,000
: EX4b  [ HEX ] 8000000000000000 0 0 0 0 0 0 0 0 0 0 0 0 0
        [ DECIMAL ] 0 3200000 WLoad
;

\ Do hash for message of 400,000 SPACES 'BL' (20h)
: EX4  SHAinit  EX4a  3125 0 DO  W SHA512  LOOP  EX4b  W SHA512 HASH. ;

\ -------------------------------------------------------------
\ Message: blank string ''
\ Hash =

: SHATest ( -- )
  CR ." SHA-512 test suite:"
  S" " U>D ( adr dcount)  SHAbuffer  HASH.  S" "  QuoteString
  EX1  S" abc"   QuoteString
  EX2  EX2a DROP QuoteString
  EX3  S" 2 million copies of ASCII 'a' (61h)" TYPE
  EX4  S" 400,000 copies of ASCII BL (20h)" TYPE  CR ;

\ ===========  Forth specific performance test ===========

  VARIABLE  start-ms

: TIMER-START  ( -- )  ?MS  start-ms  ! ;

: MS?  ( -- u )  ?MS  start-ms  @  - ( abs ) ;

: .### ( -) BASE @ >R DECIMAL MS? 0 <# # # # [CHAR] . HOLD #S #> R> BASE ! TYPE ;

  DECIMAL 1000 VALUE N#

: [EX1]  S" abc" U>D ( adr dcount) SHAbuffer  ;
: [EX2]  EX2a     SHAbuffer  ;
: [EX3]  SHAinit  EX3a  15625 0 DO W SHA512 LOOP EX3b W SHA512 ;

: test1  [ DECIMAL ]
  cr ." SHA-512 test for EX1 for " N# . ." loops in milliseconds is "
  TIMER-START  N# 0 DO  [EX1]  LOOP  MS?  U.
;

: test2  [ DECIMAL ]
  cr ." SHA-512 test for EX2 for " N# . ." loops in milliseconds is "
  TIMER-START  N# 0 DO  [EX2]  LOOP  MS?  U.
;

: test3  [ DECIMAL ]
  cr ." SHA-512 test for EX3 for " N# . ." loops in milliseconds is "
  TIMER-START  N# 0 DO  [EX3]  LOOP  MS?  U.
;

Back to comp.lang.forth | Previous | NextPrevious in thread | Find similar


Thread

SHA-512 mhx@iae.nl (Marcel Hendrix) - 2012-12-02 23:48 +0200
  Re: SHA-512 jzakiya@gmail.com - 2012-12-07 14:47 -0800
    Re: SHA-512 Coos Haak <chforth@hccnet.nl> - 2012-12-08 00:49 +0100
      Re: SHA-512 jzakiya@gmail.com - 2012-12-07 16:54 -0800
        Re: SHA-512 Coos Haak <chforth@hccnet.nl> - 2012-12-08 18:21 +0100
      Re: SHA-512 jzakiya@gmail.com - 2012-12-08 18:36 -0800
        Re: SHA-512 mhx@iae.nl (Marcel Hendrix) - 2012-12-09 09:14 +0200
          Re: SHA-512 jzakiya@gmail.com - 2012-12-09 17:23 -0800
            Re: SHA-512 jzakiya@gmail.com - 2012-12-09 17:29 -0800
              Re: SHA-512 jzakiya@gmail.com - 2012-12-09 20:46 -0800
              Re: SHA-512 m.a.m.hendrix@tue.nl - 2012-12-10 03:53 -0800
                Re: SHA-512 jzakiya@gmail.com - 2012-12-10 13:05 -0800
                Re: SHA-512 mhx@iae.nl (Marcel Hendrix) - 2012-12-10 23:17 +0200
                Re: SHA-512 jzakiya@gmail.com - 2012-12-13 06:30 -0800
                Re: SHA-512 mhx@iae.nl (Marcel Hendrix) - 2012-12-13 21:33 +0200
                Re: SHA-512 jzakiya@gmail.com - 2012-12-13 19:38 -0800
                Re: SHA-512 mhx@iae.nl (Marcel Hendrix) - 2012-12-14 22:52 +0200
                Re: SHA-512 jzakiya@gmail.com - 2012-12-14 16:39 -0800
                Re: SHA-512 mhx@iae.nl (Marcel Hendrix) - 2012-12-15 19:11 +0200
                Re: SHA-512 mhx@iae.nl (Marcel Hendrix) - 2012-12-16 16:00 +0200
                Re: SHA-512 jzakiya@gmail.com - 2012-12-16 17:33 -0800
                Re: SHA-512 jzakiya@gmail.com - 2012-12-16 22:35 -0800
                Re: SHA-512 mhx@iae.nl (Marcel Hendrix) - 2012-12-17 10:14 +0200
                Re: SHA-512 mhx@iae.nl (Marcel Hendrix) - 2012-12-17 10:51 +0200
                Re: SHA-512 jzakiya@gmail.com - 2012-12-17 09:13 -0800
                Re: SHA-512 mhx@iae.nl (Marcel Hendrix) - 2012-12-17 22:24 +0200
                Re: SHA-512 Howerd <howerdo@yahoo.co.uk> - 2012-12-13 13:06 -0800
                Re: SHA-512 Howerd <howerdo@yahoo.co.uk> - 2012-12-13 13:03 -0800
    Re: SHA-512 mhx@iae.nl (Marcel Hendrix) - 2012-12-08 22:08 +0200

csiph-web