Hex Artifact Content
Not logged in

Artifact 4d6d3e70133a4ea2d9fd70a3ac5cb476fc4933d2:


0000: 5c 20 73 63 61 6c 65 64 20 64 6f 77 6e 20 76 65  \ scaled down ve
0010: 72 73 69 6f 6e 73 20 6f 66 20 57 75 72 73 74 6b  rsions of Wurstk
0020: 65 73 73 65 6c 20 66 6f 72 20 74 65 73 74 69 6e  essel for testin
0030: 67 0a 0a 5c 20 77 75 72 73 74 6b 65 73 73 65 6c  g..\ wurstkessel
0040: 33 32 20 70 72 69 6d 69 74 69 76 65 73 0a 0a 3a  32 primitives..:
0050: 20 77 75 72 73 74 33 32 20 28 20 75 31 20 75 32   wurst32 ( u1 u2
0060: 20 2d 2d 20 75 33 20 29 20 20 3e 72 20 32 2a 20   -- u3 )  >r 2* 
0070: 64 75 70 20 31 36 20 72 73 68 69 66 74 20 31 20  dup 16 rshift 1 
0080: 61 6e 64 20 6f 72 20 24 46 46 46 46 20 61 6e 64  and or $FFFF and
0090: 20 72 3e 20 78 6f 72 20 3b 0a 3a 20 72 6e 67 73   r> xor ;.: rngs
00a0: 33 32 20 32 2a 20 27 72 6e 67 73 20 2b 20 77 40  32 2* 'rngs + w@
00b0: 20 3b 0a 0a 3a 20 6d 69 78 32 62 79 74 65 73 33   ;..: mix2bytes3
00c0: 32 20 28 20 69 6e 64 65 78 20 6e 20 6b 20 2d 2d  2 ( index n k --
00d0: 20 62 31 20 2e 2e 20 62 32 20 69 6e 64 65 78 27   b1 .. b2 index'
00e0: 20 6e 20 29 20 77 75 72 73 74 2d 73 74 61 74 65   n ) wurst-state
00f0: 20 2b 20 32 20 30 20 44 4f 0a 09 3e 72 20 6f 76   + 2 0 DO..>r ov
0100: 65 72 20 77 75 72 73 74 2d 73 6f 75 72 63 65 20  er wurst-source 
0110: 2b 20 63 40 20 72 40 20 63 40 20 78 6f 72 20 2d  + c@ r@ c@ xor -
0120: 72 6f 74 20 64 75 70 20 3e 72 20 2b 20 24 33 20  rot dup >r + $3 
0130: 61 6e 64 20 72 3e 20 72 3e 20 32 20 2b 20 4c 4f  and r> r> 2 + LO
0140: 4f 50 0a 20 20 20 20 64 72 6f 70 20 3b 0a 0a 3a  OP.    drop ;..:
0150: 20 62 79 74 65 73 32 73 75 6d 33 32 20 28 20 75   bytes2sum32 ( u
0160: 64 20 62 31 20 2e 2e 20 62 32 20 2d 2d 20 75 64  d b1 .. b2 -- ud
0170: 27 20 29 20 3e 72 20 3e 72 0a 20 20 20 20 72 3e  ' ) >r >r.    r>
0180: 20 72 6e 67 73 33 32 20 77 75 72 73 74 33 32 20   rngs32 wurst32 
0190: 20 72 3e 20 72 6e 67 73 33 32 20 77 75 72 73 74   r> rngs32 wurst
01a0: 33 32 20 3b 0a 0a 3a 20 75 70 64 61 74 65 2d 73  32 ;..: update-s
01b0: 74 61 74 65 33 32 20 28 20 2d 2d 20 29 0a 20 20  tate32 ( -- ).  
01c0: 20 20 77 75 72 73 74 2d 73 74 61 74 65 20 77 75    wurst-state wu
01d0: 72 73 74 2d 73 6f 75 72 63 65 20 73 74 61 74 65  rst-source state
01e0: 23 33 32 20 78 6f 72 73 0a 20 20 20 20 6e 65 78  #32 xors.    nex
01f0: 74 73 74 61 74 65 20 77 75 72 73 74 2d 73 74 61  tstate wurst-sta
0200: 74 65 20 73 74 61 74 65 23 33 32 20 2b 21 73 20  te state#32 +!s 
0210: 3b 0a 0a 43 72 65 61 74 65 20 70 65 72 6d 75 74  ;..Create permut
0220: 23 33 32 20 31 20 2c 20 30 20 2c 20 5c 20 70 65  #32 1 , 0 , \ pe
0230: 72 6d 75 74 20 6c 65 6e 67 74 68 20 32 0a 44 4f  rmut length 2.DO
0240: 45 53 3e 20 73 77 61 70 20 31 20 61 6e 64 20 63  ES> swap 1 and c
0250: 65 6c 6c 73 20 2b 20 40 20 3b 0a 0a 3a 20 72 6f  ells + @ ;..: ro
0260: 75 6e 64 33 32 20 28 20 6e 20 2d 2d 20 29 20 64  und32 ( n -- ) d
0270: 75 70 20 31 2d 20 73 77 61 70 20 20 32 20 30 20  up 1- swap  2 0 
0280: 44 4f 0a 09 77 75 72 73 74 2d 73 74 61 74 65 20  DO..wurst-state 
0290: 49 20 70 65 72 6d 75 74 23 33 32 20 32 2a 20 2b  I permut#32 2* +
02a0: 20 77 40 20 2d 72 6f 74 0a 09 49 20 6d 69 78 32   w@ -rot..I mix2
02b0: 62 79 74 65 73 33 32 20 32 3e 72 20 62 79 74 65  bytes32 2>r byte
02c0: 73 32 73 75 6d 33 32 20 32 72 3e 20 72 6f 74 20  s2sum32 2r> rot 
02d0: 6e 65 78 74 73 74 61 74 65 20 49 20 32 2a 20 2b  nextstate I 2* +
02e0: 20 77 21 0a 20 20 20 20 4c 4f 4f 50 20 32 64 72   w!.    LOOP 2dr
02f0: 6f 70 20 75 70 64 61 74 65 2d 73 74 61 74 65 33  op update-state3
0300: 32 20 3b 0a 0a 3a 20 2b 65 6e 74 72 6f 70 79 33  2 ;..: +entropy3
0310: 32 20 28 20 6d 65 73 73 61 67 65 20 2d 2d 20 6d  2 ( message -- m
0320: 65 73 73 61 67 65 27 20 29 0a 20 20 20 20 64 75  essage' ).    du
0330: 70 20 77 75 72 73 74 2d 73 6f 75 72 63 65 20 73  p wurst-source s
0340: 74 61 74 65 23 33 32 20 78 6f 72 73 20 20 77 75  tate#32 xors  wu
0350: 72 73 74 2d 73 6f 75 72 63 65 20 6f 76 65 72 20  rst-source over 
0360: 73 74 61 74 65 23 33 32 20 6d 6f 76 65 0a 20 20  state#32 move.  
0370: 20 20 73 74 61 74 65 23 33 32 20 2b 20 3b 0a 0a    state#32 + ;..
0380: 5c 20 77 75 72 73 74 6b 65 73 73 65 6c 31 36 20  \ wurstkessel16 
0390: 70 72 69 6d 69 74 69 76 65 73 20 2d 20 72 65 61  primitives - rea
03a0: 6c 6c 79 20 64 65 67 65 6e 65 72 61 74 65 64 20  lly degenerated 
03b0: 63 61 73 65 0a 0a 3a 20 77 75 72 73 74 31 36 20  case..: wurst16 
03c0: 28 20 75 31 20 75 32 20 2d 2d 20 75 33 20 29 20  ( u1 u2 -- u3 ) 
03d0: 20 3e 72 20 32 2a 20 64 75 70 20 38 20 72 73 68   >r 2* dup 8 rsh
03e0: 69 66 74 20 31 20 61 6e 64 20 6f 72 20 24 46 46  ift 1 and or $FF
03f0: 20 61 6e 64 20 72 3e 20 78 6f 72 20 3b 0a 3a 20   and r> xor ;.: 
0400: 72 6e 67 73 31 36 20 27 72 6e 67 73 20 2b 20 63  rngs16 'rngs + c
0410: 40 20 3b 0a 0a 3a 20 6d 69 78 32 62 79 74 65 73  @ ;..: mix2bytes
0420: 31 36 20 28 20 69 6e 64 65 78 20 6e 20 6b 20 2d  16 ( index n k -
0430: 2d 20 62 20 69 6e 64 65 78 27 20 6e 20 29 20 77  - b index' n ) w
0440: 75 72 73 74 2d 73 74 61 74 65 20 2b 0a 20 20 20  urst-state +.   
0450: 20 3e 72 20 6f 76 65 72 20 77 75 72 73 74 2d 73   >r over wurst-s
0460: 6f 75 72 63 65 20 2b 20 63 40 20 72 3e 20 63 40  ource + c@ r> c@
0470: 20 78 6f 72 20 2d 72 6f 74 20 64 75 70 20 3e 72   xor -rot dup >r
0480: 20 2b 20 24 30 20 61 6e 64 20 72 3e 20 3b 0a 0a   + $0 and r> ;..
0490: 3a 20 62 79 74 65 73 32 73 75 6d 31 36 20 28 20  : bytes2sum16 ( 
04a0: 75 64 20 62 20 2d 2d 20 75 64 27 20 29 20 72 6e  ud b -- ud' ) rn
04b0: 67 73 31 36 20 77 75 72 73 74 31 36 20 3b 0a 0a  gs16 wurst16 ;..
04c0: 3a 20 75 70 64 61 74 65 2d 73 74 61 74 65 31 36  : update-state16
04d0: 20 28 20 2d 2d 20 29 0a 20 20 20 20 77 75 72 73   ( -- ).    wurs
04e0: 74 2d 73 74 61 74 65 20 63 40 20 77 75 72 73 74  t-state c@ wurst
04f0: 2d 73 6f 75 72 63 65 20 63 40 20 78 6f 72 20 77  -source c@ xor w
0500: 75 72 73 74 2d 73 6f 75 72 63 65 20 63 21 0a 20  urst-source c!. 
0510: 20 20 20 6e 65 78 74 73 74 61 74 65 20 63 40 20     nextstate c@ 
0520: 77 75 72 73 74 2d 73 74 61 74 65 20 63 40 20 2b  wurst-state c@ +
0530: 20 77 75 72 73 74 2d 73 74 61 74 65 20 63 21 20   wurst-state c! 
0540: 3b 0a 0a 3a 20 72 6f 75 6e 64 31 36 20 28 20 6e  ;..: round16 ( n
0550: 20 2d 2d 20 29 20 64 75 70 20 31 2d 20 73 77 61   -- ) dup 1- swa
0560: 70 0a 20 20 20 20 77 75 72 73 74 2d 73 74 61 74  p.    wurst-stat
0570: 65 20 63 40 20 2d 72 6f 74 0a 20 20 20 20 30 20  e c@ -rot.    0 
0580: 6d 69 78 32 62 79 74 65 73 31 36 20 32 3e 72 20  mix2bytes16 2>r 
0590: 62 79 74 65 73 32 73 75 6d 31 36 20 32 72 3e 20  bytes2sum16 2r> 
05a0: 72 6f 74 20 6e 65 78 74 73 74 61 74 65 20 63 21  rot nextstate c!
05b0: 0a 20 20 20 20 32 64 72 6f 70 20 75 70 64 61 74  .    2drop updat
05c0: 65 2d 73 74 61 74 65 31 36 20 3b 0a 0a 3a 20 2b  e-state16 ;..: +
05d0: 65 6e 74 72 6f 70 79 31 36 20 28 20 6d 65 73 73  entropy16 ( mess
05e0: 61 67 65 20 2d 2d 20 6d 65 73 73 61 67 65 27 20  age -- message' 
05f0: 29 0a 20 20 20 20 64 75 70 20 63 40 20 77 75 72  ).    dup c@ wur
0600: 73 74 2d 73 6f 75 72 63 65 20 63 40 20 78 6f 72  st-source c@ xor
0610: 20 77 75 72 73 74 2d 73 6f 75 72 63 65 20 63 21   wurst-source c!
0620: 20 20 77 75 72 73 74 2d 73 6f 75 72 63 65 20 63    wurst-source c
0630: 40 20 6f 76 65 72 20 63 21 0a 20 20 20 20 73 74  @ over c!.    st
0640: 61 74 65 23 31 36 20 2b 20 3b 0a 0a 5c 20 33 32  ate#16 + ;..\ 32
0650: 20 62 69 74 20 72 6f 75 6e 64 73 0a 0a 5b 49 46   bit rounds..[IF
0660: 55 4e 44 45 46 5d 20 27 72 6f 75 6e 64 2d 66 6c  UNDEF] 'round-fl
0670: 61 67 73 0a 20 20 20 20 43 72 65 61 74 65 20 27  ags.    Create '
0680: 72 6f 75 6e 64 2d 66 6c 61 67 73 0a 20 20 20 20  round-flags.    
0690: 24 31 30 20 2c 20 24 33 30 20 2c 20 24 31 30 20  $10 , $30 , $10 
06a0: 2c 20 24 37 30 20 2c 20 24 31 30 20 2c 20 24 33  , $70 , $10 , $3
06b0: 30 20 2c 20 24 31 30 20 2c 20 24 46 30 20 2c 0a  0 , $10 , $F0 ,.
06c0: 5b 54 48 45 4e 5d 0a 0a 3a 20 72 6f 75 6e 64 73  [THEN]..: rounds
06d0: 33 32 20 28 20 61 64 64 72 20 6e 20 2d 2d 20 29  32 ( addr n -- )
06e0: 20 20 64 75 70 20 24 46 20 61 6e 64 20 38 20 75    dup $F and 8 u
06f0: 6d 69 6e 20 30 20 3f 44 4f 0a 09 49 20 72 6f 75  min 0 ?DO..I rou
0700: 6e 64 23 20 72 6f 75 6e 64 33 32 0a 09 64 75 70  nd# round32..dup
0710: 20 27 72 6f 75 6e 64 2d 66 6c 61 67 73 20 49 20   'round-flags I 
0720: 63 65 6c 6c 73 20 2b 20 40 20 61 6e 64 20 49 46  cells + @ and IF
0730: 0a 09 20 20 20 20 73 77 61 70 20 2b 65 6e 74 72  ..    swap +entr
0740: 6f 70 79 33 32 20 73 77 61 70 0a 09 54 48 45 4e  opy32 swap..THEN
0750: 0a 20 20 20 20 4c 4f 4f 50 20 32 64 72 6f 70 20  .    LOOP 2drop 
0760: 3b 0a 0a 5c 20 33 32 20 62 69 74 20 77 75 72 73  ;..\ 32 bit wurs
0770: 74 20 66 6f 72 20 74 65 73 74 69 6e 67 0a 0a 3a  t for testing..:
0780: 20 77 75 72 73 74 2d 73 69 7a 65 33 32 20 28 20   wurst-size32 ( 
0790: 2d 2d 20 29 0a 20 20 20 20 5b 20 63 65 6c 6c 20  -- ).    [ cell 
07a0: 34 20 3d 20 5d 20 5b 49 46 5d 0a 09 73 69 7a 65  4 = ] [IF]..size
07b0: 3f 20 64 72 6f 70 20 6d 65 73 73 61 67 65 20 21  ? drop message !
07c0: 0a 20 20 20 20 5b 45 4c 53 45 5d 0a 09 73 69 7a  .    [ELSE]..siz
07d0: 65 3f 20 64 72 6f 70 20 6d 65 73 73 61 67 65 20  e? drop message 
07e0: 6c 21 0a 20 20 20 20 5b 54 48 45 4e 5d 20 3b 0a  l!.    [THEN] ;.
07f0: 3a 20 65 6e 63 72 79 70 74 2d 72 65 61 64 33 32  : encrypt-read32
0800: 20 28 20 66 6c 61 67 73 20 2d 2d 20 6e 20 29 20   ( flags -- n ) 
0810: 20 3e 72 65 61 64 73 20 3e 72 0a 20 20 20 20 6d   >reads >r.    m
0820: 65 73 73 61 67 65 20 73 74 61 74 65 23 33 32 20  essage state#32 
0830: 72 3e 20 2a 20 32 64 75 70 20 65 72 61 73 65 20  r> * 2dup erase 
0840: 20 77 75 72 73 74 2d 69 6e 20 72 65 61 64 2d 66   wurst-in read-f
0850: 69 6c 65 20 74 68 72 6f 77 20 3b 0a 3a 20 72 65  ile throw ;.: re
0860: 61 64 2d 66 69 72 73 74 33 32 20 28 20 66 6c 61  ad-first32 ( fla
0870: 67 73 20 2d 2d 20 6e 20 29 20 20 77 75 72 73 74  gs -- n )  wurst
0880: 2d 73 69 7a 65 33 32 20 20 3e 72 65 61 64 73 20  -size32  >reads 
0890: 3e 72 0a 20 20 20 20 6d 65 73 73 61 67 65 20 73  >r.    message s
08a0: 74 61 74 65 23 33 32 20 72 3e 20 2a 20 32 20 32  tate#32 r> * 2 2
08b0: 2a 20 2f 73 74 72 69 6e 67 20 77 75 72 73 74 2d  * /string wurst-
08c0: 69 6e 20 72 65 61 64 2d 66 69 6c 65 20 74 68 72  in read-file thr
08d0: 6f 77 20 20 32 20 32 2a 20 2b 20 3b 0a 3a 20 2e  ow  2 2* + ;.: .
08e0: 34 68 20 28 20 75 20 2d 2d 20 29 0a 20 20 20 20  4h ( u -- ).    
08f0: 30 20 62 61 73 65 20 40 20 3e 72 20 68 65 78 20  0 base @ >r hex 
0900: 3c 3c 23 20 23 20 23 20 23 20 23 20 23 3e 20 74  <<# # # # # #> t
0910: 79 70 65 20 23 3e 3e 20 72 3e 20 62 61 73 65 20  ype #>> r> base 
0920: 21 20 3b 0a 0a 3a 20 2e 73 6f 75 72 63 65 33 32  ! ;..: .source32
0930: 20 28 20 2d 2d 20 29 20 32 20 30 20 44 4f 20 20   ( -- ) 2 0 DO  
0940: 77 75 72 73 74 2d 73 6f 75 72 63 65 20 49 20 32  wurst-source I 2
0950: 2a 20 2b 20 77 40 20 2e 34 68 20 20 4c 4f 4f 50  * + w@ .4h  LOOP
0960: 20 3b 0a 3a 20 2e 73 74 61 74 65 33 32 20 20 28   ;.: .state32  (
0970: 20 2d 2d 20 29 20 32 20 30 20 44 4f 20 20 77 75   -- ) 2 0 DO  wu
0980: 72 73 74 2d 73 74 61 74 65 20 49 20 32 2a 20 2b  rst-state I 2* +
0990: 20 77 40 20 2e 34 68 20 20 4c 4f 4f 50 20 3b 0a   w@ .4h  LOOP ;.
09a0: 0a 3a 20 77 75 72 73 74 2d 68 61 73 68 33 32 20  .: wurst-hash32 
09b0: 28 20 66 69 6e 61 6c 2d 72 6f 75 6e 64 73 20 72  ( final-rounds r
09c0: 6f 75 6e 64 73 20 2d 2d 20 29 0a 20 20 20 20 68  ounds -- ).    h
09d0: 61 73 68 2d 69 6e 69 74 20 64 75 70 20 72 65 61  ash-init dup rea
09e0: 64 2d 66 69 72 73 74 33 32 0a 20 20 20 20 42 45  d-first32.    BE
09f0: 47 49 4e 20 20 30 3e 20 20 57 48 49 4c 45 0a 09  GIN  0>  WHILE..
0a00: 20 20 20 20 6d 65 73 73 61 67 65 20 6f 76 65 72      message over
0a10: 20 72 6f 75 6e 64 73 33 32 0a 09 20 20 20 20 64   rounds32..    d
0a20: 75 70 20 65 6e 63 72 79 70 74 2d 72 65 61 64 33  up encrypt-read3
0a30: 32 0a 20 20 20 20 52 45 50 45 41 54 0a 20 20 20  2.    REPEAT.   
0a40: 20 64 72 6f 70 20 6d 65 73 73 61 67 65 20 73 77   drop message sw
0a50: 61 70 20 72 6f 75 6e 64 73 33 32 20 2e 73 6f 75  ap rounds32 .sou
0a60: 72 63 65 33 32 20 77 75 72 73 74 2d 63 6c 6f 73  rce32 wurst-clos
0a70: 65 20 3b 0a 0a                                   e ;..