\ readable wurstkessel - 64 bit only

8 cells Constant state#

$10 here $F and - allot 
here state# allot \ source
here state# allot \ state
here state# allot \ nextstate
here state# 8 * allot \ message
swap 2swap swap

Constant wurst-source
Constant wurst-state
Constant nextstate
Constant message

Create 'rngs \ this is essentially Wurstkessel's S-box
$EA576B15A7AFBA08 , $BF4888DC02131EF7 , $5F49A40B1DAAF5FD , $7798975E5233C89D ,
$A70A1BD518B3FBC6 , $8E31D54ECB7BCDF9 , $949D107029F94EAA , $7B40261F6B3E0763 ,
$E845F90477A30AC5 , $6BF5CDC094B7A657 , $B0796C9F61F990F9 , $C149FABA50014BFC ,
$626377228BC762EF , $639BFE93094E7B84 , $0B61140C13513E15 , $ADB800460D8B7A3F ,
$20D3873110880D43 , $144B862F4755D8EF , $69C127F350ECD709 , $4A92511FAD31D465 ,
$34EB0EF8ED8230B2 , $477BF466E332DDB8 , $086B6F20DC2F1B33 , $E020C8012E1EBC4A ,
$C4A5BEF939044AFC , $C5C5B03F80FAF739 , $AD46EFBA6E4EEFB2 , $EAD04EEF21AD5CCA ,
$68516345F32E582E , $FEDE2067A335B1F6 , $96611D13172BA044 , $1DDBC3F36257DF96 ,
$4BFE75A91B582D07 , $82DF3A7D4205D9B4 , $CDC7C2C769B10163 , $2B9EFB3A406C1C22 ,
$DA732F17BB5FA819 , $14DA2D994B88EBFB , $E9E8DA371866818E , $6AAFEAAB80D72758 ,
$E2453ACEA74719DB , $62CAB78E82137E78 , $4B60E6778A84C82B , $41BF2417B0070764 ,
$F3865ADEBF337A99 , $A1EC36C696492BE0 , $7C884B32080C649F , $AAE99BDADC37685A ,
$DCA4C59D98BEEC6C , $DD8886FED8B82090 , $F894AA6994EFDB8A , $FB954EA7107B1BF3 ,
$80E569581773CF5F , $F418E1F97E601D94 , $7A9B9F9033A40820 , $00E06D7C4F50726B ,
$19C205C7F461EB65 , $DB610A36DE40AE7C , $0FCD201AF3E65F5F , $5840910FC1902224 ,
$1210975240BE1829 , $71B97307E8E903F9 , $DF85C6C346DF4FF2 , $BB26F835FD3711F1 ,
$4DE8E6DC008BD249 , $8C11D5A647CA6231 , $B10D0F66EC07A251 , $D2D4C7BD608AACDE ,
$17C7560D621E6D62 , $A182591BC53D7C8A , $8FBF7260C16058D7 , $D20C1AA47AD280FD ,
$4C34ABC646276D3E , $DF9328222B555885 , $5FCEAC68B91AA75F , $B662C4D84F7135C6 ,
$418DBD3C45D7E67C , $5E07DB97A28D2A3A , $D5D7B024C7E148A3 , $3F3023639E4ED91D ,
$75590580D18BDCF7 , $2936C445A8CCE5D3 , $1C9B51352A9B38AA , $1EC67B0E63EA6B9C ,
$30AA42F444DD8D77 , $5490C75F1A50B3D4 , $8A62DC6866149DC6 , $45E71CA58A3A1A03 ,
$44C35A60CA62EF4C , $8A8D10F67904F203 , $73FB47C99A789E27 , $F6DA264C5EC58834 ,
$7DE707AB941A68B1 , $8E5FC15AB1B82D42 , $169F270E31E118B9 , $89D77D2CA228F1A1 ,
$F73BFCD076EA4593 , $3FC2594EA868AA6B , $7E712B3826BF940B , $C5E47523F2ED72D3 ,
$B17D5E2B40D91CB7 , $7A46CA989B6B545C , $DF53963473D8A028 , $1C2B05E95B6A2361 ,
$2A8CE6CC8AA46240 , $7E56673B8467B2D4 , $5CC08986DD1643D2 , $34BEC26C10A8A0F7 ,
$5A1065508344D9BF , $964CD691C7514A54 , $DA6642E206D8EEC0 , $FE50640EACC57736 ,
$4FD775BEEC03E00C , $2ED51322FA648470 , $D126396FE346FD82 , $321F8E62660A5358 ,
$B18AC0415120A970 , $AE66E8D0D89BDEA2 , $8FF3907042113713 , $3ED1A5AF45B9BD21 ,
$CD93C5A7676F9B80 , $B6390A3D94DAEF11 , $868976715C5CCA68 , $AD886AA064B5DDC5 ,
$DCD8A0CCB0EE4F42 , $5E825B5AF2696B48 , $C6AD2848B1BD2AFE , $4DE5A20AD330B6E4 ,
$121DA3E4428AA27D , $AD734AF69BB658E8 , $A239809834B66FEC , $4E0AFF25C162024C ,
$12ADAB1B8CDBAA49 , $7EFD205B8A2D7142 , $1100D36951CC6ACD , $56D7D5D9087D42DC ,
$19BE8F3D1D7A103F , $587697A07337E076 , $F134983D796333BF , $8A67B4F38C5624C5 ,
$5D8A9736AD2EEDE3 , $5C32F0C1D2E26BED , $029AD86080A1960A , $ED5F76D1DB276ED9 ,
$33CB581061805DFD , $A5DF2522A0F691C7 , $A4ADEDF782FD6BD2 , $FE384FF0D371C964 ,
$F5CFEF9E4A4CD273 , $85CBBAC869401C81 , $D511B713FED7005B , $A7611177D696F186 ,
$CB2BE1FFA608F675 , $25031046C85C4651 , $607171BC4577D270 , $A7BD8884299863A6 ,
$BB09FB728099A1E0 , $257145E566C8698F , $656BDB6B9184535F , $2682AAE2CA83AE91 ,
$F7A44CC4003AAEE0 , $888A9A9370DA460A , $6DE1F7FCFF64A895 , $B998294B6E631726 ,
$DD10FD0E373DE174 , $A4A1C99E1EDFF788 , $ABF89C5C23965C8C , $519FCEACDB50A42E ,
$C87EE06B04A3EE27 , $B3B84836F52EFE4A , $6771855FC5488FF2 , $029F27357BF79A7B ,
$864E931EC02D2201 , $9DFA41C069A2BEEE , $22A5DB4B50464091 , $B0D2E299A7808724 ,
$FFC352ACC4E06CD6 , $9578BEBB4DB8FC2F , $DC6E349B2D6DA548 , $2094DAB6C646C2D7 ,
$3B0AF3D2FD8EF1D0 , $63FDE78F2E0FB634 , $1C99503BC604F097 , $1C1EF3E82C9FC053 ,
$6BDB8E76017C181A , $26D88404B8CBAFAE , $187366AF04471F8D , $76A2778F66E512B8 ,
$E5BA2951AF211F80 , $86B065507B33F205 , $75E3B0DFDD17BE98 , $09EDA77B60ABFE0A ,
$97BEA04E8FA350FC , $BC6E641D8A5D1A28 , $46D6377D5FB77C8D , $3F97A7C23285D9E4 ,
$BA50164CA926C25D , $CCDB57813E220451 , $1C967F121B63DDDF , $A2A840B2E56CA3BD ,
$00787A81DB69A851 , $AB7BE835BFC19FE8 , $C35A18B6E11A9F05 , $F4FAD3C269CEA995 ,
$C52B4F9FB5F7EB87 , $BF066890B494DF0E , $E665E54BD57BF07D , $9F662650E1CAA8B3 ,
$B60FCBB205E1B3D4 , $21D47F05B16CEE46 , $A7706D9DA4D36B31 , $23028D1C88657839 ,
$E0F3BE98C0D8E92E , $9DA5D5CDED8C4DA2 , $827109BFA754CEA4 , $435571F88E42BC1F ,
$3CE06094CBB9EFCB , $2C03447D95B00977 , $D3E63B65D96A3686 , $A50C72D7437BC7FE ,
$5737E476389CA9FD , $3C8F8495ED9FB6BB , $7E66BF01BDDE8AC9 , $42FF650C947F1B73 ,
$831AD4C01A37458A , $AB86296924F9D44E , $D04534934527FE11 , $AD67B18D326BA056 ,
$CDC85BC218E596C3 , $97536CD65082A588 , $41838111A37C89B5 , $1E670AC7A5905648 ,
$7EB67D2636ADEDF6 , $0560514F780DD13E , $8B78A94B6C990708 , $7C15977BA8EA6213 ,
$8C8E898D35F895FE , $1A2CA8EE917F324B , $2CD3067B1262A84D , $169C0956D6011241 ,
$3213F9193BDB3C69 , $7BC2F0864E7C480E , $539F82006AB05B2C , $D684DD5C69A76F73 ,
$168A44E4E0FA0504 , $42A75FDDE3BA8C01 , $FB48A92AE2DAD4D1 , $86121899DC7429C7 ,
$10F72AA5B40A344A , $E4926B1781F8C90C , $4F4C3F28EDAD7518 , $744C57C4DB14A013 ,
$450FC24B306136AE , $DBE8614B7E18115C , $A4CD66811B0F87FC , $31984500099D06F5 ,

