(* * LANGUAGE : ANS Forth with extensions * PROJECT : Forth Environments * DESCRIPTION : Based on SHA-512 from Aaron D. Gifford - http://www.aarongifford.com/ * CATEGORY : Encrypter tool * AUTHOR : Marcel Hendrix * LAST CHANGE : December 1, 2012, Marcel Hendrix *) \ modified by Anton Ertl to reduce the number of ROUND512 words, and \ use the data stack and locals in SHA512_transfrom and the ROUND512 \ words rather than using values. NEEDS -miscutil REVISION -sha512 "--- SHA-512 64-bit Version 0.00 ---" PRIVATES DOC (* Examples of SHA-1, SHA-224, SHA-256, SHA-384, SHA-512, SHA-512/224 and SHA512/256 are available at http://csrc.nist.gov/groups/ST/toolkit/examples.html *) ENDDOC #128 =: SHA512_BLOCK_LENGTH PRIVATE #64 =: SHA512_DIGEST_LENGTH PRIVATE SHA512_DIGEST_LENGTH 2* 1+ =: SHA512_DIGEST_STRING_LENGTH PRIVATE SHA512_BLOCK_LENGTH #16 - =: SHA512_SHORT_BLOCK_LENGTH PRIVATE 0 VALUE bitcount PRIVATE CREATE W512[] PRIVATE SHA512_BLOCK_LENGTH CHARS ALLOT CREATE digest[] PRIVATE SHA512_DIGEST_LENGTH CHARS ALLOT CREATE digesttext[] PRIVATE SHA512_DIGEST_STRING_LENGTH CHARS ALLOT -- Hash constant words K for SHA-512 CREATE K512[] PRIVATE $428A2F98D728AE22 , $7137449123EF65CD , $B5C0FBCFEC4D3B2F , $E9B5DBA58189DBBC , $3956C25BF348B538 , $59F111F1B605D019 , $923F82A4AF194F9B , $AB1C5ED5DA6D8118 , $D807AA98A3030242 , $12835B0145706FBE , $243185BE4EE4B28C , $550C7DC3D5FFB4E2 , $72BE5D74F27B896F , $80DEB1FE3B1696B1 , $9BDC06A725C71235 , $C19BF174CF692694 , $E49B69C19EF14AD2 , $EFBE4786384F25E3 , $0FC19DC68B8CD5B5 , $240CA1CC77AC9C65 , $2DE92C6F592B0275 , $4A7484AA6EA6E483 , $5CB0A9DCBD41FBD4 , $76F988DA831153B5 , $983E5152EE66DFAB , $A831C66D2DB43210 , $B00327C898FB213F , $BF597FC7BEEF0EE4 , $C6E00BF33DA88FC2 , $D5A79147930AA725 , $06CA6351E003826F , $142929670A0E6E70 , $27B70A8546D22FFC , $2E1B21385C26C926 , $4D2C6DFC5AC42AED , $53380D139D95B3DF , $650A73548BAF63DE , $766A0ABB3C77B2A8 , $81C2C92E47EDAEE6 , $92722C851482353B , $A2BFE8A14CF10364 , $A81A664BBC423001 , $C24B8B70D0F89791 , $C76C51A30654BE30 , $D192E819D6EF5218 , $D69906245565A910 , $F40E35855771202A , $106AA07032BBD1B8 , $19A4C116B8D2D0C8 , $1E376C085141AB53 , $2748774CDF8EEB99 , $34B0BCB5E19B48A8 , $391C0CB3C5C95A63 , $4ED8AA4AE3418ACB , $5B9CCA4F7763E373 , $682E6FF3D6B2B8A3 , $748F82EE5DEFB2FC , $78A5636F43172F60 , $84C87814A1F0AB72 , $8CC702081A6439EC , $90BEFFFA23631E28 , $A4506CEBDE82BDE9 , $BEF9A3F7B2C67915 , $C67178F2E372532B , $CA273ECEEA26619C , $D186B8C721C0C207 , $EADA7DD6CDE0EB1E , $F57D4F7FEE6ED178 , $06F067AA72176FBA , $0A637DC5A2C898A6 , $113F9804BEF90DAE , $1B710B35131C471B , $28DB77F523047D84 , $32CAAB7B40C72493 , $3C9EBE0A15C9BEBC , $431D67C49C100D4C , $4CC5D4BECB3E42B6 , $597F299CFC657E2A , $5FCB6FAB3AD6FAEC , $6C44198C4A475817 , K512[] #80 CELLS CONST-DATA 0 VALUE a PRIVATE 0 VALUE b PRIVATE 0 VALUE c PRIVATE 0 VALUE d PRIVATE 0 VALUE e PRIVATE 0 VALUE f PRIVATE 0 VALUE g PRIVATE 0 VALUE h PRIVATE 0 VALUE jj PRIVATE 0 VALUE data PRIVATE : Ch ( x y z -- u ) >R OVER AND SWAP INVERT R> AND XOR ; PRIVATE : Maj ( x y z -- u ) >R DUP >R OVER AND R> R@ AND XOR SWAP R> AND XOR ; PRIVATE : sigma0_512u ( x -- u ) DUP >R #28 ROR R@ #34 ROR XOR R> #39 ROR XOR ; PRIVATE : sigma1_512u ( x -- u ) DUP >R #14 ROR R@ #18 ROR XOR R> #41 ROR XOR ; PRIVATE : sigma0_512l ( x -- u ) DUP >R 1 ROR R@ 8 ROR XOR R> 7 RSHIFT XOR ; PRIVATE : sigma1_512l ( x -- u ) DUP >R #19 ROR R@ #61 ROR XOR R> 6 RSHIFT XOR ; PRIVATE -- SHA-512: ********************************************************* : SHA512_Init ( -- ) $6A09E667F3BCC908 TO a $BB67AE8584CAA73B TO b $3C6EF372FE94F82B TO c $A54FF53A5F1D36F1 TO d $510E527FADE682D1 TO e $9B05688C2B3E6C1F TO f $1F83D9ABFB41BD6B TO g $5BE0CD19137E2179 TO h W512[] SHA512_BLOCK_LENGTH ERASE CLEAR bitcount ; PRIVATE : ROUND512_0_TO_15 ( a b c d e f g h u -- h a b c d e f g ) locals| u h g f e d c b a | data @+ SWAP TO data BSWAP W512[] u CELL[] ! h e sigma1_512u + e f g Ch + K512[] u CELL[] @ + W512[] u CELL[] @ + DUP +TO d ( T1 ) a sigma0_512u + a b c Maj + ( h ) a b c d e f g ; PRIVATE : ROUND512 ( a b c d e f g h u -- h a b c d e f g ) locals| u h g f e d c b a | W512[] u 1+ $0F AND CELL[] @ sigma0_512l ( s0) W512[] u #14 + $0F AND CELL[] @ sigma0_512l ( s1) + W512[] u 9 + $0F AND CELL[] @ + DUP W512[] u $0F AND CELL[] +! ( -- u ) h + e sigma1_512u + e f g Ch + K512[] u CELL[] @ + DUP +TO d ( T1 ) a sigma0_512u + a b c Maj + ( h ) a b c d e f g ; PRIVATE 0 VALUE r# : shows CR r# 2 .R SPACE a H. space b H. space c H. space d H. CR 3 SPACES e H. space f H. space g H. space h H. 1 +TO r# r# ?EXIT W512[] #16 CELLS DUMP ; : SHA512_Transform ( addr -- ) TO data a b c d e f g h #16 #00 do i ROUND512_0_TO_15 loop #80 #16 do i ROUND512 loop TO h TO g TO f TO e TO d TO c TO b TO a ; PRIVATE : SHA512_Update ( c-addr u -- ) 0 0 LOCALS| freespace usedspace len addr | len 0= ?EXIT bitcount 3 RSHIFT SHA512_BLOCK_LENGTH MOD TO usedspace usedspace IF SHA512_BLOCK_LENGTH usedspace - TO freespace len freespace >= IF addr W512[] usedspace + freespace MOVE freespace 3 LSHIFT +TO bitcount freespace -TO len freespace +TO addr W512[] SHA512_Transform ELSE addr W512[] usedspace + len MOVE len 3 LSHIFT +TO bitcount CLEAR usedspace CLEAR freespace EXIT ENDIF ENDIF BEGIN len SHA512_BLOCK_LENGTH >= WHILE addr SHA512_Transform SHA512_BLOCK_LENGTH 3 LSHIFT +TO bitcount SHA512_BLOCK_LENGTH -TO len SHA512_BLOCK_LENGTH +TO addr REPEAT len IF addr W512[] len MOVE len 3 LSHIFT +TO bitcount ENDIF ; PRIVATE : SHA512_Last ( -- ) bitcount 3 RSHIFT SHA512_BLOCK_LENGTH MOD LOCAL usedspace bitcount BSWAP TO bitcount usedspace IF $80 W512[] usedspace + C! 1 +TO usedspace usedspace SHA512_SHORT_BLOCK_LENGTH <= IF W512[] usedspace + SHA512_SHORT_BLOCK_LENGTH usedspace - ERASE ELSE usedspace SHA512_BLOCK_LENGTH < IF W512[] usedspace + SHA512_BLOCK_LENGTH usedspace - ERASE ENDIF W512[] SHA512_Transform W512[] SHA512_BLOCK_LENGTH 2- ERASE ENDIF ELSE W512[] SHA512_SHORT_BLOCK_LENGTH ERASE $80 W512[] C! ENDIF 0 W512[] SHA512_SHORT_BLOCK_LENGTH + ! bitcount W512[] SHA512_SHORT_BLOCK_LENGTH CELL+ + ! W512[] SHA512_Transform ; PRIVATE : SHA512_Final ( -- ) SHA512_Last digest[] a BSWAP SWAP !+ b BSWAP SWAP !+ c BSWAP SWAP !+ d BSWAP SWAP !+ e BSWAP SWAP !+ f BSWAP SWAP !+ g BSWAP SWAP !+ h BSWAP SWAP ! ; PRIVATE : SHA512_End ( -- c-addr u ) SHA512_Final digesttext[] C0! digest[] SHA512_DIGEST_LENGTH BOUNDS DO I @ BSWAP (H.) 1 /STRING digesttext[] PLACE+ 8 +LOOP digesttext[] COUNT ; PRIVATE : SHA512_Data ( data len -- c-addr u ) SHA512_Init SHA512_Update SHA512_End ; : .SHA512 ( c-addr u -- ) 0 LOCAL crs BOUNDS ?DO crs 6 MOD 0= IF CR ENDIF I 8 TYPE SPACE 1 +TO crs 8 +LOOP ; : SHAspeed ( -- ) #40000000 ALLOCATE ?ALLOCATE LOCAL buf buf #40000000 'a' FILL CR ." Processing 40 Mbytes ... " TIMER-RESET buf #40000000 SHA512_Data 2DROP .ELAPSED buf FREE ?ALLOCATE ; :ABOUT CR .~ Try: S" abc" SHA512_Data TYPE~ CR ." = DDAF35A1 93617ABA CC417349 AE204131 12E6FA4E 89A97EA2 0A9EEEE6 4B55D39A 2192992A 274FC1A8 36BA3C23 A3FEEBBD 454D4423 643CE80E 2A9AC94F A54CA49F" CR CR .~ S" abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu" SHA512_Data TYPE CR ." = 8E959B75 DAE313DA 8CF4F728 14FC143F 8F7779C6 EB9F7FA1 7299AEAD B6889018 501D289E 4900F7E4 331B99DE C4B5433A C7D329EE B6DD2654 5E96E55B 874BE909" CR CR ." SHAspeed -- test speed with a 40 MB buffer (>181 MB/sec)." ; .ABOUT -sha512 CR DEPRIVE (* End of Source *) \ -marcel