\ Based on information from FIPS 180-1 -- Secure Hash Standard
\ Written by Alexander Guy <alexander.guy@andern.org>

\ This is my second attempt, this time with less of a C
\ mentality.  I dedicate this code to the public domain.

\ Todo:
\   - 


decimal

: >> rshift ;
: << lshift ;
: <<< 2dup << -rot $20 swap - >> or $FFFFFFFF and ;

: 16swap dup $FF and 8 << swap 8 >> or ;
: 32swap dup $FFFF and 16swap 16 << swap 16 >> 16swap or ;

: +! swap over @ + $FFFFFFFF and swap ! ;

\ ===> CHANGE THIS DEPENDING ON YOUR BYTE ORDER <===
\ For little endian machines:
: >bigendian 32swap ;
\ For big endian machines:
\ : >bigendian ; 
\ ===> CHANGE THIS DEPENDING ON YOUR BYTE ORDER <===

16 cells constant segment-size

variable a
variable b
variable c
variable d
variable e
variable len
variable cur-round
variable func
variable k

variable H0
variable H1
variable H2
variable H3
variable H4

: .context
    H0 @ hex.
    H1 @ hex.
    H2 @ hex.
    H3 @ hex.
    H4 @ hex.
;

: context-reset
    0 len !
    $67452301 H0 !
    $efcdab89 H1 !
    $98badcfe H2 !
    $10325476 H3 !
    $c3d2e1f0 H4 !
;

: context> H0 @ H1 @ H2 @ H3 @ H4 @ ;

: .temp
    a @ hex.
    b @ hex.
    c @ hex.
    d @ hex.
    e @ hex.
;

: h>
    0 cur-round !
    H0 @ a !
    H1 @ b !
    H2 @ c !
    H3 @ d !
    H4 @ e !
;

: +>h
    a @ H0 +!
    b @ H1 +!
    c @ H2 +!
    d @ H3 +!
    e @ H4 +!
;

create W 80 cells allot

: zero-workspace W segment-size 0 fill ;
    
: >workspace
    zero-workspace
    dup len +!
    W swap chars cmove ;

: W! cells W + ! ;
: W@ cells W + @ ;
: -W@ over swap - cells W + @ swap ;
: W-gen 3 -W@ 8 -W@ 14 -W@ 16 -W@ drop xor xor xor 1 <<< ;

: compute-workspace
    16 0 do i W@ >bigendian i W! loop
    80 16 do i W-gen i W! loop ;

: needs-padding len @ segment-size mod 0> ;

: pad
    len @
    dup W + $80 swap c! 
    dup 29 >> >bigendian W 14 cells + !
         3 << >bigendian W 15 cells + ! ;

: finalize needs-padding if pad endif ;

: shuffle
    d @ e !
    c @ d !
    b @ 30 <<< c !
    a @ b !
    a !
;

: munge W@ a @ 5 <<< func @ execute e @ k @ + + + + $FFFFFFFF and ;

\ Debug Version
: round dup . munge shuffle .temp cr ;
\ : round munge shuffle ;

: rounds func ! k ! cur-round @ dup 20 + swap do i round loop 20 cur-round +! ;

: ch b @ c @ and b @ invert d @ and xor ;
: parity b @ c @ d @ xor xor ;
: maj b @ c @ and b @ d @ and xor c @ d @ and xor ;

: process-workspace
    h> 
    $5a827999 ['] ch rounds 
    $6ed9eba1 ['] parity rounds 
    $8f1bbcdc ['] maj rounds 
    $ca62c1d6 ['] parity rounds
    +>h
;

: sha1-simple
    context-reset
    >workspace
    finalize
    compute-workspace
    process-workspace
    context>
;

\ Utility functions that aren't needed for sha1.
: c!+ over c! 1+ ;

\ An example of using sha1.


: test-sha1 cr ." Processing: " 2dup type cr sha1-simple hex .s cr drop drop drop drop drop ;

s" abc" test-sha1
s" abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" test-sha1