diff --git a/src/bitset.ml b/src/bitset.ml
new file mode 100644
index 0000000..b447ab7
--- /dev/null
+++ b/src/bitset.ml
@@ -0,0 +1,276 @@
+module Make (B : Context.A_DISK) = struct
+  module Sector = Sector.Make (B)
+  module Schema = Schema.Make (B)
+
+  type t = Sector.t
+
+  open Lwt_result.Syntax
+
+  let get_page_size () = B.page_size
+
+  let get_nb_leaves () =
+    let nb_sectors = Int64.to_int B.nb_sectors in
+    let page_size = get_page_size () in
+    let bit_size = page_size * 8 in
+    (nb_sectors + bit_size - 1) / bit_size
+
+  let get_group_size nb_children nb_leaves =
+    let rec get_group_size group_size =
+      if group_size * nb_children >= nb_leaves
+      then group_size
+      else get_group_size (group_size * nb_children)
+    in
+    get_group_size 1
+
+  let get_ptr_size () = Sector.ptr_size
+
+  let get_nb_children page_size =
+    let incr = get_ptr_size () in
+    page_size / incr
+
+  let get value offset = value land (1 lsl offset)
+
+  let get_flag t i =
+    let pos = i / 8 in
+    let* value = Sector.get_uint8 t pos in
+    let offset = i mod 8 in
+    let flag = get value offset in
+    Lwt_result.return flag
+
+  let get_leaf t i =
+    let page_size = get_page_size () in
+    let bit_size = page_size * 8 in
+    let leaf_ind = i / bit_size in
+    let nb_leaves = get_nb_leaves () in
+    let nb_children = get_nb_children page_size in
+    let incr = get_ptr_size () in
+    let rec reach_leaf t leaf_ind nb_leaves =
+      let group_size = get_group_size nb_children nb_leaves in
+      let child_ind = leaf_ind / group_size in
+      let new_leaves =
+        if child_ind = (nb_leaves - 1) / group_size
+        then ((nb_leaves - 1) mod group_size) + 1
+        else group_size
+      in
+      let* child = Sector.get_child t (incr * child_ind) in
+      if group_size = 1
+      then Lwt_result.return child
+      else reach_leaf child (leaf_ind mod group_size) new_leaves
+    in
+    reach_leaf t leaf_ind nb_leaves
+
+  let free_leaf t i =
+    let pos = i / 8 in
+    let* value = Sector.get_uint8 t pos in
+    let offset = i mod 8 in
+    let flag = value land (1 lsl offset) in
+    assert (flag > 0) ;
+    let update = value lxor (1 lsl offset) in
+    Sector.set_uint8 t pos update
+
+  let free t i =
+    let page_size = get_page_size () in
+    let bit_size = page_size * 8 in
+    let* leaf = get_leaf t i in
+    free_leaf leaf (i mod bit_size)
+
+  let free_range_leaf t (ind, len) =
+    assert (ind / 8 = (ind + len - 1) / 8) ;
+    let rec set_used cur_ind value =
+      if cur_ind = ind + len
+      then value
+      else (
+        let offset = cur_ind mod 8 in
+        let flag = value land (1 lsl offset) in
+        assert (flag > 0) ;
+        let update = value lxor (1 lsl offset) in
+        set_used (cur_ind + 1) update)
+    in
+    let pos = ind / 8 in
+    let* value = Sector.get_uint8 t pos in
+    let update = set_used ind value in
+    Sector.set_uint8 t pos update
+
+  let free_range t (id, len) =
+    let page_size = get_page_size () in
+    let bit_size = page_size * 8 in
+    let rec split leaf (ind, len) =
+      match len with
+      | 0 -> Lwt_result.return ()
+      | len ->
+        let cur_len = min len (8 - (ind mod 8)) in
+        let next_ind = ind + cur_len in
+        let next_len = len - cur_len in
+        let* next_leaf =
+          if ind / bit_size <> next_ind / bit_size
+          then get_leaf t next_ind
+          else Lwt_result.return leaf
+        in
+        let* () = free_range_leaf leaf (ind mod bit_size, cur_len) in
+        split next_leaf (next_ind, next_len)
+    in
+    let ind = Int64.to_int @@ B.Id.to_int64 id in
+    let* leaf = get_leaf t ind in
+    split leaf (ind, len)
+
+  let use_leaf t i =
+    let pos = i / 8 in
+    let* value = Sector.get_uint8 t pos in
+    let offset = i mod 8 in
+    let flag = value land (1 lsl offset) in
+    assert (flag = 0) ;
+    let update = value lor (1 lsl offset) in
+    Sector.set_uint8 t pos update
+
+  let use t i =
+    let page_size = get_page_size () in
+    let bit_size = page_size * 8 in
+    let* leaf = get_leaf t i in
+    use_leaf leaf (i mod bit_size)
+
+  let use_range_leaf t (ind, len) =
+    assert (ind / 8 = (ind + len - 1) / 8) ;
+    let rec set_used cur_ind value =
+      if cur_ind = ind + len
+      then value
+      else (
+        let offset = cur_ind mod 8 in
+        let flag = value land (1 lsl offset) in
+        assert (flag = 0) ;
+        let update = value lor (1 lsl offset) in
+        set_used (cur_ind + 1) update)
+    in
+    let pos = ind / 8 in
+    let* value = Sector.get_uint8 t pos in
+    let update = set_used ind value in
+    Sector.set_uint8 t pos update
+
+  let use_range t (id, len) =
+    let page_size = get_page_size () in
+    let bit_size = page_size * 8 in
+    let rec split leaf (ind, len) =
+      match len with
+      | 0 -> Lwt_result.return ()
+      | len ->
+        let cur_len = min len (8 - (ind mod 8)) in
+        let next_ind = ind + cur_len in
+        let next_len = len - cur_len in
+        let* next_leaf =
+          if ind / bit_size <> next_ind / bit_size
+          then get_leaf t next_ind
+          else Lwt_result.return leaf
+        in
+        let* () = use_range_leaf leaf (ind mod bit_size, cur_len) in
+        split next_leaf (next_ind, next_len)
+    in
+    let ind = Int64.to_int @@ B.Id.to_int64 id in
+    let* leaf = get_leaf t ind in
+    split leaf (ind, len)
+
+  let create_leaf () =
+    let* t = Sector.create () in
+    let sz = B.page_size in
+    let rec init = function
+      | i when i >= sz -> Lwt_result.return ()
+      | i ->
+        let* () = Sector.set_uint8 t i 0 in
+        init (i + 1)
+    in
+    let+ () = init 0 in
+    t
+
+  let rec create_parent nb_leaves page_size =
+    let* parent = create_leaf () in
+    let incr = get_ptr_size () in
+    let nb_children = get_nb_children page_size in
+    let group_size = get_group_size nb_children nb_leaves in
+    if group_size = 1
+    then (
+      let rec init_leaves cur_index = function
+        | -1 -> Lwt_result.return ()
+        | nb_leaf ->
+          let* leaf = create_leaf () in
+          let* () = Sector.set_child parent cur_index leaf in
+          init_leaves (cur_index + incr) (nb_leaf - 1)
+      in
+      let+ () = init_leaves 0 (nb_leaves - 1) in
+      parent)
+    else (
+      let rec init_parent index = function
+        | 0 -> Lwt_result.return ()
+        | nb_leaves ->
+          let group = min nb_leaves group_size in
+          let* child = create_parent group page_size in
+          let* () = Sector.set_child parent index child in
+          init_parent (index + incr) (nb_leaves - group)
+      in
+      let+ () = init_parent 0 nb_leaves in
+      parent)
+
+  let create () =
+    let page_size = get_page_size () in
+    let nb_leaves = get_nb_leaves () in
+    let* root = create_parent nb_leaves page_size in
+    let rec init_res = function
+      | num when num < 0 -> Lwt_result.return ()
+      | num ->
+        let* () = use root num in
+        init_res (num - 1)
+    in
+    let+ () = init_res 12 in
+    root
+
+  let pop_front t bitset_start quantity =
+    let page_size = get_page_size () in
+    let bit_size = page_size * 8 in
+    let nb_sectors = Int64.to_int B.nb_sectors in
+    let start_ind = Int64.to_int @@ B.Id.to_int64 bitset_start in
+    let start_ind = start_ind - (start_ind mod 8) in
+    let rec do_pop_front ind lst leaf =
+      assert (List.length lst < quantity) ;
+      let pos = ind mod bit_size / 8 in
+      let* value = Sector.get_uint8 leaf pos in
+      let needed = quantity - List.length lst in
+      let rec get_id cur_ind needed lst =
+        if cur_ind >= nb_sectors || cur_ind = ind + 8 || needed = 0
+        then Lwt_result.return lst
+        else (
+          let flag = get value (cur_ind mod 8) in
+          if flag = 0
+          then
+            let* () = use_leaf leaf (cur_ind mod bit_size) in
+            get_id (cur_ind + 1) (needed - 1) (cur_ind :: lst)
+          else get_id (cur_ind + 1) needed lst)
+      in
+      let* lst = get_id ind needed lst in
+      if List.length lst = quantity
+      then Lwt_result.return (List.nth lst 0, lst)
+      else if ind < start_ind && ind + 8 >= start_ind
+      then Lwt_result.fail `Disk_is_full
+      else (
+        let new_ind = if ind + 8 >= nb_sectors then 0 else ind + 8 in
+        let* leaf =
+          if ind / bit_size <> new_ind / bit_size
+          then get_leaf t new_ind
+          else Lwt_result.return leaf
+        in
+        do_pop_front new_ind lst leaf)
+    in
+    let* start_leaf = get_leaf t start_ind in
+    let* new_bitset_start, lst = do_pop_front start_ind [] start_leaf in
+    let new_bitset_start = B.Id.of_int new_bitset_start in
+    let lst = List.rev lst in
+    let rec get_range_list cur = function
+      | id :: res ->
+        (match cur with
+         | (top, range) :: rest_cur ->
+           if top + range = id
+           then get_range_list ((top, range + 1) :: rest_cur) res
+           else get_range_list ((id, 1) :: cur) res
+         | [] -> get_range_list [ id, 1 ] res)
+      | [] -> cur
+    in
+    let lst = get_range_list [] lst in
+    let lst = List.map (fun (id, range) -> B.Id.of_int id, range) lst in
+    Lwt_result.return (lst, new_bitset_start)
+end
diff --git a/src/fs.ml b/src/fs.ml
index 9ed73e9..9371f6a 100644
--- a/src/fs.ml
+++ b/src/fs.ml
@@ -85,7 +85,7 @@ module Make_disk (Clock : Mirage_clock.PCLOCK) (B : Context.A_DISK) :
       else Files.reachable_size t.files
     in
     let+ queue =
-      let* _, root_queue, _ = Root.get_free_queue t.root in
+      let* _, root_queue, _, _, _ = Root.get_free_queue t.root in
       if Sector.is_null_ptr root_queue
       then Lwt_result.return 0
       else Queue.reachable_size t.free_queue
diff --git a/src/queue.ml b/src/queue.ml
index 7454dee..2276c3e 100644
--- a/src/queue.ml
+++ b/src/queue.ml
@@ -1,6 +1,7 @@
 module Make (B : Context.A_DISK) = struct
   module Sector = Sector.Make (B)
   module Schema = Schema.Make (B)
+  module Bitset = Bitset.Make (B)
 
   type t = Sector.t
   type range = Sector.id * int
@@ -125,12 +126,12 @@ module Make (B : Context.A_DISK) = struct
     in
     size ptr
 
-  let rec push_discarded ~quantity t =
+  let rec push_discarded ~quantity t bitset =
     match B.acquire_discarded () with
     | [] -> Lwt_result.return (t, quantity)
     | lst ->
       let* t = push_back_list t lst in
-      push_discarded ~quantity:(quantity + List.length lst) t
+      push_discarded ~quantity:(quantity + List.length lst) t bitset
 
   let push_discarded t = push_discarded ~quantity:0 t
 
@@ -214,9 +215,9 @@ module Make (B : Context.A_DISK) = struct
       go 0 nb acc
     end
 
-  let pop_front t nb =
+  let pop_front t bitset nb =
     let* acc, res = do_pop_front t nb [] in
-    let* t, nb_discarded = push_discarded t in
+    let* t, nb_discarded = push_discarded t bitset in
     match res with
     | Ok_pop -> Lwt_result.return (t, acc, Int64.of_int (nb - nb_discarded))
     | Underflow _ -> Lwt_result.fail `Disk_is_full
