Add value<->native_pointer intrinsics (#855)

* add value<->native_pointer builtins
* add Cintofvalue/Cvalueofint and onwards
* update cmm parser
* allow allocating two registers
* reload intofvalue/valueofint allow stack operands
* make the new ops not pure

Co-authored-by: Xavier Clerc <xclerc@users.noreply.github.com>

backend/CSEgen.ml

@@ -246,7 +246,7 @@ method class_of_operation op =
   | Iintop_imm(_, _) -> Op_pure
   | Icompf _
   | Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf
-  | Ifloatofint | Iintoffloat -> Op_pure
+  | Ifloatofint | Iintoffloat | Ivalueofint | Iintofvalue -> Op_pure
   | Ispecific _ -> Op_other
   | Iname_for_debugger _ -> Op_pure
   | Iprobe_is_enabled _ -> Op_other

backend/amd64/CSE.ml

@@ -34,7 +34,7 @@ method! class_of_operation op =
     | Ioffset_loc(_, _) -> Op_store true
     | Ifloatarithmem _ | Ifloatsqrtf _ -> Op_load Mutable
     | Ibswap _ | Isqrtf -> super#class_of_operation op
-    | Irdtsc | Irdpmc 
+    | Irdtsc | Irdpmc
     | Ilfence | Isfence | Imfence -> Op_other
     | Ifloat_iround | Ifloat_min | Ifloat_max | Ifloat_round _
     | Icrc32q -> Op_pure
@@ -43,7 +43,8 @@ method! class_of_operation op =
     end
   | Imove | Ispill | Ireload | Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf
   | Icompf _
-  | Ifloatofint | Iintoffloat | Iconst_int _ | Iconst_float _ | Iconst_symbol _
+  | Ifloatofint | Iintoffloat | Ivalueofint | Iintofvalue
+  | Iconst_int _ | Iconst_float _ | Iconst_symbol _
   | Icall_ind | Icall_imm _ | Itailcall_ind | Itailcall_imm _ | Iextcall _
   | Istackoffset _ | Iload _ | Istore _ | Ialloc _
   | Iintop _ | Iintop_imm _

backend/amd64/cfg_stack_operands.ml

@@ -194,7 +194,7 @@ let basic (map : spilled_map) (instr : Cfg.basic Cfg.instruction) =
   | Op (Intop (Ipopcnt | Iclz _| Ictz _))
   | Op (Move | Spill | Reload | Negf | Absf | Const_float _ | Compf _ | Stackoffset _
        | Load _ | Store _ | Name_for_debugger _ | Probe_is_enabled _
-       | Opaque | Begin_region | End_region )
+       | Valueofint | Intofvalue | Opaque | Begin_region | End_region )
   | Op (Specific (Isqrtf | Isextend32 | Izextend32 | Ilea _
                  | Istore_int (_, _, _)
                  | Ioffset_loc (_, _) | Ifloatarithmem (_, _)

backend/amd64/emit.mlp

@@ -908,6 +908,8 @@ let emit_instr fallthrough i =
       I.cvtsi2sd  (arg i 0)  (res i 0)
   | Lop(Iintoffloat) ->
       I.cvttsd2si (arg i 0) (res i 0)
+  | Lop(Iintofvalue | Ivalueofint) ->
+      move i.arg.(0) i.res.(0)
   | Lop(Iopaque) ->
       assert (i.arg.(0).loc = i.res.(0).loc)
   | Lop(Ispecific(Ilea addr)) ->

backend/amd64/proc.ml

@@ -360,6 +360,7 @@ let destroyed_at_oper = function
   | Iop(Imove | Ispill | Ireload | Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf
        | Icompf _
        | Ifloatofint | Iintoffloat
+       | Ivalueofint | Iintofvalue
        | Iconst_int _ | Iconst_float _ | Iconst_symbol _
        | Itailcall_ind | Itailcall_imm _ | Istackoffset _ | Iload (_, _, _)
        | Iname_for_debugger _ | Iprobe _| Iprobe_is_enabled _ | Iopaque)
@@ -411,6 +412,7 @@ let destroyed_at_basic (basic : Cfg_intf.S.basic) =
        | Negf | Absf | Addf | Subf | Mulf | Divf
        | Compf _
        | Floatofint | Intoffloat
+       | Valueofint | Intofvalue
        | Probe _
        | Probe_is_enabled _
        | Opaque
@@ -449,7 +451,8 @@ let destroyed_at_terminator (terminator : Cfg_intf.S.terminator) =
 let safe_register_pressure = function
     Iextcall _ -> if win64 then if fp then 7 else 8 else 0
   | Ialloc _ | Imove | Ispill | Ireload
-  | Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf | Ifloatofint | Iintoffloat
+  | Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf
+  | Ifloatofint | Iintoffloat | Ivalueofint | Iintofvalue
   | Icompf _
   | Iconst_int _ | Iconst_float _ | Iconst_symbol _
   | Icall_ind | Icall_imm _ | Itailcall_ind | Itailcall_imm _
@@ -486,7 +489,8 @@ let max_register_pressure =
             | Double ),
             _, _)
   | Imove | Ispill | Ireload | Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf
