\ RC4.4TH -- compiles under SwiftForth
\ written by Hugh Aguilar --- BSD license

decimal

marker rc4.4th

true  constant DisplayTime?


\ *************************************************************************************************
\ ************ miscellaneous
\ *************************************************************************************************

: <<  \ --                                      \runtime --  \r: -- Dmicroseconds
    DisplayTime? if
        postpone uCounter  postpone 2>r
        then ;
immediate

: >>"  \ --    \" string"                       \runtime --  \r: --
    DisplayTime? if
        postpone cr  postpone 2r> postpone uTimer  postpone ."
    else
        [char] " word drop
        then ;
immediate

\ << and >>" should bracket the code that needs to be timed.
\ Note that << and >>" use the r-stack, so they should be in the same function.

icode rover  \ a b c -- a b c a                         \ rotate over
    4 [ebp] eax mov                         \ eax= third stack element
    4 # ebp sub  ebx 0 [ebp] mov            \ push ebx onto stack
    eax ebx mov  ret end-code               \ move eax into ebx (top stack element)

: drops  \ n --                                         \ drops n stack values
    [+assembler]
    4 *  dup 4 -                            \ -- bytes offset
    [ebp] ebx mov  # ebp add                \ --
    [previous] ;

\ The bytes are the number bytes to be removed from the stack.
\ The offset is to the element that will become the new top-of-stack.

icode Exchange  \ adr1 adr2 --                          \ exchange words at adr1 and adr2
    0 [ebp] edx mov                         \ edx= adr1, ebx= adr2
    edx ebx cmp  0<> if
        0 [edx] eax mov  eax 0 [ebx] xor
        0 [ebx] eax mov  eax 0 [edx] xor
        0 [edx] eax mov  eax 0 [ebx] xor  then
    2 drops  ret end-code


\ *************************************************************************************************
\ ************ RC4 encryption (invented by Ron Rivest, 1987)
\ *************************************************************************************************

30 constant MinPassphrase           \ anything up to 255 will work; the larger, the more secure

create Kboxes 256 allot             \ this is the passphrase appended upon itself repeatedly
create Sboxes 256 allot             \ this array is used during the encryption process

: InitK  \ adr count --                                 \ needs the passphrase
    dup MinPassphrase u< abort" *** the passphrase is too short ***"
    256 0 do                        \ -- adr count
        I over mod                  \ -- adr count index            \ index= I/count (remainder)
        rover + c@                  \ -- adr count char
        Kboxes I + c!  loop         \ -- count adr
    [ 2 drops ] ;

: SwapSiSj  \ --                    \ assumes ecx=I and edx=J; sets al=Si and ah=Sj
    [+assembler]
    Sboxes [ecx] ah mov  Sboxes [edx] al mov
    al Sboxes [ecx] mov  ah Sboxes [edx] mov                        \ swap Si and Sj; al=Si, ah=Sj
    [previous] ;

code InitS  \ --                                        \ needs Kboxes already initialized
    ecx ecx xor  begin  $100 # ecx cmp  u< while                    \ ecx= I= 0..255
        cl Sboxes [ecx] mov  ecx inc  repeat                        \ Si= I
    edx edx xor                                                     \ edx= J= 0
    ecx ecx xor  begin  $100 # ecx cmp  u< while                    \ ecx= I= 0..255
        Sboxes [ecx] dl add  Kboxes [ecx] dl add  $ff # edx and     \ J= (J+Si+Ki) mod 256
        SwapSiSj  ecx inc  repeat                                   \ repeat with next I
    ret end-code
    
code <EncryptString>  \ upper_limit base_adr --         \ needs Sboxes already initialized
    ecx ecx xor  edx edx xor                                        \ ecx= I, edx= J, ebx= adr
    begin  0 [ebp] ebx cmp  u< while                                \ while data
        ecx inc  $ff # ecx and                                      \ I=(I+1) mod $100
        Sboxes [ecx] edx add  $ff # edx and                         \ J=(J+Si) mod $100
        SwapSiSj  ah al add  $ff # eax and                          \ T=(Si+Sj) mod $100
        Sboxes [eax] al mov  al 0 [ebx] xor                         \ X= St; encrypt datum
        ebx inc  repeat                                             \ repeat with next character
    2 drops  ret end-code

: EncryptString  \ adr count --                         \ needs the data string; encrypts in place
    InitS                                               \ needs Kboxes already initialized
    over + swap <EncryptString> ;


\ *************************************************************************************************
\ ************ testing
\ *************************************************************************************************

: Initialize  \ --                                      \ initializes Kboxes
    s" These are the days of miracle and wonder! "
    InitK ;

create TestString  ," Hello World"

: Test  \ --                                            \ needs Kboxes already initialized
    TestString count Dump
    <<  TestString count EncryptString  >>" uSeconds"
    TestString count Dump ;