@@ -224,22 +225,44 @@ module Make (B : Context.A_DISK) = struct
   type q =
     { free_start : Sector.id
     ; free_queue : t
+    ; bitset : Bitset.t
+    ; bitset_start : Sector.id
     ; free_sectors : Int64.t
     }
 
-  let push_back { free_start; free_queue; free_sectors } lst =
+  let push_back { free_start; free_queue; bitset; bitset_start; free_sectors } lst =
     let* free_queue = push_back_list free_queue lst in
-    let+ free_queue, nb = push_discarded free_queue in
+    let+ free_queue, nb = push_discarded free_queue bitset in
     { free_start
     ; free_queue
+    ; bitset
+    ; bitset_start
     ; free_sectors = Int64.add free_sectors (Int64.of_int (nb + List.length lst))
     }
 
-  let push_discarded { free_start; free_queue; free_sectors } =
-    let+ free_queue, nb = push_discarded free_queue in
-    { free_start; free_queue; free_sectors = Int64.add free_sectors (Int64.of_int nb) }
+  let push_discarded { free_start; free_queue; bitset; bitset_start; free_sectors } =
+    let+ free_queue, nb = push_discarded free_queue bitset in
+    { free_start
+    ; free_queue
+    ; bitset
+    ; bitset_start
+    ; free_sectors = Int64.add free_sectors (Int64.of_int nb)
+    }
 
