Check in Proc if a Cmm.operation is supported by the target (oxcaml#23)

Author: gretay-js

backend/amd64/proc.ml

@@ -379,3 +379,15 @@ let init () =
     num_available_registers.(0) <- 12
   end else
     num_available_registers.(0) <- 13
+
+let operation_supported = function
+  | Capply _ | Cextcall _ | Cload _ | Calloc | Cstore _
+  | Caddi | Csubi | Cmuli | Cmulhi | Cdivi | Cmodi
+  | Cand | Cor | Cxor | Clsl | Clsr | Casr
+  | Ccmpi _ | Caddv | Cadda | Ccmpa _
+  | Cnegf | Cabsf | Caddf | Csubf | Cmulf | Cdivf
+  | Cfloatofint | Cintoffloat | Ccmpf _
+  | Craise _
+  | Ccheckbound
+  | Cprobe _ | Cprobe_is_enabled _
+    -> true

backend/arm/proc.ml

@@ -360,3 +360,15 @@ let assemble_file infile outfile =
 
 
 let init () = ()
+
+let operation_supported = function
+  | Capply _ | Cextcall _ | Cload _ | Calloc | Cstore _
+  | Caddi | Csubi | Cmuli | Cmulhi | Cdivi | Cmodi
+  | Cand | Cor | Cxor | Clsl | Clsr | Casr
+  | Ccmpi _ | Caddv | Cadda | Ccmpa _
+  | Cnegf | Cabsf | Caddf | Csubf | Cmulf | Cdivf
+  | Cfloatofint | Cintoffloat | Ccmpf _
+  | Craise _
+  | Ccheckbound
+  | Cprobe _ | Cprobe_is_enabled _
+    -> true

backend/arm64/proc.ml

@@ -308,3 +308,15 @@ let assemble_file infile outfile =
 
 
 let init () = ()
+
+let operation_supported = function
+  | Capply _ | Cextcall _ | Cload _ | Calloc | Cstore _
+  | Caddi | Csubi | Cmuli | Cmulhi | Cdivi | Cmodi
+  | Cand | Cor | Cxor | Clsl | Clsr | Casr
+  | Ccmpi _ | Caddv | Cadda | Ccmpa _
+  | Cnegf | Cabsf | Caddf | Csubf | Cmulf | Cdivf
+  | Cfloatofint | Cintoffloat | Ccmpf _
+  | Craise _
+  | Ccheckbound
+  | Cprobe _ | Cprobe_is_enabled _
+    -> true

backend/cmm_helpers.ml

@@ -2543,6 +2543,20 @@ let bigstring_set size unsafe arg1 arg2 arg3 dbg =
             check_bound unsafe size dbg (bigstring_length ba dbg)
               idx (unaligned_set size ba_data idx newval dbg))))))
 
+
+(* [cextcall] is called from [Cmmgen.transl_ccall] *)
+let cextcall (prim : Primitive.description) args dbg ret ty_args =
+  let name = Primitive.native_name prim in
+  let default = Cop(Cextcall { name; ret;
+                               builtin = prim.prim_c_builtin;
+                               effects = Arbitrary_effects;
+                               coeffects = Has_coeffects;
+                               alloc = prim.prim_alloc;
+                               ty_args },
+                    args, dbg)
+  in
+  default
+
 (* Symbols *)
 
 let cdefine_symbol (symb, (global: Cmmgen_state.is_global)) =

backend/cmm_helpers.mli

@@ -575,6 +575,12 @@ val send :
   Lambda.meth_kind -> expression -> expression -> expression list ->
   Debuginfo.t -> expression
 