-  | Ifloatofint | Iintoffloat | Iconst_int _ | Iconst_float _ | Iconst_symbol _
+  | Ifloatofint | Iintoffloat | Ivalueofint | Iintofvalue
+  | Iconst_int _ | Iconst_float _ | Iconst_symbol _
   | Icall_ind | Icall_imm _ | Itailcall_ind | Itailcall_imm _
   | Istackoffset _ | Iload (_, _, _)
   | Ispecific(Ilea _ | Isextend32 | Izextend32 | Iprefetch _ | Ipause
@@ -530,7 +534,9 @@ let operation_supported = function
   | Cclz _ | Cctz _
   | Ccmpi _ | Caddv | Cadda | Ccmpa _
   | Cnegf | Cabsf | Caddf | Csubf | Cmulf | Cdivf
-  | Cfloatofint | Cintoffloat | Ccmpf _
+  | Cfloatofint | Cintoffloat
+  | Cvalueofint | Cintofvalue
+  | Ccmpf _
   | Craise _
   | Ccheckbound
   | Cprobe _ | Cprobe_is_enabled _ | Copaque | Cbeginregion | Cendregion

backend/amd64/reload.ml

@@ -158,7 +158,7 @@ method! reload_operation op arg res =
   | Icompf _
   | Itailcall_ind|Itailcall_imm _|Iextcall _|Istackoffset _|Iload (_, _, _)
   | Istore (_, _, _)|Ialloc _|Iname_for_debugger _|Iprobe _|Iprobe_is_enabled _
-  | Iopaque
+  | Ivalueofint | Iintofvalue | Iopaque
   | Ibeginregion | Iendregion
     -> (* Other operations: all args and results in registers,
           except moves and probes. *)

backend/amd64/selection.ml

@@ -153,7 +153,8 @@ let pseudoregs_for_operation op arg res =
               |Ifloat_iround|Ifloat_round _
               |Ipause|Ilfence|Isfence|Imfence
               |Ioffset_loc (_, _)|Ifloatsqrtf _|Irdtsc|Iprefetch _)
-  | Imove|Ispill|Ireload|Ifloatofint|Iintoffloat|Iconst_int _|Iconst_float _
+  | Imove|Ispill|Ireload|Ifloatofint|Iintoffloat|Ivalueofint|Iintofvalue
+  | Iconst_int _|Iconst_float _
   | Iconst_symbol _|Icall_ind|Icall_imm _|Itailcall_ind|Itailcall_imm _
   | Iextcall _|Istackoffset _|Iload (_, _, _) | Istore (_, _, _)|Ialloc _
   | Iname_for_debugger _|Iprobe _|Iprobe_is_enabled _ | Iopaque
@@ -324,11 +325,11 @@ method! select_operation op args dbg =
          Ispecific Ifloat_max, args
       | "caml_pause_hint", ([|Val|] | [| |]) ->
          Ispecific Ipause, args
-      | "caml_load_fence", ([|Val|] | [| |]) -> 
+      | "caml_load_fence", ([|Val|] | [| |]) ->
          Ispecific Ilfence, args