-  let pop_front { free_start; free_queue; free_sectors } quantity =
+  let pop_old_generation q last_gen_id =
+    let rec pop queue =
+      let* queue, lst, _ = pop_front queue q.bitset 1 in
+      let range = List.nth lst 0 in
+      if range = last_gen_id
+      then Lwt_result.return queue
+      else
+        let* () = Bitset.free_range q.bitset range in
+        pop queue
+    in
+    let+ queue = pop q.free_queue in
+    { q with free_queue = queue }
+
+  let pop_front { free_start; free_queue; bitset; bitset_start; free_sectors } quantity =
     let easy_alloc =
       min quantity Int64.(to_int (sub B.nb_sectors (B.Id.to_int64 free_start)))
     in
@@ -249,23 +272,37 @@ module Make (B : Context.A_DISK) = struct
     let+ free_queue, tail, quantity =
       if rest_alloc <= 0
       then Lwt_result.return (free_queue, [], 0L)
-      else pop_front free_queue rest_alloc
+      else pop_front free_queue bitset rest_alloc
     in
     let quantity = Int64.add quantity (Int64.of_int easy_alloc) in
     let q =
       { free_start = B.Id.add free_start easy_alloc
       ; free_queue
+      ; bitset
+      ; bitset_start
       ; free_sectors = Int64.sub free_sectors quantity
       }
     in
     q, head @ tail
 