: rngs cells 'rngs + @ ;
: wurst ( ud1 ud2 -- ud3 )  2>r
    dup 0< >r d2* r> dup d- 2r>
    xor ;

: mix2bytes ( index n k -- b1 .. b8 index' n ) wurst-state + 8 0 DO
	>r over wurst-source + c@ r@ c@ xor -rot dup >r + $3F and r> r> 8 + LOOP
    drop ;

: bytes2sum ( ud b1 .. b8 -- ud' ) >r >r >r >r  >r >r >r >r
    r> rngs wurst  r> rngs wurst  r> rngs wurst  r> rngs wurst
    r> rngs wurst  r> rngs wurst  r> rngs wurst  r> rngs wurst ;

Create round# 13 c, 29 c, 19 c, 23 c, 31 c, 47 c, 17 c, 37 c, \ rounds
Create permut# 2 c, 6 c, 1 c, 4 c, 7 c, 0 c, 5 c, 3 c, \ permut length 15

: xors ( addr1 addr2 n -- ) bounds ?DO
    dup @ I @ xor I ! cell+  cell +LOOP  drop ;
: +!s ( addr1 addr2 n -- ) bounds ?DO
    dup @ I @ + I ! cell+  1 cells +LOOP  drop ;

: update-state ( -- )
    wurst-state wurst-source state# xors
    nextstate wurst-state state# +!s ;
: round ( n -- ) dup 1- swap  8 0 DO
	wurst-state I permut# + c@ cells + @ -rot
	I mix2bytes 2>r bytes2sum 2r> rot nextstate I cells + !
    LOOP 2drop update-state ;

Create 'round-flags
    $10 c, $30 c, $10 c, $70 c, $10 c, $30 c, $10 c, $F0 c,

: +entropy ( message -- message' )
    dup wurst-source state# xors
    wurst-state over state# xors
    state# + ;
: -entropy ( message -- message' )
    wurst-state over state# xors
    dup wurst-source state# xors
    state# + ;

: rounds ( addr n -- )  dup $F0 and ?DO
	I $F and round# + c@ round
	I 'round-flags I $F and + c@ and IF  +entropy  THEN
    LOOP drop ;

: rounds-decrypt ( addr n -- )  dup $F0 and ?DO
	I $F and round# + c@ round
	I 'round-flags I $F and + c@ and IF  -entropy  THEN
    LOOP drop ;
