tests/hash_stats.f

   1 0 value show-details?
   2
   3 : bucket-count  ( -- bkcount )  1 wlist-hash-bits lshift ;
   4
   5 0 var word-count
   6 0 value vocid
   7 0 value buckets
   8 bucket-count cells buffer: bucket-items
   9
  10 : count-bucket-items  ( bkptr -- )
  11   0 swap
  12   begin
  13     @ ?dup
  14   while
  15     swap 1+ swap
  16   repeat
  17 ;
  18
  19 : setup-word-count  ( vocid -- )
  20   word-count 0!
  21   [: drop word-count 1+! false ;] foreach-word drop
  22 ;
  23
  24 : setup-buckets-info  ( vocid -- )
  25   vocid->htable to buckets
  26   bucket-items bucket-count cells erase
  27   bucket-count 0 do
  28     i cells buckets + count-bucket-items
  29     i cells bucket-items + !
  30   loop
  31 ;
  32
  33 : voc-setup  ( vocid -- )
  34   to vocid
  35   vocid setup-word-count
  36   vocid setup-buckets-info
  37 ;
  38
  39
  40 : has-bucket-with?  ( count -- flag )
  41   bucket-count 0 do
  42     i cells bucket-items + @ over = if drop true unloop exit endif
  43   loop
  44   drop false
  45 ;
  46
  47 : show-details  ( -- )
  48   0
  49   bucket-count 0 do  i cells bucket-items + @ max  loop
  50   1 swap do
  51     i has-bucket-with? if
  52       endcr
  53       i 3 .r ." : "
  54       bucket-count 0 do
  55         i cells bucket-items + @ j = if i . endif
  56       loop
  57     endif
  58     -1
  59   +loop
  60 ;
  61
  62
  63 : show-stats  ( vocid -- )
  64   voc-setup
  65
  66   endcr
  67   ." VOC: " vocid voc.
  68   ."  -- " word-count @ . ." words, "
  69
  70   0 0x7fff_ffff  \ max and min in bucket
  71   0  \ buckets used
  72   bucket-count 0 do
  73     i cells bucket-items + @
  74     ?dup if
  75       >r
  76       1+  \ update total used
  77       rot r@ max
  78       rot r@ min
  79       rot
  80       rdrop
  81     endif
  82   loop
  83   ;; ( bkmin bkmax bkused )
  84   nrot 2dup 2>r rot  \ for average
  85   0 .r ." /" bucket-count . ." buckets, " . ." min, " . ." max, average per bucket: "
  86   \ show average
  87   2r> + 2/ 0 .r cr
  88
  89   show-details? if show-details endif
  90 ;
  91
  92
  93 : ?show-stats  ( addr count -- )
  94   wfind if
  95     voc-cfa->vocid show-stats
  96   endif
  97 ;
  98
  99 cli-arg-next argv-str s" --details" s=ci to show-details?
 100
 101
 102 s" forth" ?show-stats
 103 s" disx86" ?show-stats
 104 s" asmx86" ?show-stats
 105 s" asmx86:lexer" ?show-stats
 106 s" asmx86:instructions" ?show-stats
 107 s" asm-labman" ?show-stats
 108 s" asm-meta" ?show-stats
 109
 110 .stack
 111 bye