needs hal/vreg hal/muldiv
unit mem/sort

: partition, ( nslots --  run: lo hi -- n )
  >r PSP) A>) @+, \ W=hi A=lo
  S) &) !, A) &) S>) -,
  r@ 2+ i) S>) >>, r@ 1+ i) S>) <<,
  A) &) S>) +, S) S>) @, \ S=pivot
  r@ 4* i) +, r@ 4* i) A>) -, [compile] begin
    [compile] begin r@ 4* i) A>) +, A) S>) >) ?br,
    [compile] begin r@ 4* i) -, W) S>) <) ?br,
    A) &) >) if,
      r> 0 do
        A) i 4* +) R0>) @, W) i 4* +) R0>) @!, A) i 4* +) R0>) !, loop
    ( comp: loopjmp ifjmp ) swap [compile] again [compile] then ;

\ Recursive (one for left, one for right) application of partition
: qsort, ( nslots --  run: a u -- )
  1 i) -, dup 4* i) *, PSP) +, ( lo hi )
  [compile] begin PSP) =) if, 2drop, exit, [compile] then
  \ comp sig: nslots loopjmp
  2dup, over partition, ( lo hi mid )
  rot, over, pushlr, ( loop ) dup execute, poplr, ( mid hi )
  swap 4* i) +, swap, ( loop ) bbr, ;

code sort 1 qsort,
code sortpairs 2 qsort,

: bisect, ( nslots --  run: n a u -- idx f )
  >r rot, R2) !, drop, 0 i) A>) @, [compile] begin ( a u A=idx R2=n V1=nslots )
    0 i) =) if, PSP) A>) !, exit, [compile] then
    S) &) !, 1 i) S>) >>, \ S=pivotidx
    S) &) R0>) @, r> 4* i) R0>) mulorshift, PSP) R0>) +, \ R0=pivotaddr
    R0) R1>) @, R2) R1>) =) if,
      S) &) A>) +, PSP) A>) !, 1 i) @, exit, [compile] then
    R2) R1>) <) if, \ pivot < n
      1 i) S>) +, S) &) A>) +, S) &) -, 2 i) S>) <<, PSP) dir) S>) +,
      [compile] else S) &) @, [compile] then [compile] again ;

code bisect 1 bisect,
code bisectpairs 2 bisect,

: left, ( nslots --  run: idx f A=idx R2=n R0=pivotaddr -- idx f )
  >r 0 i) =) if, exit, [compile] then [compile] begin
    0 i) A>) =) if, PSP) A>) !, exit, [compile] then
    r> 4* i) R0>) -, R0) S>) @, R2) S>) <>) if, PSP) A>) !, exit, [compile] then
    1 i) A>) -, [compile] again ;

: bisectleft bisect [ poplr, 1 left,
: bisectpairsleft bisectpairs [ poplr, 2 left,