Forth-eV Wiki

This page is read only. You can view the source, but not change it. Ask your administrator if you think this is wrong.
##SHA-256 HASH-generator##


The SHA-256 hash is widely used as the basis for computer security. Generating a SHA-256 hash is not totally trivial though. This version closely follows the original description, by using and naming all the variables and functions as put down in the documentation. This helps in understanding the actual SHA-hash algorithm. More efficient implementation are easily possible, but tend to be more or less system specific.


This program generates SHA-256 hashes on files with a maximum length of 2^32 bytes. The hash is created in the 8 values called H0-H7, and can be printed using the .HASH word.


This version is runs on 32 bit Forths with little-endian storage in memory

In this setup it is suitable for messages upto 4GB (ie 32Gb)


TAKE CARE: the invert of 'we' in function CH is MISSING in the draft spec of SHA-256!!


<code>

\ ===== support words - use primitives if available in your system
: D8* ( n -- d_n*8 ) \ takes a single as input, multiplies with 8 into a double
    dup 29 rshift swap 3 lshift swap ;

: ROTR ( n rot -- rotated_n ) \ rotate right n with rot bits
    31 and 2dup 32 swap - lshift >r rshift r> or ;

hex : BYTES>< ( m -- w ) \ reverse cell bytes: 0x12345678 <-> 0x78563412
    dup >r 18 lshift r@ ff00 and 8 lshift or
    r@ ff0000 and 8 rshift or r> 18 rshift or
 ; decimal


\ ===== values, arrays and related helper-functions
\ h0-h7 form the actual hash
    0 value h0  0 value h1  0 value h2  0 value h3
    0 value h4  0 value h5  0 value h6  0 value h7

\ wa-wg are working variables
    0 value wa  0 value wb  0 value wc  0 value wd
    0 value we  0 value wf  0 value wg  0 value wh

: HASH->WVAR
    h0 to wa  h1 to wb  h2 to wc  h3 to wd
    h4 to we  h5 to wf  h6 to wg  h7 to wh ;

: WVAR->HASH
    wa +to h0 wb +to h1 wc +to h2 wd +to h3
    we +to h4 wf +to h5 wg +to h6 wh +to h7 ;


\ temp values
    0 value t1  0 value t2  0 value lenmess  0 value addrmess

\ message block = 16 words for message and...
\ ...48 words for temp storage of Wi for last 48 rounds
    create  MBLCK 64 cells allot

: MESS@ ( n -- mess ) 4 * mblck + @ ;
: MESS! ( m n -- )    4 * mblck + ! ;
: CLEARMESS ( -- ) 64 0 do 0 i mess! loop ;     \ clear message-block

hex create  KI[]  \ 64 SHA-256 constants, 1 for each subloop - checked
428a2f98 , 71374491 , b5c0fbcf , e9b5dba5 , 3956c25b , 59f111f1 , 923f82a4 , ab1c5ed5 ,
d807aa98 , 12835b01 , 243185be , 550c7dc3 , 72be5d74 , 80deb1fe , 9bdc06a7 , c19bf174 ,
e49b69c1 , efbe4786 , 0fc19dc6 , 240ca1cc , 2de92c6f , 4a7484aa , 5cb0a9dc , 76f988da ,
983e5152 , a831c66d , b00327c8 , bf597fc7 , c6e00bf3 , d5a79147 , 06ca6351 , 14292967 ,
27b70a85 , 2e1b2138 , 4d2c6dfc , 53380d13 , 650a7354 , 766a0abb , 81c2c92e , 92722c85 ,
a2bfe8a1 , a81a664b , c24b8b70 , c76c51a3 , d192e819 , d6990624 , f40e3585 , 106aa070 ,
19a4c116 , 1e376c08 , 2748774c , 34b0bcb5 , 391c0cb3 , 4ed8aa4a , 5b9cca4f , 682e6ff3 ,
748f82ee , 78a5636f , 84c87814 , 8cc70208 , 90befffa , a4506ceb , bef9a3f7 , c67178f2 ,
decimal

: KI@ ( i -- KI ) 4* ki[] + @ ;


\ ===== the 6 basic logic functions of SHA-256 - all 6 functions mix and combine data
: SIGMA0 ( x -- xn )
    >r r@  2 rotr  r@ 13 rotr xor  r> 22 rotr   xor ;
: SIGMA1 ( x -- xn )
    >r r@  6 rotr  r@ 11 rotr xor  r> 25 rotr   xor ;

: SIG0  ( x -- n )
    >r r@  7 rotr  r@ 18 rotr xor  r>  3 rshift xor ;
