[project @ 2005-06-21 10:44:37 by simonmar]

[ghc-hetmet.git] / ghc / compiler / codeGen / CgUtils.hs

diff --git a/ghc/compiler/codeGen/CgUtils.hs b/ghc/compiler/codeGen/CgUtils.hs
index c8cae4b..b70bd26 100644 (file)
--- a/ghc/compiler/codeGen/CgUtils.hs
+++ b/ghc/compiler/codeGen/CgUtils.hs
@@ -45,14 +45,15 @@ 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 )
 import Digraph         ( SCC(..), stronglyConnComp )
 import ListSetOps      ( assocDefault )
 import Util            ( filterOut, sortLe )
-import CmdLineOpts     ( DynFlags(..), HscTarget(..) )
+import DynFlags                ( DynFlags(..), HscTarget(..) )
+import Packages                ( HomeModules )
 import FastString      ( LitString, FastString, unpackFS )
 import Outputable
 
@@ -153,6 +154,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
@@ -209,11 +211,11 @@ addToMemE rep ptr n
 --
 -------------------------------------------------------------------------
 
-tagToClosure :: DynFlags -> TyCon -> CmmExpr -> CmmExpr
-tagToClosure dflags tycon tag
+tagToClosure :: HomeModules -> TyCon -> CmmExpr -> CmmExpr
+tagToClosure hmods tycon tag
   = CmmLoad (cmmOffsetExprW closure_tbl tag) wordRep
   where closure_tbl = CmmLit (CmmLabel lbl)
-       lbl = mkClosureTableLabel dflags (tyConName tycon)
+       lbl = mkClosureTableLabel hmods (tyConName tycon)
 
 -------------------------------------------------------------------------
 --
@@ -456,16 +458,27 @@ 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          = ASSERT( n_branches > 1 && n_tags > 1 ) 
-                  {- pprTrace "mk_switch" (ppr tag_expr <+> text "n_tags: "
-                                       <+> int n_tags <+> text "dense: "
-                                       <+> int n_branches) $ -}
+    use_switch          = {- pprTrace "mk_switch" (
+                       ppr tag_expr <+> text "n_tags:" <+> int n_tags <+>
+                       text "n_branches:" <+> int n_branches <+>
+                       text "lo_tag: " <+> int lo_tag <+>
+                       text "hi_tag: " <+> int hi_tag <+>
+                       text "real_lo_tag: " <+> int real_lo_tag <+>
+                       text "real_hi_tag: " <+> int real_hi_tag) $ -}
+                  ASSERT( n_branches > 1 && n_tags > 1 ) 
                   n_tags > 2 && (small || dense)
                 -- a 2-branch switch always turns into an if.
     small               = n_tags <= 4