Index: src/daemon/common/commonSwarming.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonSwarming.ml,v
retrieving revision 1.38
diff -u -r1.38 commonSwarming.ml
--- src/daemon/common/commonSwarming.ml	7 Jun 2006 00:17:46 -0000	1.38
+++ src/daemon/common/commonSwarming.ml	7 Jun 2006 08:44:13 -0000
@@ -154,6 +154,9 @@
     mutable s_strategy : strategy;
 
     mutable s_verified_bitmap : string;
+    mutable s_priorities_bitmap : string;
+    mutable s_priorities_intervals : (int64 * int64 * int) list;
+      (* beginning, end, priority *)
     mutable s_availability : int array;
     mutable s_nuploading : int array;
 (*    mutable s_last_seen : int array; *)
@@ -589,6 +592,8 @@
     s_networks = [];
     s_strategy = AdvancedStrategy;
     s_verified_bitmap = "";
+    s_priorities_bitmap = "";
+    s_priorities_intervals = [(zero, zero, 1)];
     s_blocks = [||];
     s_block_pos = [||];
     s_availability = [||];
@@ -599,6 +604,20 @@
     Otherwise create a new one with default values, that will be fixed
     by the first frontend association *)
 
+let swarmer_recompute_priorities_bitmap s =
+  String.fill s.s_priorities_bitmap 0 
+    (String.length s.s_priorities_bitmap) '0';
+  List.iter (fun (interval_begin, interval_end, priority) ->
+    if interval_end > interval_begin then
+      let i_begin = compute_block_num s interval_begin in
+      let i_end = compute_block_num s (Int64.pred interval_end) in
+      let priochar = 
+	Char.chr (max 0 (min priority 255)) in
+      for i = i_begin to i_end do
+	s.s_priorities_bitmap.[i] <- priochar
+      done
+  ) s.s_priorities_intervals
+
 let create_swarmer file_name file_size =
   try
     HS.find swarmers_by_name
@@ -620,6 +639,8 @@
       s_strategy = AdvancedStrategy;
 
       s_verified_bitmap = String.make nblocks '0';
+      s_priorities_bitmap = String.make nblocks '0';
+      s_priorities_intervals = [(zero, file_size, 1)]; (*JAVE init all prios to 1, thus all chunks will be downloaded as usual*)
       s_blocks = Array.create nblocks EmptyBlock ;
       s_block_pos = Array.create nblocks zero;
       s_availability = Array.create nblocks 0;
@@ -627,6 +648,7 @@
 (*      s_last_seen = Array.create nblocks 0; *)
     }
     in
+    swarmer_recompute_priorities_bitmap s;
     HS.add swarmers_by_name s;
     s
 
@@ -754,6 +776,7 @@
 
   s.s_blocks <- Array.create nblocks EmptyBlock;
   s.s_verified_bitmap <- String.make nblocks '0';
+  s.s_priorities_bitmap <- String.make nblocks '0';
   s.s_block_pos <- Array.create nblocks zero;
   s.s_availability <- Array.create nblocks 0; (* not preserved ? *)
   s.s_nuploading <- Array.create nblocks 0; (* not preserved ? *)
@@ -788,7 +811,9 @@
 
         iter (i+1) tail
   in
-  iter 0 blocks
+  iter 0 blocks;
+  swarmer_recompute_priorities_bitmap s
+
 
 (** Associate a(n additional) frontend to a swarmer *)
 
@@ -1870,7 +1895,7 @@
     up.up_npartial <- n-1;
     let t = up.up_t in
     let s = t.t_s in
-    (* priority bitmap <> 0 here ? *)
+    if s.s_priorities_bitmap.[b] = '0' then iter_partial up else
     match s.s_blocks.(b) with
     | CompleteBlock | VerifiedBlock ->
         iter_partial up
@@ -1887,7 +1912,7 @@
       up.up_ncomplete <- n-1;
       let t = up.up_t in
       let s = t.t_s in
-      (* priority bitmap <> 0 here ? *)
+      if s.s_priorities_bitmap.[b] = '0' then iter_complete up else
       match s.s_blocks.(b) with
       | CompleteBlock | VerifiedBlock ->
           iter_complete up
