New back-end optimization pass: dead code elimination.

(Removes arithmetic and load instructions whose results are unused.)
(Cherry-picked from branch backend-optim.)


git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14686 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

16 files changed, 232 insertions, 55 deletions

diff --git a/.depend b/.depend
index f0ecc73c2..9162031fa 100644
--- a/.depend
+++ b/.depend
@@ -1,4 +1,4 @@
-putils/ccomp.cmi :
+utils/ccomp.cmi :
 utils/clflags.cmi :
 utils/config.cmi :
 utils/consistbl.cmi :
@@ -455,15 +455,15 @@ bytecomp/bytesections.cmx : utils/misc.cmx utils/config.cmx \
 bytecomp/dll.cmo : utils/misc.cmi utils/config.cmi bytecomp/dll.cmi
 bytecomp/dll.cmx : utils/misc.cmx utils/config.cmx bytecomp/dll.cmi
 bytecomp/emitcode.cmo : bytecomp/translmod.cmi typing/primitive.cmi \
-    bytecomp/opcodes.cmo utils/misc.cmi bytecomp/meta.cmi bytecomp/lambda.cmi \
-    bytecomp/instruct.cmi typing/env.cmi utils/config.cmi \
-    bytecomp/cmo_format.cmi utils/clflags.cmi typing/btype.cmi \
-    parsing/asttypes.cmi bytecomp/emitcode.cmi
+    bytecomp/opcodes.cmo utils/misc.cmi bytecomp/meta.cmi \
+    parsing/location.cmi bytecomp/lambda.cmi bytecomp/instruct.cmi \
+    typing/env.cmi utils/config.cmi bytecomp/cmo_format.cmi utils/clflags.cmi \
+    typing/btype.cmi parsing/asttypes.cmi bytecomp/emitcode.cmi
 bytecomp/emitcode.cmx : bytecomp/translmod.cmx typing/primitive.cmx \
-    bytecomp/opcodes.cmx utils/misc.cmx bytecomp/meta.cmx bytecomp/lambda.cmx \
-    bytecomp/instruct.cmx typing/env.cmx utils/config.cmx \
-    bytecomp/cmo_format.cmi utils/clflags.cmx typing/btype.cmx \
-    parsing/asttypes.cmi bytecomp/emitcode.cmi
+    bytecomp/opcodes.cmx utils/misc.cmx bytecomp/meta.cmx \
+    parsing/location.cmx bytecomp/lambda.cmx bytecomp/instruct.cmx \
+    typing/env.cmx utils/config.cmx bytecomp/cmo_format.cmi utils/clflags.cmx \
+    typing/btype.cmx parsing/asttypes.cmi bytecomp/emitcode.cmi
 bytecomp/instruct.cmo : typing/types.cmi typing/subst.cmi \
     parsing/location.cmi bytecomp/lambda.cmi typing/ident.cmi typing/env.cmi \
     bytecomp/instruct.cmi
@@ -508,12 +508,12 @@ bytecomp/printlambda.cmx : typing/types.cmx typing/primitive.cmx \
     parsing/asttypes.cmi bytecomp/printlambda.cmi
 bytecomp/runtimedef.cmo : bytecomp/runtimedef.cmi
 bytecomp/runtimedef.cmx : bytecomp/runtimedef.cmi