: SIG1 ( x -- n )
     >r r@ 17 rotr  r@ 19 rotr xor  r> 10 rshift xor ;

: CH ( -- an )
    we wf and we invert wg and xor ;
: MAJ ( -- an )
    wa wb and  wa wc and xor  wb wc and xor ;


\ ===== the HASH functions
hex
: INITHASH \ fill first hash with intial values
  6a09e667 to h0  bb67ae85 to h1  3c6ef372 to h2  a54ff53a to h3
  510e527f to h4  9b05688c to h5  1f83d9ab to h6  5be0cd19 to h7
; decimal

\ do 1 of the 64 rounds per block
: SUBLOOP ( message+ki -- )
    wh +  CH +  we sigma1 + to t1   \ t1 filled with temp value
    MAJ  wa sigma0 +        to t2   \ t2 filled with temp value
    wg                      to wh
    wf                      to wg
    we                      to wf
    wd t1 +                 to we
    wc                      to wd
    wb                      to wc
    wa                      to wb
    t1 t2 +                 to wa ;

: HASH1BLOCK \ 27us -> MACRO based=12us
    hash->wvar                      \ copy hash-variables h0-h7 to temp-variables wa-wh

    \ first 16 rounds digest message-data from message-block & does initial scrambling
    16 0 do
        i  mess@                    \ get data from message
        i ki@ + subloop             \ message+Ki to subloop
    loop

    \ the next 48 rounds scramble the data from the first 16 rounds by combining
    \ data from 4 earlier messages into a new 'message', as input to the subloop
    64 16 do
        i  2 - mess@ sig1
        i  7 - mess@      +
        i 15 - mess@ sig0 +
        i 16 - mess@      +         \ ( Wi )

        dup  i mess!                \ store Wi for following rounds
        i ki@ + subloop             \ message+Ki to subloop
    loop

    wvar->hash ;                    \ this is where the hash is actually created

: FILLMESS ( addr -- ) \ fills message block from message with reversed words
    16 0 do
        dup i 4* + @  bytes><  i mess!
    loop drop ;

: MBLCKREVERSE  ( -- )  \ reverse bytes words in message-block - only for last block!
    16 0 do  i mess@  bytes><  i mess!  loop ;

: PUTLEN ( len -- ) d8*  14 mess!  15 mess! ;

: GENSHA256 ( addr len -- )
    to lenmess  to addrmess         \ addr en len point to message-array

    \ first hash all full blocks
    lenmess 6 rshift dup >r         \ number of full blocks - also in r:
    0 ?do
        addrmess i 64 * + fillmess  \ i = blocknumber
        hash1block
    loop

    \ than hash the last block << including 1 extra block if needed
    r> 64 * addrmess + to addrmess  \ addrmess now address of last block of data
    lenmess 63 and >r               \ bytes_left in r:
    clearmess                       \ clear mblck

    addrmess mblck r@ cmove         \ move last bytes to mblck
    mblck r@ + 128 swap c!          \ add bit after last byte
    mblckreverse                    \ block now definitely filled with message

    r> 55 > if
        hash1block                  \ mblck is already filled and zeroed till the end
        clearmess                   \ clear mblck again
    then

    lenmess putlen                  \ put len at correct place
    hash1block ;                    \ and last block

: sha256 ( addr len -- )            \ create a hash in hash-variables H0-H7 for the data starting at addr
                                    \ with length len
    inithash gensha256 ;


\ ===== printing 

: .HAHDR
    ." ---h0--- ---h1--- ---h2--- ---h3--- ---h4--- ---h5--- ---h6--- ---h7---" ;
: .32HEX base @ hex >r 0 <# # # # # # # # # #> type r> base ! ;
: .HASH h0 .32hex  h1 .32hex  h2 .32hex  h3 .32hex
        h4 .32hex  h5 .32hex  h6 .32hex  h7 .32hex ;

\ ===== END of code

</code>
 
 
 
 
 
**Testing the SHA-256 algorithm**


Testing the SHA-256 algorithm can be done with the following code. The 'abc' example comes directly from the the standard document.
 
 
<code>

\ ===== TEST routines

create ABC 97 c, 98 c, 99 c,
: ldr cr ." must be: " ;
: proof ( -- )
    ABC 3 sha256
    cr 9 spaces .hahdr ldr
    ." ba7816bf 8f01cfea 414140de 5dae2223 b00361a3 96177a9c b410ff61 f20015ad"
    cr ." SHA-256: " .hash ;

