From 14c17b5963ea8465580e27a51ffc0905cc314e78 Mon Sep 17 00:00:00 2001 From: Sudha Parimala Date: Tue, 26 May 2020 13:21:41 +0530 Subject: [PATCH 1/2] add intarray --- lib/domainslib.ml | 1 + lib/intarray.ml | 68 +++++++++++++++++++++++++ lib/intarray.mli | 14 ++++++ test/dune | 11 ++++- test/mergesort_multicore.ml | 99 +++++++++++++++++++++++++++++++++++++ test/quicksort_multicore.ml | 70 ++++++++++++++++++++++++++ 6 files changed, 262 insertions(+), 1 deletion(-) create mode 100644 lib/intarray.ml create mode 100644 lib/intarray.mli create mode 100644 test/mergesort_multicore.ml create mode 100644 test/quicksort_multicore.ml diff --git a/lib/domainslib.ml b/lib/domainslib.ml index 056f9dd..0c215e8 100644 --- a/lib/domainslib.ml +++ b/lib/domainslib.ml @@ -1,2 +1,3 @@ module Chan = Chan module Task = Task +module IntArray = Intarray.IntArray diff --git a/lib/intarray.ml b/lib/intarray.ml new file mode 100644 index 0000000..febb3eb --- /dev/null +++ b/lib/intarray.ml @@ -0,0 +1,68 @@ +module Int64Array : sig + module Array : sig + type t + val create_uninitialised : int -> t + val get : t -> int -> int64 + val set : t -> int -> int64 -> unit + val unsafe_get : t -> int -> int64 + val unsafe_set : t -> int -> int64 -> unit + val unsafe_blit : t -> int -> t -> int -> int -> unit + val length : t -> int + val sub : t -> int -> int -> t + val copy : t -> t + end +end = struct + module Array = struct + type t = Bytes.t + let create_uninitialised sz = Bytes.create (sz * 8) + external set_raw_64 : Bytes.t -> int -> int64 -> unit = "%caml_bytes_set64" + external get_raw_64 : Bytes.t -> int -> int64 = "%caml_bytes_get64" + external unsafe_set_raw_64 : Bytes.t -> int -> int64 -> unit = "%caml_bytes_set64u" + external unsafe_get_raw_64 : Bytes.t -> int -> int64 = "%caml_bytes_get64u" + external unsafe_blit : Bytes.t -> int -> Bytes.t -> int -> int -> unit + = "caml_blit_bytes" [@@noalloc] + let get arr i = get_raw_64 arr (i * 8) + let set arr i x = set_raw_64 arr (i * 8) x + let unsafe_get arr i = unsafe_get_raw_64 arr (i * 8) + let unsafe_set arr i x = unsafe_set_raw_64 arr (i * 8) x + let length a = (Bytes.length a) / 8 + let sub a s len = Bytes.sub a (s * 8) (len * 8) + let copy = Bytes.copy + end +end + +module IntArray : sig + module Array : sig + type t + val create_uninitialised : int -> t + val get : t -> int -> int + val set : t -> int -> int -> unit + val unsafe_get : t -> int -> int + val unsafe_set : t -> int -> int -> unit + val length : t -> int + val sub : t -> int -> int -> t + val copy : t -> t + val blit : t -> int -> t -> int -> int -> unit + end +end = struct + module Array = struct + type t = Int64Array.Array.t + let create_uninitialised = Int64Array.Array.create_uninitialised + let get arr i = Int64.to_int (Int64Array.Array.get arr i) + let set arr i x = Int64Array.Array.set arr i (Int64.of_int x) + let unsafe_get arr i = Int64.to_int (Int64Array.Array.unsafe_get arr i) + let unsafe_set arr i x = Int64Array.Array.unsafe_set arr i (Int64.of_int x) + let length = Int64Array.Array.length + let sub = Int64Array.Array.sub + let copy = Int64Array.Array.copy + let blit s1 ofs1 s2 ofs2 len = + if len < 0 || ofs1 < 0 || ofs1 > length s1 - len + || ofs2 < 0 || ofs2 > length s2 - len + then invalid_arg "Array.blit" + else Int64Array.Array.unsafe_blit s1 (ofs1 * 8) s2 (ofs2 * 8) (len * 8) + end +end + + + + \ No newline at end of file diff --git a/lib/intarray.mli b/lib/intarray.mli new file mode 100644 index 0000000..fa241ed --- /dev/null +++ b/lib/intarray.mli @@ -0,0 +1,14 @@ +module IntArray : sig + module Array : sig + type t + val create_uninitialised : int -> t + val get : t -> int -> int + val set : t -> int -> int -> unit + val unsafe_get : t -> int -> int + val unsafe_set : t -> int -> int -> unit + val length : t -> int + val sub : t -> int -> int -> t + val copy : t -> t + val blit : t -> int -> t -> int -> int -> unit + end +end \ No newline at end of file diff --git a/test/dune b/test/dune index db312cd..07945dc 100644 --- a/test/dune +++ b/test/dune @@ -49,9 +49,18 @@ (modules task_exn) (modes native)) - (test (name spectralnorm2_multicore) (libraries domainslib) (modules spectralnorm2_multicore) (modes native)) + +(test + (name quicksort_multicore) + (libraries domainslib) + (modules quicksort_multicore)) + +(test + (name mergesort_multicore) + (libraries domainslib) + (modules mergesort_multicore)) \ No newline at end of file diff --git a/test/mergesort_multicore.ml b/test/mergesort_multicore.ml new file mode 100644 index 0000000..61ddb49 --- /dev/null +++ b/test/mergesort_multicore.ml @@ -0,0 +1,99 @@ +module T = Domainslib.Task +module A = Domainslib.IntArray + +let num_domains = try int_of_string @@ Sys.argv.(1) with _ -> 1 +let n = try int_of_string @@ Sys.argv.(2) with _ -> 1024 +let min = 128 +let pool = T.setup_pool ~num_domains:(num_domains - 1) + +open A + +let a = Array.create_uninitialised n + +let init_part s e arr = + let my_state = Random.State.make_self_init () in + for i = s to e do + arr.(i) <- Random.State.int my_state n + done + +let _ = +T.parallel_for pool ~chunk_size:1 ~start:0 ~finish:(num_domains - 1) +~body:(fun i -> init_part (i * n / num_domains) ((i+1) * n / num_domains - 1) a) + +let b = Array.create_uninitialised n + + +type array_slice = {arr: A.Array.t; index: int; length: int} + +let print_array_slice s a = + print_string (s^"="); + for i = a.index to a.index + a.length - 1 do + Printf.printf "%d " a.arr.(i) + done; + print_endline "" + +let sort a = + for i = a.index to a.index + a.length - 2 do + for j = i + 1 to a.index + a.length - 1 do + if a.arr.(j) < a.arr.(i) then + let t = a.arr.(i) in + a.arr.(i) <- a.arr.(j); + a.arr.(j) <- t + done + done + +let merge a b res = + let rec loop ai bi ri = + match a.index + a.length - ai, b.index + b.length - bi with + | n, 0 -> Array.blit a.arr ai res.arr ri n + | 0, n -> Array.blit b.arr bi res.arr ri n + | _, _ -> + if a.arr.(ai) < b.arr.(bi) then begin + res.arr.(ri) <- a.arr.(ai); + loop (ai+1) bi (ri+1) + end else begin + res.arr.(ri) <- b.arr.(bi); + loop ai (bi+1) (ri+1) + end + in + loop a.index b.index res.index + +let rec merge_sort a b l = + if a.length <= min then begin + sort a; + a + end else + let a1= {a with index = a.index; length = a.length / 2} in + let b1 = {b with index = b.index; length = b.length / 2} in + let r1 = T.async pool (fun _ -> merge_sort a1 b1 (2*l+1)) in + + let a2 = {a with index = a.index + a.length / 2; + length = a.length - a.length / 2} in + let b2 = {b with index = b.index + b.length / 2; + length = b.length - b.length / 2} in + let r2 = T.async pool (fun _ -> merge_sort a2 b2 (2*l+2)) in + + let (r1, r2) = (T.await pool r1, T.await pool r2) in + + if r1.arr != r2.arr then begin + if r2.arr == a.arr then begin + merge r1 r2 a; + a + end else begin + merge r1 r2 b; + b + end + end else if r1.arr == a.arr then begin + merge r1 r2 b; + b + end else begin + merge r1 r2 a; + a + end + +let _ = + let aslice = {arr = a; index = 0; length = n}in + let bslice = {arr = b; index = 0; length = n} in + + let _r = merge_sort aslice bslice 0 in + T.teardown_pool pool \ No newline at end of file diff --git a/test/quicksort_multicore.ml b/test/quicksort_multicore.ml new file mode 100644 index 0000000..e4c9012 --- /dev/null +++ b/test/quicksort_multicore.ml @@ -0,0 +1,70 @@ +let num_domains = try int_of_string Sys.argv.(1) with _ -> 1 +let n = try int_of_string Sys.argv.(2) with _ -> 2000 + +module A = Domainslib.IntArray +module T = Domainslib.Task + +open A + +let swap arr i j = + let temp = arr.(i) in + arr.(i) <- arr.(j); + arr.(j) <- temp + +let partition arr low high = + let x = arr.(high) and i = ref (low-1) in + if (high-low > 0) then + begin + for j= low to high - 1 do + Domain.Sync.poll (); + if arr.(j) <= x then + begin + i := !i+1; + swap arr !i j + end + done + end; + swap arr (!i+1) high; + !i+1 + +let rec quicksort_o arr low high = + match (high - low) <= 0 with + | true -> () + | false -> + let q = partition arr low high in + quicksort_o arr low (q-1); + quicksort_o arr (q+1) high + +let rec quicksort arr low high d = + match (high - low) <= 0 with + | true -> () + | false -> + if d > 1 then + let q = partition arr low high in + let c = Domain.spawn (fun () -> quicksort arr low (q-1) (d/2)) in + quicksort arr (q+1) high (d/2 + (d mod 2)); + Domain.join c + else begin + let q = partition arr low high in + quicksort arr low (q-1) d; + quicksort arr (q+1) high d + end + +let init_part s e arr = + let my_state = Random.State.make_self_init () in + for i = s to e do + arr.(i) <- Random.State.int my_state n + done + +let () = + let arr = Array.create_uninitialised n in + let domains = T.setup_pool ~num_domains:(num_domains - 1) in + T.parallel_for domains ~chunk_size:1 ~start:0 ~finish:(num_domains - 1) + ~body:(fun i -> init_part (i * n / num_domains) ((i+1) * n / num_domains - 1) arr); + quicksort arr 0 (Array.length arr - 1) num_domains; + (* for i = 0 to Array.length arr - 1 do + print_int arr.(i); + print_string " " + done *) + T.teardown_pool domains + \ No newline at end of file From 389564b28dda6a7f1269e4247a0286683403bb30 Mon Sep 17 00:00:00 2001 From: Sudha Parimala Date: Wed, 27 May 2020 13:52:55 +0530 Subject: [PATCH 2/2] add test_intarray --- test/dune | 7 ++++++- test/mergesort_multicore.ml | 1 - test/test_intarray.ml | 17 +++++++++++++++++ 3 files changed, 23 insertions(+), 2 deletions(-) create mode 100644 test/test_intarray.ml diff --git a/test/dune b/test/dune index 20fc347..d95ac4b 100644 --- a/test/dune +++ b/test/dune @@ -75,4 +75,9 @@ (test (name quicksort_multicore) (libraries domainslib) - (modules quicksort_multicore)) \ No newline at end of file + (modules quicksort_multicore)) + +(test + (name test_intarray) + (libraries domainslib) + (modules test_intarray)) \ No newline at end of file diff --git a/test/mergesort_multicore.ml b/test/mergesort_multicore.ml index 61ddb49..4325cfc 100644 --- a/test/mergesort_multicore.ml +++ b/test/mergesort_multicore.ml @@ -22,7 +22,6 @@ T.parallel_for pool ~chunk_size:1 ~start:0 ~finish:(num_domains - 1) let b = Array.create_uninitialised n - type array_slice = {arr: A.Array.t; index: int; length: int} let print_array_slice s a = diff --git a/test/test_intarray.ml b/test/test_intarray.ml new file mode 100644 index 0000000..ab4453b --- /dev/null +++ b/test/test_intarray.ml @@ -0,0 +1,17 @@ +open Domainslib.IntArray + +let () = + let a = Array.create_uninitialised 10 in + for i = 0 to 9 do + a.(i) <- i + done; + let b = Array.copy a in + for i = 0 to (Array.length b - 1) do + assert (a.(i) = b.(i)) + done; + let c = Array.create_uninitialised 3 in + Array.blit a 0 c 0 3; + assert (c.(0) = a.(0)); + assert (c.(1) = a.(1)); + assert (c.(2) = a.(2)); + Printf.printf "ok" \ No newline at end of file