Artifact 4d6d3e70133a4ea2d9fd70a3ac5cb476fc4933d2:
- File wurstkessel-small.fs — part of check-in [f4464cf7b0] at 2012-12-24 01:19:54 on branch trunk — Moved 32 and 16 bit wurstkessel in extra file (user: bernd size: 2677)
- File wurstkessel/wurstkessel-small.fs — part of check-in [2788abc2d4] at 2014-01-28 18:48:59 on branch trunk — Moved Wurstkessel into subfolder (user: bernd size: 2677)
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 ;..