-bytecomp/simplif.cmo : utils/tbl.cmi typing/stypes.cmi bytecomp/lambda.cmi \
-    typing/ident.cmi utils/clflags.cmi parsing/asttypes.cmi typing/annot.cmi \
-    bytecomp/simplif.cmi
-bytecomp/simplif.cmx : utils/tbl.cmx typing/stypes.cmx bytecomp/lambda.cmx \
-    typing/ident.cmx utils/clflags.cmx parsing/asttypes.cmi typing/annot.cmi \
-    bytecomp/simplif.cmi
+bytecomp/simplif.cmo : utils/tbl.cmi typing/stypes.cmi utils/misc.cmi \
+    bytecomp/lambda.cmi typing/ident.cmi utils/clflags.cmi \
+    parsing/asttypes.cmi typing/annot.cmi bytecomp/simplif.cmi
+bytecomp/simplif.cmx : utils/tbl.cmx typing/stypes.cmx utils/misc.cmx \
+    bytecomp/lambda.cmx typing/ident.cmx utils/clflags.cmx \
+    parsing/asttypes.cmi typing/annot.cmi bytecomp/simplif.cmi
 bytecomp/switch.cmo : bytecomp/switch.cmi
 bytecomp/switch.cmx : bytecomp/switch.cmi
 bytecomp/symtable.cmo : utils/tbl.cmi bytecomp/runtimedef.cmi \
@@ -592,6 +592,7 @@ asmcomp/coloring.cmi :
 asmcomp/comballoc.cmi : asmcomp/mach.cmi
 asmcomp/compilenv.cmi : typing/ident.cmi asmcomp/cmx_format.cmi \
     asmcomp/clambda.cmi
+asmcomp/deadcode.cmi : asmcomp/mach.cmi
 asmcomp/debuginfo.cmi : parsing/location.cmi bytecomp/lambda.cmi
 asmcomp/emit.cmi : asmcomp/linearize.cmi asmcomp/cmm.cmi
 asmcomp/emitaux.cmi : asmcomp/debuginfo.cmi
@@ -625,20 +626,20 @@ asmcomp/asmgen.cmo : bytecomp/translmod.cmi asmcomp/split.cmi \
     asmcomp/printlinear.cmi asmcomp/printcmm.cmi asmcomp/printclambda.cmi \
     typing/primitive.cmi utils/misc.cmi asmcomp/mach.cmi parsing/location.cmi \
     asmcomp/liveness.cmi asmcomp/linearize.cmi asmcomp/interf.cmi \
-    asmcomp/emitaux.cmi asmcomp/emit.cmi utils/config.cmi \
-    asmcomp/compilenv.cmi asmcomp/comballoc.cmi asmcomp/coloring.cmi \
-    asmcomp/cmmgen.cmi asmcomp/cmm.cmi asmcomp/closure.cmi utils/clflags.cmi \
-    asmcomp/asmgen.cmi
+    asmcomp/emitaux.cmi asmcomp/emit.cmi asmcomp/deadcode.cmi \
+    utils/config.cmi asmcomp/compilenv.cmi asmcomp/comballoc.cmi \
+    asmcomp/coloring.cmi asmcomp/cmmgen.cmi asmcomp/cmm.cmi \
+    asmcomp/closure.cmi utils/clflags.cmi asmcomp/asmgen.cmi
 asmcomp/asmgen.cmx : bytecomp/translmod.cmx asmcomp/split.cmx \
     asmcomp/spill.cmx asmcomp/selection.cmx asmcomp/scheduling.cmx \
     asmcomp/reload.cmx asmcomp/reg.cmx asmcomp/proc.cmx asmcomp/printmach.cmx \
     asmcomp/printlinear.cmx asmcomp/printcmm.cmx asmcomp/printclambda.cmx \
     typing/primitive.cmx utils/misc.cmx asmcomp/mach.cmx parsing/location.cmx \
     asmcomp/liveness.cmx asmcomp/linearize.cmx asmcomp/interf.cmx \