: 65aaa 65 0 do [char] a c, loop ; create AAA 65aaa
: aaatest ( n -- )
    aaa swap 0 max 65 min sha256 cr ." SHA-256: " .hash ;

: fulltest \ tests all critical lengths for the function
    cr 9 spaces .hahdr ldr
    ." e3b0c442 98fc1c14 9afbf4c8 996fb924 27ae41e4 649b934c a495991b 7852b855"
    0 aaatest ldr
    ." ca978112 ca1bbdca fac231b3 9a23dc4d a786eff8 147c4e72 b9807785 afee48bb"
    1 aaatest ldr
    ." 9f4390f8 d30c2dd9 2ec9f095 b65e2b9a e9b0a925 a5258e24 1c9f1e91 0f734318"
    55 aaatest ldr
    ." b35439a4 ac6f0948 b6d6f9e3 c6af0f5f 590ce20f 1bde7090 ef797068 6ec6738a"
    56 aaatest ldr
    ." 7d3e74a0 5d7db15b ce4ad9ec 0658ea98 e3f06eee cf16b4c6 fff2da45 7ddc2f34"
    63 aaatest ldr
    ." ffe054fe 7ae0cb6d c65c3af9 b61d5209 f439851d b43d0ba5 997337df 154668eb"
    64 aaatest ldr
    ." 635361c4 8bb9eab1 4198e76e a8ab7f1a 41685d6a d62aa914 6d301d4f 17eb0ae0"
    65 aaatest cr ;


</code>
 
 
 
 
 
**Optimising performance of the SHA-256 hash generator - step 1 **


Creating SHA-256 hashes is an area where time of execution is usually seen as relevant. The above version, using generic Forth, will run on most Forth systems but is rather slow. Running on wabiForth in tests it achieves a throughput of around 2.6 MB/s.

One way of optimising performance is to use Forth-Macros, as described by Wil Baden in Forth Dimensions Vol. 19, No. 2. There is a version floating around on the internet which does exactly that. Here is an simplified version of that code. It is not totally using generic Forth as I wanted to keep te original as unchanged as possible. The extensive use of PICK and the 64DROP used after each block are noteworthy.
 
 
 
<code>
 
 
\ ========================================================
\ ANS Forth code for Secure Hash Algorithms SHA-256
\ This version: copyright (c) 2024 Jeroen Hoekstra
\ ========================================================

\ =====  THIS WORK BASED ON:  ============================
\ FIPS 180-4 specs at: http://csrc.nist.gov/publications/PubsFIPS.html

\ ...previous work by Jabari Zakiya
\ Copyright (c) 2001-2013 Jabari Zakiya - jzakiya@mail.com - 15jan2013
\ https://gist.github.com/jzakiya/4544459

\ ...previous work by Wil Baden
\ Forth Dimensions (FD) Vol. 19, No. 2, July/August 1997

\ Use of this code is free, subject to acknowledgment of the copyrights,
\ especially those of Jabari Zakiya and Wil Baden

\ =====  DEPENDENCIES  ===================================
\ This version for 32bit, little endian, byte-addressable CPUs,
\ and strings with a 32bit index

\ dependencies: CORE CORE_EXT wordsets
\ common usage: ROTR TUCK BYTES>< d2*
\ and CASE-independency

\ =====  MACRO Wordset ===================================
\ This implementation depends heavily on MACROs to speed up
\ the performance. Macros are not very portable. If the code does
\ not run on your system, than use the reference of Wil Baden to
\ adapt the MACRO words to your system

\ This version of MACRO allows insertion of parameters following
\ the macro -- "\" specifies the position where a parameter is inserted
\ Example:  MACRO  ??  " IF  \  THEN "
\ : FOO .. ?? exit .... ;  ?? compiles to -- IF EXIT THEN

\ =====  USAGE  ==========================================
\ To generate and show the hash of a string or counted message do:
\ Example: S" some message string" GENSHA256 .SHA

\ =====  words not in CORE or CORE_EXT ===================

\ for optimal performance the following two words could be done in assembly
: ROTR ( n rot -- rotated_n )
	32 mod 2dup 32 swap - lshift >r rshift r> or ;
hex : BYTES>< ( m -- w )  \ reverse cell bytes
	dup >r 18 lshift r@ ff00 and 8 lshift or
	r@ ff0000 and 8 rshift or r> 18 rshift or ; decimal

\ ========================================================
\ unused \ 8296 bytes excluding BMs and BM-buffers

\ =====  MACRO definitions ===============================
decimal
: PLACE  ( caddr n addr -- ) 2dup ! 4 + swap move ; \ pressumes a 32b string-index
: SSTRING ( char "ccc" -- ) char word count here over 4 + chars allot place ;

