[Mldonkey-commits] mldonkey distrib/ChangeLog src/daemon/common/co...

[mldonkey-commits]

CVSROOT:        /sources/mldonkey
Module name:    mldonkey
Changes by:     spiralvoice <spiralvoice>       11/10/25 17:33:22

Modified files:
        distrib        : ChangeLog 
        src/daemon/common: commonFile.ml commonFile.mli 
        src/networks/bittorrent: bTGlobals.ml 
        src/networks/direct_connect: dcGlobals.ml 
        src/networks/donkey: donkeyGlobals.ml 
        src/networks/fasttrack: fasttrackGlobals.ml 
        src/networks/fileTP: fileTPGlobals.ml 
        src/networks/gnutella: gnutellaGlobals.ml 
        src/networks/openFT: openFTGlobals.ml 
        src/networks/opennap: opennapGlobals.ml 
        src/networks/soulseek: slskGlobals.ml 
        src/utils/net  : basicSocket.ml 

Log message:
        patch 7593

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/mldonkey/distrib/ChangeLog?cvsroot=mldonkey&r1=1.1534&r2=1.1535
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/common/commonFile.ml?cvsroot=mldonkey&r1=1.82&r2=1.83
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/common/commonFile.mli?cvsroot=mldonkey&r1=1.34&r2=1.35
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/networks/bittorrent/bTGlobals.ml?cvsroot=mldonkey&r1=1.90&r2=1.91
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/networks/direct_connect/dcGlobals.ml?cvsroot=mldonkey&r1=1.19&r2=1.20
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/networks/donkey/donkeyGlobals.ml?cvsroot=mldonkey&r1=1.122&r2=1.123
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/networks/fasttrack/fasttrackGlobals.ml?cvsroot=mldonkey&r1=1.46&r2=1.47
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/networks/fileTP/fileTPGlobals.ml?cvsroot=mldonkey&r1=1.34&r2=1.35
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/networks/gnutella/gnutellaGlobals.ml?cvsroot=mldonkey&r1=1.47&r2=1.48
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/networks/openFT/openFTGlobals.ml?cvsroot=mldonkey&r1=1.5&r2=1.6
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/networks/opennap/opennapGlobals.ml?cvsroot=mldonkey&r1=1.12&r2=1.13
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/networks/soulseek/slskGlobals.ml?cvsroot=mldonkey&r1=1.16&r2=1.17
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/utils/net/basicSocket.ml?cvsroot=mldonkey&r1=1.36&r2=1.37

Patches:
Index: distrib/ChangeLog
===================================================================
RCS file: /sources/mldonkey/mldonkey/distrib/ChangeLog,v
retrieving revision 1.1534
retrieving revision 1.1535
diff -u -b -r1.1534 -r1.1535
--- distrib/ChangeLog   7 Aug 2011 10:25:14 -0000       1.1534
+++ distrib/ChangeLog   25 Oct 2011 17:33:20 -0000      1.1535
@@ -14,6 +14,9 @@
 ChangeLog
 =========
 
+2011/10/25
+7593: Less allocations (ygrek)
+-------------------------------------------------------------------------------
 2011/08/07: version 3.1.0 = tag release-3-1-0
 
 2011/07/24

Index: src/daemon/common/commonFile.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonFile.ml,v
retrieving revision 1.82
retrieving revision 1.83
diff -u -b -r1.82 -r1.83
--- src/daemon/common/commonFile.ml     31 Jan 2011 17:17:04 -0000      1.82
+++ src/daemon/common/commonFile.ml     25 Oct 2011 17:33:21 -0000      1.83
@@ -56,7 +56,7 @@
     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 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 @@
     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 @@
     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_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_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

Index: src/daemon/common/commonFile.mli
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonFile.mli,v
retrieving revision 1.34
retrieving revision 1.35
diff -u -b -r1.34 -r1.35
--- src/daemon/common/commonFile.mli    19 Dec 2010 10:04:58 -0000      1.34
+++ src/daemon/common/commonFile.mli    25 Oct 2011 17:33:21 -0000      1.35
@@ -32,7 +32,7 @@
   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 @@
 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_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

Index: src/networks/bittorrent/bTGlobals.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/networks/bittorrent/bTGlobals.ml,v
retrieving revision 1.90
retrieving revision 1.91
diff -u -b -r1.90 -r1.91
--- src/networks/bittorrent/bTGlobals.ml        20 Mar 2011 17:59:46 -0000      
1.90
+++ src/networks/bittorrent/bTGlobals.ml        25 Oct 2011 17:33:21 -0000      
1.91
@@ -304,7 +304,7 @@
           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 @@
       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;

