Refactor and correct the "is pure" and "can raise" (port upstream PR#10354 and PR#10387)

backend/amd64/arch.ml

@@ -230,11 +230,32 @@ let print_specific_operation printreg op ppf arg =
         is_write (string_of_prefetch_temporal_locality_hint locality)
         printreg arg.(0)
 
+(* Are we using the Windows 64-bit ABI? *)
 let win64 =
   match Config.system with
   | "win64" | "mingw64" | "cygwin" -> true
   | _                   -> false
 
+(* Specific operations that are pure *)
+
+let operation_is_pure = function
+  | Ilea _ | Ibswap _ | Isqrtf | Isextend32 | Izextend32 -> true
+  | Ifloatarithmem _ | Ifloatsqrtf _ -> true
+  | Ifloat_iround | Ifloat_round _ | Ifloat_min | Ifloat_max -> true
+  | Icrc32q -> true
+  | Irdtsc | Irdpmc | Ipause | Istore_int (_, _, _) | Ioffset_loc (_, _)
+  | Iprefetch _ -> false
+
+(* Specific operations that can raise *)
+
+let operation_can_raise = function
+  | Ilea _ | Ibswap _ | Isqrtf | Isextend32 | Izextend32
+  | Ifloatarithmem _ | Ifloatsqrtf _
+  | Ifloat_iround | Ifloat_round _ | Ifloat_min | Ifloat_max
+  | Icrc32q | Irdtsc | Irdpmc | Ipause
+  | Istore_int (_, _, _) | Ioffset_loc (_, _)
+  | Iprefetch _ -> false
+
 open X86_ast
 
 (* Certain float conditions aren't represented directly in the opcode for
@@ -334,23 +355,3 @@ let equal_specific_operation left right =
     | Ifloat_iround | Ifloat_round _ | Ifloat_min | Ifloat_max | Ipause
     | Icrc32q | Iprefetch _), _ ->
     false
-
-let is_pure_specific : specific_operation -> bool = function
-  | Ilea _ -> true
-  | Istore_int _ -> false
-  | Ioffset_loc _ -> false
-  | Ifloatarithmem _ -> false
-  | Ibswap _ -> true
-  | Isqrtf -> true
-  | Ifloatsqrtf _ -> false
-  | Ifloat_iround -> true
-  | Ifloat_round _ -> true
-  | Ifloat_min -> true
-  | Ifloat_max -> true
-  | Isextend32 -> true
-  | Izextend32 -> true
-  | Irdtsc -> false
-  | Irdpmc -> false
-  | Icrc32q -> true
-  | Ipause -> false
-  | Iprefetch _ -> false

backend/amd64/proc.ml

@@ -426,32 +426,6 @@ let max_register_pressure =
   | Ibeginregion | Iendregion
     -> consumes ~int:0 ~float:0
 
-(* Pure operations (without any side effect besides updating their result
-   registers). *)
-
-let op_is_pure = function
-  | Icall_ind | Icall_imm _ | Itailcall_ind | Itailcall_imm _
-  | Iextcall _ | Istackoffset _ | Istore _ | Ialloc _
-  | Iintop(Icheckbound) | Iintop_imm(Icheckbound, _) | Iopaque -> false
-  | Ibeginregion | Iendregion -> false
-  | Ispecific(Ipause)
-  | Ispecific(Iprefetch _) -> false
-  | Ispecific(Ilea _ | Isextend32 | Izextend32 | Ifloat_iround | Ifloat_round _
-             | Ifloat_min | Ifloat_max) -> true
-  | Ispecific(Irdtsc | Irdpmc | Icrc32q | Istore_int (_, _, _)
-             | Ioffset_loc (_, _) | Ifloatarithmem (_, _)
-             | Ibswap _ | Ifloatsqrtf _ | Isqrtf)-> false
-  | Iprobe _ | Iprobe_is_enabled _-> false
-  | Iintop(Iadd | Isub | Imul | Imulh _ | Idiv | Imod | Iand | Ior | Ixor
-          | Ilsl | Ilsr | Iasr | Ipopcnt | Iclz _|Ictz _|Icomp _)
-  | Iintop_imm((Iadd | Isub | Imul | Imulh _ | Idiv | Imod | Iand | Ior | Ixor
-               | 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 _
-  | Iload (_, _, _) | Iname_for_debugger _
-    -> true
-
 (* Layout of the stack frame *)
 
 let frame_required ~fun_contains_calls ~fun_num_stack_slots =

backend/arm64/arch.ml

@@ -301,7 +301,9 @@ let logical_imm_length x =
 let is_logical_immediate x =
   x <> 0n && x <> -1n && run_automata (logical_imm_length x) 0 x
 
-let is_pure_specific : specific_operation -> bool = function
+(* Specific operations that are pure *)
+
+let operation_is_pure : specific_operation -> bool = function
   | Ifar_alloc _ -> false
   | Ifar_intop_checkbound -> false
   | Ifar_intop_imm_checkbound _ -> false
@@ -319,3 +321,24 @@ let is_pure_specific : specific_operation -> bool = function
   | Ibswap _ -> true
   | Imove32 -> true
   | Isignext _ -> true
+
+(* Specific operations that can raise *)
+
+let operation_can_raise = function
+  | Ifar_alloc _
+  | Ifar_intop_checkbound
+  | Ifar_intop_imm_checkbound _
+  | Ishiftcheckbound _
+  | Ifar_shiftcheckbound _ -> true
+  | Imuladd
+  | Imulsub
+  | Inegmulf
+  | Imuladdf
+  | Inegmuladdf
+  | Imulsubf
+  | Inegmulsubf
+  | Isqrtf
+  | Imove32
+  | Ishiftarith (_, _)
+  | Isignext _
+  | Ibswap _ -> false

backend/arm64/proc.ml

@@ -293,17 +293,6 @@ let max_register_pressure = function
   | Iload(Single, _, _) | Istore(Single, _, _) -> [| 23; 31 |]
   | _ -> [| 23; 32 |]
 
-(* Pure operations (without any side effect besides updating their result
-   registers). *)
-
-let op_is_pure = function
-  | Icall_ind | Icall_imm _ | Itailcall_ind | Itailcall_imm _
-  | Iextcall _ | Istackoffset _ | Istore _ | Ialloc _
-  | Iintop(Icheckbound) | Iintop_imm(Icheckbound, _) | Iopaque
-  | Ibeginregion | Iendregion
-  | Ispecific(Ishiftcheckbound _) -> false
-  | _ -> true
-
 (* Layout of the stack *)
 let frame_required ~fun_contains_calls ~fun_num_stack_slots =
   fun_contains_calls

backend/cfg/cfg.ml

@@ -323,8 +323,8 @@ let can_raise_operation : operation -> bool = function
   | Floatofint -> false
   | Intoffloat -> false
   | Probe _ -> true
-  | Probe_is_enabled _ -> false (* CR xclerc for xclerc: double check *)
-  | Specific _ -> false (* CR xclerc for xclerc: double check *)
+  | Probe_is_enabled _ -> true
+  | Specific op -> Arch.operation_can_raise op
   | Opaque -> false
   | Name_for_debugger _ -> false
   | Begin_region -> false
@@ -375,7 +375,7 @@ let is_pure_operation : operation -> bool = function
   | Opaque -> false
   | Begin_region -> false
   | End_region -> false
-  | Specific s -> Arch.is_pure_specific s
+  | Specific s -> Arch.operation_is_pure s
   | Name_for_debugger _ -> true
 
 let is_pure_basic : basic -> bool = function

backend/deadcode.ml

@@ -43,7 +43,7 @@ let rec deadcode i =
       { i; regs; exits = Int.Set.empty; }
   | Iop op ->
       let s = deadcode i.next in
-      if Proc.op_is_pure op                     (* no side effects *)
+      if operation_is_pure op                  (* no side effects *)
       && Reg.disjoint_set_array s.regs i.res   (* results are not used after *)
       && not (Proc.regs_are_volatile i.arg)    (* no stack-like hard reg *)
       && not (Proc.regs_are_volatile i.res)    (*            is involved *)

backend/liveness.ml

@@ -101,7 +101,7 @@ let rec live env i finally =
       Reg.set_of_array i.arg
   | Iop op ->
       let after = live env i.next finally in
-      if Proc.op_is_pure op                    (* no side effects *)
+      if operation_is_pure op                    (* no side effects *)
       && Reg.disjoint_set_array after i.res    (* results are not used after *)
       && not (Proc.regs_are_volatile i.arg)    (* no stack-like hard reg *)
       && not (Proc.regs_are_volatile i.res)    (*            is involved *)
@@ -112,22 +112,14 @@ let rec live env i finally =
       end else begin
         let across_after = Reg.diff_set_array after i.res in
         let across =
-          match op with
-          | Iextcall { returns = false; _ } ->
-              (* extcalls that never return can raise an exception *)
-              env.at_raise
-          | Icall_ind | Icall_imm _ | Iextcall _ | Ialloc _
-          | Iprobe _
-          | Iintop (Icheckbound) | Iintop_imm(Icheckbound, _) ->
-              (* The function call may raise an exception, branching to the
-                 nearest enclosing try ... with. Similarly for bounds checks,
-                 probes and allocation (for the latter: finalizers may throw
-                 exceptions, as may signal handlers).
-                 Hence, everything that must be live at the beginning of
-                 the exception handler must also be live across this instr. *)
-               Reg.Set.union across_after env.at_raise
-           | _ ->
-               across_after in
+          (* Operations that can raise an exception (function calls,
+             bounds checks, allocations) can branch to the
+             nearest enclosing try ... with.
+             Hence, everything that must be live at the beginning of
+             the exception handler must also be live across this instr. *)
+          if operation_can_raise op
+          then Reg.Set.union across_after env.at_raise
+          else across_after in
         i.live <- across;
         Reg.add_set_array across i.arg
       end

backend/mach.ml

@@ -181,13 +181,44 @@ let rec instr_iter f i =
             | Ibeginregion | Iendregion) ->
         instr_iter f i.next
 
+let operation_is_pure = function
+  | Icall_ind | Icall_imm _ | Itailcall_ind | Itailcall_imm _
+  | Iextcall _ | Istackoffset _ | Istore _ | Ialloc _
+  | Iintop(Icheckbound) | Iintop_imm(Icheckbound, _) | Iopaque -> false
+  | Ibeginregion | Iendregion -> false
+  | Iprobe _ -> false
+  | Iprobe_is_enabled _-> true
+  | Ispecific sop -> Arch.operation_is_pure sop
+  | Iintop_imm((Iadd | Isub | Imul | Imulh _ | Idiv | Imod | Iand | Ior | Ixor
+               | Ilsl | Ilsr | Iasr | Ipopcnt | Iclz _|Ictz _|Icomp _), _)
+  | Iintop(Iadd | Isub | Imul | Imulh _ | Idiv | Imod | Iand | Ior | Ixor
+          | 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 _
+  | Iload (_, _, _) | Iname_for_debugger _
+    -> true
+
+
 let operation_can_raise op =
   match op with
   | Icall_ind | Icall_imm _ | Iextcall _
   | Iintop (Icheckbound) | Iintop_imm (Icheckbound, _)
   | Iprobe _
   | Ialloc _ -> true
-  | _ -> false
+  | Ispecific sop -> Arch.operation_can_raise sop
+  | Iintop_imm((Iadd | Isub | Imul | Imulh _ | Idiv | Imod | Iand | Ior | Ixor
+               | Ilsl | Ilsr | Iasr | Ipopcnt | Iclz _|Ictz _|Icomp _), _)
+  | Iintop(Iadd | Isub | Imul | Imulh _ | Idiv | Imod | Iand | Ior | Ixor
+          | 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 _
+  | Istackoffset _ | Istore _  | Iload (_, _, _) | Iname_for_debugger _
+  | Itailcall_imm _ | Itailcall_ind
+  | Iopaque | Ibeginregion | Iendregion
+  | Iprobe_is_enabled _
+    -> false
 
 let free_conts_for_handlers fundecl =
   let module S = Numbers.Int.Set in

backend/mach.mli

@@ -130,7 +130,14 @@ val instr_cons_debug:
         instruction -> instruction
 val instr_iter: (instruction -> unit) -> instruction -> unit
 
+val operation_is_pure : operation -> bool
+  (** Returns [true] if the given operation only produces a result
+      in its destination registers, but has no side effects whatsoever:
+      it doesn't raise exceptions, it doesn't modify already-allocated
+      blocks, it doesn't adjust the stack frame, etc. *)
+
 val operation_can_raise : operation -> bool
+  (** Returns [true] if the given operation can raise an exception. *)
 
 val free_conts_for_handlers : fundecl -> Numbers.Int.Set.t Numbers.Int.Map.t
 val equal_trap_stack : trap_stack -> trap_stack -> bool

backend/proc.mli

@@ -58,9 +58,6 @@ val destroyed_at_reloadretaddr : Reg.t array
 (* Volatile registers: those that change value when read *)
 val regs_are_volatile: Reg.t array -> bool
 
-(* Pure operations *)
-val op_is_pure: Mach.operation -> bool
-
 (* Info for laying out the stack frame *)
 val frame_required :
   fun_contains_calls:bool ->

backend/spill.ml

@@ -494,17 +494,13 @@ let rec spill :
       let before1 = Reg.diff_set_array after i.res in
       k (instr_cons i.desc i.arg i.res new_next)
         (Reg.add_set_array before1 i.res))
-  | Iop _ ->
+  | Iop op ->
     spill env i.next finally (fun new_next after ->
       let before1 = Reg.diff_set_array after i.res in
       let before =
-        match i.desc with
-          Iop Icall_ind | Iop(Icall_imm _) | Iop(Iextcall _) | Iop(Ialloc _)
-        | Iop(Iintop Icheckbound) | Iop(Iintop_imm(Icheckbound, _))
-        | Iop (Iprobe _) ->
-            Reg.Set.union before1 env.at_raise
-        | _ ->
-            before1 in
+        if operation_can_raise op
+        then Reg.Set.union before1 env.at_raise
+        else before1 in
       k (instr_cons_debug i.desc i.arg i.res i.dbg
                   (add_spills env (Reg.inter_set_array after i.res) new_next))
         before)

ocaml/asmcomp/amd64/arch.ml

@@ -134,7 +134,20 @@ let print_specific_operation printreg op ppf arg =
   | Izextend32 ->
       fprintf ppf "zextend32 %a" printreg arg.(0)
 
+(* Are we using the Windows 64-bit ABI? *)
+
 let win64 =
   match Config.system with
   | "win64" | "mingw64" | "cygwin" -> true
   | _                   -> false
+
+(* Specific operations that are pure *)
+
+let operation_is_pure = function
+  | Ilea _ | Ibswap _ | Isqrtf | Isextend32 | Izextend32 -> true
+  | Ifloatarithmem _ | Ifloatsqrtf _ -> true
+  | _ -> false
+
+(* Specific operations that can raise *)
+
+let operation_can_raise _ = false

ocaml/asmcomp/amd64/proc.ml

@@ -360,19 +360,6 @@ let max_register_pressure = function
     if fp then [| 12; 15 |] else [| 13; 15 |]
   | _ -> if fp then [| 12; 16 |] else [| 13; 16 |]
 
-(* Pure operations (without any side effect besides updating their result
-   registers). *)
-
-let op_is_pure = function
-  | Icall_ind | Icall_imm _ | Itailcall_ind | Itailcall_imm _
-  | Iextcall _ | Istackoffset _ | Istore _ | Ialloc _
-  | Iintop(Icheckbound) | Iintop_imm(Icheckbound, _) | Iopaque -> false
-  | Ispecific(Ilea _|Isextend32|Izextend32) -> true
-  | Ispecific _ -> false
-  | Iprobe _ | Iprobe_is_enabled _-> false
-  | Ibeginregion | Iendregion -> false
-  | _ -> true
-
 (* Layout of the stack frame *)
 
 let frame_required fd =

ocaml/asmcomp/arm/arch.ml

@@ -262,3 +262,15 @@ let is_immediate n =
     s := !s + 2
   done;
   !s <= m
+
+(* Specific operations that are pure *)
+
+let operation_is_pure = function
+  | Ishiftcheckbound _ -> false
+  | _ -> true
+
+(* Specific operations that can raise *)
+
+let operation_can_raise = function
+  | Ishiftcheckbound _ -> true
+  | _ -> false

ocaml/asmcomp/arm/proc.ml

@@ -340,16 +340,6 @@ let max_register_pressure = function
   | Iintop Imulh when !arch < ARMv6 -> [| 8; 16; 32 |]
   | _ -> [| 9; 16; 32 |]
 
-(* Pure operations (without any side effect besides updating their result
-   registers). *)
-
-let op_is_pure = function
-  | Icall_ind | Icall_imm _ | Itailcall_ind | Itailcall_imm _
-  | Iextcall _ | Istackoffset _ | Istore _ | Ialloc _
-  | Iintop(Icheckbound) | Iintop_imm(Icheckbound, _) | Iopaque
-  | Ispecific(Ishiftcheckbound _) -> false
-  | _ -> true
-
 (* Layout of the stack *)
 
 let frame_required fd =