: 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> ;

: [MACRO]  \ compiles the macro
    count begin
        92 ( ='\') split-at-char 2>r evaluate r@
    while
        bl word count evaluate 2r> 1 /string
    repeat
    r> drop r> drop ;

\ Macro creation word - allows parameter insertion
: MACRO create immediate sstring does> [macro] ;

\ =====  Utility Words  ==================================

: ]L postpone ] postpone literal ; immediate

\ =====  Start SHA-256 Code  =============================
  32 constant cellsize                      \ CPU bitsize

  2variable shalen                          \ byte length of message
  create    shaval  8 cells allot           \ hash after each block
  create    shash  72 cells allot           \ fully extended hash array
  create    w      16 cells allot           \ message block

hex create  KI  \ SHA-256 constants array for work-schedule
    428a2f98 , 71374491 , b5c0fbcf , e9b5dba5 , 3956c25b , 59f111f1 , 923f82a4 , ab1c5ed5 ,
    d807aa98 , 12835b01 , 243185be , 550c7dc3 , 72be5d74 , 80deb1fe , 9bdc06a7 , c19bf174 ,
    e49b69c1 , efbe4786 , 0fc19dc6 , 240ca1cc , 2de92c6f , 4a7484aa , 5cb0a9dc , 76f988da ,
    983e5152 , a831c66d , b00327c8 , bf597fc7 , c6e00bf3 , d5a79147 , 06ca6351 , 14292967 ,
    27b70a85 , 2e1b2138 , 4d2c6dfc , 53380d13 , 650a7354 , 766a0abb , 81c2c92e , 92722c85 ,
    a2bfe8a1 , a81a664b , c24b8b70 , c76c51a3 , d192e819 , d6990624 , f40e3585 , 106aa070 ,
    19a4c116 , 1e376c08 , 2748774c , 34b0bcb5 , 391c0cb3 , 4ed8aa4a , 5b9cca4f , 682e6ff3 ,
    748f82ee , 78a5636f , 84c87814 , 8cc70208 , 90befffa , a4506ceb , bef9a3f7 , c67178f2 ,
decimal

 0 value H[H]  \ Pointer to addr of hash value H for each round
    macro H[G]  " h[h]  [ 1 cells ]l  +"    \ return g adr
    macro H[F]  " h[h]  [ 2 cells ]l  +"    \ return f adr
    macro H[E]  " h[h]  [ 3 cells ]l  +"    \ return e adr
    macro H[D]  " h[h]  [ 4 cells ]l  +"    \ return d adr
    macro H[C]  " h[h]  [ 5 cells ]l  +"    \ return c adr
    macro H[B]  " h[h]  [ 6 cells ]l  +"    \ return b adr
    macro H[A]  " h[h]  [ 7 cells ]l  +"    \ return a adr

hex : SHAINIT ( -- ) \ load initial sha-256 hash values h0 - h7
    6a09e667 ( h0) dup [ shaval 7 cells + ]l ! [ shash 7 cells + ]l !
    bb67ae85 ( h1) dup [ shaval 6 cells + ]l ! [ shash 6 cells + ]l !
    3c6ef372 ( h2) dup [ shaval 5 cells + ]l ! [ shash 5 cells + ]l !
    a54ff53a ( h3) dup [ shaval 4 cells + ]l ! [ shash 4 cells + ]l !
    510e527f ( h4) dup [ shaval 3 cells + ]l ! [ shash 3 cells + ]l !
    9b05688c ( h5) dup [ shaval 2 cells + ]l ! [ shash 2 cells + ]l !
    1f83d9ab ( h6) dup [ shaval 1 cells + ]l ! [ shash 1 cells + ]l !
    5be0cd19 ( h7) dup   shaval ! shash !
    shash to h[h] ; decimal

: UPDATEHASH ( -- ) \ 156c -- update values: shash(i) = shaval(i) <= shaval(i-1) + h(i-1)
  h[h] dup @ [ shaval 0 cells + ]l tuck +! @ [ shash 0 cells + ]l ! cell+
       dup @ [ shaval 1 cells + ]l tuck +! @ [ shash 1 cells + ]l ! cell+
       dup @ [ shaval 2 cells + ]l tuck +! @ [ shash 2 cells + ]l ! cell+
       dup @ [ shaval 3 cells + ]l tuck +! @ [ shash 3 cells + ]l ! cell+
       dup @ [ shaval 4 cells + ]l tuck +! @ [ shash 4 cells + ]l ! cell+
       dup @ [ shaval 5 cells + ]l tuck +! @ [ shash 5 cells + ]l ! cell+
       dup @ [ shaval 6 cells + ]l tuck +! @ [ shash 6 cells + ]l ! cell+
           @ [ shaval 7 cells + ]l tuck +! @ [ shash 7 cells + ]l !
  shash to h[h] ; \ init pointer to last hash value h7=h