+(** [cextcall prim args dbg type_of_result] returns Cextcall operation
+    that corresponds to [prim]. If [prim] is a C builtin supported on the
+    target, returns [Cmm.operation] variant for [prim]'s intrinsics. *)
+val cextcall : Primitive.description -> expression list -> Debuginfo.t ->
+  machtype -> exttype list -> expression
+
 (** Generic Cmm fragments *)
 
 (** Generate generic functions *)

backend/i386/proc.ml

@@ -256,3 +256,15 @@ let assemble_file infile outfile =
   X86_proc.assemble_file infile outfile
 
 let init () = ()
+
+let operation_supported = function
+  | Capply _ | Cextcall _ | Cload _ | Calloc | Cstore _
+  | Caddi | Csubi | Cmuli | Cmulhi | Cdivi | Cmodi
+  | Cand | Cor | Cxor | Clsl | Clsr | Casr
+  | Ccmpi _ | Caddv | Cadda | Ccmpa _
+  | Cnegf | Cabsf | Caddf | Csubf | Cmulf | Cdivf
+  | Cfloatofint | Cintoffloat | Ccmpf _
+  | Craise _
+  | Ccheckbound
+  | Cprobe _ | Cprobe_is_enabled _
+    -> true

backend/power/proc.ml

@@ -361,3 +361,15 @@ let assemble_file infile outfile =
                  " -o " ^ Filename.quote outfile ^ " " ^ Filename.quote infile)
 
 let init () = ()
+
+let operation_supported = function
+  | Capply _ | Cextcall _ | Cload _ | Calloc | Cstore _
+  | Caddi | Csubi | Cmuli | Cmulhi | Cdivi | Cmodi
+  | Cand | Cor | Cxor | Clsl | Clsr | Casr
+  | Ccmpi _ | Caddv | Cadda | Ccmpa _
+  | Cnegf | Cabsf | Caddf | Csubf | Cmulf | Cdivf
+  | Cfloatofint | Cintoffloat | Ccmpf _
+  | Craise _
+  | Ccheckbound
+  | Cprobe _ | Cprobe_is_enabled _
+    -> true

backend/proc.mli

@@ -81,3 +81,9 @@ val assemble_file: string -> string -> int
 
 (* Called before translating a fundecl. *)
 val init : unit -> unit
+
+(** [operation_supported op] returns true when [op]
+    can be implemented directly with a hardware instruction.
+    Used in Cmmgen when converting [@@builtin] external calls
+    to primitive operations. *)
+val operation_supported : Cmm.operation -> bool

backend/riscv/proc.ml

@@ -320,3 +320,15 @@ let assemble_file infile outfile =
     (Config.asm ^ " -o " ^ Filename.quote outfile ^ " " ^ Filename.quote infile)
 
 let init () = ()
+
+let operation_supported = function
+  | Capply _ | Cextcall _ | Cload _ | Calloc | Cstore _
+  | Caddi | Csubi | Cmuli | Cmulhi | Cdivi | Cmodi
+  | Cand | Cor | Cxor | Clsl | Clsr | Casr
+  | Ccmpi _ | Caddv | Cadda | Ccmpa _
+  | Cnegf | Cabsf | Caddf | Csubf | Cmulf | Cdivf
+  | Cfloatofint | Cintoffloat | Ccmpf _
+  | Craise _
+  | Ccheckbound
+  | Cprobe _ | Cprobe_is_enabled _
+    -> true

backend/s390x/proc.ml

@@ -237,3 +237,15 @@ let assemble_file infile outfile =
                  " -o " ^ Filename.quote outfile ^ " " ^ Filename.quote infile)
 
 let init () = ()
+
+let operation_supported = function
+  | Capply _ | Cextcall _ | Cload _ | Calloc | Cstore _
+  | Caddi | Csubi | Cmuli | Cmulhi | Cdivi | Cmodi
+  | Cand | Cor | Cxor | Clsl | Clsr | Casr
+  | Ccmpi _ | Caddv | Cadda | Ccmpa _
+  | Cnegf | Cabsf | Caddf | Csubf | Cmulf | Cdivf
+  | Cfloatofint | Cintoffloat | Ccmpf _
+  | Craise _
+  | Ccheckbound
+  | Cprobe _ | Cprobe_is_enabled _
+    -> true