-  let count_new { free_queue = q; _ } = Sector.count_new q
+  let pop_front q quantity =
+    let _ = pop_front in
+    (* just so that pop_front is being used somewhere *)
+    let* lst, new_bitset_start = Bitset.pop_front q.bitset q.bitset_start quantity in
+    let+ q = push_discarded q in
+    { q with bitset_start = new_bitset_start }, lst
+
+  let count_new { free_queue = q; bitset = b; _ } =
+    let* bitset_size = Sector.count_new b in
+    let+ queue_size = Sector.count_new q in
+    bitset_size + queue_size
 
-  let finalize { free_start = f; free_queue = q; free_sectors } ids =
-    let+ ts, rest = Sector.finalize q ids in
+  let finalize { free_start = f; free_queue = q; bitset; bitset_start; free_sectors } ids =
+    let* tsqueue, rest = Sector.finalize q ids in
+    let+ tsbitset, rest = Sector.finalize bitset rest in
     assert (rest = []) ;
-    { free_start = f; free_queue = q; free_sectors }, ts
+    ( { free_start = f; free_queue = q; bitset; bitset_start; free_sectors }
+    , tsqueue @ tsbitset )
 
   let allocate ~free_queue sector =
     let* count = Sector.count_new sector in
@@ -313,9 +350,14 @@ module Make (B : Context.A_DISK) = struct
     then alloc_queue [] count free_queue
     else Lwt_result.return (free_queue, [])
 
