fix for compiling the base package with --make

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

diff --git a/ghc/compiler/codeGen/CgInfoTbls.hs b/ghc/compiler/codeGen/CgInfoTbls.hs
index 7692e7d..b769950 100644 (file)
--- a/ghc/compiler/codeGen/CgInfoTbls.hs
+++ b/ghc/compiler/codeGen/CgInfoTbls.hs
@@ -44,7 +44,8 @@ import CgCallConv     ( isBigLiveness, mkLivenessCLit, buildContLiveness,
                          CtrlReturnConvention(..) )
 import CgUtils         ( mkStringCLit, packHalfWordsCLit, mkWordCLit, 
                          cmmOffsetB, cmmOffsetExprW, cmmLabelOffW, cmmOffsetW,
-                         emitDataLits, emitRODataLits, emitSwitch, cmmNegate )
+                         emitDataLits, emitRODataLits, emitSwitch, cmmNegate,
+                         newTemp )
 import CgMonad
 
 import CmmUtils                ( mkIntCLit, zeroCLit )
@@ -56,7 +57,8 @@ import StgSyn         ( SRT(..) )
 import Name            ( Name )
 import DataCon         ( DataCon, dataConTag, fIRST_TAG )
 import Unique          ( Uniquable(..) )
-import CmdLineOpts     ( opt_SccProfilingOn )
+import DynFlags                ( DynFlags(..), HscTarget(..) )
+import StaticFlags     ( opt_SccProfilingOn )
 import ListSetOps      ( assocDefault )
 import Maybes          ( isJust )
 import Constants       ( wORD_SIZE, sIZEOF_StgFunInfoExtraRev )
@@ -189,9 +191,9 @@ mkFunGenInfoExtraBits fun_type arity srt_label liveness slow_entry
 --                     <srt slot>
 --                     <forward vector table>
 --
--- * The vector table is only present for vectored returns
+--  * The vector table is only present for vectored returns
 --
--- * The SRT slot is only there if either
+--  * The SRT slot is only there if either
 --     (a) there is SRT info to record, OR
 --     (b) if the return is vectored
 --   The latter (b) is necessary so that the vector is in a
@@ -247,7 +249,7 @@ emitReturnTarget name stmts vector srt
        ; emitInfoTableAndCode info_lbl std_info extra_bits args blks
        ; return info_lbl }
   where
-    args = trace "emitReturnTarget: missing args" []
+    args      = {- trace "emitReturnTarget: missing args" -} []
     uniq      = getUnique name
     info_lbl  = mkReturnInfoLabel uniq
 
@@ -344,11 +346,22 @@ emitDirectReturnInstr
   = do         { info_amode <- getSequelAmode
        ; stmtC (CmmJump (entryCode info_amode) []) }
 
-emitVectoredReturnInstr :: CmmExpr     -- *Zero-indexed* constructor tag
+emitVectoredReturnInstr :: CmmExpr     -- _Zero-indexed_ constructor tag
                        -> Code
 emitVectoredReturnInstr zero_indexed_tag
   = do { info_amode <- getSequelAmode
-       ; let target = retVec info_amode zero_indexed_tag
+               -- HACK! assign info_amode to a temp, because retVec
+               -- uses it twice and the NCG doesn't have any CSE yet.
+               -- Only do this for the NCG, because gcc is too stupid
+               -- to optimise away the extra tmp (grrr).
+       ; dflags <- getDynFlags
+       ; x <- if hscTarget dflags == HscAsm
+                  then do z <- newTemp wordRep
+                          stmtC (CmmAssign z info_amode)
+                          return (CmmReg z)
+                  else
+                       return info_amode
+       ; let target = retVec x zero_indexed_tag
        ; stmtC (CmmJump target []) }
 
 
@@ -381,7 +394,7 @@ mkStdInfoTable type_descr closure_descr cl_type srt_len layout_lit
 
  where  
     prof_info 
-       | opt_SccProfilingOn = [closure_descr, type_descr]
+       | opt_SccProfilingOn = [type_descr, closure_descr]
        | otherwise          = []
 
     type_lit = packHalfWordsCLit cl_type srt_len