\ ( -- n )  T1x = Ch(e,f,g) + SIGMA1(e) + h ( 74c )
: T1X
        h[f] 2@ over dup >r
            and swap invert
        h[g] @ and xor
        r@  6 rotr r@ 11 rotr xor r> 25 rotr xor +
        h[h] @ + ;

\ ( -- n )  T2 = Maj(a,b,c) + SIGMA0(a) ( 87c )
: T2  h[b] 2@ ( a b) >r dup >r 2 rotr r@ 13 rotr xor r@ 22 rotr xor
      h[c] @ dup r@ and r> r@ and xor swap r> and xor + ;

: SIG0 ( x -- n ) dup >r  7 rotr r@ 18 rotr xor r>  3 rshift xor ; \ 30c
: SIG1 ( x -- n ) dup >r 17 rotr r@ 19 rotr xor r> 10 rshift xor ; \ 30c

\ Put two copies of original Wi on stack, keep its address
    MACRO WI@ " dup  @  tuck " ( [wi] -- wi [wi] wi)

\ Create 2 copies of new Wi' from Wi on stack  ( ..Wi -- ..Wi' Wi')
    MACRO WI  " 15 pick 15 pick sig0 + 7 pick + 2 pick sig1 + dup "

\ Drop 64 Wi cells from stack ( W0..W63 -- )
    MACRO WIDROP " 4 0 do 2drop 2drop 2drop 2drop 2drop 2drop 2drop 2drop loop "

\ Add round constant Ki (to T1x to make T1) for each round
    MACRO KI+     " i @ + " \ as fast as assembly but 2 of 5 opc longer
    MACRO SUBRND  " t1x + ki+ dup h[d] +! t2 + h[g] to h[h] h[a] ! "

    MACRO KI16    " [ ki 16 cells + ]l "
    MACRO KI64    " [ ki 64 cells + ]l "

: SHA256  ( wadr -- )  \ compute sha-256 hash of 512-bit message block
  ki16   ki do wi@ subrnd cell+ 4 +loop drop                \ ( w0..w15 ) original block
  ki64 ki16 do wi  subrnd       4 +loop widrop              \ ( -- )
  updatehash ;

: SETLEN  ( -- )  \ store bit count into last two cells of final message block
  shalen 2@ d2* d2* d2* ( bytes->bits) [ w 56 chars + ]l ! [ w 60 chars + ]l ! ;

: cellsreverse  ( adr n -- )  \ Reverse bytes of n cells in array
  0 do dup @ bytes>< over ! cell+ loop drop ;

    MACRO ENDIAN16 " dup 16 cellsreverse "
    MACRO ENDIAN14 " dup 14 cellsreverse "      \ for final message-block

: HASHFULLBLOCKS ( adr1 ud -- adr2 count )  \ hash all but last block
  swap dup >r 6 rshift                      \ store lo on return, lo*=lo/64
  over [ cellsize 6 - ]l lshift or >r       \ return is now: :r lo lo'
  6 rshift 0 ?do                            \ do if hi'= hi/64 > 0
      0 0 do dup endian16 sha256 64 + loop  \ hash for 2^cellsize full blocks
  loop                                      \ hash for hi'*2^cellsize full blocks
  r> 0 ?do dup endian16 sha256 64 + loop    \ hash for lo' count full 64 byte blocks
  r> 63 and ;                               \ 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!                        \ put 80h after last message byte
  char+ 55 r@ -                             \ compute tentative 0 byte fill count
  r> 55 >                                   \ is partial block byte count > 55 ?
  if  8 + 0 fill                            \ if yes, fill rest of block w/zeroes
      w endian16 sha256                     \ endian adjust block, then hash
      w 56                                  \ now setup last block containing bit count
  then
  0 fill setlen w endian14 sha256           \ zero fill last block, set message bit count
;                                           \ endian adjust, except bit count, then hash

\ Generate SHA-256 from a counted buffer of text
: GENSHA256 ( addr n -- )
    0 shainit
    2dup shalen 2!
    hashfullblocks
    hashfinal ;

\ print SHA-256 hash --
: .SHA cr ." sha-256: " 0 7 do h[h] i 4* + @ .hex -1 +loop ;

\ unused -