-  let load (free_start, ptr, free_sectors) =
-    let+ free_queue = if Sector.is_null_ptr ptr then create () else Sector.load ptr in
-    { free_start; free_queue; free_sectors }
+  let load (free_start, queue_ptr, bitset_ptr, bitset_start, free_sectors) =
+    let* free_queue =
+      if Sector.is_null_ptr queue_ptr then create () else Sector.load queue_ptr
+    in
+    let+ bitset =
+      if Sector.is_null_ptr bitset_ptr then Bitset.create () else Sector.load bitset_ptr
+    in
+    { free_start; free_queue; bitset; bitset_start; free_sectors }
 
   let verify_checksum { free_queue = ptr; _ } =
     let rec verify_queue queue =
diff --git a/src/queue.mli b/src/queue.mli
index 463b029..e0412d6 100644
--- a/src/queue.mli
+++ b/src/queue.mli
@@ -6,15 +6,18 @@ module Make (B : Context.A_DISK) : sig
   type q =
     { free_start : Sector.id
     ; free_queue : Sector.t
+    ; bitset : Sector.t
+    ; bitset_start : Sector.id
     ; free_sectors : Int64.t
     }
 
   type 'a r := ('a, B.error) Lwt_result.t
 
-  val load : Sector.id * Sector.ptr * Int64.t -> q r
+  val load : Sector.id * Sector.ptr * Sector.ptr * Sector.id * Int64.t -> q r
   val verify_checksum : q -> unit r
   val push_back : q -> range list -> q r
   val push_discarded : q -> q r
+  val pop_old_generation : q -> range  -> q r
   val pop_front : q -> int -> (q * range list) r
   val finalize : q -> Sector.id list -> (q * (Sector.id * Cstruct.t) list) r
   val allocate : free_queue:q -> Sector.t -> (q * (Sector.id * Cstruct.t) list) r
diff --git a/src/root.ml b/src/root.ml
index a89ab0e..85e5e83 100644
--- a/src/root.ml
+++ b/src/root.ml
@@ -5,7 +5,7 @@ module Leaf (B : Context.A_DISK) : sig
 
   type t = Sector.t
   type 'a io := ('a, B.error) Lwt_result.t
-  type q := Sector.id * Sector.ptr * int64
+  type q := Sector.id * Sector.ptr * Sector.ptr * Sector.id * int64
 
   val get_free_queue : t -> q io
   val get_payload : t -> Sector.ptr io
@@ -32,11 +32,22 @@ end = struct
     ; generation : int64 Schema.field
     ; free_start : Sector.id Schema.field
     ; free_queue : Schema.ptr
+    ; bitset : Schema.ptr
+    ; bitset_start : Sector.id Schema.field
     ; free_sectors : int64 Schema.field
     ; payload : Schema.ptr
     }
 
-  let { format_uid; generation; free_start; free_queue; free_sectors; payload } =
+  let { format_uid
+      ; generation
+      ; free_start
+      ; free_queue
+      ; free_sectors
+      ; bitset
+      ; bitset_start
+      ; payload
+      }
+    =
     Schema.define
     @@
     let open Schema.Syntax in
@@ -44,9 +55,19 @@ end = struct
     and+ generation = Schema.uint64
     and+ free_start = Schema.id
     and+ free_queue = Schema.ptr
+    and+ bitset = Schema.ptr
+    and+ bitset_start = Schema.id
     and+ free_sectors = Schema.uint64
     and+ payload = Schema.ptr in
-    { format_uid; generation; free_start; free_queue; free_sectors; payload }
+    { format_uid
+    ; generation
+    ; free_start
+    ; free_queue
+    ; free_sectors
+    ; bitset
+    ; bitset_start
+    ; payload
+    }
 
   include struct
     open Schema.Infix
@@ -59,6 +80,10 @@ end = struct
     let get_free_start t = t.@(free_start)
     let set_free_queue t v = t.@(free_queue) <- v
     let free_queue t = t.@(free_queue)
