Hex Artifact Content
Not logged in

Artifact 60076c31f29fbd0fab7fe4f0e319a78c9aac64b1:


0000: 5c 20 77 75 72 73 74 6b 65 73 73 65 6c 20 74 65  \ wurstkessel te
0010: 73 74 73 0a 0a 3a 20 74 65 73 74 2d 68 61 73 68  sts..: test-hash
0020: 0a 20 20 20 20 73 22 20 77 75 72 73 74 6b 65 73  .    s" wurstkes
0030: 73 65 6c 2e 66 73 22 20 77 75 72 73 74 2d 66 69  sel.fs" wurst-fi
0040: 6c 65 0a 20 20 20 20 73 6f 75 72 63 65 2d 69 6e  le.    source-in
0050: 69 74 20 73 74 61 74 65 2d 69 6e 69 74 20 20 72  it state-init  r
0060: 6f 75 6e 64 73 65 23 20 72 6f 75 6e 64 73 68 23  oundse# roundsh#
0070: 20 77 75 72 73 74 2d 68 61 73 68 20 3b 0a 3a 20   wurst-hash ;.: 
0080: 74 65 73 74 2d 65 6e 63 72 79 70 74 0a 20 20 20  test-encrypt.   
0090: 20 73 22 20 77 75 72 73 74 6b 65 73 73 65 6c 2e   s" wurstkessel.
00a0: 66 73 22 20 77 75 72 73 74 2d 66 69 6c 65 20 73  fs" wurst-file s
00b0: 22 20 77 75 72 73 74 6b 65 73 73 65 6c 2e 77 75  " wurstkessel.wu
00c0: 72 73 74 22 20 77 75 72 73 74 2d 6f 75 74 66 69  rst" wurst-outfi
00d0: 6c 65 0a 20 20 20 20 77 75 72 73 74 2d 6b 65 79  le.    wurst-key
00e0: 20 77 75 72 73 74 2d 73 61 6c 74 20 72 6f 75 6e   wurst-salt roun
00f0: 64 73 65 23 20 72 6f 75 6e 64 73 23 20 77 75 72  dse# rounds# wur
0100: 73 74 2d 65 6e 63 72 79 70 74 20 3b 0a 3a 20 74  st-encrypt ;.: t
0110: 65 73 74 2d 64 65 63 72 79 70 74 0a 20 20 20 20  est-decrypt.    
0120: 73 22 20 77 75 72 73 74 6b 65 73 73 65 6c 2e 77  s" wurstkessel.w
0130: 75 72 73 74 22 20 77 75 72 73 74 2d 66 69 6c 65  urst" wurst-file
0140: 20 73 22 20 77 75 72 73 74 6b 65 73 73 65 6c 2e   s" wurstkessel.
0150: 66 73 32 22 20 77 75 72 73 74 2d 6f 75 74 66 69  fs2" wurst-outfi
0160: 6c 65 0a 20 20 20 20 77 75 72 73 74 2d 6b 65 79  le.    wurst-key
0170: 20 72 6f 75 6e 64 73 65 23 20 72 6f 75 6e 64 73   roundse# rounds
0180: 23 20 77 75 72 73 74 2d 64 65 63 72 79 70 74 20  # wurst-decrypt 
0190: 3b 0a 3a 20 74 65 73 74 2d 72 6e 67 20 28 20 6e  ;.: test-rng ( n
01a0: 20 2d 2d 20 29 20 73 22 20 77 75 72 73 74 2e 72   -- ) s" wurst.r
01b0: 61 6e 64 6f 6d 22 20 77 75 72 73 74 2d 6f 75 74  andom" wurst-out
01c0: 66 69 6c 65 20 72 6e 67 2d 69 6e 69 74 0a 20 20  file rng-init.  
01d0: 20 20 72 6f 75 6e 64 73 23 20 3e 72 65 61 64 73    rounds# >reads
01e0: 20 73 74 61 74 65 23 20 2a 20 73 77 61 70 0a 20   state# * swap. 
01f0: 20 20 20 30 20 3f 44 4f 0a 09 72 6f 75 6e 64 73     0 ?DO..rounds
0200: 23 20 77 75 72 73 74 2d 72 6e 67 0a 09 6d 65 73  # wurst-rng..mes
0210: 73 61 67 65 20 6f 76 65 72 20 77 75 72 73 74 2d  sage over wurst-
0220: 6f 75 74 20 77 72 69 74 65 2d 66 69 6c 65 20 74  out write-file t
0230: 68 72 6f 77 0a 09 6d 65 73 73 61 67 65 20 6f 76  hrow..message ov
0240: 65 72 20 65 72 61 73 65 20 20 4c 4f 4f 50 20 77  er erase  LOOP w
0250: 75 72 73 74 2d 63 6c 6f 73 65 20 3b 0a 3a 20 6f  urst-close ;.: o
0260: 75 74 2d 72 6e 67 20 28 20 6e 20 2d 2d 20 29 20  ut-rng ( n -- ) 
0270: 73 74 64 6f 75 74 20 74 6f 20 77 75 72 73 74 2d  stdout to wurst-
0280: 6f 75 74 20 5c 20 72 6e 67 2d 69 6e 69 74 0a 20  out \ rng-init. 
0290: 20 20 20 72 6f 75 6e 64 73 23 20 3e 72 65 61 64     rounds# >read
02a0: 73 20 73 74 61 74 65 23 20 2a 20 73 77 61 70 0a  s state# * swap.
02b0: 20 20 20 20 30 20 3f 44 4f 0a 09 72 6f 75 6e 64      0 ?DO..round
02c0: 73 23 20 77 75 72 73 74 2d 72 6e 67 0a 09 6d 65  s# wurst-rng..me
02d0: 73 73 61 67 65 20 6f 76 65 72 20 77 75 72 73 74  ssage over wurst
02e0: 2d 6f 75 74 20 77 72 69 74 65 2d 66 69 6c 65 20  -out write-file 
02f0: 74 68 72 6f 77 0a 09 6d 65 73 73 61 67 65 20 6f  throw..message o
0300: 76 65 72 20 65 72 61 73 65 20 20 4c 4f 4f 50 20  ver erase  LOOP 
0310: 77 75 72 73 74 2d 63 6c 6f 73 65 20 3b 0a 0a 5c  wurst-close ;..\
0320: 20 74 65 73 74 20 66 6f 72 20 71 75 61 6c 69 74   test for qualit
0330: 79 0a 0a 5b 49 46 44 45 46 5d 20 27 72 6f 75 6e  y..[IFDEF] 'roun
0340: 64 73 0a 20 20 20 20 3a 20 77 75 72 73 74 2d 62  ds.    : wurst-b
0350: 72 65 61 6b 20 20 73 22 20 77 75 72 73 74 6b 65  reak  s" wurstke
0360: 73 73 65 6c 2e 66 73 22 20 77 75 72 73 74 2d 66  ssel.fs" wurst-f
0370: 69 6c 65 20 73 22 20 77 75 72 73 74 6b 65 73 73  ile s" wurstkess
0380: 65 6c 2e 77 75 72 73 74 32 22 20 77 75 72 73 74  el.wurst2" wurst
0390: 2d 6f 75 74 66 69 6c 65 0a 09 77 75 72 73 74 2d  -outfile..wurst-
03a0: 6b 65 79 20 77 75 72 73 74 2d 73 61 6c 74 20 72  key wurst-salt r
03b0: 6f 75 6e 64 73 65 23 20 72 6f 75 6e 64 73 68 23  oundse# roundsh#
03c0: 20 77 75 72 73 74 2d 65 6e 63 72 79 70 74 0a 09   wurst-encrypt..
03d0: 73 22 20 77 75 72 73 74 6b 65 73 73 65 6c 2e 66  s" wurstkessel.f
03e0: 73 22 20 77 75 72 73 74 2d 66 69 6c 65 20 72 6f  s" wurst-file ro
03f0: 75 6e 64 73 68 23 20 72 65 61 64 2d 66 69 72 73  undsh# read-firs
0400: 74 20 64 72 6f 70 0a 09 73 22 20 77 75 72 73 74  t drop..s" wurst
0410: 6b 65 73 73 65 6c 2e 77 75 72 73 74 32 22 20 77  kessel.wurst2" w
0420: 75 72 73 74 2d 66 69 6c 65 0a 09 77 75 72 73 74  urst-file..wurst
0430: 2d 73 6f 75 72 63 65 20 73 74 61 74 65 23 20 77  -source state# w
0440: 75 72 73 74 2d 69 6e 20 72 65 61 64 2d 66 69 6c  urst-in read-fil
0450: 65 20 74 68 72 6f 77 20 64 72 6f 70 0a 09 73 22  e throw drop..s"
0460: 20 77 75 72 73 74 6b 65 73 73 65 6c 2e 77 75 72   wurstkessel.wur
0470: 73 74 32 22 20 77 75 72 73 74 2d 66 69 6c 65 0a  st2" wurst-file.
0480: 09 77 75 72 73 74 2d 73 6f 75 72 63 65 20 73 74  .wurst-source st
0490: 61 74 65 23 20 77 75 72 73 74 2d 69 6e 20 72 65  ate# wurst-in re
04a0: 61 64 2d 66 69 6c 65 20 74 68 72 6f 77 20 64 72  ad-file throw dr
04b0: 6f 70 0a 09 77 75 72 73 74 2d 73 74 61 74 65 20  op..wurst-state 
04c0: 73 74 61 74 65 23 20 77 75 72 73 74 2d 69 6e 20  state# wurst-in 
04d0: 72 65 61 64 2d 66 69 6c 65 20 74 68 72 6f 77 20  read-file throw 
04e0: 64 72 6f 70 0a 09 77 75 72 73 74 2d 73 74 61 74  drop..wurst-stat
04f0: 65 20 77 75 72 73 74 2d 73 6f 75 72 63 65 20 73  e wurst-source s
0500: 74 61 74 65 23 20 78 6f 72 73 0a 09 6d 65 73 73  tate# xors..mess
0510: 61 67 65 20 77 75 72 73 74 2d 73 6f 75 72 63 65  age wurst-source
0520: 20 73 74 61 74 65 23 20 78 6f 72 73 0a 09 77 75   state# xors..wu
0530: 72 73 74 2d 73 6f 75 72 63 65 20 77 75 72 73 74  rst-source wurst
0540: 2d 73 74 61 74 65 20 73 74 61 74 65 23 20 78 6f  -state state# xo
0550: 72 73 0a 09 77 75 72 73 74 2d 73 74 61 74 65 20  rs..wurst-state 
0560: 77 75 72 73 74 2d 73 6f 75 72 63 65 20 73 74 61  wurst-source sta
0570: 74 65 23 20 78 6f 72 73 0a 09 77 75 72 73 74 2d  te# xors..wurst-
0580: 73 74 61 74 65 20 73 74 61 74 65 23 20 77 75 72  state state# wur
0590: 73 74 2d 69 6e 20 72 65 61 64 2d 66 69 6c 65 20  st-in read-file 
05a0: 74 68 72 6f 77 20 64 72 6f 70 0a 09 77 75 72 73  throw drop..wurs
05b0: 74 2d 73 6f 75 72 63 65 20 77 75 72 73 74 2d 73  t-source wurst-s
05c0: 74 61 74 65 20 73 74 61 74 65 23 20 78 6f 72 73  tate state# xors
05d0: 0a 09 6d 65 73 73 61 67 65 20 73 74 61 74 65 23  ..message state#
05e0: 20 2b 20 77 75 72 73 74 2d 73 74 61 74 65 20 73   + wurst-state s
05f0: 74 61 74 65 23 20 78 6f 72 73 0a 09 6d 65 73 73  tate# xors..mess
0600: 61 67 65 20 77 75 72 73 74 2d 73 6f 75 72 63 65  age wurst-source
0610: 20 73 74 61 74 65 23 20 78 6f 72 73 0a 09 73 74   state# xors..st
0620: 61 74 65 23 20 30 20 77 75 72 73 74 2d 69 6e 20  ate# 0 wurst-in 
0630: 72 65 70 6f 73 69 74 69 6f 6e 2d 66 69 6c 65 20  reposition-file 
0640: 74 68 72 6f 77 0a 09 73 22 20 77 75 72 73 74 6b  throw..s" wurstk
0650: 65 73 73 65 6c 2e 66 73 33 22 20 77 75 72 73 74  essel.fs3" wurst
0660: 2d 6f 75 74 66 69 6c 65 20 72 6f 75 6e 64 73 68  -outfile roundsh
0670: 23 20 3e 72 0a 09 72 40 20 65 6e 63 72 79 70 74  # >r..r@ encrypt
0680: 2d 72 65 61 64 0a 09 72 40 20 20 6d 65 73 73 61  -read..r@  messa
0690: 67 65 20 73 77 61 70 20 20 64 75 70 20 24 46 20  ge swap  dup $F 
06a0: 61 6e 64 20 38 20 75 6d 69 6e 20 30 20 3f 44 4f  and 8 umin 0 ?DO
06b0: 0a 09 20 20 20 20 49 20 30 3e 20 49 46 20 27 72  ..    I 0> IF 'r
06c0: 6f 75 6e 64 73 20 49 20 63 65 6c 6c 73 20 2b 20  ounds I cells + 
06d0: 40 20 65 78 65 63 75 74 65 20 54 48 45 4e 0a 09  @ execute THEN..
06e0: 20 20 20 20 64 75 70 20 27 72 6f 75 6e 64 2d 66      dup 'round-f
06f0: 6c 61 67 73 20 49 74 68 20 61 6e 64 20 49 46 0a  lags Ith and IF.
0700: 09 09 73 77 61 70 20 2d 65 6e 74 72 6f 70 79 20  ..swap -entropy 
0710: 73 77 61 70 0a 09 20 20 20 20 54 48 45 4e 0a 09  swap..    THEN..
0720: 4c 4f 4f 50 20 32 64 72 6f 70 0a 09 72 40 20 2e  LOOP 2drop..r@ .
0730: 78 6f 72 6d 73 67 2d 73 69 7a 65 0a 09 42 45 47  xormsg-size..BEG
0740: 49 4e 20 20 30 3e 20 20 57 48 49 4c 45 0a 09 09  IN  0>  WHILE...
0750: 72 40 20 65 6e 63 72 79 70 74 2d 72 65 61 64 0a  r@ encrypt-read.
0760: 09 09 72 40 20 72 6f 75 6e 64 73 2d 64 65 63 72  ..r@ rounds-decr
0770: 79 70 74 20 20 72 40 20 6d 65 73 73 61 67 65 3e  ypt  r@ message>
0780: 27 0a 09 52 45 50 45 41 54 0a 09 72 64 72 6f 70  '..REPEAT..rdrop
0790: 20 20 77 75 72 73 74 2d 63 6c 6f 73 65 20 3b 0a    wurst-close ;.
07a0: 5b 54 48 45 4e 5d 0a 0a 43 72 65 61 74 65 20 72  [THEN]..Create r
07b0: 6e 67 2d 68 69 73 74 6f 67 72 61 6d 20 24 31 30  ng-histogram $10
07c0: 30 20 30 20 5b 44 4f 5d 20 30 20 2c 20 5b 4c 4f  0 0 [DO] 0 , [LO
07d0: 4f 50 5d 0a 3a 20 74 69 6d 65 2d 72 6e 67 20 28  OP].: time-rng (
07e0: 20 6e 20 2d 2d 20 29 20 72 6e 67 2d 69 6e 69 74   n -- ) rng-init
07f0: 0a 20 20 20 20 30 20 3f 44 4f 20 20 72 6f 75 6e  .    0 ?DO  roun
0800: 64 73 23 20 77 75 72 73 74 2d 72 6e 67 20 20 4c  ds# wurst-rng  L
0810: 4f 4f 50 20 3b 0a 3a 20 65 76 61 6c 2d 72 6e 67  OOP ;.: eval-rng
0820: 20 28 20 6e 20 2d 2d 20 29 0a 20 20 20 20 30 20   ( n -- ).    0 
0830: 3f 44 4f 20 20 72 6f 75 6e 64 73 23 20 77 75 72  ?DO  rounds# wur
0840: 73 74 2d 72 6e 67 0a 09 77 75 72 73 74 2d 73 74  st-rng..wurst-st
0850: 61 74 65 20 73 74 61 74 65 23 20 62 6f 75 6e 64  ate state# bound
0860: 73 20 3f 44 4f 0a 09 20 20 20 20 31 20 49 20 63  s ?DO..    1 I c
0870: 40 20 63 65 6c 6c 73 20 72 6e 67 2d 68 69 73 74  @ cells rng-hist
0880: 6f 67 72 61 6d 20 2b 20 2b 21 20 20 4c 4f 4f 50  ogram + +!  LOOP
0890: 0a 20 20 20 20 4c 4f 4f 50 0a 20 20 20 20 73 74  .    LOOP.    st
08a0: 61 74 65 23 20 30 20 44 4f 20 72 6e 67 2d 68 69  ate# 0 DO rng-hi
08b0: 73 74 6f 67 72 61 6d 20 49 20 63 65 6c 6c 73 20  stogram I cells 
08c0: 2b 20 40 20 2e 20 63 72 20 4c 4f 4f 50 20 3b 0a  + @ . cr LOOP ;.
08d0: 0a 3a 20 77 75 72 73 74 2d 74 65 73 74 20 74 65  .: wurst-test te
08e0: 73 74 2d 68 61 73 68 20 74 65 73 74 2d 65 6e 63  st-hash test-enc
08f0: 72 79 70 74 20 74 65 73 74 2d 64 65 63 72 79 70  rypt test-decryp
0900: 74 20 3b 0a 0a 43 72 65 61 74 65 20 77 75 72 73  t ;..Create wurs
0910: 74 2d 74 6d 70 20 73 74 61 74 65 23 20 61 6c 6c  t-tmp state# all
0920: 6f 74 0a 0a 3a 20 66 69 6e 64 2d 73 61 6d 65 20  ot..: find-same 
0930: 28 20 64 20 2d 2d 20 29 0a 20 20 20 20 24 31 30  ( d -- ).    $10
0940: 30 20 30 20 44 4f 0a 09 24 31 30 30 20 49 20 44  0 0 DO..$100 I D
0950: 4f 0a 09 20 20 20 20 6a 20 72 6e 67 73 20 69 20  O..    j rngs i 
0960: 72 6e 67 73 20 72 6f 74 20 78 6f 72 20 2d 72 6f  rngs rot xor -ro
0970: 74 20 78 6f 72 20 73 77 61 70 0a 09 20 20 20 20  t xor swap..    
0980: 38 20 30 20 44 4f 20 32 6f 76 65 72 20 32 6f 76  8 0 DO 2over 2ov
0990: 65 72 20 64 3d 20 49 46 20 49 20 2e 20 4a 20 2e  er d= IF I . J .
09a0: 20 4b 20 2e 20 63 72 20 54 48 45 4e 20 30 2e 20   K . cr THEN 0. 
09b0: 77 75 72 73 74 0a 09 20 20 20 20 4c 4f 4f 50 20  wurst..    LOOP 
09c0: 32 64 72 6f 70 0a 09 4c 4f 4f 50 0a 20 20 20 20  2drop..LOOP.    
09d0: 4c 4f 4f 50 20 32 64 72 6f 70 20 3b 0a 0a 73 22  LOOP 2drop ;..s"
09e0: 20 67 66 6f 72 74 68 22 20 65 6e 76 69 72 6f 6e   gforth" environ
09f0: 6d 65 6e 74 3f 20 5b 49 46 5d 20 32 64 72 6f 70  ment? [IF] 2drop
0a00: 0a 20 20 20 20 72 65 71 75 69 72 65 20 66 66 74  .    require fft
0a10: 2e 66 73 0a 5b 54 48 45 4e 5d 0a 73 22 20 62 69  .fs.[THEN].s" bi
0a20: 67 66 6f 72 74 68 22 20 65 6e 76 69 72 6f 6e 6d  gforth" environm
0a30: 65 6e 74 3f 20 5b 49 46 5d 20 32 64 72 6f 70 0a  ent? [IF] 2drop.
0a40: 20 20 20 20 69 6e 63 6c 75 64 65 20 66 66 74 2e      include fft.
0a50: 66 62 0a 5b 54 48 45 4e 5d 0a 0a 3a 20 33 32 3e  fb.[THEN]..: 32>
0a60: 66 20 64 75 70 20 24 38 30 30 30 30 30 30 30 20  f dup $80000000 
0a70: 61 6e 64 20 6e 65 67 61 74 65 20 6f 72 20 73 3e  and negate or s>
0a80: 66 20 34 2e 36 35 36 36 31 32 38 37 33 31 45 2d  f 4.6566128731E-
0a90: 31 30 20 66 2a 20 3b 0a 0a 3a 20 72 6e 67 2d 66  10 f* ;..: rng-f
0aa0: 66 74 2d 74 65 73 74 20 28 20 6e 20 2d 2d 20 29  ft-test ( n -- )
0ab0: 20 64 75 70 20 70 6f 69 6e 74 73 20 72 6e 67 2d   dup points rng-
0ac0: 69 6e 69 74 0a 20 20 20 20 72 6f 75 6e 64 73 23  init.    rounds#
0ad0: 20 3e 72 65 61 64 73 20 73 74 61 74 65 23 20 2a   >reads state# *
0ae0: 20 73 77 61 70 0a 20 20 20 20 64 75 70 20 30 20   swap.    dup 0 
0af0: 3f 44 4f 0a 09 72 6f 75 6e 64 73 23 20 77 75 72  ?DO..rounds# wur
0b00: 73 74 2d 72 6e 67 0a 09 49 20 6d 65 73 73 61 67  st-rng..I messag
0b10: 65 20 32 20 70 69 63 6b 20 62 6f 75 6e 64 73 20  e 2 pick bounds 
0b20: 3f 44 4f 0a 09 20 20 20 20 49 20 20 20 20 20 33  ?DO..    I     3
0b30: 32 40 20 33 32 3e 66 0a 09 20 20 20 20 49 20 34  2@ 32>f..    I 4
0b40: 20 2b 20 33 32 40 20 33 32 3e 66 20 64 75 70 20   + 32@ 32>f dup 
0b50: 76 61 6c 75 65 73 20 7a 21 20 31 2b 0a 09 38 20  values z! 1+..8 
0b60: 2b 4c 4f 4f 50 20 64 72 6f 70 0a 09 6d 65 73 73  +LOOP drop..mess
0b70: 61 67 65 20 6f 76 65 72 20 65 72 61 73 65 0a 20  age over erase. 
0b80: 20 20 20 38 20 2b 4c 4f 4f 50 0a 20 20 20 20 66     8 +LOOP.    f
0b90: 66 74 20 23 70 6f 69 6e 74 73 20 73 3e 66 20 31  ft #points s>f 1
0ba0: 2f 66 20 66 73 71 72 74 20 66 66 74 73 63 61 6c  /f fsqrt fftscal
0bb0: 65 20 3b 0a 0a 3a 20 72 6e 67 73 2d 66 66 74 2d  e ;..: rngs-fft-
0bc0: 74 65 73 74 20 28 20 2d 2d 20 29 20 24 31 30 30  test ( -- ) $100
0bd0: 20 70 6f 69 6e 74 73 0a 20 20 20 20 27 72 6e 67   points.    'rng
0be0: 73 20 24 31 30 30 20 36 34 73 20 62 6f 75 6e 64  s $100 64s bound
0bf0: 73 20 3f 44 4f 0a 09 20 20 20 20 49 20 20 20 20  s ?DO..    I    
0c00: 20 33 32 40 20 33 32 3e 66 0a 09 20 20 20 20 49   32@ 32>f..    I
0c10: 20 34 20 2b 20 33 32 40 20 33 32 3e 66 20 64 75   4 + 32@ 32>f du
0c20: 70 20 76 61 6c 75 65 73 20 7a 21 20 31 2b 0a 20  p values z! 1+. 
0c30: 20 20 20 38 20 2b 4c 4f 4f 50 0a 20 20 20 20 66     8 +LOOP.    f
0c40: 66 74 20 23 70 6f 69 6e 74 73 20 73 3e 66 20 31  ft #points s>f 1
0c50: 2f 66 20 66 73 71 72 74 20 66 66 74 73 63 61 6c  /f fsqrt fftscal
0c60: 65 20 3b 0a 0a 43 72 65 61 74 65 20 66 66 74 2d  e ;..Create fft-
0c70: 74 65 73 74 2d 32 64 20 68 65 72 65 20 24 31 30  test-2d here $10
0c80: 30 30 20 63 65 6c 6c 73 20 64 75 70 20 61 6c 6c  00 cells dup all
0c90: 6f 74 20 65 72 61 73 65 0a 0a 3a 20 3e 74 65 73  ot erase..: >tes
0ca0: 74 2d 32 64 20 28 20 2d 2d 20 29 0a 20 20 20 20  t-2d ( -- ).    
0cb0: 23 70 6f 69 6e 74 73 20 30 20 3f 44 4f 0a 09 49  #points 0 ?DO..I
0cc0: 20 76 61 6c 75 65 73 20 7a 40 0a 09 24 38 20 66   values z@..$8 f
0cd0: 6d 2a 20 33 32 65 20 66 2b 20 66 3e 73 20 24 38  m* 32e f+ f>s $8
0ce0: 20 66 6d 2a 20 33 32 65 20 66 2b 20 66 3e 73 20   fm* 32e f+ f>s 
0cf0: 36 20 6c 73 68 69 66 74 20 2b 20 63 65 6c 6c 73  6 lshift + cells
0d00: 20 66 66 74 2d 74 65 73 74 2d 32 64 20 2b 20 31   fft-test-2d + 1
0d10: 20 73 77 61 70 20 2b 21 0a 20 20 20 20 4c 4f 4f   swap +!.    LOO
0d20: 50 20 3b 0a 0a 3a 20 2e 74 65 73 74 2d 32 64 20  P ;..: .test-2d 
0d30: 28 20 2d 2d 20 29 0a 20 20 20 20 24 34 30 20 30  ( -- ).    $40 0
0d40: 20 44 4f 0a 09 24 34 30 20 30 20 44 4f 0a 09 20   DO..$40 0 DO.. 
0d50: 20 20 20 4a 20 36 20 6c 73 68 69 66 74 20 49 20     J 6 lshift I 
0d60: 2b 20 63 65 6c 6c 73 20 66 66 74 2d 74 65 73 74  + cells fft-test
0d70: 2d 32 64 20 2b 20 3f 0a 09 4c 4f 4f 50 20 63 72  -2d + ?..LOOP cr
0d80: 0a 20 20 20 20 4c 4f 4f 50 20 3b 0a 0a 3a 20 3e  .    LOOP ;..: >
0d90: 74 65 73 74 2d 31 64 20 28 20 2d 2d 20 29 0a 20  test-1d ( -- ). 
0da0: 20 20 20 23 70 6f 69 6e 74 73 20 30 20 3f 44 4f     #points 0 ?DO
0db0: 0a 09 49 20 76 61 6c 75 65 73 20 7a 40 0a 09 24  ..I values z@..$
0dc0: 38 20 66 6d 2a 20 33 32 65 20 66 2b 20 66 3e 73  8 fm* 32e f+ f>s
0dd0: 20 63 65 6c 6c 73 20 66 66 74 2d 74 65 73 74 2d   cells fft-test-
0de0: 32 64 20 2b 20 31 20 73 77 61 70 20 2b 21 0a 09  2d + 1 swap +!..
0df0: 24 38 20 66 6d 2a 20 33 32 65 20 66 2b 20 66 3e  $8 fm* 32e f+ f>
0e00: 73 20 63 65 6c 6c 73 20 66 66 74 2d 74 65 73 74  s cells fft-test
0e10: 2d 32 64 20 2b 20 31 20 73 77 61 70 20 2b 21 0a  -2d + 1 swap +!.
0e20: 20 20 20 20 4c 4f 4f 50 20 3b 0a 0a 3a 20 2e 74      LOOP ;..: .t
0e30: 65 73 74 2d 31 64 20 28 20 2d 2d 20 29 0a 20 20  est-1d ( -- ).  
0e40: 20 20 24 34 30 20 30 20 44 4f 0a 09 49 20 63 65    $40 0 DO..I ce
0e50: 6c 6c 73 20 66 66 74 2d 74 65 73 74 2d 32 64 20  lls fft-test-2d 
0e60: 2b 20 3f 0a 20 20 20 20 4c 4f 4f 50 20 3b 0a 0a  + ?.    LOOP ;..
0e70: 5c 20 63 68 65 63 6b 20 66 6f 72 20 64 75 70 65  \ check for dupe
0e80: 73 0a 0a 3a 20 74 65 73 74 33 32 20 28 20 6e 20  s..: test32 ( n 
0e90: 2d 2d 20 29 20 20 6d 65 73 73 61 67 65 20 24 32  -- )  message $2
0ea0: 30 20 65 72 61 73 65 20 62 61 73 65 20 40 20 3e  0 erase base @ >
0eb0: 72 20 68 65 78 0a 20 20 20 20 30 20 3f 44 4f 20  r hex.    0 ?DO 
0ec0: 20 68 61 73 68 2d 69 6e 69 74 20 49 20 6d 65 73   hash-init I mes
0ed0: 73 61 67 65 20 21 20 72 6f 75 6e 64 73 68 23 20  sage ! roundsh# 
0ee0: 72 6f 75 6e 64 73 33 32 20 72 6f 75 6e 64 73 65  rounds32 roundse
0ef0: 23 20 72 6f 75 6e 64 73 33 32 0a 09 2e 73 6f 75  # rounds32...sou
0f00: 72 63 65 33 32 20 73 70 61 63 65 20 2e 73 74 61  rce32 space .sta
0f10: 74 65 33 32 20 73 70 61 63 65 20 49 20 38 20 75  te32 space I 8 u
0f20: 2e 72 20 63 72 20 4c 4f 4f 50 0a 20 20 20 20 72  .r cr LOOP.    r
0f30: 3e 20 62 61 73 65 20 21 20 3b 0a 0a 56 61 72 69  > base ! ;..Vari
0f40: 61 62 6c 65 20 6c 61 73 74 78 0a 0a 72 6f 6f 74  able lastx..root
0f50: 20 64 65 66 69 6e 69 74 69 6f 6e 73 0a 3a 20 78   definitions.: x
0f60: 3f 20 28 20 2d 2d 20 29 0a 20 20 20 20 32 20 70  ? ( -- ).    2 p
0f70: 69 63 6b 20 6c 61 73 74 78 20 40 20 3d 20 49 46  ick lastx @ = IF
0f80: 20 20 70 61 64 20 63 6f 75 6e 74 20 74 79 70 65    pad count type
0f90: 20 73 6f 75 72 63 65 20 74 79 70 65 20 63 72 20   source type cr 
0fa0: 20 54 48 45 4e 20 20 32 64 72 6f 70 20 6c 61 73   THEN  2drop las
0fb0: 74 78 20 21 0a 20 20 20 20 73 6f 75 72 63 65 20  tx !.    source 
0fc0: 70 61 64 20 70 6c 61 63 65 20 3b 0a 66 6f 72 74  pad place ;.fort
0fd0: 68 20 64 65 66 69 6e 69 74 69 6f 6e 73           h definitions