-    asmcomp/emitaux.cmx asmcomp/emit.cmx utils/config.cmx \
-    asmcomp/compilenv.cmx asmcomp/comballoc.cmx asmcomp/coloring.cmx \
-    asmcomp/cmmgen.cmx asmcomp/cmm.cmx asmcomp/closure.cmx utils/clflags.cmx \
-    asmcomp/asmgen.cmi
+    asmcomp/emitaux.cmx asmcomp/emit.cmx asmcomp/deadcode.cmx \
+    utils/config.cmx asmcomp/compilenv.cmx asmcomp/comballoc.cmx \
+    asmcomp/coloring.cmx asmcomp/cmmgen.cmx asmcomp/cmm.cmx \
+    asmcomp/closure.cmx utils/clflags.cmx asmcomp/asmgen.cmi
 asmcomp/asmlibrarian.cmo : utils/misc.cmi parsing/location.cmi \
     utils/config.cmi asmcomp/compilenv.cmi asmcomp/cmx_format.cmi \
     utils/clflags.cmi asmcomp/clambda.cmi utils/ccomp.cmi asmcomp/asmlink.cmi \
@@ -719,6 +720,10 @@ asmcomp/compilenv.cmo : utils/misc.cmi parsing/location.cmi typing/ident.cmi \
 asmcomp/compilenv.cmx : utils/misc.cmx parsing/location.cmx typing/ident.cmx \
     typing/env.cmx utils/config.cmx asmcomp/cmx_format.cmi \
     asmcomp/clambda.cmx asmcomp/compilenv.cmi
+asmcomp/deadcode.cmo : asmcomp/reg.cmi asmcomp/proc.cmi asmcomp/mach.cmi \
+    asmcomp/deadcode.cmi
+asmcomp/deadcode.cmx : asmcomp/reg.cmx asmcomp/proc.cmx asmcomp/mach.cmx \
+    asmcomp/deadcode.cmi
 asmcomp/debuginfo.cmo : parsing/location.cmi bytecomp/lambda.cmi \
     asmcomp/debuginfo.cmi
 asmcomp/debuginfo.cmx : parsing/location.cmx bytecomp/lambda.cmx \
@@ -983,18 +988,22 @@ toplevel/opttopmain.cmx : utils/warnings.cmx asmcomp/printmach.cmx \
     driver/compenv.cmx utils/clflags.cmx toplevel/opttopmain.cmi
 toplevel/opttopstart.cmo : toplevel/opttopmain.cmi
 toplevel/opttopstart.cmx : toplevel/opttopmain.cmx
-toplevel/topdirs.cmo : utils/warnings.cmi typing/types.cmi \
-    toplevel/trace.cmi toplevel/toploop.cmi bytecomp/symtable.cmi \
-    typing/printtyp.cmi typing/path.cmi bytecomp/opcodes.cmo utils/misc.cmi \
-    bytecomp/meta.cmi parsing/longident.cmi typing/ident.cmi typing/env.cmi \
-    bytecomp/dll.cmi typing/ctype.cmi utils/consistbl.cmi utils/config.cmi \
-    bytecomp/cmo_format.cmi utils/clflags.cmi toplevel/topdirs.cmi
-toplevel/topdirs.cmx : utils/warnings.cmx typing/types.cmx \
-    toplevel/trace.cmx toplevel/toploop.cmx bytecomp/symtable.cmx \
-    typing/printtyp.cmx typing/path.cmx bytecomp/opcodes.cmx utils/misc.cmx \
-    bytecomp/meta.cmx parsing/longident.cmx typing/ident.cmx typing/env.cmx \
-    bytecomp/dll.cmx typing/ctype.cmx utils/consistbl.cmx utils/config.cmx \
-    bytecomp/cmo_format.cmi utils/clflags.cmx toplevel/topdirs.cmi
+toplevel/topdirs.cmo : utils/warnings.cmi typing/typetexp.cmi \
+    typing/types.cmi toplevel/trace.cmi toplevel/toploop.cmi \
+    bytecomp/symtable.cmi typing/printtyp.cmi typing/path.cmi \
+    parsing/parsetree.cmi bytecomp/opcodes.cmo utils/misc.cmi \
+    bytecomp/meta.cmi parsing/longident.cmi parsing/location.cmi \
+    typing/ident.cmi typing/env.cmi bytecomp/dll.cmi typing/ctype.cmi \
+    utils/consistbl.cmi utils/config.cmi bytecomp/cmo_format.cmi \
+    utils/clflags.cmi toplevel/topdirs.cmi
+toplevel/topdirs.cmx : utils/warnings.cmx typing/typetexp.cmx \
+    typing/types.cmx toplevel/trace.cmx toplevel/toploop.cmx \
+    bytecomp/symtable.cmx typing/printtyp.cmx typing/path.cmx \
+    parsing/parsetree.cmi bytecomp/opcodes.cmx utils/misc.cmx \
+    bytecomp/meta.cmx parsing/longident.cmx parsing/location.cmx \
+    typing/ident.cmx typing/env.cmx bytecomp/dll.cmx typing/ctype.cmx \
+    utils/consistbl.cmx utils/config.cmx bytecomp/cmo_format.cmi \
+    utils/clflags.cmx toplevel/topdirs.cmi
 toplevel/toploop.cmo : utils/warnings.cmi typing/types.cmi \
     typing/typemod.cmi typing/typedtree.cmi typing/typecore.cmi \
     bytecomp/translmod.cmi bytecomp/symtable.cmi bytecomp/simplif.cmi \