-      | "caml_store_fence", ([|Val|] | [| |]) -> 
+      | "caml_store_fence", ([|Val|] | [| |]) ->
          Ispecific Isfence, args
-      | "caml_memory_fence", ([|Val|] | [| |]) -> 
+      | "caml_memory_fence", ([|Val|] | [| |]) ->
          Ispecific Imfence, args
       | _ ->
         super#select_operation op args dbg

backend/arm64/emit.mlp

@@ -524,6 +524,7 @@ module BR = Branch_relaxation.Make (struct
     | Lop (Iintop _) -> 1
     | Lop (Iintop_imm _) -> 1
     | Lop (Ifloatofint | Iintoffloat | Iabsf | Inegf | Ispecific Isqrtf) -> 1
+    | Lop (Ivalueofint | Iintofvalue) -> 1
     | Lop (Iaddf | Isubf | Imulf | Idivf | Ispecific Inegmulf) -> 1
     | Lop (Iopaque) -> 0
     | Lop (Ispecific (Imuladdf | Inegmuladdf | Imulsubf | Inegmulsubf)) -> 1
@@ -863,6 +864,19 @@ let emit_instr i =
                      | Ispecific Isqrtf -> "fsqrt"
                      | _                -> assert false) in
         `	{emit_string instr}	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n`
+    | Lop(Ivalueofint | Iintofvalue) ->
+        let src = i.arg.(0) and dst = i.res.(0) in
+        if src.loc <> dst.loc then begin
+          match (src, dst) with
+          | {loc = Reg _}, {loc = Reg _} ->
+              `	mov	{emit_reg dst}, {emit_reg src}\n`
+          | {loc = Reg _}, {loc = Stack _} ->
+              `	str	{emit_reg src}, {emit_stack dst}\n`
+          | {loc = Stack _}, {loc = Reg _} ->
+              `	ldr	{emit_reg dst}, {emit_stack src}\n`
+          | _ ->
+              assert false
+        end
     | Lop(Iaddf | Isubf | Imulf | Idivf | Ispecific Inegmulf as op) ->
         let instr = (match op with
                      | Iaddf              -> "fadd"

backend/arm64/proc.ml

@@ -362,7 +362,8 @@ let operation_supported = function
   | Cand | Cor | Cxor | Clsl | Clsr | Casr
   | Ccmpi _ | Caddv | Cadda | Ccmpa _
   | Cnegf | Cabsf | Caddf | Csubf | Cmulf | Cdivf
-  | Cfloatofint | Cintoffloat | Ccmpf _
+  | Cfloatofint | Cintoffloat | Cintofvalue | Cvalueofint
+  | Ccmpf _
   | Craise _
   | Ccheckbound
   | Cprobe _ | Cprobe_is_enabled _ | Copaque

backend/cfg/cfg.ml

@@ -227,6 +227,8 @@ let dump_op ?(specific = fun ppf _ -> Format.fprintf ppf "specific") ppf =
   | Compf _ -> Format.fprintf ppf "compf"
   | Floatofint -> Format.fprintf ppf "floattoint"
   | Intoffloat -> Format.fprintf ppf "intoffloat"
+  | Valueofint -> Format.fprintf ppf "valueofint"
+  | Intofvalue -> Format.fprintf ppf "intofvalue"
   | Specific op -> specific ppf op
   | Probe { name; handler_code_sym } ->
     Format.fprintf ppf "probe %s %s" name handler_code_sym
@@ -376,6 +378,8 @@ let can_raise_operation : operation -> bool = function
   | Compf _ -> false
   | Floatofint -> false
   | Intoffloat -> false
+  | Valueofint -> false
+  | Intofvalue -> false
   | Probe _ -> true
   | Probe_is_enabled _ -> false
   | Specific op -> Arch.operation_can_raise op
@@ -424,6 +428,10 @@ let is_pure_operation : operation -> bool = function
   | Compf _ -> true
   | Floatofint -> true
   | Intoffloat -> true
+  (* Conservative to ensure valueofint/intofvalue are not eliminated before
+     emit. *)
+  | Valueofint -> false
+  | Intofvalue -> false
   | Probe _ -> false
   | Probe_is_enabled _ -> true
   | Opaque -> false
@@ -461,9 +469,9 @@ let is_noop_move instr =
   | Op
       ( Const_int _ | Const_float _ | Const_symbol _ | Stackoffset _ | Load _
       | Store _ | Intop _ | Intop_imm _ | Negf | Absf | Addf | Subf | Mulf
-      | Divf | Compf _ | Floatofint | Intoffloat | Probe _ | Opaque
-      | Probe_is_enabled _ | Specific _ | Name_for_debugger _ | Begin_region
-      | End_region )
+      | Divf | Compf _ | Floatofint | Intoffloat | Intofvalue | Valueofint
+      | Probe _ | Opaque | Probe_is_enabled _ | Specific _ | Name_for_debugger _
+      | Begin_region | End_region )
   | Call _ | Reloadretaddr | Pushtrap _ | Poptrap | Prologue ->
     false
 

