[project @ 2005-01-28 12:55:17 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 9727fec..9a99bfd 100644 (file)
--- a/ghc/compiler/codeGen/CgUtils.hs
+++ b/ghc/compiler/codeGen/CgUtils.hs
@@ -52,16 +52,14 @@ import CLabel               ( CLabel, mkStringLitLabel )
 import Digraph         ( SCC(..), stronglyConnComp )
 import ListSetOps      ( assocDefault )
 import Util            ( filterOut, sortLe )
-import Char            ( ord )
+import CmdLineOpts     ( DynFlags )
 import FastString      ( LitString, FastString, unpackFS )
 import Outputable
 
+import Char            ( ord )
 import DATA_BITS
 import Maybe           ( isNothing )
 
-#include "../includes/ghcconfig.h"
-       -- For WORDS_BIGENDIAN
-
 -------------------------------------------------------------------------
 --
 --     Random small functions
@@ -211,10 +209,11 @@ addToMemE rep ptr n
 --
 -------------------------------------------------------------------------
 
-tagToClosure :: TyCon -> CmmExpr -> CmmExpr
-tagToClosure tycon tag
+tagToClosure :: DynFlags -> TyCon -> CmmExpr -> CmmExpr
+tagToClosure dflags tycon tag
   = CmmLoad (cmmOffsetExprW closure_tbl tag) wordRep
-  where closure_tbl = CmmLit (CmmLabel (mkClosureTblLabel (tyConName tycon)))
+  where closure_tbl = CmmLit (CmmLabel lbl)
+       lbl = mkClosureTableLabel dflags (tyConName tycon)
 
 -------------------------------------------------------------------------
 --
@@ -297,7 +296,12 @@ emitDataLits lbl lits
 emitRODataLits :: CLabel -> [CmmLit] -> Code
 -- Emit a read-only data block
 emitRODataLits lbl lits
-  = emitData ReadOnlyData (CmmDataLabel lbl : map CmmStaticLit lits)
+  = emitData section (CmmDataLabel lbl : map CmmStaticLit lits)
+  where section | any needsRelocation lits = RelocatableReadOnlyData
+                | otherwise                = ReadOnlyData
+        needsRelocation (CmmLabel _)      = True
+        needsRelocation (CmmLabelOff _ _) = True
+        needsRelocation _                 = False
 
 mkStringCLit :: String -> FCode CmmLit
 -- Make a global definition for the string,
@@ -403,11 +407,15 @@ mk_switch tag_expr branches mb_deflt lo_tag hi_tag
                find_branch :: ConTagZ -> Maybe BlockId
                find_branch i = assocDefault mb_deflt tagged_blk_ids i
 
-               arms = [ find_branch (i+lo_tag) | i <- [0..n_tags-1]]
+               -- NB. we have eliminated impossible branches at
+               -- either end of the range (see below), so the first
+               -- tag of a real branch is real_lo_tag (not lo_tag).
+               arms = [ find_branch i | i <- [real_lo_tag..real_hi_tag]]
 
-               switch_stmt = CmmSwitch (cmmOffset tag_expr (- lo_tag)) arms
+               switch_stmt = CmmSwitch (cmmOffset tag_expr (- real_lo_tag)) arms
 
-       ; return (oneCgStmt switch_stmt)
+       ; ASSERT(not (all isNothing arms)) 
+         return (oneCgStmt switch_stmt)
        }
 
   -- if we can knock off a bunch of default cases with one if, then do so