src/utils/lib/sparseFile.ml

   1 (* The implementation *)
   2
   3 type chunk = {
   4   mutable pos : int64;
   5   mutable len : int64;
   6   mutable filename : string option;
   7   mutable next : chunk option;
   8 }
   9
  10 type t = {
  11   filename : string;
  12   size : int64;
  13   mutable chunks : chunk;
  14 }
  15
  16 let create filename size =
  17   let dirname = Printf.sprintf "%s.chunks" filename in
  18   Unix.mkdir dirname;
  19   {
  20     filename = filename;
  21     size = size;
  22     chunks = {
  23         pos = Int64.zero;
  24         len = size;
  25         created = None;
  26         next = None;
  27        };
  28   }
  29
  30 let chunk_min_size = ref 65000
  31
  32 let split_chunk c pos =
  33   let cc = {
  34     created = None;
  35     pos = pos;
  36     len = c.len -- pos;
  37    } in
  38   c.next <- Some cc;
  39   c.len <- pos -- c.pos
  40
  41 let rec extend_chunk c size =
  42   match c.next with
  43     None ->
  44      lprintf "Cannot extend last chunk\n";
  45      assert false
  46   | Some cc ->
  47      if cc.created <> None then
  48        begin
  49          append_chunk c cc;
  50          remove_chunk cc;
  51          c.next <- cc.next;
  52          c.len <- (cc.pos ++ cc.len) -- c.pos;
  53        end
  54      else
  55      if cc.len >= size ++ !chunk_min_size then
  56        begin
  57          split_chunk cc (cc.pos ++ size);
  58          extend_chunk c size;
  59        end
  60      else
  61        begin
  62          c.next <- cc.next;
  63          c.len <- (cc.pos ++ cc.len) -- c.pos;
  64          ftruncate_chunk c (c.len ++ cc.len);
  65        end
  66
  67 let open_chunk c = ()
  68 let create_chunk c = ()
  69
  70 let get_chunk t pos len =
  71   let c = t.chunks in
  72   let rec iter c =
  73
  74     if c.created <> None && c.pos <= pos && c.pos ++ c.len >= pos ++ len then
  75        (open_chunk c, pos -- c.pos)
  76     else
  77     if c.created <> None && pos <= c.pos ++ c.len ++ !chunk_min_size then
  78       begin
  79         extend_chunk c (maxi !chunk_min_size (pos ++ len -- c.pos -- c.len ++ !chunk_min_size));
  80         iter c
  81       end
  82     else
  83     if c.pos ++ c.len <= pos then
  84       match c.next with
  85       | None ->
  86          lprintf "Invalid access in file pos %Ld is after last chunk\n" pos;
  87          assert false
  88       | Some c -> iter c
  89     else
  90     if c.pos ++ !chunk_min_size < pos then
  91       begin
  92         split_chunk c pos;
  93         iter c
  94       end
  95     else
  96     if c.pos ++ c.len > pos ++ (maxi len !chunk_min_size) ++ !chunk_min_size then
  97       begin
  98         split_chunk c (pos ++ (maxi len !chunk_min_size) ++ !chunk_min_size);
  99         iter c
 100       end
 101     else
 102       begin
 103         create_chunk c;
 104         iter c
 105       end
 106   in
 107   iter c
 108
 109 let build t =
 110   if t.chunks.created = None then create_chunk c;
 111   while t.chunks.next <> None do
 112     extend_chunk c t.size
 113   done;