Updated for CVS. Untested.

Remark: CommonSwarming.compute_block_num was "unprotected" at the end
of commonSwarming.ml; I think it's ok in this patch, since it's used
for debugging purpose. (Just don't forget to put protection back in place
when debugging code gets removed ;) ).

Index: src/daemon/common/commonSwarming.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonSwarming.ml,v
retrieving revision 1.51
diff -u -r1.51 commonSwarming.ml
--- src/daemon/common/commonSwarming.ml	12 Aug 2006 20:36:14 -0000	1.51
+++ src/daemon/common/commonSwarming.ml	27 Aug 2006 14:44:03 -0000
@@ -147,6 +147,9 @@
     mutable s_strategy : strategy;
 
     mutable s_verified_bitmap : VerificationBitmap.t;
+    mutable s_priorities_bitmap : string;
+    mutable s_priorities_intervals : (int64 * int64 * int) list;
+                                       (* beginning, end, priority *)
     mutable s_disk_allocated : Bitv.t;
     mutable s_availability : int array;
     mutable s_nuploading : int array;
@@ -569,6 +572,8 @@
     s_networks = [];
     s_strategy = AdvancedStrategy;
     s_verified_bitmap = VB.create 0 VB.State_missing;
+    s_priorities_bitmap = "";
+    s_priorities_intervals = [(zero, zero, 1)];
     s_disk_allocated = Bitv.create 0 false;
     s_blocks = [||];
     s_block_pos = [||];
@@ -580,6 +585,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
@@ -609,6 +628,8 @@
       s_strategy = AdvancedStrategy;
 
       s_verified_bitmap = VB.create nblocks VB.State_missing;
+      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_disk_allocated = Bitv.create ndiskblocks false;
       s_blocks = Array.create nblocks EmptyBlock ;
       s_block_pos = Array.create nblocks zero;
@@ -617,6 +638,7 @@
 (*      s_last_seen = Array.create nblocks 0; *)
     }
     in
+    swarmer_recompute_priorities_bitmap s;
     HS.add swarmers_by_name s;
     s
 
@@ -739,6 +761,7 @@
 
   s.s_blocks <- Array.create nblocks EmptyBlock;
   s.s_verified_bitmap <- VB.create nblocks VB.State_missing;
+  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 ? *)
@@ -773,7 +796,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 *)
 
@@ -1923,7 +1948,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
     let chunk = t.t_chunk_of_block.(b) in
     match s.s_blocks.(b) with
     | CompleteBlock | VerifiedBlock ->
@@ -1949,7 +1974,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
       let chunk = t.t_chunk_of_block.(b) in
       match s.s_blocks.(b) with
       | CompleteBlock | VerifiedBlock ->
@@ -2116,9 +2141,7 @@
 	  {
 	    choice_num = n;
 	    choice_block = b;
-	    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_remaining = remaining;
             choice_preallocated = is_fully_preallocated t block_begin block_end;
 	    choice_unselected_remaining = unselected_remaining;
@@ -2331,7 +2354,8 @@
 	  Array2.subarray_fold_lefti (fun 
 	    ((current_chunk_num, current_chunk_blocks_indexes, 
 	    best_choices, specimen) as acc) n b ->
-	    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 chunk_num = t.t_chunk_of_block.(b) in
 	      if chunk_num = current_chunk_num then
 		(current_chunk_num, n :: current_chunk_blocks_indexes,
@@ -2397,7 +2421,8 @@
 	  if probably_buggy then begin
             lprintf_nl "Probably buggy choice (%d):" chunk;
 	    Array2.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 = create_choice n b in
 		if List.mem n blocks then lprintf "** "
 		else if List.exists (List.mem n) best_choices then
@@ -2673,7 +2698,8 @@
 	  let block = up.up_complete_blocks.(i) in
 	  if not (List.exists (fun b -> b.up_block.block_num = block
 			      ) up.up_blocks) 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
@@ -3040,7 +3066,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"
 
 (*************************************************************************)
 (*                                                                       *)
@@ -3303,6 +3329,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 ->
@@ -3323,6 +3356,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
@@ -3335,6 +3374,10 @@
 	  (Bitv.to_string s.s_disk_allocated));
         ("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 =
@@ -3481,6 +3524,35 @@
       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 = VB.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
+
 (* using compute_block_num outside of swarming code is probably
    broken, networks supports are aware of chunks, not blocks 
    maybe other block-related functions should be censored in the same
@@ -3488,4 +3560,4 @@
    tag block numbers are chunk numbers so they're not inadvertedly
    mistaken for each other ?
 *)
-let compute_block_num = ()
+(* let compute_block_num = () *)
Index: src/daemon/driver/driverCommands.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/driver/driverCommands.ml,v
retrieving revision 1.164
diff -u -r1.164 driverCommands.ml
--- src/daemon/driver/driverCommands.ml	26 Aug 2006 12:05:53 -0000	1.164
+++ src/daemon/driver/driverCommands.ml	27 Aug 2006 14:44:05 -0000
@@ -49,6 +49,8 @@
 open Gettext
 open Autoconf
 
+module VB = VerificationBitmap
+
 let log_prefix = "[dCmd]"
 
 let lprintf_nl fmt =
@@ -2868,6 +2870,99 @@
 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 
+	       (VB.to_string 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 
+			  (VB.state_to_char (VB.get 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.65
diff -u -r1.65 unix32.ml
--- src/utils/lib/unix32.ml	15 Jul 2006 11:52:54 -0000	1.65
+++ src/utils/lib/unix32.ml	27 Aug 2006 14:44:07 -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)"
@@ -1642,7 +1650,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	27 Aug 2006 14:44:07 -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)
