needs lib/bit
unit mem/mark

: newmarklist ( n -- ) here# swap 32 /+ dup , 4* allot0 ;
: markall @+ -1 fill ;
: unmarkall @+ 0 fill ;

: oob abort"mark list out of bounds" ;
: [?oob] ( idx mlist -- idx mlist )
  PSP) S>) @, 5 i) S>) >>, ['] oob W) S>) >=) ?br, ; immediate

:~ ( idx mlist -- bit a ) [?oob] 4+ swap 32 /mod 4* rot + ;
: mark ( idx mlist -- ) ~ >A bitmask @A@ or @A! ;
: unmark ( idx mlist -- ) ~ >A bitmask inv @A@ and @A! ;
: marked? ( idx mlist -- f ) ~ >A bitmask @A@ and bool ;
: ?mark ( idx mlist -- f ) ~ >A bitmask @A@ 2dup or @A! and bool ;

: findunmarked ( mlist -- ?idx f )
  @+ 0 do ( a ) [
    W) S>) @+, -1 i) S>) <>) if,
      S) &) @, ] ( bits ) i 32 * swap findbit0 + 1 unloop exit then loop
  drop 0 ;

: markcnt ( mlist -- n ) 0 swap @+ 0 do @+ bitscnt rot + swap loop drop ;