src/utils/lib/fifo.ml

   1 (* Copyright 2001, 2002 b8_bavard, b8_fee_carabine, INRIA *)
   2 (*
   3     This file is part of mldonkey.
   4
   5     mldonkey is free software; you can redistribute it and/or modify
   6     it under the terms of the GNU General Public License as published by
   7     the Free Software Foundation; either version 2 of the License, or
   8     (at your option) any later version.
   9
  10     mldonkey is distributed in the hope that it will be useful,
  11     but WITHOUT ANY WARRANTY; without even the implied warranty of
  12     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13     GNU General Public License for more details.
  14
  15     You should have received a copy of the GNU General Public License
  16     along with mldonkey; if not, write to the Free Software
  17     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  18 *)
  19
  20 (*
  21 exception Empty;;
  22
  23 type 'a t = { mutable inlist : 'a list; mutable outlist : 'a list };;
  24
  25 let create () = {inlist = []; outlist = []};;
  26 let put t e =
  27   t.inlist <- e :: t.inlist
  28
  29 let rec take t =
  30   match t.outlist with
  31     e :: queue -> t.outlist <- queue; e
  32   | [] ->
  33       t.outlist <- List.rev t.inlist;
  34       t.inlist <- [];
  35       match t.outlist with
  36         e :: queue -> t.outlist <- queue; e
  37       | [] -> raise Empty
  38 let clear t =
  39   t.inlist <- [];
  40   t.outlist <- []
  41
  42 let read t =
  43   match t.outlist with
  44     e :: queue -> e
  45   | [] ->
  46       t.outlist <- List.rev t.inlist;
  47       t.inlist <- [];
  48       match t.outlist with
  49         e :: queue -> e
  50       | [] -> raise Empty
  51
  52 let empty t = (t.inlist == [] && t.outlist == [])
  53
  54 let to_list t =
  55   t.outlist <- t.outlist @ (List.rev t.inlist);
  56   t.inlist <- [];
  57   t.outlist
  58
  59 let length t = List.length t.inlist + List.length t.outlist
  60 let put_back t l = t.outlist <- l@t.outlist
  61
  62     *)
  63
  64 exception Empty;;
  65
  66 type 'a t = {
  67     mutable empty : bool;
  68     mutable inpos : int;
  69     mutable outpos : int;
  70     mutable array : 'a array;
  71     mutable size : int; (* bit Mask *)
  72   }
  73
  74 let create () = {
  75     empty = true;
  76     inpos = 0;
  77     outpos = 0;
  78     array = Array.make 4 (Obj.magic ());
  79     size = 3;
  80   }
  81
  82 let iter f t =
  83   if not t.empty then
  84     if t.inpos > t.outpos then
  85       for i = t.outpos to t.inpos - 1 do
  86         f t.array.(i)
  87       done
  88     else begin
  89         for i = t.outpos to t.size do
  90           f t.array.(i)
  91         done;
  92         for i = 0 to t.inpos - 1 do
  93           f t.array.(i)
  94         done
  95       end
  96
  97 let mem t v =
  98   try
  99     if not t.empty then
 100       if t.inpos > t.outpos then
 101         for i = t.outpos to t.inpos - 1 do
 102           if t.array.(i) = v then raise Exit;
 103         done
 104       else begin
 105           for i = t.outpos to t.size do
 106             if t.array.(i) = v then raise Exit
 107           done;
 108           for i = 0 to t.inpos - 1 do
 109             if t.array.(i) = v then raise Exit
 110           done
 111         end;
 112       false
 113   with _ -> true
 114
 115 let realloc t =
 116   let len = Array.length t.array in
 117   let tab = Array.make (2*len) t.array.(0) in
 118   let start = len - t.inpos in
 119   Array.blit t.array t.inpos tab 0 start;
 120   Array.blit t.array 0 tab start (len - start);
 121   t.array <- tab;
 122   t.outpos <- 0;
 123   t.inpos <- len;
 124   t.size <- t.size * 2 + 1
 125
 126 let shrink t =
 127   if t.size > 3 then begin
 128     let len = Array.length t.array in
 129     let tab = Array.make (len/2) t.array.(0) in
 130     if t.outpos < t.inpos then begin
 131       Array.blit t.array t.outpos tab 0 (t.inpos - t.outpos);
 132       t.inpos <- t.inpos - t.outpos;
 133     end else begin
 134       let ol = len - t.outpos in
 135       Array.blit t.array t.outpos tab 0 ol;
 136       Array.blit t.array 0 tab ol t.inpos;
 137       t.inpos <- ol + t.inpos;
 138     end;
 139     t.array <- tab;
 140     t.outpos <- 0;
 141     t.size <- (t.size - 1) / 2 ;
 142   end
 143
 144 let put t e =
 145 (*  lprintf "FIFO PUT"; lprint_newline (); *)
 146   if t.inpos = t.outpos && not t.empty then realloc t;
 147   t.array.(t.inpos) <- e;
 148   t.inpos <- (t.inpos + 1) land t.size;
 149   t.empty <- false;
 150 (*
 151 lprintf "FIFO NOT EMPTY %s" (string_of_bool t.empty); lprint_newline ();
 152 *)
 153   ()
 154
 155 let clear t =
 156 (*  lprintf "FIFO CLEAR"; lprint_newline (); *)
 157   let tab = Array.make 4 t.array.(0) in
 158   t.array <- tab;
 159   t.size <- 3;
 160   t.empty <- true;
 161   t.inpos <- 0;
 162   t.outpos <- 0
 163
 164 let length t =
 165 (*  lprintf "FIFO LEN"; lprint_newline (); *)
 166   if t.empty then 0 else
 167   if t.inpos > t.outpos then t.inpos - t.outpos else
 168   let s = Array.length t.array in
 169   s + t.inpos - t.outpos
 170
 171 let take t =
 172 (*  lprintf "FIFO TAKE"; lprint_newline (); *)
 173   if t.empty then raise Empty;
 174   if (length t) < ((t.size + 1) / 4) then shrink t;
 175   let e = t.array.(t.outpos) in
 176   t.outpos <- (t.outpos + 1) land t.size;
 177   if t.outpos = t.inpos then clear t;
 178   e
 179
 180 let head t =
 181   if t.empty then raise Empty;
 182   t.array.(t.outpos)
 183
 184 let empty t =
 185 (*  lprintf "FIFO EMPTY %s" (string_of_bool t.empty); lprint_newline (); *)
 186   t.empty
 187
 188 let to_list t =
 189   if t.empty then [] else
 190   if t.inpos > t.outpos then
 191     let len = t.inpos - t.outpos in
 192     let tab = Array.make len t.array.(0) in
 193     Array.blit t.array t.outpos tab 0 len;
 194     Array.to_list tab
 195   else
 196   let s = Array.length t.array in
 197   let len = s + t.inpos - t.outpos in
 198   let tab = Array.make len t.array.(0) in
 199   Array.blit t.array t.outpos tab 0 (s - t.outpos);
 200   Array.blit t.array 0 tab (s - t.outpos) t.inpos;
 201   Array.to_list tab
 202
 203 let to_array t =
 204   if t.empty then [||] else
 205   if t.inpos > t.outpos then
 206     let len = t.inpos - t.outpos in
 207     let tab = Array.make len t.array.(0) in
 208     Array.blit t.array t.outpos tab 0 len;
 209     tab
 210   else
 211   let s = Array.length t.array in
 212   let len = s + t.inpos - t.outpos in
 213   let tab = Array.make len t.array.(0) in
 214   Array.blit t.array t.outpos tab 0 (s - t.outpos);
 215   Array.blit t.array 0 tab (s - t.outpos) t.inpos;
 216   tab
 217
 218 let put_back_ele t e =
 219   if t.inpos = t.outpos && not t.empty then realloc t;
 220   t.outpos <- (t.outpos - 1) land t.size;
 221   t.array.(t.outpos) <- e;
 222   t.empty <- false
 223
 224 let rec put_back t list =
 225   match list with
 226     [] -> ()
 227   | ele :: tail ->
 228       put_back t tail; put_back_ele t ele
 229
 230 let reformat t =
 231   if not t.empty then begin
 232       let s = Array.length t.array in
 233       let len = s + t.inpos - t.outpos in
 234       let tab = Array.make s t.array.(0) in
 235       Array.blit t.array t.outpos tab 0 (s - t.outpos);
 236       Array.blit t.array 0 tab (s - t.outpos) t.inpos;
 237       t.array <- tab;
 238       t.inpos <- len;
 239       t.outpos <- 0;
 240     end
 241
 242 let remove t e =
 243   if not t.empty then begin
 244       if t.outpos >= t.inpos then reformat t;
 245       let rec iter t i j =
 246 (*        Printf2.lprintf "i=%d j=%d inpos=%d outpos=%d\n"
 247           i j t.inpos t.outpos; print_newline (); *)
 248         if i >= t.inpos then
 249           (if i > j then begin
 250                 t.inpos <- j;
 251                 if t.inpos = t.outpos then clear t;
 252               end)
 253         else
 254         let ee = t.array.(i) in
 255         if e = ee then
 256           iter t (i+1) j
 257         else begin
 258             if i > j then begin
 259 (*                Printf2.lprintf "Move i=%d at j=%d" i j; print_newline ();  *)
 260                 t.array.(j) <- ee;
 261               end;
 262             iter t (i+1) (j+1)
 263           end
 264       in
 265       iter t t.outpos t.outpos
 266     end
 267
 268 (* TEST SUITE
 269
 270 let t = Fifo.create ();;
 271
 272 for i = 0 to 100 do
 273   Fifo.put t i
 274 done;;
 275
 276 for i = 0 to 80 do
 277   Fifo.put t (Fifo.take t)
 278 done;;
 279
 280 Fifo.length t;;
 281
 282 for i = 56 to 76 do
 283   Fifo.remove t i
 284 done
 285 ;;
 286
 287 while true do
 288   Printf2.lprintf "%d\n" (Fifo.take t)
 289 done;;
 290
 291 *)