[Mldonkey-users] [PATCH] less allocations

[ygrek]

BasicSocket.iter_timer: do not allocate new list when not needed
CommonFile: use Queue for sliding window
---
 src/daemon/common/commonFile.ml            |   42 ++++++++++++++--------------
 src/daemon/common/commonFile.mli           |    5 +--
 src/networks/bittorrent/bTGlobals.ml       |    4 +-
 src/networks/direct_connect/dcGlobals.ml   |    4 +-
 src/networks/donkey/donkeyGlobals.ml       |    2 +-
 src/networks/fasttrack/fasttrackGlobals.ml |    2 +-
 src/networks/fileTP/fileTPGlobals.ml       |    2 +-
 src/networks/gnutella/gnutellaGlobals.ml   |    2 +-
 src/networks/openFT/openFTGlobals.ml       |    2 +-
 src/networks/opennap/opennapGlobals.ml     |    2 +-
 src/networks/soulseek/slskGlobals.ml       |    2 +-
 src/utils/net/basicSocket.ml               |   26 ++++++++++++++--
 12 files changed, 56 insertions(+), 39 deletions(-)

diff --git a/src/daemon/common/commonFile.ml b/src/daemon/common/commonFile.ml
index 8567134..f1f15e1 100644
--- a/src/daemon/common/commonFile.ml
+++ b/src/daemon/common/commonFile.ml
@@ -56,7 +56,7 @@ type 'a file_impl = {
     mutable impl_file_fd : Unix32.t option;
     mutable impl_file_downloaded : int64;
     mutable impl_file_received : int64;
-    mutable impl_file_last_received : (int64 * int) list;
+    impl_file_last_received : (int64 * int) Queue.t; (* NB Queue is mutable *)
     mutable impl_file_last_rate : float;
     mutable impl_file_best_name : string;
     mutable impl_file_filenames : string list;
@@ -120,7 +120,7 @@ let file_num file =
   let impl = as_file_impl  file in
   impl.impl_file_num
 
