flambda-backend: Refactor and correct the "is pure" and "can raise" (…

…port upstream PR#10354 and PR#10387) (#555)

* Refactor Proc.op_is_pure and fix Mach.operation_can_raise

These two predicates test properties of Mach operations.  For the
standard operations, the results are independent of the target
platform.  For the platform-specific operations, results vary.

The "is pure" predicate was implemented in a platform-specific file,
$ARCH/proc.ml. The treatment of standard operations was duplicated.

The "can raise" predicate was implemented in a platform-independent file,
mach.ml.  All specific operations were assumed not to raise, which is
incorrect for ARM and ARM64 and their "shiftcheckbound" specific operation.
(See #10339.)

This commit refactors the two predicates as follows:
- `Arch.operation_is_pure` and `Arch.operation_can_raise` predicates
  are added to each platform description file.  They deal with
  specific operations only.
- `Mach.operation_is_pure` was added and `Mach.operation_can_raise`
  was fixed to implement the test for standard operations and
  delegate to the Arch functions for specific operations.

* Fix handling of exception-raising specific operations during spilling

The ARM and ARM64 architectures have `Ishiftcheckbound` specific instructions
that can raise an Invalid_argument exception.  This exception can, in turn,
be handled in the same function (see PR#10339 for an example).

However, these specific instructions were not taken into account
during insertion of spill code in asmcomp/spill.ml.  The consequence
is a variable that is reloaded from stack in the exception handler,
yet has not been spilled to stack before.

This commit fixes the issue by using the recently-fixed
`Mach.operation_can_raise` predicate to handle operations during spill
code insertion, instead of an ad-hoc pattern-matching.

Fixes: PR#10339

* Fix handling of exception-raising specific operations during liveness analysis (#10387)

This is a follow-up to 15e6354 and #10354.

Use the `Mach.operation_can_raise` predicate instead of an ad-hoc
pattern matching to spot operations where the variables live at entry
to the enclosing exception handler must also be live.

The ad-hoc pattern matching was missing the `Ishiftcheckbound`
specific operations of ARM and ARM64.

* Handle flambda-backend operations

* Update cfg

* Iprobe_is_enabled is pure

* Exhaustive match

* Fix after rebase

* Fix arm64 after rebase and cleanup

Co-authored-by: Xavier Leroy <xavier.leroy@college-de-france.fr>
Co-authored-by: Xavier Leroy <xavierleroy@users.noreply.github.com>

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

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 =

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

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 =

asmcomp/arm64/arch.ml

@@ -241,3 +241,24 @@ let logical_imm_length x =
 
 let is_logical_immediate x =
   x <> 0n && x <> -1n && run_automata (logical_imm_length x) 0 x
+
+(* Specific operations that are pure *)
+
+let operation_is_pure = function
+  | Ifar_alloc _
+  | Ifar_intop_checkbound
+  | Ifar_intop_imm_checkbound _
+  | Ishiftcheckbound _
+  | Ifar_shiftcheckbound _ -> false
+  | _ -> true
+
+(* Specific operations that can raise *)
+
+let operation_can_raise = function
+  | Ifar_alloc _
+  | Ifar_intop_checkbound
+  | Ifar_intop_imm_checkbound _
+  | Ishiftcheckbound _
+  | Ifar_shiftcheckbound _ -> true
+  | _ -> false
+

asmcomp/arm64/proc.ml

@@ -292,17 +292,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 fd =
   fd.fun_contains_calls

asmcomp/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 *)

asmcomp/i386/arch.ml

@@ -162,3 +162,15 @@ let stack_alignment =
   | "win32" -> 4     (* MSVC *)
   | _ -> 16
   (* PR#6038: GCC and Clang seem to require 16-byte alignment nowadays *)
+
+(* Specific operations that are pure *)
+
+let operation_is_pure = function
+  | Ilea _ -> true
+  | _ -> false
+(* x87 floating-point operations are not pure because they push and pop
+   on the FP stack as a side effect *)
+
+(* Specific operations that can raise *)
+
+let operation_can_raise _ = false

asmcomp/i386/proc.ml

@@ -225,18 +225,6 @@ let max_register_pressure = function
     Iintoffloat -> [| 6; max_int |]
   | _ -> [|7; max_int |]
 
-(* 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 _) -> true
-  | Ispecific _ -> false
-  | Ibeginregion | Iendregion -> false
-  | _ -> true
-
 (* Layout of the stack frame *)
 
 let frame_required fd =

asmcomp/liveness.ml

@@ -44,7 +44,7 @@ let rec live i finally =
       Reg.set_of_array i.arg
   | Iop op ->
       let after = live 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 *)
@@ -55,19 +55,14 @@ let rec live i finally =
       end else begin
         let across_after = Reg.diff_set_array after i.res in
         let across =
-          match op with
-          | 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 !live_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 !live_at_raise
+          else across_after in
         i.live <- across;
         Reg.add_set_array across i.arg
       end

asmcomp/mach.ml

@@ -160,10 +160,21 @@ let rec instr_iter f i =
       | _ ->
           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
+  | _ -> true
+
 let operation_can_raise op =
   match op with
   | Icall_ind | Icall_imm _ | Iextcall _
   | Iintop (Icheckbound) | Iintop_imm (Icheckbound, _)
   | Iprobe _
   | Ialloc _ -> true
+  | Ispecific sop -> Arch.operation_can_raise sop
   | _ -> false

asmcomp/mach.mli

@@ -116,4 +116,11 @@ 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. *)

asmcomp/power/arch.ml

@@ -115,3 +115,11 @@ let print_specific_operation printreg op ppf arg =
         printreg arg.(0) printreg arg.(1) printreg arg.(2)
   | Ialloc_far { bytes; _ } ->
       fprintf ppf "alloc_far %d" bytes
+
+(* Specific operations that are pure *)
+
+let operation_is_pure _ = true
+
+(* Specific operations that can raise *)
+
+let operation_can_raise _ = false

asmcomp/power/proc.ml

@@ -328,17 +328,6 @@ let max_register_pressure = function
     Iextcall _ -> [| 14; 18 |]
   | _ -> [| 23; 30 |]
 
-(* 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(Imultaddf | Imultsubf) -> true
-  | Ispecific _ -> false
-  | _ -> true
-
 (* Layout of the stack *)
 
 (* See [reserved_stack_space] in emit.mlp. *)

asmcomp/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 : Mach.fundecl -> bool
 

asmcomp/riscv/arch.ml

@@ -82,3 +82,11 @@ let print_specific_operation printreg op ppf arg =
   | Imultsubf true ->
       fprintf ppf "-f (%a *f %a -f %a)"
         printreg arg.(0) printreg arg.(1) printreg arg.(2)
+
+(* Specific operations that are pure *)
+
+let operation_is_pure _ = true
+
+(* Specific operations that can raise *)
+
+let operation_can_raise _ = false

asmcomp/riscv/proc.ml

@@ -274,16 +274,6 @@ let max_register_pressure = function
   | Iextcall _ -> [| 9; 12 |]
   | _ -> [| 23; 30 |]
 
-(* 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, _) -> false
-  | Ispecific(Imultaddf _ | Imultsubf _) -> true
-  | _ -> true
-
 (* Layout of the stack *)
 
 let frame_required fd =

asmcomp/s390x/arch.ml

@@ -87,3 +87,11 @@ let print_specific_operation printreg op ppf arg =
   | Imultsubf ->
       fprintf ppf "%a *f %a -f %a"
         printreg arg.(0) printreg arg.(1) printreg arg.(2)
+
+(* Specific operations that are pure *)
+
+let operation_is_pure _ = true
+
+(* Specific operations that can raise *)
+
+let operation_can_raise _ = false

asmcomp/s390x/proc.ml

@@ -219,16 +219,6 @@ let max_register_pressure = function
     Iextcall _ -> [| 4; 7 |]
   | _ -> [| 9; 15 |]
 
-(* 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(Imultaddf | Imultsubf) -> true
-  | _ -> true
-
 (* Layout of the stack *)
 
 let frame_required fd =

asmcomp/spill.ml

@@ -301,17 +301,13 @@ let rec spill i finally =
       let before1 = Reg.diff_set_array after i.res in
       (instr_cons i.desc i.arg i.res new_next,
        Reg.add_set_array before1 i.res)
-  | Iop _ ->
+  | Iop op ->
       let (new_next, after) = spill i.next finally in
       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 (Iprobe _)
-        | Iop(Iintop (Icheckbound)) | Iop(Iintop_imm(Icheckbound, _)) ->
-            Reg.Set.union before1 !spill_at_raise
-        | _ ->
-            before1 in
+        if operation_can_raise op
+        then Reg.Set.union before1 !spill_at_raise
+        else before1 in
       (instr_cons_debug i.desc i.arg i.res i.dbg
                   (add_spills (Reg.inter_set_array after i.res) new_next),
        before)

testsuite/tests/asmcomp/try_checkbound.ml

@@ -0,0 +1,12 @@
+(* TEST *)
+
+(* See PR#10339 *)
+
+let access (a: string array) n =
+  try
+    ignore (a.(n)); -1
+  with _ ->
+    n
+
+let _ =
+  assert (access [||] 1 = 1)