Index: src/networks/direct_connect/dcGlobals.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/networks/direct_connect/dcGlobals.ml,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -b -r1.19 -r1.20
--- src/networks/direct_connect/dcGlobals.ml    19 Dec 2010 10:04:58 -0000      
1.19
+++ src/networks/direct_connect/dcGlobals.ml    25 Oct 2011 17:33:21 -0000      
1.20
@@ -490,7 +490,7 @@
     (*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 @@
         (*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;

Index: src/networks/donkey/donkeyGlobals.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/networks/donkey/donkeyGlobals.ml,v
retrieving revision 1.122
retrieving revision 1.123
diff -u -b -r1.122 -r1.123
--- src/networks/donkey/donkeyGlobals.ml        24 Feb 2009 18:35:46 -0000      
1.122
+++ src/networks/donkey/donkeyGlobals.ml        25 Oct 2011 17:33:21 -0000      
1.123
@@ -420,7 +420,7 @@
           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;

Index: src/networks/fasttrack/fasttrackGlobals.ml
===================================================================
RCS file: 
/sources/mldonkey/mldonkey/src/networks/fasttrack/fasttrackGlobals.ml,v
retrieving revision 1.46
retrieving revision 1.47
diff -u -b -r1.46 -r1.47
--- src/networks/fasttrack/fasttrackGlobals.ml  3 Aug 2007 22:12:58 -0000       
1.46
+++ src/networks/fasttrack/fasttrackGlobals.ml  25 Oct 2011 17:33:21 -0000      
1.47
@@ -298,7 +298,7 @@
       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;

Index: src/networks/fileTP/fileTPGlobals.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/networks/fileTP/fileTPGlobals.ml,v
retrieving revision 1.34
retrieving revision 1.35
diff -u -b -r1.34 -r1.35
--- src/networks/fileTP/fileTPGlobals.ml        3 Aug 2007 22:12:59 -0000       
1.34
+++ src/networks/fileTP/fileTPGlobals.ml        25 Oct 2011 17:33:22 -0000      
1.35
@@ -151,7 +151,7 @@
       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;

Index: src/networks/gnutella/gnutellaGlobals.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/networks/gnutella/gnutellaGlobals.ml,v
retrieving revision 1.47
retrieving revision 1.48
diff -u -b -r1.47 -r1.48
--- src/networks/gnutella/gnutellaGlobals.ml    3 Aug 2007 22:12:59 -0000       
1.47
+++ src/networks/gnutella/gnutellaGlobals.ml    25 Oct 2011 17:33:22 -0000      
1.48
@@ -335,7 +335,7 @@
       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;

Index: src/networks/openFT/openFTGlobals.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/networks/openFT/openFTGlobals.ml,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -b -r1.5 -r1.6
--- src/networks/openFT/openFTGlobals.ml        9 Jan 2006 00:25:59 -0000       
1.5
+++ src/networks/openFT/openFTGlobals.ml        25 Oct 2011 17:33:22 -0000      
1.6
@@ -186,7 +186,7 @@
           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;

Index: src/networks/opennap/opennapGlobals.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/networks/opennap/opennapGlobals.ml,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -b -r1.12 -r1.13
--- src/networks/opennap/opennapGlobals.ml      10 Apr 2006 19:16:36 -0000      
1.12
+++ src/networks/opennap/opennapGlobals.ml      25 Oct 2011 17:33:22 -0000      
1.13
@@ -200,7 +200,7 @@
           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;

Index: src/networks/soulseek/slskGlobals.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/networks/soulseek/slskGlobals.ml,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -b -r1.16 -r1.17
--- src/networks/soulseek/slskGlobals.ml        5 Sep 2006 14:15:20 -0000       
1.16
+++ src/networks/soulseek/slskGlobals.ml        25 Oct 2011 17:33:22 -0000      
1.17
@@ -272,7 +272,7 @@
       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;

Index: src/utils/net/basicSocket.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/utils/net/basicSocket.ml,v
retrieving revision 1.36
retrieving revision 1.37
diff -u -b -r1.36 -r1.37
--- src/utils/net/basicSocket.ml        23 Oct 2010 18:19:58 -0000      1.36
+++ src/utils/net/basicSocket.ml        25 Oct 2011 17:33:22 -0000      1.37
@@ -389,18 +389,36 @@
 (*                                                                       *)
 (*************************************************************************)
 
-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                                        *)