diff --git a/Changes b/Changes
index 4a649b428..3f32d5dee 100644
--- a/Changes
+++ b/Changes
@@ -39,6 +39,8 @@ Compilers:
   int32/int64/nativeint arithmetic.  Constant propagation for floats
   can be turned off with option -no-float-const-prop, for codes that
   change FP rounding modes at run-time.
+- New back-end optimization pass: dead code elimination.
+  (Removes arithmetic and load instructions whose results are unused.)
 - PR#6269 Optimization of string matching (patch by Benoit Vaugon
   and Luc Maranget)
 - Experimental native code generator for AArch64 (ARM 64 bits)
diff --git a/Makefile b/Makefile
index ccddd149a..594c650e7 100644
--- a/Makefile
+++ b/Makefile
@@ -88,6 +88,7 @@ ASMCOMP=asmcomp/arch.cmo asmcomp/debuginfo.cmo \
   asmcomp/spill.cmo asmcomp/split.cmo \
   asmcomp/interf.cmo asmcomp/coloring.cmo \
   asmcomp/reloadgen.cmo asmcomp/reload.cmo \
+  asmcomp/deadcode.cmo \
   asmcomp/printlinear.cmo asmcomp/linearize.cmo \
   asmcomp/schedgen.cmo asmcomp/scheduling.cmo \
   asmcomp/emitaux.cmo asmcomp/emit.cmo asmcomp/asmgen.cmo \
diff --git a/asmcomp/amd64/proc.ml b/asmcomp/amd64/proc.ml
index b6e0fa94a..5d448df36 100644
--- a/asmcomp/amd64/proc.ml
+++ b/asmcomp/amd64/proc.ml
@@ -294,6 +294,17 @@ 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, _) -> false
+  | Ispecific(Ilea _) -> true
+  | Ispecific _ -> false
+  | _ -> true
+
 (* Layout of the stack frame *)
 
 let num_stack_slots = [| 0; 0 |]
diff --git a/asmcomp/arm/proc.ml b/asmcomp/arm/proc.ml
index a16c35a22..c49e3f087 100644
--- a/asmcomp/arm/proc.ml
+++ b/asmcomp/arm/proc.ml
@@ -225,6 +225,15 @@ let max_register_pressure = function
   | Iload(Single, _) | Istore(Single, _) -> [| 9; 15; 31 |]
   | _ -> [| 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, _) -> false
+  | _ -> true
+
 (* Layout of the stack *)
 
 let num_stack_slots = [| 0; 0; 0 |]
diff --git a/asmcomp/asmgen.ml b/asmcomp/asmgen.ml
index 34283875c..ab71d51a0 100644
--- a/asmcomp/asmgen.ml
+++ b/asmcomp/asmgen.ml
@@ -65,6 +65,7 @@ let compile_fundecl (ppf : formatter) fd_cmm =
   ++ Comballoc.fundecl
   ++ pass_dump_if ppf dump_combine "After allocation combining"
   ++ liveness ppf