\ =====  TESTING  =====================================
: .HAHDR
    ." ---h0--- ---h1--- ---h2--- ---h3--- ---h4--- ---h5--- ---h6--- ---h7---" ;

: proof ( -- ) \ ~11-12us for s" abc"
    t[ s" abc" gensha256 ]t.
    cr 9 spaces .hahdr cr ." must be: "
    ." ba7816bf 8f01cfea 414140de 5dae2223 b00361a3 96177a9c b410ff61 f20015ad"
    .sha ;


</code>
 
 
 
 
**Optimising performance of the SHA-256 hash generator - step 2 **

A more thorough optimisation is possible by looking at often used parts of the code and optimising those.


A first step to make the algorithm faster is to check if BYTES>< and ROTR are available as faster primitives on your forth-system. Especially using a fast primitive for ROTR is beneficial, as most processors have a specific opcode for that function. On the Raspberry Pi4 this change alone makes the routine 1.7 times faster.

The next step could be to use a data-array for the hash-variables H0-H7 and the temp variables. On systems with a memory-cache, this saves time by reducing writes to and reads from memory.

A next step would be to program the six logical functions in assembly. Tested on wabiForth, combining these optimisation steps makes the program run about 5 times faster, with a throughput of around 12.1 MB/s

The nest step would be to program the subloop as a whole in assembly. This is a surprisingly short assembly routine of only 37 opcodes, including the 4 logical functions, in ARM32 assembly. The throughput is now around 25 MB/s

The last step tested by the author is to also program the HASH1BLOCK word in assembly. The final throughput achieved is 45 MB/s. Around 17 times faster than using generic Forth.


The following is an example where ARM32 assembly is used for the subloop and the HASH1BLOCK word:
 
 
<code>

\ **SHA-256 assembly version - for Project Forth Works - wabiPi4 specific**

\ system specific:
\ wabiForth measures time-intervals with T[ and ]T.
\ integrated wabi Armv8-assembler

\ CAVE: the invert of we in function CH is MISSING in the draft spec of SHA-256!!

unused \ 4620 bytes

\ ===== variables, arrays and helper-functions
\ h0-h7 form the actual hash
    0 value h0  0 value h1  0 value h2  0 value h3
    0 value h4  0 value h5  0 value h6  0 value h7

\ other values
    0 value lenmess  0 value addrmess

\ message block = 16 words for message and...
\ ...48 words for temp storage of Wi for last 48 rounds

    256 allocate drop constant MBLCK    \ wabiForth specific data-oriented memory
     32 allocate drop constant WBLCK    \ storage for 8 32b woring variables wa-wh
                                        \ no need to store T1 and T2
: MESS! ( m n -- )    4* mblck + ! ;
: CLEARMESS 16 0 do 0 i mess! loop ;    \ clears message-block - FILL is slower

: HASH->WVAR \ move hash to working variables - checked - 102c!
    h0 WBLCK  0 +  !
    h1 WBLCK  4 +  !
    h2 WBLCK  8 +  !
    h3 WBLCK 12 +  !
    h4 WBLCK 16 +  !
    h5 WBLCK 20 +  !
    h6 WBLCK 24 +  !
    h7 WBLCK 28 +  ! ;

: WVAR->HASH \ add working variables to hash - checked - 42c!
    WBLCK  0 + @  +to h0
    WBLCK  4 + @  +to h1
    WBLCK  8 + @  +to h2
    WBLCK 12 + @  +to h3
    WBLCK 16 + @  +to h4
    WBLCK 20 + @  +to h5
    WBLCK 24 + @  +to h6
    WBLCK 28 + @  +to h7 ;


hex create  KI[]  \ 64 SHA-256 constants - could be in data-mem
428a2f98 , 71374491 , b5c0fbcf , e9b5dba5 , 3956c25b , 59f111f1 , 923f82a4 , ab1c5ed5 ,
d807aa98 , 12835b01 , 243185be , 550c7dc3 , 72be5d74 , 80deb1fe , 9bdc06a7 , c19bf174 ,
e49b69c1 , efbe4786 , 0fc19dc6 , 240ca1cc , 2de92c6f , 4a7484aa , 5cb0a9dc , 76f988da ,
983e5152 , a831c66d , b00327c8 , bf597fc7 , c6e00bf3 , d5a79147 , 06ca6351 , 14292967 ,
27b70a85 , 2e1b2138 , 4d2c6dfc , 53380d13 , 650a7354 , 766a0abb , 81c2c92e , 92722c85 ,
a2bfe8a1 , a81a664b , c24b8b70 , c76c51a3 , d192e819 , d6990624 , f40e3585 , 106aa070 ,
19a4c116 , 1e376c08 , 2748774c , 34b0bcb5 , 391c0cb3 , 4ed8aa4a , 5b9cca4f , 682e6ff3 ,
748f82ee , 78a5636f , 84c87814 , 8cc70208 , 90befffa , a4506ceb , bef9a3f7 , c67178f2 ,
decimal

