Anonymous avatar Anonymous committed 0e8c0b1

Subarray_cat.sub_copy_out: gc optimizations

Comments (0)

Files changed (4)

 
 clean :
 	sh ./clean.sh
+
+test_sc : all
+	ocamlc -w A -pp camlp4r -I _build it_Ops.cmo subarray.cmo subarray_cat.cmo test_sc_sub_copy_out.ml -o test_sc && ./test_sc
       C.mk ~arr:a.arr ~ofs:a.ofs ~len:(alen + blen)
   ]
 ;
+
+value blit_to_array ~src ~src_ofs ~dst ~dst_ofs ~len =
+  if len < 0
+  then invalid_arg "Subarray.blit: len"
+  else
+  if src_ofs < 0 || src_ofs > src.len - len
+  then invalid_arg "Subarray.blit: source"
+  else
+  if dst_ofs < 0 || dst_ofs > Array.length dst - len
+  then invalid_arg "Subarray.blit: destination"
+  else
+    Array.blit
+      src.arr (src_ofs + src.ofs)
+      dst      dst_ofs
+      len
+;
           inner ~i:(i - sj_len) ~j:(j+1)
 ;
 
+
+value empty_array = [| |]
+;
+
+
+value rec sub_copy__loop ~to_skip ~to_copy ~res ~res_i ~sc_i ~sc =
+  if to_copy = 0
+  then
+    ( assert
+        (res != empty_array && to_skip = 0 && to_copy = 0 &&
+         res_i = Array.length res
+        )
+    ; res
+    )
+  else
+    let s = sc.(sc_i) in
+    let s_len = S.length s in
+    if (* s_len = 0 || *) to_skip >= s_len
+       (* ^^^ included in ^^^ as a logic coincidence *)
+    then
+      sub_copy__loop
+        ~to_skip:(to_skip - s_len) ~to_copy ~res ~res_i ~sc_i:(sc_i + 1)
+        ~sc
+    else
+      if to_skip = 0
+      then
+        (* blitting *)
+        let s_copy_len = min to_copy s_len in
+        sub_copy__copy
+          ~res ~res_i ~s ~ofs:0 ~len:s_copy_len
+          ~sc_i ~to_copy ~sc
+      else
+        (* here: 0 < to_skip < s_len:
+           skipping part of s, copying other part
+         *)
+        let s_copy_ofs = to_skip in
+        let s_avail = s_len - s_copy_ofs in
+        let s_copy_len = min to_copy s_avail in
+        sub_copy__copy
+          ~res ~res_i ~s ~ofs:s_copy_ofs ~len:s_copy_len
+          ~sc_i ~to_copy ~sc
+
+and sub_copy__copy ~res ~res_i ~s ~ofs ~len ~sc_i ~to_copy ~sc =
+  let res =
+    if res == empty_array
+    then
+      let init_item = S.get s ofs in
+      Array.make to_copy init_item
+      (* no items were copied, so to_copy == all items we need *)
+    else
+      res
+  in
+  ( S.blit_to_array
+      ~src:s   ~src_ofs:ofs
+      ~dst:res ~dst_ofs:res_i
+      ~len
+  ;
+    (* copy can pass sc_i out of sc to loop when to_copy = 0 *)
+    sub_copy__loop
+      ~to_skip:0 ~to_copy:(to_copy - len) ~res ~res_i:(res_i + len)
+      ~sc_i:(sc_i + 1) ~sc
+  )
+;
+
+value sub_copy_out_to_array ~ofs ~len sc =
+  (* here: checked that ofs..len is a valid subarray of sc. *)
+  if len = 0
+  then empty_array
+  else sub_copy__loop
+    ~to_skip:ofs ~to_copy:len ~res:empty_array ~res_i:0 ~sc ~sc_i:0
+;
+
 value sub_copy_out ?(ofs=0) ?len sc =
   let len =
     match len with
   if ofs < 0 || len < 0 || ofs+len > sc_len
   then invalid_arg "Subarray_cat.sub_copy_out"
   else
-  S.of_array & Array.init len (fun i -> get sc (ofs+i))
+  S.of_array & sub_copy_out_to_array ~ofs ~len sc
 ;

test_sc_sub_copy_out.ml

+value () = Random.init 2
+;
+
+value res f =
+  try `Ok (f ()) with [ e -> `Error e ]
+;
+
+value cmp_res f1 f2 =
+  (res f1) = (res f2)
+;
+
+
+module SC = Subarray_cat
+;
+
+module S = Subarray
+;
+
+open It_Ops
+;
+
+value old_sub_copy_out ~ofs ~len sc =
+  let sc_len = SC.length sc in
+  if ofs < 0 || len < 0 || ofs+len > sc_len
+  then invalid_arg "Subarray_cat.sub_copy_out"
+  else
+  S.of_array & Array.init len (fun i -> SC.get sc (ofs+i))
+;
+
+value new_sub_copy_out = SC.sub_copy_out
+;
+
+(*******************)
+
+value random_subarray () =
+  let arr_len = Random.int 500 in
+  let arr = Array.init arr_len (fun _ -> Random.int 10000) in
+  let subarr_ofs = Random.int (arr_len + 1) in
+  let arr_avail = arr_len - subarr_ofs in
+  let subarr_len = Random.int (arr_avail + 1) in
+  S.of_array_sub arr subarr_ofs subarr_len
+;
+
+value random_sc () =
+  let count = Random.int 5 in
+  SC.make & Array.to_list & Array.init count (fun _ -> random_subarray ())
+;
+
+value test () =
+  for _sc's = 0 to 10000 do
+    let sc = random_sc () in
+    let sc_len = SC.length sc in
+    for _tests = 0 to 10000 do
+      let ofs = -3 + Random.int (sc_len + 6)
+      and len = -3 + Random.int (sc_len + 6) in
+      if cmp_res
+        (fun () -> old_sub_copy_out ~ofs ~len sc)
+        (fun () -> new_sub_copy_out ~ofs ~len sc)
+      then ()
+      else failwith "bad"
+    done
+  done
+;
+
+
+value bench () =
+  for _sc's = 0 to 0 do
+    let sc = random_sc () in
+    let sc_len = SC.length sc in
+    for _tests = 0 to 10000000 do
+      let ofs = -3 + Random.int (sc_len + 6)
+      and len = -3 + Random.int (sc_len + 6) in
+      ignore (res
+        (fun () -> old_sub_copy_out ~ofs ~len sc)
+(*
+        (fun () -> new_sub_copy_out ~ofs ~len sc)
+*)
+      )
+    done
+  done
+;
+
+
+value () = (bench (); Printf.printf "alloc = %f\n" (Gc.allocated_bytes ()))
+;
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.