+  ++ Deadcode.fundecl
   ++ pass_dump_if ppf dump_live "Liveness analysis"
   ++ Spill.fundecl
   ++ liveness ppf
diff --git a/asmcomp/deadcode.ml b/asmcomp/deadcode.ml
new file mode 100644
index 000000000..a92ab681c
--- /dev/null
+++ b/asmcomp/deadcode.ml
@@ -0,0 +1,66 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Gallium, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2012 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* $Id: linearize.ml 11156 2011-07-27 14:17:02Z doligez $ *)
+
+(* Dead code elimination: remove pure instructions whose results are
+   not used. *)
+
+open Mach
+
+(* [deadcode i] returns a pair of an optimized instruction [i']
+   and a set of registers live "before" instruction [i]. *)
+
+let rec deadcode i =
+  match i.desc with
+  | Iend | Ireturn | Iop(Itailcall_ind) | Iop(Itailcall_imm _) | Iraise _ ->
+      (i, Reg.add_set_array i.live i.arg)
+  | Iop op ->
+      let (s, before) = deadcode i.next in
+      if Proc.op_is_pure op
+      && Reg.disjoint_set_array before i.res then begin
+        assert (Array.length i.res > 0);  (* sanity check *)
+        (s, before)
+      end else begin
+        ({i with next = s}, Reg.add_set_array i.live i.arg)
+      end
+  | Iifthenelse(test, ifso, ifnot) ->
+      let (ifso', _) = deadcode ifso in
+      let (ifnot', _) = deadcode ifnot in
+      let (s, _) = deadcode i.next in
+      ({i with desc = Iifthenelse(test, ifso', ifnot'); next = s},
+       Reg.add_set_array i.live i.arg)
+  | Iswitch(index, cases) ->
+      let cases' = Array.map (fun c -> fst (deadcode c)) cases in
+      let (s, _) = deadcode i.next in
+      ({i with desc = Iswitch(index, cases'); next = s},
+       Reg.add_set_array i.live i.arg)
+  | Iloop(body) ->
+      let (body', _) = deadcode body in
+      let (s, _) = deadcode i.next in
+      ({i with desc = Iloop body'; next = s}, i.live)
+  | Icatch(nfail, body, handler) ->
+      let (body', _) = deadcode body in
+      let (handler', _) = deadcode handler in
+      let (s, _) = deadcode i.next in
+      ({i with desc = Icatch(nfail, body', handler'); next = s}, i.live)
+  | Iexit nfail ->
+      (i, i.live)
+  | Itrywith(body, handler) ->
+      let (body', _) = deadcode body in
+      let (handler', _) = deadcode handler in
+      let (s, _) = deadcode i.next in
+      ({i with desc = Itrywith(body', handler'); next = s}, i.live)
+
+let fundecl f =
+  let (new_body, _) = deadcode f.fun_body in
+  {f with fun_body = new_body}
diff --git a/asmcomp/deadcode.mli b/asmcomp/deadcode.mli
new file mode 100644
index 000000000..c313e1057
--- /dev/null
+++ b/asmcomp/deadcode.mli
@@ -0,0 +1,18 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Gallium, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2012 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* $Id: linearize.ml 11156 2011-07-27 14:17:02Z doligez $ *)
+
+(* Dead code elimination: remove pure instructions whose results are
+   not used. *)
+
+val fundecl: Mach.fundecl -> Mach.fundecl
diff --git a/asmcomp/i386/proc.ml b/asmcomp/i386/proc.ml
index d80d18208..38bfdb29f 100644
--- a/asmcomp/i386/proc.ml
+++ b/asmcomp/i386/proc.ml
@@ -182,6 +182,20 @@ let max_register_pressure = function
     Iintoffloat -> [| 6; max_int |]
   | _ -> [|7; max_int |]
 
+(* Pure operations (without any side effect besides updating their result
+   registers).  Note that floating-point operations are not pure
+   because they update the float stack. *)
+
+let op_is_pure = function
+  | Icall_ind | Icall_imm _ | Itailcall_ind | Itailcall_imm _
+  | Iextcall _ | Istackoffset _ | Istore _ | Ialloc _
+  | Iintop(Icheckbound) | Iintop_imm(Icheckbound, _) -> false
+  | Iconst_float _ | Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf
+  | Iintoffloat | Ifloatofint | Iload((Single | Double | Double_u), _) -> false
+  | Ispecific(Ilea _) -> true
+  | Ispecific _ -> false
+  | _ -> true
+
 (* Layout of the stack frame *)
 
 let num_stack_slots = [| 0; 0 |]
diff --git a/asmcomp/liveness.ml b/asmcomp/liveness.ml
index 434d50655..7e3f1fe08 100644
--- a/asmcomp/liveness.ml
+++ b/asmcomp/liveness.ml
@@ -16,13 +16,13 @@
 open Mach
 
 let live_at_exit = ref []
+
 let find_live_at_exit k =
   try
     List.assoc k !live_at_exit
   with
-  | Not_found -> Misc.fatal_error "Spill.find_live_at_exit"
+  | Not_found -> Misc.fatal_error "Liveness.find_live_at_exit"
 
-let live_at_break = ref Reg.Set.empty
 let live_at_raise = ref Reg.Set.empty
 
 let rec live i finally =
@@ -37,8 +37,30 @@ let rec live i finally =
       i.live <- finally;
       finally
   | Ireturn | Iop(Itailcall_ind) | Iop(Itailcall_imm _) ->
-      (* i.live remains empty since no regs are live across *)
+      i.live <- Reg.Set.empty; (* no regs are live across *)
       Reg.set_of_array i.arg
+  | Iop op ->
+      let after = live i.next finally in
+      if Proc.op_is_pure op && Reg.disjoint_set_array after i.res then begin
+        (* This operation is dead code.  Ignore its arguments. *)
+        i.live <- after;
+        after
+      end else begin
+        let across_after = Reg.diff_set_array after i.res in
+        let across =
+          match op with
+          | Icall_ind | Icall_imm _ | Iextcall _
+          | Iintop Icheckbound | Iintop_imm(Icheckbound, _) ->
+              (* The function call may raise an exception, branching to the
+                 nearest enclosing try ... with. Similarly for bounds checks.
+                 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
+        i.live <- across;
+        Reg.add_set_array across i.arg
+      end
   | Iifthenelse(test, ifso, ifnot) ->
       let at_join = live i.next finally in
       let at_fork = Reg.Set.union (live ifso at_join) (live ifnot at_join) in
@@ -90,23 +112,8 @@ let rec live i finally =
       i.live <- before_body;
       before_body
   | Iraise _ ->
-      (* i.live remains empty since no regs are live across *)
+      i.live <- !live_at_raise;
       Reg.add_set_array !live_at_raise i.arg
-  | _ ->
-      let across_after = Reg.diff_set_array (live i.next finally) i.res in
-      let across =
-        match i.desc with
-          Iop Icall_ind | Iop(Icall_imm _) | Iop(Iextcall _)
-        | Iop(Iintop Icheckbound) | Iop(Iintop_imm(Icheckbound, _)) ->
-            (* The function call may raise an exception, branching to the
-               nearest enclosing try ... with. Similarly for bounds checks.
-               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
-      i.live <- across;
-      Reg.add_set_array across i.arg
 
 let fundecl ppf f =
   let initially_live = live f.fun_body Reg.Set.empty in
diff --git a/asmcomp/power/proc.ml b/asmcomp/power/proc.ml
index 203e8a9ef..77e37deda 100644
--- a/asmcomp/power/proc.ml
+++ b/asmcomp/power/proc.ml
@@ -224,6 +224,17 @@ let max_register_pressure = function
     Iextcall(_, _) -> [| 15; 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, _) -> false
+  | Ispecific(Imultaddf | Imultsubf) -> true
+  | Ispecific _ -> false
+  | _ -> true
+
 (* Layout of the stack *)
 
 let num_stack_slots = [| 0; 0 |]
diff --git a/asmcomp/proc.mli b/asmcomp/proc.mli
index 6cc6aedc9..cd3374ab9 100644
--- a/asmcomp/proc.mli
+++ b/asmcomp/proc.mli
@@ -40,6 +40,9 @@ val max_register_pressure: Mach.operation -> int array
 val destroyed_at_oper: Mach.instruction_desc -> Reg.t array
 val destroyed_at_raise: Reg.t array
 
+(* Pure operations *)
+val op_is_pure: Mach.operation -> bool
+
 (* Info for laying out the stack frame *)
 val num_stack_slots: int array
 val contains_calls: bool ref
diff --git a/asmcomp/reg.ml b/asmcomp/reg.ml
index a0fc7dfff..ef6db5cb6 100644
--- a/asmcomp/reg.ml
+++ b/asmcomp/reg.ml
@@ -178,6 +178,16 @@ let inter_set_array s v =
            else inter_all(i+1)
          in inter_all 0
 
+let disjoint_set_array s v =
+  match Array.length v with
+    0 -> true
+  | 1 -> not (Set.mem v.(0) s)
+  | n -> let rec disjoint_all i =
+           if i >= n then true
+           else if Set.mem v.(i) s then false
+           else disjoint_all (i+1)
+         in disjoint_all 0
+
 let set_of_array v =
   match Array.length v with
     0 -> Set.empty
diff --git a/asmcomp/reg.mli b/asmcomp/reg.mli
index 34e749801..e3cb2d952 100644
--- a/asmcomp/reg.mli
+++ b/asmcomp/reg.mli
@@ -58,6 +58,7 @@ module Map: Map.S with type key = t
 val add_set_array: Set.t -> t array -> Set.t
 val diff_set_array: Set.t -> t array -> Set.t
 val inter_set_array: Set.t -> t array -> Set.t
+val disjoint_set_array: Set.t -> t array -> bool
 val set_of_array: t array -> Set.t
 
 val reset: unit -> unit
diff --git a/asmcomp/sparc/proc.ml b/asmcomp/sparc/proc.ml
index ed107a82a..a538df434 100644
--- a/asmcomp/sparc/proc.ml
+++ b/asmcomp/sparc/proc.ml
@@ -196,6 +196,15 @@ let max_register_pressure = function
     Iextcall(_, _) -> [| 11; 0 |]
   | _ -> [| 19; 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, _) -> false
+  | _ -> true
+
 (* Layout of the stack *)
 
 let num_stack_slots = [| 0; 0 |]
diff --git a/asmcomp/spill.ml b/asmcomp/spill.ml
index ca17fe5bf..95c49de39 100644
--- a/asmcomp/spill.ml
+++ b/asmcomp/spill.ml
@@ -233,7 +233,12 @@ let rec reload i before =
       (i, Reg.Set.empty)
   | Itrywith(body, handler) ->
       let (new_body, after_body) = reload body before in
-      let (new_handler, after_handler) = reload handler handler.live in
+      (* All registers live at the beginning of the handler are destroyed,
+         except the exception bucket *)
+      let before_handler = 
+        Reg.Set.remove Proc.loc_exn_bucket
+                       (Reg.add_set_array handler.live handler.arg) in
+      let (new_handler, after_handler) = reload handler before_handler in
       let (new_next, finally) =
         reload i.next (Reg.Set.union after_body after_handler) in
       (instr_cons (Itrywith(new_body, new_handler)) i.arg i.res new_next,