backend/cfg/cfg_equivalence.ml

@@ -237,6 +237,8 @@ let check_operation : location -> Cfg.operation -> Cfg.operation -> unit =
     ()
   | Floatofint, Floatofint -> ()
   | Intoffloat, Intoffloat -> ()
+  | Valueofint, Valueofint -> ()
+  | Intofvalue, Intofvalue -> ()
   | ( Probe
         { name = expected_name; handler_code_sym = expected_handler_code_sym },
       Probe { name = result_name; handler_code_sym = result_handler_code_sym } )

backend/cfg/cfg_intf.ml

@@ -75,6 +75,8 @@ module S = struct
     | Compf of Mach.float_comparison (* CR gyorsh: can merge with float_test? *)
     | Floatofint
     | Intoffloat
+    | Valueofint
+    | Intofvalue
     | Probe of
         { name : string;
           handler_code_sym : string

backend/cfg/cfg_irc_utils.ml

@@ -143,6 +143,8 @@ let is_move_basic : Cfg.basic -> bool =
     | Compf _ -> false
     | Floatofint -> false
     | Intoffloat -> false
+    | Valueofint -> false
+    | Intofvalue -> false
     | Probe _ -> false
     | Probe_is_enabled _ -> false
     | Opaque -> false

backend/cfg/cfg_regalloc_utils.ml

@@ -194,6 +194,8 @@ let precondition : Cfg_with_layout.t -> unit =
       | Compf _ -> ()
       | Floatofint -> ()
       | Intoffloat -> ()
+      | Valueofint -> ()
+      | Intofvalue -> ()
       | Probe _ -> ()
       | Probe_is_enabled _ -> ()
       | Opaque -> ()

backend/cfg/cfg_to_linear_desc.ml

@@ -39,6 +39,8 @@ let from_basic (basic : basic) : Linear.instruction_desc =
       | Compf c -> Icompf c
       | Floatofint -> Ifloatofint
       | Intoffloat -> Iintoffloat
+      | Valueofint -> Ivalueofint
+      | Intofvalue -> Iintofvalue
       | Probe { name; handler_code_sym } -> Iprobe { name; handler_code_sym }
       | Probe_is_enabled { name } -> Iprobe_is_enabled { name }
       | Opaque -> Iopaque

backend/cfg/cfgize.ml

@@ -180,6 +180,8 @@ let basic_or_terminator_of_operation :
   | Idivf -> Basic (Op Divf)
   | Ifloatofint -> Basic (Op Floatofint)
   | Iintoffloat -> Basic (Op Intoffloat)
+  | Ivalueofint -> Basic (Op Valueofint)
+  | Iintofvalue -> Basic (Op Intofvalue)
   | Ispecific op -> Basic (Op (Specific op))
   | Iopaque -> Basic (Op Opaque)
   | Iname_for_debugger _ ->
@@ -653,9 +655,9 @@ module Stack_offset_and_exn = struct
     | Op
         ( Move | Spill | Reload | Const_int _ | Const_float _ | Const_symbol _
         | Load _ | Store _ | Intop _ | Intop_imm _ | Negf | Absf | Addf | Subf
-        | Mulf | Divf | Compf _ | Floatofint | Intoffloat | Probe _
-        | Probe_is_enabled _ | Opaque | Begin_region | End_region | Specific _
-        | Name_for_debugger _ )
+        | Mulf | Divf | Compf _ | Floatofint | Intoffloat | Valueofint
+        | Intofvalue | Probe _ | Probe_is_enabled _ | Opaque | Begin_region
+        | End_region | Specific _ | Name_for_debugger _ )
     | Call _ | Reloadretaddr | Prologue ->
       stack_offset, traps, instr
 