@@ -2033,9 +2058,7 @@
 	  let nuploaders = s.s_nuploading.(b) in
 	  {
 	    choice_num = n;
-	    choice_user_priority = (* priority bitmap here instead ? *)
-	      if block_begin < preview_beginning then 3 else
-		if block_end > preview_end then 2 else 1;
+	    choice_user_priority = Char.code s.s_priorities_bitmap.[b];
 	    choice_nuploaders = nuploaders;
 	    choice_remaining = remaining;
 	    choice_unselected_remaining = unselected_remaining;
@@ -2190,8 +2213,8 @@
 
 	let best_choices, specimen = 
 	  subarray_fold_lefti (fun ((best_choices, specimen) as acc) n b ->
-	  (* priority bitmap <> 0 here ? *)
-	  if not (should_download_block s b) then acc else
+	  if s.s_priorities_bitmap.[b] = '0' ||
+	    not (should_download_block s b) then acc else
 	    let this_choice = evaluate_choice n b in
 	    match best_choices with
 	    | [] -> [n], this_choice
@@ -2237,7 +2260,8 @@
 	  if probably_buggy then begin
 	    lprintf_nl "Probably buggy choice:";
 	    subarray_fold_lefti (fun () n b ->
-	      if should_download_block s b then
+	      if s.s_priorities_bitmap.[b] <> '0' &&
+                should_download_block s b then
 		let this_choice = evaluate_choice n b in
 		if List.mem n best_choices then lprintf "** "
 		else lprintf "   ";
@@ -2500,7 +2524,8 @@
 	for i = 0 to up.up_ncomplete - 1 do
 	  let block = up.up_complete_blocks.(i) in
 	  if block <> current_block then
-	    if should_download_block s block then (* priority bitmap <> 0 here ? *)
+	    if s.s_priorities_bitmap.[block] <> '0' && 
+	      should_download_block s block then
 	      let partial_found = match s.s_blocks.(block) with
 		| EmptyBlock -> true
 		| CompleteBlock | VerifiedBlock -> false
@@ -2821,7 +2846,7 @@
   | List [v1;v2] | SmallList [v1;v2] ->
       (value_to_int64 v1, value_to_int64 v2)
   | _ ->
-      failwith "Options: Not an int32 pair"
+      failwith "Options: Not an int64 pair"
 
 (*************************************************************************)
 (*                                                                       *)
@@ -3084,6 +3109,13 @@
 
 module SwarmerOption = struct
 
+  let value_to_priority_interval v =
+    match v with
+    | List [v1;v2;p] | SmallList [v1;v2;p] ->
+	(value_to_int64 v1, value_to_int64 v2, value_to_int p)
+    | _ -> 
+	failwith "Options: Not a priority interval"
+
     let value_to_swarmer v =
       match v with
       | Module assocs ->
@@ -3096,6 +3128,12 @@
           List.iter (fun bsize ->
               split_blocks s bsize
           ) block_sizes;
+	  let priorities_intervals = 
+	    try
+	      get_value	"file_priorities_intervals" 
+		(value_to_list value_to_priority_interval) 
+	    with Not_found -> [(zero, s.s_size, 1)] in
+	  swarmer_recompute_priorities_bitmap s;
           s
 
       | _ -> assert false
@@ -3107,6 +3145,10 @@
         ("file_bitmap", string_to_value s.s_verified_bitmap);
         ("file_chunk_sizes", list_to_value int64_to_value
             (List.map (fun t -> t.t_chunk_size) s.s_networks));
+	("file_priorities_intervals", List
+	  (List.map (fun (i_begin, i_end, priority) ->
+	    SmallList [int64_to_value i_begin; int64_to_value i_end;
+	    int_to_value priority]) s.s_priorities_intervals))
         ]
 
     let t =
@@ -3244,3 +3286,33 @@
       Printf.bprintf buf "  Uploaders: %d\n" !counter;
       Printf.bprintf buf "  Storage: %d bytes\n" !storage;
   )
+
+(* functions for priority bitmask *)
+
+let file_swarmer f =
+  HS.find swarmers_by_name { dummy_swarmer with s_filename = file_disk_name f }
+
+(** set the priority bitmask for each chunk in a file *)
+let set_swarmer_chunk_priorities f priobitmap =
+  let s = file_swarmer f in
+  if String.length priobitmap = String.length s.s_verified_bitmap then
+    s.s_priorities_bitmap <- priobitmap
+
+(** get the priority bitmask for a file *)
+let get_swarmer_chunk_priorities f =
+  let s = file_swarmer f in
+    s.s_priorities_bitmap
+
+let get_swarmer_chunk_verified f = 
+  let s = file_swarmer f in
+    s.s_verified_bitmap
+
+let set_swarmer_priorities_intervals f priorities_intervals = 
+  let s = file_swarmer f in
+  s.s_priorities_intervals <- priorities_intervals;
+  swarmer_recompute_priorities_bitmap s
+
+let get_swarmer_priorities_intervals f = 
+  let s = file_swarmer f in
+    s.s_priorities_intervals
+
Index: src/daemon/driver/driverCommands.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/driver/driverCommands.ml,v
retrieving revision 1.151
diff -u -r1.151 driverCommands.ml
--- src/daemon/driver/driverCommands.ml	1 Jun 2006 01:41:11 -0000	1.151
+++ src/daemon/driver/driverCommands.ml	7 Jun 2006 08:44:14 -0000
@@ -2852,6 +2852,97 @@
 let _ =
   register_commands "Driver/Xpert"
     [
+      
+      "debug_set_download_prio", Arg_two 
+        (fun arg priostring  o ->
+           let num = int_of_string arg in
+           let file = file_find num in
+             CommonSwarming.set_swarmer_chunk_priorities file priostring;
+             "set prio"
+               
+        ), ":\t\t\t\t\tset block download priorities for a file. 0=never download, >0=download largest prio first";
+      
+      "debug_get_download_prio", Arg_one 
+        (fun arg o ->
+	   let buf = o.conn_buf in
+           let num = int_of_string arg in
+           let file = file_find num in
+           let swarmer = CommonSwarming.file_swarmer file in
+           let prio=CommonSwarming.get_swarmer_chunk_priorities file in
+           let downloaded = CommonSwarming.get_swarmer_chunk_verified file in
+             Printf.bprintf buf
+               "prio      :%s\ndownloaded:%s\n" prio downloaded;
+             Unix32.subfile_tree_map (file_fd file)
+               (fun fname start length current_length ->
+                 let stop = 
+		   if length <> 0L then (start ++ length -- 1L)
+		   else start in
+                  let blockstart = 
+		    try CommonSwarming.compute_block_num swarmer start
+		    with _ -> 0 in
+                  let blockend = 
+		    try CommonSwarming.compute_block_num swarmer stop
+	            with _ -> 0 in
+                    Printf.bprintf buf "sf:%5Ld ef:%5Ld l:%Ld cl:%Ld > sc:%5d ec:%5d filename:%-30s \n" 
+                      start
+                      stop
+                      length
+                      current_length
+                      blockstart
+                      blockend
+                      fname;
+                    
+                    (*make a chunk downloaded status string for a subfile*)
+                    (try 
+		      for i = blockstart to blockend do
+                        Buffer.add_char buf downloaded.[i];
+                      done;
+                      Printf.bprintf buf "\n";
+                    with _ -> ())
+               );
+              "";
+    ), ":\t\t\t\t\tget file block priorities for a file, and show subfile completion status";
+
+
+    "debug_set_subfile_prio", Arg_multiple 
+      (fun args o ->
+	let buf = o.conn_buf in
+	match args with
+	| filenum :: priochar :: subfilestart :: q ->
+	    let filenum = int_of_string filenum in
+	    let priochar = priochar.[0] in
+	    let subfilestart = int_of_string subfilestart in
+	    let subfileend =
+	      match q with
+	      | subfileend :: _ ->
+		  int_of_string subfileend
+	      | _ -> subfilestart in
+            let file = file_find filenum in
+            let swarmer = CommonSwarming.file_swarmer file in
+            let priostring = 
+	      CommonSwarming.get_swarmer_chunk_priorities file in
+
+            let subfile1 = Unix32.find_file_index (file_fd file) subfilestart in (*subfilestart is subfile number, not a byte index, so is buggy*) 
+            let subfile2 = Unix32.find_file_index (file_fd file) subfileend in
+            let subfile_pos = function (_,y,_) -> y in
+            let subfile_len = function (_,_,y) -> y in
+            let start = subfile_pos subfile1 in
+            let stop = 
+	      subfile_pos subfile2 ++ subfile_len subfile2 -- 
+		if subfile_len subfile2 > 0L then 1L else 0L in
+            let blockstart = (CommonSwarming.compute_block_num swarmer start) in
+            let blockend = (CommonSwarming.compute_block_num swarmer stop) in
+	    for i = blockstart to blockend do (* use String.fill instead? *)
+              priostring.[i] <- priochar
+            done;
+            Printf.bprintf buf
+              "start:%Ld stop:%Ld bs:%d be:%d\npriostring:%s\n" 
+              start stop blockstart blockend priostring;
+
+            CommonSwarming.set_swarmer_chunk_priorities file priostring;
+            _s "done"
+	| _ -> bad_number_of_args
+    ), "debug_set_subfile_prio <download id> <prio> <1st subfile> <optional last subfile>";
 
     "reload_messages", Arg_none (fun o ->
         CommonMessages.load_message_file ();
Index: src/utils/lib/unix32.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/utils/lib/unix32.ml,v
retrieving revision 1.63
diff -u -r1.63 unix32.ml
--- src/utils/lib/unix32.ml	25 May 2006 19:47:25 -0000	1.63
+++ src/utils/lib/unix32.ml	7 Jun 2006 08:44:14 -0000
@@ -442,6 +442,14 @@
           find_file
             (if file_pos < pos then tree1 else tree2) file_pos
 
+    let rec subfile_tree_map indent tree f=
+      match tree with
+        | Leaf file -> 
+            f file.filename file.pos file.len file.current_len
+        | Node (pos, tree1, tree2) ->
+            subfile_tree_map (indent ^ "  ") tree1 f;
+            subfile_tree_map (indent ^ "  ") tree2 f
+              
     let rec print_tree indent tree =
       match tree with
         Leaf file -> lprintf_nl "%s  - %s (%Ld,%Ld)"
@@ -1690,7 +1698,29 @@
       let shared_end = shared_begin ++ shared_len in
       ()
 *)      
-  end
+end
+
+(* subfile tree map function*)
+let subfile_tree_map t f =
+  match t.file_kind with
+    | MultiFile t -> MultiFile.subfile_tree_map "" t.MultiFile.tree f; ()
+    | _ -> ()
+        
+
+let find_file t chunk_begin = 
+  match t.file_kind with
+    | MultiFile t ->  
+        let (sf, tail) = (MultiFile.find_file t chunk_begin) in
+          (sf.MultiFile.filename, sf.MultiFile.pos , sf.MultiFile.len)
+    | _ -> ("unimplemeted" , 0L, 0L)
+
+let find_file_index t index = 
+  match t.file_kind with
+    | MultiFile t ->  
+        let sf = List.nth t.MultiFile.files index in
+          (sf.MultiFile.filename, sf.MultiFile.pos , sf.MultiFile.len)
+    | _ -> ("unimplemeted" , 0L, 0L)
+
 type t = file
 
 (*
Index: src/utils/lib/unix32.mli
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/utils/lib/unix32.mli,v
retrieving revision 1.23
diff -u -r1.23 unix32.mli
--- src/utils/lib/unix32.mli	6 Mar 2006 18:02:16 -0000	1.23
+++ src/utils/lib/unix32.mli	7 Jun 2006 08:44:14 -0000
@@ -101,3 +101,6 @@
 val percentused : string -> int option
 val percentfree : string -> int option
 val filesystem : string -> string
+val subfile_tree_map : t -> (string -> int64 -> int64 -> int64-> unit)  ->  unit
+val find_file : t -> int64 -> (string * int64 * int64)
+val find_file_index : t -> int -> (string * int64 * int64)
