From: simonmar <unknown>
Date: Mon, 11 Apr 2005 08:52:29 +0000 (+0000)
Subject: [project @ 2005-04-11 08:52:29 by simonmar]
X-Git-Tag: Initial_conversion_from_CVS_complete~767
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=5ba806d8ea2fb64c058f8a17fb7e5d4b9afa6515;p=ghc-hetmet.git

[project @ 2005-04-11 08:52:29 by simonmar]
When generating a switch for:

  case e of
    0 -> A
    1 -> B

instead of generating

  if (e < 1) then goto A
  B

generate

  if (e >= 1) then goto B
  A

because this helps the NCG to generate better code.  In particular, if
e is a comparison, then we don't need to reverse the sense of the
comparison to eliminate the comparse against 1 (the NCG does try to
reverse the comparison, but floating-point comparisons can't be
reversed).
---

diff --git a/ghc/compiler/codeGen/CgUtils.hs b/ghc/compiler/codeGen/CgUtils.hs
index 535d016..67e5973 100644
--- a/ghc/compiler/codeGen/CgUtils.hs
+++ b/ghc/compiler/codeGen/CgUtils.hs
@@ -45,7 +45,7 @@ import CLabel
 import CmmUtils
 import MachOp		( MachRep(..), wordRep, MachOp(..),  MachHint(..),
 			  mo_wordOr, mo_wordAnd, mo_wordNe, mo_wordEq,
-			  mo_wordULt, mo_wordUGt, machRepByteWidth )
+			  mo_wordULt, mo_wordUGt, mo_wordUGe, machRepByteWidth )
 import ForeignCall	( CCallConv(..) )
 import Literal		( Literal(..) )
 import CLabel		( CLabel, mkStringLitLabel )
@@ -153,6 +153,7 @@ cmmAndWord e1 e2 = CmmMachOp mo_wordAnd [e1, e2]
 cmmNeWord  e1 e2 = CmmMachOp mo_wordNe  [e1, e2]
 cmmEqWord  e1 e2 = CmmMachOp mo_wordEq  [e1, e2]
 cmmULtWord e1 e2 = CmmMachOp mo_wordULt [e1, e2]
+cmmUGeWord e1 e2 = CmmMachOp mo_wordUGe [e1, e2]
 cmmUGtWord e1 e2 = CmmMachOp mo_wordUGt [e1, e2]
 
 cmmNegate :: CmmExpr -> CmmExpr
@@ -456,11 +457,18 @@ mk_switch tag_expr branches mb_deflt lo_tag hi_tag via_C
 				lo_tag (mid_tag-1) via_C
 	; hi_stmts <- mk_switch tag_expr' hi_branches mb_deflt 
 				mid_tag hi_tag via_C
-	; lo_id <- forkCgStmts lo_stmts
-	; let cond = cmmULtWord tag_expr' (CmmLit (mkIntCLit mid_tag))
-	      branch_stmt = CmmCondBranch cond lo_id
-	; return (assign_tag `consCgStmt` (branch_stmt `consCgStmt` hi_stmts)) 
+	; hi_id <- forkCgStmts hi_stmts
+	; let cond = cmmUGeWord tag_expr' (CmmLit (mkIntCLit mid_tag))
+	      branch_stmt = CmmCondBranch cond hi_id
+	; return (assign_tag `consCgStmt` (branch_stmt `consCgStmt` lo_stmts)) 
 	}
+	-- we test (e >= mid_tag) rather than (e < mid_tag), because
+	-- the former works better when e is a comparison, and there
+	-- are two tags 0 & 1 (mid_tag == 1).  In this case, the code
+	-- generator can reduce the condition to e itself without
+	-- having to reverse the sense of the comparison: comparisons
+	-- can't always be easily reversed (eg. floating
+	-- pt. comparisons).
   where
     use_switch 	 = {- pprTrace "mk_switch" (
 			ppr tag_expr <+> text "n_tags:" <+> int n_tags <+>