From f5b7cee7ecec2033c8ef9e3973dbea4700bfa649 Mon Sep 17 00:00:00 2001 From: Anmol Sahoo Date: Thu, 1 Aug 2019 14:39:08 +0530 Subject: [PATCH 1/3] Changed the declaration in the atomic.mli file The declarations for the atomic.mli files were declared as val instead of external, which was causing it to not be generated as primitives. --- stdlib/atomic.mli | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/stdlib/atomic.mli b/stdlib/atomic.mli index 7bb97bc490..0c935dbda2 100644 --- a/stdlib/atomic.mli +++ b/stdlib/atomic.mli @@ -1,10 +1,11 @@ type 'a t -val make : 'a -> 'a t -val get : 'a t -> 'a +external make : 'a -> 'a t = "%makemutable" +external get : 'a t -> 'a = "%atomic_load" +external exchange : 'a t -> 'a -> 'a = "%atomic_exchange" +external compare_and_set : 'a t -> 'a -> 'a -> bool = "%atomic_cas" +external fetch_and_add : int t -> int -> int = "%atomic_fetch_add" + val 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 From 744da7fc2ab7a1904f88e0b34c1e53d762162039 Mon Sep 17 00:00:00 2001 From: Anmol Sahoo Date: Thu, 1 Aug 2019 15:53:37 +0530 Subject: [PATCH 2/3] Specialize primitive entry added in translcore During the translation to the lambda language, conservatively a primitive is emitted and then specialized based on the types of the arguments. A new entry was added for Patomic_load, which specializes based on whether the load is to an immediate value or a pointer --- asmcomp/cmmgen.ml | 2 +- bytecomp/translcore.ml | 5 +++++ 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml index 2fec2d5ca0..344ab38e8d 100644 --- a/asmcomp/cmmgen.ml +++ b/asmcomp/cmmgen.ml @@ -2097,7 +2097,7 @@ and transl_prim_1 env p arg dbg = let ptr = transl env arg in ( match immediate_or_pointer with - | Immediate -> Cop (Cload {memory_chunk=Word_int ; mutability=Mutable ; is_atomic=true} , [ptr; Cconst_int 0], dbg) + | Immediate -> Cop (Cload {memory_chunk=Word_int ; mutability=Mutable ; is_atomic=true} , [ptr], dbg) | Pointer -> Cop (Cloadmut {is_atomic=true}, [ptr; Cconst_int 0], dbg) ) | prim -> fatal_errorf "Cmmgen.transl_prim_1: %a" Printlambda.primitive prim diff --git a/bytecomp/translcore.ml b/bytecomp/translcore.ml index 0aa81d3be2..4ded9f53aa 100644 --- a/bytecomp/translcore.ml +++ b/bytecomp/translcore.ml @@ -464,6 +464,11 @@ let specialize_primitive p env ty ~has_constant_constructor = | (Pmakeblock(tag, mut, None), fields) -> let shape = List.map (Typeopt.value_kind env) fields in Pmakeblock(tag, mut, Some shape) + | (Patomic_load _, _) -> + let is_int = match is_function_type env ty with + | None -> Pointer + | Some (_p1, rhs) -> maybe_pointer_type env rhs in + Patomic_load {immediate_or_pointer = is_int} | _ -> p (* Eta-expand a primitive *) From c1bb7bde6b8e9a5c409b9478814c979a66f4c4a8 Mon Sep 17 00:00:00 2001 From: Anmol Sahoo Date: Fri, 2 Aug 2019 09:24:28 +0530 Subject: [PATCH 3/3] Updated the specialize primitive entry in translcore Only pattern matching on `Patomic_load Pointer` that can be specialized --- bytecomp/translcore.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/bytecomp/translcore.ml b/bytecomp/translcore.ml index 4ded9f53aa..09752ad926 100644 --- a/bytecomp/translcore.ml +++ b/bytecomp/translcore.ml @@ -464,7 +464,7 @@ let specialize_primitive p env ty ~has_constant_constructor = | (Pmakeblock(tag, mut, None), fields) -> let shape = List.map (Typeopt.value_kind env) fields in Pmakeblock(tag, mut, Some shape) - | (Patomic_load _, _) -> + | (Patomic_load { immediate_or_pointer = Pointer }, _) -> let is_int = match is_function_type env ty with | None -> Pointer | Some (_p1, rhs) -> maybe_pointer_type env rhs in