KI[] constant KITBL \ using KITBL is faster than using the name KI[]


\ =====  the functions MAJ, CH, SIGMA0 and SIGMA1 are integrated into SUBLOOP
\ the functions SIG0 and SIG1 are integrated into HASH1BLOCK

\ =====  assembly macros
: ldv32, ( reg n -- )           \ load value n into reg - creates 2 opcodes!
  2dup
  16 lshift 16 rshift movw,
  16 rshift movt, ;

: prologcust
    r13, {, r0, r4, r-r, r6, r8, r-r, v, w, }!, stmfd, ; \ saving v and w critical
: nextcust
    r13, {, r0, r4, r-r, r6, r8, r-r, v, w, }!, ldmfd, ; \ restoring v and w critical


\ =====  The actual HASH-routiunes
hex : INITHASH \ fill first hash with intial values
  6a09e667 to h0  bb67ae85 to h1  3c6ef372 to h2  a54ff53a to h3
  510e527f to h4  9b05688c to h5  1f83d9ab to h6  5be0cd19 to h7
; decimal

\ wa=r0  wb=r1  wc=r2  wd=r3  we=r4  wf=r6
\ wg=r7  wh=r8  t1=v   t2=w   top=scratch

code: SUBLOOP  ( message+ki -- ) \ 25c - 37 opcodes
[   prologcust

    \ get working variables into registers - w=T2=> here scratch
    w, WBLCK ldv32,             \ get address of work-regs in w
    w, {, r0, r4, r-r, r6, r8, r-r, }, ldmia, \ move work-regs into cpu-regs

    \ start of T1
    v, top, r8, add,            \ r8=wh - top=message+ki - v=wh+message+ki=t1_step1

    \ now CH => ( we wf and ) ( we invert wg and )  xor ;
    top, r4, r6, and,           \ =we wf and - top=scratch
    w, r7, r4, bic,             \ only faster in full assembly version
    w, w, top, eor,             \ w=eor result

    v, v, w, add,               \ v=t1_step2 - add result to t1 - top and w free

    \ now SIGMA1 ( x -- xn ) >r r@  6 rotr  r@ 11 rotr xor  r> 25 rotr   xor
    w, r4, 6 ror#, mov,         \ r4=we
    w, w, r4, 11 ror#, eor,
    w, w, r4, 25 ror#, eor,

    v, v, w, add,               \ v=t1_final

    \ start of T2
    r8, r0, r1, and,            \ r8=wa and wb
    top, r0, r2, and,           \ top=wa and wc
    r8, r8, top, eor,
    top, r1, r2, and,           \ top=wb and wc
    w, top, r8, eor,            \ w=t2_step1

    \ now SIGMA0 as part of T2 with wa=r0
    top, r0, 2 ror#, mov,
    top, top, r0, 13 ror#, eor,
    top, top, r0, 22 ror#, eor,

    w, w, top, add,             \ w=t2_final

    \ actual update of the 8 working regs
    r8, r7, mov,                \ wg to wh
    r7, r6, mov,                \ wf to wg
    r6, r4, mov,                \ cave: we=r4 - we to wf

    r4, v, r3, add,             \ wd t1 + to we

    r3, r2, mov,                \ wc to wd
    r2, r1, mov,                \ wb to wc
    r1, r0, mov,                \ wa to wb

    r0, v, w, add,              \ t1 t2 + to wa

    \ write wregs back to work-block
    w, wblck ldv32,             \ get address of work-regs in w
    w, {, r0, r4, r-r, r6, r8, r-r, }, stmia,

    top, dts, 4 ]i+!, ldr,      \ =drop -> stack neutral

    nextcust ] ;

