Create a multicore-magic-dscheck library

dune-project

@@ -41,3 +41,14 @@
    (and
     (>= 2.4.1)
     :with-doc))))
+
+(package
+ (name multicore-magic-dscheck)
+ (synopsis
+  "A implementation of multicore-magic API using the atomic module of DScheck to make DScheck tests possible in libraries using multicore-magic")
+ (allow_empty)
+ (depends
+  (ocaml
+   (>= 4.12.0))
+  (dscheck
+   (>= 0.5.0))))

multicore-magic-dscheck.opam

@@ -0,0 +1,30 @@
+# This file is generated by dune, edit dune-project instead
+opam-version: "2.0"
+synopsis:
+  "A implementation of multicore-magic API using the atomic module of DScheck to make DScheck tests possible in libraries using multicore-magic"
+maintainer: ["Vesa Karvonen <[email protected]>"]
+authors: ["Vesa Karvonen <[email protected]>"]
+license: "ISC"
+homepage: "https://github.com/ocaml-multicore/multicore-magic"
+bug-reports: "https://github.com/ocaml-multicore/multicore-magic/issues"
+depends: [
+  "dune" {>= "3.14"}
+  "ocaml" {>= "4.12.0"}
+  "dscheck" {>= "0.5.0"}
+  "odoc" {with-doc}
+]
+build: [
+  ["dune" "subst"] {dev}
+  [
+    "dune"
+    "build"
+    "-p"
+    name
+    "-j"
+    jobs
+    "@install"
+    "@runtest" {with-test}
+    "@doc" {with-doc}
+  ]
+]
+dev-repo: "git+https://github.com/ocaml-multicore/multicore-magic.git"

src/dscheck/dune

@@ -0,0 +1,6 @@
+(library
+ (name multicore_magic_dscheck)
+ (public_name multicore-magic-dscheck)
+ (libraries dscheck)
+ (enabled_if
+  (>= %{ocaml_version} 5)))

src/dscheck/multicore_magic.ml

@@ -0,0 +1,38 @@
+module Atomic = Dscheck.TracedAtomic
+
+let copy_as_padded = Fun.id
+let copy_as ?padded:_ x = x
+let make_padded_array = Array.make
+let length_of_padded_array = Array.length
+let length_of_padded_array_minus_1 xs = Array.length xs - 1
+
+module Transparent_atomic = struct
+  include Atomic
+
+  let make_contended = make
+  let fenceless_get = get
+  let fenceless_set = set
+end
+
+let fenceless_get = Atomic.get
+let fenceless_set = Atomic.set
+let[@inline] fence atomic = Atomic.fetch_and_add atomic 0 |> ignore
+
+module Atomic_array = struct
+  type 'a t = 'a Atomic.t array
+
+  let[@inline] at (xs : 'a t) i : 'a Atomic.t = Array.get xs i
+  let[@inline] make n v = Array.init n @@ fun _ -> Atomic.make v
+  let[@inline] init n fn = Array.init n @@ fun i -> Atomic.make (fn i)
+  let[@inline] of_array xs = init (Array.length xs) (Array.get xs)
+
+  external length : 'a array -> int = "%array_length"
+
+  let unsafe_fenceless_set xs i v = Atomic.set xs.(i) v
+  let unsafe_fenceless_get xs i = Atomic.get xs.(i)
+
+  let[@inline] unsafe_compare_and_set xs i b a =
+    Atomic.compare_and_set (at xs i) b a
+end
+
+let instantaneous_domain_index () = 0

src/dscheck/multicore_magic.mli

@@ -0,0 +1,40 @@
+module Atomic = Dscheck.TracedAtomic
+
+val copy_as_padded : 'a -> 'a
+val copy_as : ?padded:bool -> 'a -> 'a
+val make_padded_array : int -> 'a -> 'a array
+val length_of_padded_array : 'a array -> int
+val length_of_padded_array_minus_1 : 'a array -> int
+val fenceless_get : 'a Atomic.t -> 'a
+val fenceless_set : 'a Atomic.t -> 'a -> unit
+val fence : int Atomic.t -> unit
+
+module Transparent_atomic : sig
+  type !'a t = 'a Atomic.t
+
+  val make : 'a -> 'a t
+  val make_contended : 'a -> 'a t
+  val get : 'a t -> 'a
+  val fenceless_get : 'a t -> 'a
+  val set : 'a t -> 'a -> unit
+  val fenceless_set : 'a t -> 'a -> unit
+  val exchange : 'a t -> 'a -> 'a
+  val compare_and_set : 'a t -> 'a -> 'a -> bool
+  val fetch_and_add : int t -> int -> int
+  val incr : int t -> unit
+  val decr : int t -> unit
+end
+
+module Atomic_array : sig
+  type !'a t
+
+  val make : int -> 'a -> 'a t
+  val of_array : 'a array -> 'a t
+  val init : int -> (int -> 'a) -> 'a t
+  val length : 'a t -> int
+  val unsafe_fenceless_get : 'a t -> int -> 'a
+  val unsafe_fenceless_set : 'a t -> int -> 'a -> unit
+  val unsafe_compare_and_set : 'a t -> int -> 'a -> 'a -> bool
+end
+
+val instantaneous_domain_index : unit -> int

test/dune

@@ -1,4 +1,5 @@
 (test
  (name Multicore_magic_test)
+ (package multicore-magic)
  (modules Multicore_magic_test)
  (libraries Multicore_magic alcotest domain_shims threads.posix unix))