backend/cfg/linear_to_cfg.ml

@@ -403,6 +403,8 @@ let to_basic (mop : Mach.operation) : C.basic =
   | Icompf c -> Op (Compf c)
   | Ifloatofint -> Op Floatofint
   | Iintoffloat -> Op Intoffloat
+  | Ivalueofint -> Op Valueofint
+  | Iintofvalue -> Op Intofvalue
   | Iopaque -> Op Opaque
   | Ibeginregion -> Op Begin_region
   | Iendregion -> Op End_region
@@ -592,8 +594,9 @@ let rec create_blocks (t : t) (i : L.instruction) (block : C.basic_block)
       let stack_offset = stack_offset + bytes in
       create_blocks t i.next block ~stack_offset ~traps
     | Imove | Ispill | Ireload | Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf
-    | Ifloatofint | Iintoffloat | Iconst_int _ | Iconst_float _ | Icompf _
-    | Iconst_symbol _ | Icall_ind | Icall_imm _ | Iextcall _
+    | Ifloatofint | Iintoffloat | Ivalueofint | Iintofvalue | Iconst_int _
+    | Iconst_float _ | Icompf _ | Iconst_symbol _ | Icall_ind | Icall_imm _
+    | Iextcall _
     | Iload (_, _, _)
     | Istore (_, _, _)
     | Ialloc _ | Iintop _

backend/checkmach.ml

@@ -317,7 +317,7 @@ end = struct
     match op with
     | Imove | Ispill | Ireload | Iconst_int _ | Iconst_float _ | Iconst_symbol _
     | Iload _ | Icompf _ | Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf
-    | Ifloatofint | Iintoffloat
+    | Ifloatofint | Iintoffloat | Ivalueofint | Iintofvalue
     | Iintop_imm
         ( ( Iadd | Isub | Imul | Imulh _ | Idiv | Imod | Iand | Ior | Ixor
           | Ilsl | Ilsr | Iasr | Ipopcnt | Iclz _ | Ictz _ | Icomp _ ),

backend/cmm.ml

@@ -200,6 +200,7 @@ and operation =
   | Cnegf | Cabsf
   | Caddf | Csubf | Cmulf | Cdivf
   | Cfloatofint | Cintoffloat
+  | Cvalueofint | Cintofvalue
   | Ccmpf of float_comparison
   | Craise of Lambda.raise_kind
   | Ccheckbound

backend/cmm.mli

@@ -202,6 +202,7 @@ and operation =
   | Cnegf | Cabsf
   | Caddf | Csubf | Cmulf | Cdivf
   | Cfloatofint | Cintoffloat
+  | Cvalueofint | Cintofvalue
   | Ccmpf of float_comparison
   | Craise of Lambda.raise_kind
   | Ccheckbound (* Takes two arguments : first the bound to check against,

backend/cmm_helpers.ml

@@ -2676,6 +2676,11 @@ let floatfield n ptr dbg =
       dbg )
 
 let int_as_pointer arg dbg = Cop (Caddi, [arg; Cconst_int (-1, dbg)], dbg)
+
+let int_of_value arg dbg = Cop (Cintofvalue, [arg], dbg)
+
+let value_of_int arg dbg = Cop (Cvalueofint, [arg], dbg)
+
 (* always a pointer outside the heap *)
 
 let raise_prim raise_kind arg dbg =
@@ -3357,6 +3362,10 @@ let transl_builtin name args dbg =
   (* Native_pointer: handled as unboxed nativeint *)
   | "caml_ext_pointer_as_native_pointer" ->
     Some (int_as_pointer (one_arg name args) dbg)
+  | "caml_native_pointer_of_value" ->
+    Some (int_of_value (one_arg name args) dbg)
+  | "caml_native_pointer_to_value" ->
+    Some (value_of_int (one_arg name args) dbg)
   | "caml_native_pointer_load_immediate"
   | "caml_native_pointer_load_unboxed_nativeint" ->
     Some (Cop (Cload (Word_int, Mutable), args, dbg))

backend/comballoc.ml

@@ -86,7 +86,7 @@ let rec combine i allocstate =
           (instr_cons_debug i.desc i.arg i.res i.dbg newnext, s')
     end
   | Iop((Imove|Ispill|Ireload|Inegf|Iabsf|Iaddf|Isubf|Imulf|Idivf|Ifloatofint|
-         Iintoffloat|Iopaque|Iconst_int _|Iconst_float _|
+         Iintoffloat|Ivalueofint|Iintofvalue|Iopaque|Iconst_int _|Iconst_float _|
          Iconst_symbol _|Istackoffset _|Iload (_, _, _)|Istore (_, _, _)|Icompf _|
          Ispecific _|Iname_for_debugger _|Iprobe_is_enabled _))
   | Iop(Iintop(Iadd | Isub | Imul | Idiv | Imod | Iand | Ior | Ixor

backend/mach.ml

@@ -70,6 +70,7 @@ type operation =
   | Icompf of float_comparison
   | Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf
   | Ifloatofint | Iintoffloat
+  | Ivalueofint | Iintofvalue
   | Iopaque
   | Ispecific of Arch.specific_operation
   | Iname_for_debugger of { ident : Backend_var.t; which_parameter : int option;
@@ -175,7 +176,7 @@ let rec instr_iter f i =
             | Iintop _ | Iintop_imm _
             | Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf
             | Icompf _
-            | Ifloatofint | Iintoffloat
+            | Ifloatofint | Iintoffloat | Ivalueofint | Iintofvalue
             | Ispecific _ | Iname_for_debugger _ | Iprobe _ | Iprobe_is_enabled _
             | Iopaque
             | Ibeginregion | Iendregion) ->
@@ -184,7 +185,9 @@ let rec instr_iter f i =
 let operation_is_pure = function
   | Icall_ind | Icall_imm _ | Itailcall_ind | Itailcall_imm _
   | Iextcall _ | Istackoffset _ | Istore _ | Ialloc _
-  | Iintop(Icheckbound) | Iintop_imm(Icheckbound, _) | Iopaque -> false
+  | Iintop(Icheckbound) | Iintop_imm(Icheckbound, _) | Iopaque
+  (* Conservative to ensure valueofint/intofvalue are not eliminated before emit. *)
+  | Ivalueofint | Iintofvalue -> false
   | Ibeginregion | Iendregion -> false
   | Iprobe _ -> false
   | Iprobe_is_enabled _-> true
@@ -195,7 +198,8 @@ let operation_is_pure = function
           | Ilsl | Ilsr | Iasr | Ipopcnt | Iclz _|Ictz _|Icomp _)
   | Imove | Ispill | Ireload | Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf
   | Icompf _
-  | Ifloatofint | Iintoffloat | Iconst_int _ | Iconst_float _ | Iconst_symbol _
+  | Ifloatofint | Iintoffloat
+  | Iconst_int _ | Iconst_float _ | Iconst_symbol _
   | Iload (_, _, _) | Iname_for_debugger _
     -> true
 
@@ -213,7 +217,8 @@ let operation_can_raise op =
           | Ilsl | Ilsr | Iasr | Ipopcnt | Iclz _|Ictz _|Icomp _)
   | Imove | Ispill | Ireload | Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf
   | Icompf _
-  | Ifloatofint | Iintoffloat | Iconst_int _ | Iconst_float _ | Iconst_symbol _
+  | Ifloatofint | Iintoffloat | Ivalueofint | Iintofvalue
+  | Iconst_int _ | Iconst_float _ | Iconst_symbol _
   | Istackoffset _ | Istore _  | Iload (_, _, _) | Iname_for_debugger _
   | Itailcall_imm _ | Itailcall_ind
   | Iopaque | Ibeginregion | Iendregion