: HASH1BLOCK \ 3-4us -> MACRO based=12us
    [ r13, {, r0, r3, r-r, }!, stmfd, ] \ unsure if necessary

    hash->wvar                      \ << to assembly!

    \ first digest 16*4 bytes message-data from message-block & scrambles a bit
    16 0 do

    \ the next part saves 1c from 67.5 to 66.5c/subloop
      [ top, dts, 4 i-]!, str,      \ dup

        w, mblck ldv32,             \ get address of message-regs in w
        w, w, i, 2 lsl#, add,
        top, w, ldr,

        v, kitbl ldv32,
        w, v, i, 2 lsl#, add,
        v, w, ldr,

        top, top, v, add, ]

        subloop
    loop

    \ the data from the first 16 rounds is scrambled by mixing the data from
    \ 4 earlier messages into a new 'message', as input to the 48 subloops

    64 16 do

    \ the following saves ~20c/subloop
      [ top, dts, 4 i-]!, str,          \ dup

    \ =====  line 1
        r0, mblck ldv32,                \ get address of message-block in r0 - keep
        r2, i, 0 2 i#, sub,             \ r2=i-2 - r2=temp
        top, r0, r2, 2 lsl#, +], ldr,   \ now 'i 4* [  2 cells ] literal -  mblck + @'

        r3, top, 17 ror#, mov,
        r3, r3, top, 19 ror#, eor,
        top, r3, top, 10 lsr#, eor,

    \ =====  line 2
        r2, i, 0 7 i#, sub,             \ r2=i-7 - temp
        r2, r0, r2, 2 lsl#, +], ldr,    \ r2
        top, top, r2, add,              \ keep top

    \ =====  line 3
        r2, i, 0 15 i#, sub,            \ r2=i-15 - temp
        r2, r0, r2, 2 lsl#, +], ldr,

        r3, r2, 7 ror#, mov,
        r3, r3, r2, 18 ror#, eor,
        r3, r3, r2, 3 lsr#, eor,
        top, top, r3, add,

    \ =====  line 4
        r2, i, 0 16 i#, sub,            \ r2=i-16 - temp
        r2, r0, r2, 2 lsl#, +], ldr,    \ r2
        top, top, r2, add,

        \ dup  i 4* mblck + !           \ store Wi for following rounds
        w, mblck ldv32,                 \ get address of message-regs in w
        w, w, i, 2 lsl#, add,
        top, w, str,

        \ i 4* kitbl + @ + subloop      \ ( message+ki )
        v, kitbl ldv32,
        w, v, i, 2 lsl#, add,
        v, w, ldr,

        top, top, v, add, ]

        subloop
    loop

    wvar->hash
    [ r13, {, r0, r3, r-r, }!, ldmfd, ] \ unsure if necessary
;

: FILLMESS ( addr -- ) \ ( 54c wabi:165c ) fills message block with reversed words
    [ r13, {, r0, r3, r-r, }!, stmfd, ] \ costs 4ms in BM - not sure if needed

    16 0 do
      [ r0, top, i, 2 lsl#, +], ldr,    \ r0=[top + i*4]
        r1, mblck ldv32,                \ get address of message-block in r1 - keep
        r0, r0, rev,                    \ reverse bytes in word
        r0, r1, i, 2 lsl#, +], str, ]   \ store in message-block
    loop drop

    [ r13, {, r0, r3, r-r, }!, ldmfd, ] \ not sure if needed
;

: MBLCKREVERSE  ( -- ) \ reverse bytes in words in message-block
  16 0 do mblck i 4* + dup @ bytes>< swap ! loop ;

: PUTLEN ( len -- ) \ len*8 for number of bits
    0 3 dlshift  14 mess!  15 mess! ;

: GENSHA256 ( addr len -- ) \ addr en len point to message-array
    to lenmess  to addrmess

    inithash

    \ do hashing of full block
    lenmess 6 rshift dup >r         \ number of full blocks - also in r:
    0 ?do
        addrmess i 64 * + fillmess  \ i = blocknumber
        hash1block
    loop

    \ do hashing of last block
    r> 64 * addrmess + to addrmess  \ addrmess now address of last block of data
    lenmess 63 and >r               \ bytes_left in r:
    clearmess                       \ clear mblck

    addrmess mblck r@ cmove         \ move last bytes to mblck
    mblck r@ + 128 swap c!          \ add bit after last byte
    mblckreverse                    \ block now definitely filled with message

    r> 55 > if
        hash1block                  \ mblck is already filled and zeroed till the end
        clearmess                   \ clear mblck again
    then

    lenmess putlen                  \ put len at correct place
    hash1block ;                    \ and last block

: sha256 ( addr len -- )
    inithash gensha256 ;

</code>
 
 
 
 
Please note that this is all done using bog-standard ARM32 assembly, no SHA-256 specific opcodes are used. These  SHA_256 specific opcodes would increase the performance even more. Another option would be to use the NEON coprocessor. This is available on Raspberry Pi2 and later and would allow some parallel processing of the subloop. If this really raises throughput is as yet unproven.


\j2h