From 11db3838a8cbfd09ecca368e87305054832a4719 Mon Sep 17 00:00:00 2001
From: xleroy <xleroy@fca1b0fc-160b-0410-b1d3-a4f43f01ea2e>
Date: Sun, 23 Feb 2014 08:23:10 +0000
Subject: In Regalloc, dead code elimination, don't eliminate move operations
 that pop the x87 FP stack (var <- FP0).  Otherwise, (void) f(); where f
 returns a float eventually produces a FP stack overflow.

git-svn-id: https://yquem.inria.fr/compcert/svn/compcert/trunk@2416 fca1b0fc-160b-0410-b1d3-a4f43f01ea2e
---
 arm/Machregs.v          | 2 ++
 backend/Regalloc.ml     | 6 +++---
 backend/XTL.ml          | 6 ++++++
 backend/XTL.mli         | 4 ++++
 extraction/extraction.v | 2 +-
 ia32/Machregs.v         | 3 +++
 powerpc/Machregs.v      | 2 ++
 7 files changed, 21 insertions(+), 4 deletions(-)

diff --git a/arm/Machregs.v b/arm/Machregs.v
index d4439ef..b55259b 100644
--- a/arm/Machregs.v
+++ b/arm/Machregs.v
@@ -77,6 +77,8 @@ Module IndexedMreg <: INDEXED_TYPE.
   Qed.
 End IndexedMreg.
 
+Definition is_stack_reg (r: mreg) : bool := false.
+
 (** ** Destroyed registers, preferred registers *)
 
 Definition destroyed_by_op (op: operation): list mreg :=
diff --git a/backend/Regalloc.ml b/backend/Regalloc.ml
index b21eeb0..b736f29 100644
--- a/backend/Regalloc.ml
+++ b/backend/Regalloc.ml
@@ -228,7 +228,7 @@ let vset_addros vos after =
 let live_before instr after =
   match instr with
   | Xmove(src, dst) | Xspill(src, dst) | Xreload(src, dst) ->
-      if VSet.mem dst after
+      if VSet.mem dst after || is_stack_reg src
       then VSet.add src (VSet.remove dst after)
       else after
   | Xparmove(srcs, dsts, itmp, ftmp) ->
@@ -302,7 +302,7 @@ let rec dce_parmove srcs dsts after =
   | [], [] -> [], []
   | src1 :: srcs, dst1 :: dsts ->
       let (srcs', dsts') = dce_parmove srcs dsts after in
-      if VSet.mem dst1 after
+      if VSet.mem dst1 after || is_stack_reg src1
       then (src1 :: srcs', dst1 :: dsts')
       else (srcs', dsts')
   | _, _ -> assert false
@@ -310,7 +310,7 @@ let rec dce_parmove srcs dsts after =
 let dce_instr instr after k =
   match instr with
   | Xmove(src, dst) ->
-      if VSet.mem dst after
+      if VSet.mem dst after || is_stack_reg src
       then instr :: k
       else k
   | Xparmove(srcs, dsts, itmp, ftmp) ->
diff --git a/backend/XTL.ml b/backend/XTL.ml
index 46c59b0..9cb8e0a 100644
--- a/backend/XTL.ml
+++ b/backend/XTL.ml
@@ -64,6 +64,12 @@ let vlocs ll = List.map vloc ll
 let vmreg mr = L(R mr)
 let vmregs mrl = List.map vmreg mrl
 
+(* Tests over variables *)
+
+let is_stack_reg = function
+  | L(R r) -> Machregs.is_stack_reg r
+  | _      -> false
+
 (* Sets of variables *)
 
 module VSet = Set.Make(struct type t = var let compare = compare end)
diff --git a/backend/XTL.mli b/backend/XTL.mli
index 21671e9..75a3d65 100644
--- a/backend/XTL.mli
+++ b/backend/XTL.mli
@@ -65,6 +65,10 @@ val vlocs: loc list -> var list
 val vmreg: mreg -> var
 val vmregs: mreg list -> var list
 
+(* Tests over variables *)
+
+val is_stack_reg: var -> bool
+
 (* Sets of variables *)
 
 module VSet: Set.S with type elt = var
diff --git a/extraction/extraction.v b/extraction/extraction.v
index 654e80f..6b93db2 100644
--- a/extraction/extraction.v
+++ b/extraction/extraction.v
@@ -128,4 +128,4 @@ Separate Extraction
    Conventions1.dummy_int_reg Conventions1.dummy_float_reg
    RTL.instr_defs RTL.instr_uses
    Machregs.mregs_for_operation Machregs.mregs_for_builtin
-   Machregs.two_address_op.
+   Machregs.two_address_op Machregs.is_stack_reg.
diff --git a/ia32/Machregs.v b/ia32/Machregs.v
index 47340ec..85b561e 100644
--- a/ia32/Machregs.v
+++ b/ia32/Machregs.v
@@ -69,6 +69,9 @@ Module IndexedMreg <: INDEXED_TYPE.
   Qed.
 End IndexedMreg.
 
+Definition is_stack_reg (r: mreg) : bool :=
+  match r with FP0 => true | _ => false end.
+
 (** ** Destroyed registers, preferred registers *)
 
 Definition destroyed_by_op (op: operation): list mreg :=
diff --git a/powerpc/Machregs.v b/powerpc/Machregs.v
index d057dce..baad496 100644
--- a/powerpc/Machregs.v
+++ b/powerpc/Machregs.v
@@ -105,6 +105,8 @@ Module IndexedMreg <: INDEXED_TYPE.
   Qed.
 End IndexedMreg.
 
+Definition is_stack_reg (r: mreg) : bool := false.
+
 (** ** Destroyed registers, preferred registers *)
 
 Definition destroyed_by_op (op: operation): list mreg :=
-- 
cgit v1.2.3