+    let set_free_bitset t v = t.@(bitset) <- v
+    let free_bitset t = t.@(bitset)
+    let set_bitset_start t v = t.@(bitset_start) <- v
+    let get_bitset_start t = t.@(bitset_start)
     let set_free_sectors t v = t.@(free_sectors) <- v
     let free_sectors t = t.@(free_sectors)
     let get_payload t = t.@(payload)
@@ -68,17 +93,27 @@ end = struct
   let get_free_queue t =
     let* queue = free_queue t in
     let* free_start = get_free_start t in
+    let* bitset = free_bitset t in
+    let* bitset_start = get_bitset_start t in
     let+ free_sectors = free_sectors t in
-    free_start, queue, free_sectors
+    free_start, queue, bitset, bitset_start, free_sectors
 
   let get_format_uid t = format_uid t
 
-  let create ~format_uid ~gen ~at (free_start, free_queue, free_sectors) payload =
+  let create
+    ~format_uid
+    ~gen
+    ~at
+    (free_start, free_queue, bitset, bitset_start, free_sectors)
+    payload
+    =
     let* s = Sector.create ~at:(Sector.root_loc at) () in
     let* () = set_format_uid s format_uid in
     let* () = set_generation s gen in
     let* () = set_free_start s free_start in
     let* () = set_free_queue s free_queue in
+    let* () = set_free_bitset s bitset in
+    let* () = set_bitset_start s bitset_start in
     let* () = set_free_sectors s free_sectors in
     let+ () = set_payload s payload in
     s
@@ -246,6 +281,7 @@ module Make (B : Context.A_DISK) = struct
     let* format_uid = Header.get_format_uid header in
     let used = nb_roots + nb + B.header_size in
     let free_start = B.Id.of_int used in
+    let bitset_start = free_start in
     let free_sectors = Int64.sub B.nb_sectors (Int64.of_int used) in
     let* roots = create_roots nb_roots 0 [] in
     let s0 = List.hd roots in
@@ -268,7 +304,7 @@ module Make (B : Context.A_DISK) = struct
         ~format_uid
         ~gen:Int64.one
         ~at
-        (free_start, Sector.null_ptr, free_sectors)
+        (free_start, Sector.null_ptr, Sector.null_ptr, bitset_start, free_sectors)
         Sector.null_ptr
     in
     let rec write_all = function
@@ -326,13 +362,23 @@ module Make (B : Context.A_DISK) = struct
     in
     let previous_generation = Sector.force_id t.current in
     let* queue =
-      let* queue = Queue.push_back queue [ previous_generation, 1 ] in
+      let old_generation = 4 in
+      if Int64.to_int t.generation > old_generation
+      then (
+        let gen = B.Id.of_int 0 in
+        Queue.pop_old_generation queue (gen, 1))
+      else Lwt_result.return queue
+    in
+    let* queue =
+      let* queue = Queue.push_back queue [ B.Id.of_int 0, 1; previous_generation, 1 ] in
       let* queue, to_flush_queue = Queue.self_allocate ~free_queue:queue in
       let+ () = flush to_flush_queue in
       queue
     in
     let { Queue.free_start = new_free_start
         ; free_queue = new_free_root
+        ; bitset = new_bitset
+        ; bitset_start = new_bitset_start
         ; free_sectors = new_free_sectors
         }
       =
@@ -344,7 +390,11 @@ module Make (B : Context.A_DISK) = struct
         ~format_uid:t.format_uid
         ~gen:t.generation
         ~at
-        (new_free_start, Sector.to_ptr new_free_root, new_free_sectors)
+        ( new_free_start
+        , Sector.to_ptr new_free_root
+        , Sector.to_ptr new_bitset
+        , new_bitset_start
+        , new_free_sectors )
         (Sector.to_ptr payload)
     in
     t.current <- current ;
diff --git a/src/schema.ml b/src/schema.ml
index 7aeab1a..522b21b 100644
--- a/src/schema.ml
+++ b/src/schema.ml
@@ -117,4 +117,5 @@ module Make (B : Context.A_DISK) = struct
   type ptr = Sector.ptr field
 
   let ptr : ptr t = make Sector.ptr_size Sector.get_child_ptr Sector.set_child_ptr
+  type uint8 = char field
 end