-let dummy_file_impl = {
+let dummy_file_impl () = {
     impl_file_update = 1;
     impl_file_state = FileNew;
     impl_file_num = 0;
@@ -131,7 +131,7 @@ let dummy_file_impl = {
     impl_file_fd = None;
     impl_file_downloaded = Int64.zero;
     impl_file_received = Int64.zero;
-    impl_file_last_received = [];
+    impl_file_last_received = Queue.create ();
     impl_file_last_rate = 0.0;
     impl_file_best_name = "<UNKNOWN>";
     impl_file_filenames = [];
@@ -145,7 +145,7 @@ let dummy_file_impl = {
     impl_file_group = Some (admin_group ());
   }
 
-let dummy_file = as_file dummy_file_impl
+let dummy_file = as_file (dummy_file_impl ())
 
 (*************************************************************************)
 (*                                                                       *)
@@ -456,7 +456,7 @@ let file_print file o =
 
 let file_find num =
   H.find files_by_num (as_file {
-    dummy_file_impl   with impl_file_num = num
+    (dummy_file_impl ()) with impl_file_num = num
   })
 
 let file_add_source (file : file) c =
@@ -466,34 +466,34 @@ let file_add_source (file : file) c =
 let file_remove_source (file : file) c =
   CommonEvent.add_event (File_remove_source_event (file,c))
 
-let rec last = function
-    [x] -> x
-  | _ :: l -> last l
-  | _ -> (Int64.zero, 0)
+let queue_last q =
+  if Queue.is_empty q then None else
+  Some (Queue.fold (fun _ x -> x) (Queue.top q) q)
 
 let sample_timer () =
-  let trimto list length =
-    let (list, _) = List2.cut length list in
-    list 
-  in
   let time = BasicSocket.last_time () in
   H.iter (fun file ->
       let impl = as_file_impl file in
-      impl.impl_file_last_received <-
-        trimto ((impl.impl_file_received, time) ::
-        impl.impl_file_last_received) 
-      !!CommonOptions.download_sample_size;
-      match impl.impl_file_last_received with
-        _ :: (last_received, _) :: _ ->
+      let last = queue_last impl.impl_file_last_received in
+      Queue.add (impl.impl_file_received, time) impl.impl_file_last_received;
+      if Queue.length impl.impl_file_last_received > max 0 
!!CommonOptions.download_sample_size then
+        ignore (Queue.pop impl.impl_file_last_received);
+      match last with
+      | Some (last_received, _) ->
           if last_received = impl.impl_file_received &&
             impl.impl_file_last_rate > 0. then
             file_must_update_downloaded file
-      | _ -> ()
+      | None -> ()
   ) files_by_num
 
 let file_download_rate impl =
   let time = BasicSocket.last_time () in
-  let (last_received, file_last_time) = last impl.impl_file_last_received in
+  let (last_received, file_last_time) = 
+    if Queue.is_empty impl.impl_file_last_received then
+      (Int64.zero, 0)
+    else
+      Queue.top impl.impl_file_last_received
+  in
   let time = time - file_last_time in
   let diff = Int64.sub impl.impl_file_received last_received in
   let rate = if time > 0 && diff > Int64.zero then begin
diff --git a/src/daemon/common/commonFile.mli b/src/daemon/common/commonFile.mli
index e542233..875f5e8 100644
--- a/src/daemon/common/commonFile.mli
+++ b/src/daemon/common/commonFile.mli
@@ -32,7 +32,7 @@ type 'a file_impl = {
   mutable impl_file_fd : Unix32.t option;
   mutable impl_file_downloaded : int64;
   mutable impl_file_received : int64;
-  mutable impl_file_last_received : (int64 * int) list;
+  impl_file_last_received : (int64 * int) Queue.t;
   mutable impl_file_last_rate : float;
   mutable impl_file_best_name : string;
   mutable impl_file_filenames : string list;
@@ -69,7 +69,7 @@ and 'a file_ops = {
 val as_file : 'a file_impl -> CommonTypes.file
 val as_file_impl : CommonTypes.file -> 'a file_impl
 val file_num : CommonTypes.file -> int
-val dummy_file_impl : int file_impl
+val dummy_file_impl : unit -> int file_impl
 val dummy_file : CommonTypes.file
 val file_counter : int ref
 val ni : CommonTypes.network -> string -> string
@@ -109,7 +109,6 @@ val file_find : int -> CommonTypes.file
 val file_state : CommonTypes.file -> CommonTypes.file_state
 val file_add_source : CommonTypes.file -> CommonTypes.client -> unit
 val file_remove_source : CommonTypes.file -> CommonTypes.client -> unit
-val last : (int64 * int) list -> int64 * int
 val sample_timer : unit -> unit
 val file_download_rate : 'a file_impl -> float
 val add_file_downloaded : CommonTypes.file -> Int64.t -> unit
diff --git a/src/networks/bittorrent/bTGlobals.ml 
b/src/networks/bittorrent/bTGlobals.ml
index 8d8c5e7..5be098f 100644
--- a/src/networks/bittorrent/bTGlobals.ml
+++ b/src/networks/bittorrent/bTGlobals.ml
@@ -304,7 +304,7 @@ let new_file file_id t torrent_diskname file_temp 
file_state user group =
           file_last_dht_announce = 0;
           file_private = t.torrent_private;
         } and file_impl =  {
-          dummy_file_impl with
+          (dummy_file_impl ()) with
           impl_file_owner = user;
           impl_file_group = group;
           impl_file_fd = Some file_fd;
@@ -370,7 +370,7 @@ let new_ft file_name user =
       ft_filename = file_name;
       ft_retry = (fun _ -> ());
     } and file_impl =  {
-      dummy_file_impl with
+      (dummy_file_impl ()) with
       impl_file_owner = user;
       impl_file_group = user.user_default_group;
       impl_file_fd = None;
diff --git a/src/networks/direct_connect/dcGlobals.ml 
b/src/networks/direct_connect/dcGlobals.ml
index e30c2fc..4b4ac11 100644
--- a/src/networks/direct_connect/dcGlobals.ml
+++ b/src/networks/direct_connect/dcGlobals.ml
@@ -490,7 +490,7 @@ let new_upfile dcsh fd =
     (*file_tiger_array = [||];*)
     file_autosearch_count = 0;
   } and impl = {
-    dummy_file_impl with
+    (dummy_file_impl ()) with
     impl_file_fd = Some fd;
     impl_file_size = Unix32.getsize64 fd;
     impl_file_downloaded = Int64.zero;
@@ -541,7 +541,7 @@ let new_file tiger_root (directory:string) 
(filename:string) (file_size:int64) =
         (*file_tiger_array = [||];*)
         file_autosearch_count = 0;
         } and impl = {
-          dummy_file_impl with
+          (dummy_file_impl ()) with
         impl_file_fd = Some temp_file;
           impl_file_size = file_size;
           impl_file_downloaded = current_size;
diff --git a/src/networks/donkey/donkeyGlobals.ml 
b/src/networks/donkey/donkeyGlobals.ml
index 3e93648..14096a6 100644
--- a/src/networks/donkey/donkeyGlobals.ml
+++ b/src/networks/donkey/donkeyGlobals.ml
@@ -420,7 +420,7 @@ let new_file file_diskname file_state md4 file_size 
filename writable user group
           file_comments = [];
         }
       and file_impl = {
-          dummy_file_impl with
+          (dummy_file_impl ()) with
           impl_file_owner = user;
           impl_file_group = group;
           impl_file_val = file;
diff --git a/src/networks/fasttrack/fasttrackGlobals.ml 
b/src/networks/fasttrack/fasttrackGlobals.ml
index af790e8..ba24f4d 100644
--- a/src/networks/fasttrack/fasttrackGlobals.ml
+++ b/src/networks/fasttrack/fasttrackGlobals.ml
@@ -298,7 +298,7 @@ let new_file file_temporary file_name file_size file_hash 
user group =
       file_nconnected_clients = 0;
       file_ttr = None;
     } and file_impl =  {
-      dummy_file_impl with
+      (dummy_file_impl ()) with
       impl_file_fd = Some t;
       impl_file_size = file_size;
       impl_file_downloaded = Int64.zero;
diff --git a/src/networks/fileTP/fileTPGlobals.ml 
b/src/networks/fileTP/fileTPGlobals.ml
index 64a6956..f72e02f 100644
--- a/src/networks/fileTP/fileTPGlobals.ml
+++ b/src/networks/fileTP/fileTPGlobals.ml
@@ -151,7 +151,7 @@ let new_file file_id file_name file_size user group =
       file_clients_queue = Queues.workflow (fun _ -> false);
       file_nconnected_clients = 0;
     } and file_impl =  {
-      dummy_file_impl with
+      (dummy_file_impl ()) with
       impl_file_owner = user;
       impl_file_group = group;
       impl_file_fd = Some t;
diff --git a/src/networks/gnutella/gnutellaGlobals.ml 
b/src/networks/gnutella/gnutellaGlobals.ml
index 11aa467..46cde64 100644
--- a/src/networks/gnutella/gnutellaGlobals.ml
+++ b/src/networks/gnutella/gnutellaGlobals.ml
@@ -335,7 +335,7 @@ let new_file file_temporary file_name file_size file_uids 
user group =
       file_nconnected_clients = 0;      
       file_ttr = None;
     } and file_impl =  {
-      dummy_file_impl with
+      (dummy_file_impl ()) with
       impl_file_fd = Some t;
       impl_file_size = file_size;
       impl_file_downloaded = Int64.zero;
diff --git a/src/networks/openFT/openFTGlobals.ml 
b/src/networks/openFT/openFTGlobals.ml
index 4c2115b..3c97b37 100644
--- a/src/networks/openFT/openFTGlobals.ml
+++ b/src/networks/openFT/openFTGlobals.ml
@@ -186,7 +186,7 @@ let new_file file_id file_name file_size =
           file_name = file_name;
           file_clients = [];
         } and file_impl =  {
-          dummy_file_impl with
+          (dummy_file_impl ()) with
           impl_file_fd = Some (Unix32.create_rw file_temp);
           impl_file_size = file_size;
           impl_file_downloaded = current_size;
diff --git a/src/networks/opennap/opennapGlobals.ml 
b/src/networks/opennap/opennapGlobals.ml
index 7dcd6fb..6649f34 100644
--- a/src/networks/opennap/opennapGlobals.ml
+++ b/src/networks/opennap/opennapGlobals.ml
@@ -200,7 +200,7 @@ let new_file file_id file_name file_size =
           file_clients = [];
         } 
       and file_impl = {
-          dummy_file_impl with
+          (dummy_file_impl ()) with
           impl_file_ops = file_ops;
           impl_file_val = file; 
           impl_file_fd = Some t;
diff --git a/src/networks/soulseek/slskGlobals.ml 
b/src/networks/soulseek/slskGlobals.ml
index 0008ae5..9ba1692 100644
--- a/src/networks/soulseek/slskGlobals.ml
+++ b/src/networks/soulseek/slskGlobals.ml
@@ -272,7 +272,7 @@ let new_file file_id name file_size =
       file_clients = [];
       file_swarmer = None;
     } and file_impl =  {
-      dummy_file_impl with
+      (dummy_file_impl ()) with
       impl_file_fd = Some t;
       impl_file_size = file_size;
       impl_file_val = file;
diff --git a/src/utils/net/basicSocket.ml b/src/utils/net/basicSocket.ml
index 8832dc1..f346618 100644
--- a/src/utils/net/basicSocket.ml
+++ b/src/utils/net/basicSocket.ml
@@ -389,18 +389,36 @@ let rec iter_task old_tasks time =
 (*                                                                       *)
 (*************************************************************************)
 
-let rec iter_timer timers time =
+let rec iter_timer_filter timers time acc =
   match timers with
-    [] -> []
+    [] -> acc
   | t :: timers ->
       if t.applied then
-        iter_timer timers time
+        iter_timer_filter timers time acc
       else
         begin
           timeout := minf (t.next_time -. time) !timeout;
-          t :: (iter_timer timers time)
+          iter_timer_filter timers time (t::acc)
         end
 
+(* fast version that doesn't allocate new list if no timers have expired
+  TODO use double-linked list instead? *)
+let iter_timer timers time =
+  let rec loop l =
+    match l with
+    | [] -> timers
+    | t :: l ->
+      if t.applied then
+        (* need to filter, reiterate and rebuild the list *)
+        iter_timer_filter timers time []
+      else
+        begin
+          timeout := minf (t.next_time -. time) !timeout;
+          loop l
+        end
+  in
+  loop timers
+
 (*************************************************************************)
 (*                                                                       *)
 (*                         TIMERS                                        *)
-- 
1.7.5.4