Semi-tagging optimisation

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

diff --git a/compiler/codeGen/CgInfoTbls.hs b/compiler/codeGen/CgInfoTbls.hs
index 5a40a3d..3751824 100644 (file)
--- a/compiler/codeGen/CgInfoTbls.hs
+++ b/compiler/codeGen/CgInfoTbls.hs
@@ -2,7 +2,7 @@
 --
 -- Building info tables.
 --
--- (c) The University of Glasgow 2004
+-- (c) The University of Glasgow 2004-2006
 --
 -----------------------------------------------------------------------------
 
@@ -19,7 +19,7 @@ module CgInfoTbls (
        mkFunGenInfoExtraBits,
        entryCode, closureInfoPtr,
        getConstrTag,
-       infoTable, infoTableClosureType,
+       infoTable, infoTableClosureType, infoTableConstrTag,
        infoTablePtrs, infoTableNonPtrs,
        funInfoTable,
        retVec
@@ -28,42 +28,27 @@ module CgInfoTbls (
 
 #include "HsVersions.h"
 
-import ClosureInfo     ( ClosureInfo, closureTypeDescr, closureName,
-                         infoTableLabelFromCI, Liveness,
-                         closureValDescr, closureSRT, closureSMRep,
-                         closurePtrsSize, closureNonHdrSize, closureFunInfo,
-                         C_SRT(..), needsSRT, isConstrClosure_maybe,
-                         ArgDescr(..) )
-import SMRep           ( StgHalfWord, hALF_WORD_SIZE_IN_BITS, hALF_WORD_SIZE,
-                         WordOff, ByteOff,
-                         smRepClosureTypeInt, tablesNextToCode,
-                         rET_BIG, rET_SMALL, rET_VEC_BIG, rET_VEC_SMALL )
-import CgBindery       ( getLiveStackSlots )
-import CgCallConv      ( isBigLiveness, mkLivenessCLit, buildContLiveness,
-                         argDescrType, getSequelAmode,
-                         CtrlReturnConvention(..) )
-import CgUtils         ( mkStringCLit, packHalfWordsCLit, mkWordCLit, 
-                         cmmOffsetB, cmmOffsetExprW, cmmLabelOffW, cmmOffsetW,
-                         emitDataLits, emitRODataLits, emitSwitch, cmmNegate,
-                         newTemp )
+import ClosureInfo
+import SMRep
+import CgBindery
+import CgCallConv
+import CgUtils
 import CgMonad
 
-import CmmUtils                ( mkIntCLit, zeroCLit )
-import Cmm             ( CmmStmt(..), CmmExpr(..), CmmLit(..), LocalReg,
-                         CmmBasicBlock, nodeReg )
+import CmmUtils
+import Cmm
 import MachOp
 import CLabel
-import StgSyn          ( SRT(..) )
-import Name            ( Name )
-import DataCon         ( DataCon, dataConTag, fIRST_TAG )
-import Unique          ( Uniquable(..) )
-import DynFlags                ( DynFlags(..), HscTarget(..) )
-import StaticFlags     ( opt_SccProfilingOn )
-import ListSetOps      ( assocDefault )
-import Maybes          ( isJust )
-import Constants       ( wORD_SIZE, sIZEOF_StgFunInfoExtraRev )
-import Outputable
+import StgSyn
+import Name
+import DataCon
+import Unique
+import DynFlags
+import StaticFlags
 
+import ListSetOps
+import Maybes
+import Constants
 
 -------------------------------------------------------------------------
 --
@@ -217,18 +202,19 @@ retVec :: CmmExpr -> CmmExpr -> CmmExpr
 -- Get a return vector from the info pointer
 retVec info_amode zero_indexed_tag
   = let slot = vectorSlot info_amode zero_indexed_tag
-#ifdef x86_64_TARGET_ARCH
-        tableEntry = CmmMachOp (MO_S_Conv I32 I64) [CmmLoad slot I32]
+        table_slot = CmmLoad slot wordRep
+#if defined(x86_64_TARGET_ARCH)
+        offset_slot = CmmMachOp (MO_S_Conv I32 I64) [CmmLoad slot I32]
        -- offsets are 32-bits on x86-64, due to the inability of
        -- the tools to handle 64-bit PC-relative relocations.  See also
        -- PprMach.pprDataItem, and InfoTables.h:OFFSET_FIELD().
 #else
-        tableEntry = CmmLoad slot wordRep
+       offset_slot = table_slot
 #endif
     in if tablesNextToCode
-           then CmmMachOp (MO_Add wordRep) [tableEntry, info_amode]
-           else tableEntry
-           
+           then CmmMachOp (MO_Add wordRep) [offset_slot, info_amode]
+           else table_slot
+
 emitReturnTarget
    :: Name
    -> CgStmts                  -- The direct-return code (if any)