FIX panic from the GHC API

[ghc-hetmet.git] / compiler / codeGen / SMRep.lhs

diff --git a/compiler/codeGen/SMRep.lhs b/compiler/codeGen/SMRep.lhs
index c807703..f323c1b 100644 (file)
--- a/compiler/codeGen/SMRep.lhs
+++ b/compiler/codeGen/SMRep.lhs
@@ -1,7 +1,9 @@
 %
 %

+% (c) The University of Glasgow 2006

 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %

-\section[SMRep]{Storage manager representations of closure}
+
+Storage manager representation of closures

 
 This is here, rather than in ClosureInfo, just to keep nhc happy.
 Other modules should access this info through ClosureInfo.
 
 This is here, rather than in ClosureInfo, just to keep nhc happy.
 Other modules should access this info through ClosureInfo.

@@ -17,7 +19,7 @@ module SMRep (
        CgRep(..), nonVoidArg,
        argMachRep, primRepToCgRep, primRepHint,
        isFollowableArg, isVoidArg, 
        CgRep(..), nonVoidArg,
        argMachRep, primRepToCgRep, primRepHint,
        isFollowableArg, isVoidArg, 

-       isFloatingArg, isNonPtrArg, is64BitArg,
+       isFloatingArg, is64BitArg,

        separateByPtrFollowness,
        cgRepSizeW, cgRepSizeB,
        retAddrSizeW,
        separateByPtrFollowness,
        cgRepSizeW, cgRepSizeB,
        retAddrSizeW,

@@ -29,25 +31,23 @@ module SMRep (
        isStaticRep,
        fixedHdrSize, arrWordsHdrSize, arrPtrsHdrSize,
        profHdrSize, thunkHdrSize,
        isStaticRep,
        fixedHdrSize, arrWordsHdrSize, arrPtrsHdrSize,
        profHdrSize, thunkHdrSize,

-       tablesNextToCode,

        smRepClosureType, smRepClosureTypeInt,
 
        smRepClosureType, smRepClosureTypeInt,
 

-       rET_SMALL, rET_VEC_SMALL, rET_BIG, rET_VEC_BIG
+       rET_SMALL, rET_BIG

     ) where
 
 #include "HsVersions.h"
 #include "../includes/MachDeps.h"
 
     ) where
 
 #include "HsVersions.h"
 #include "../includes/MachDeps.h"
 

-import Id              ( Id, idType )
-import Type            ( Type, typePrimRep, PrimRep(..) )
-import TyCon           ( TyCon, tyConPrimRep )
-import MachOp--                ( MachRep(..), MachHint(..), wordRep )
-import StaticFlags     ( opt_SccProfilingOn, opt_GranMacros,
-                         opt_Unregisterised )
+import Id
+import Type
+import TyCon
+import MachOp
+import StaticFlags

 import Constants
 import Outputable
 
 import Constants
 import Outputable
 

-import DATA_WORD
+import Data.Word

 \end{code}
 
 
 \end{code}
 
 

@@ -158,13 +158,13 @@ primRepHint FloatRep      = FloatHint
 primRepHint DoubleRep  = FloatHint
 
 idCgRep :: Id -> CgRep
 primRepHint DoubleRep  = FloatHint
 
 idCgRep :: Id -> CgRep

-idCgRep = typeCgRep . idType
+idCgRep x = typeCgRep . idType $ x

 
 tyConCgRep :: TyCon -> CgRep
 tyConCgRep = primRepToCgRep . tyConPrimRep
 
 typeCgRep :: Type -> CgRep
 
 tyConCgRep :: TyCon -> CgRep
 tyConCgRep = primRepToCgRep . tyConPrimRep
 
 typeCgRep :: Type -> CgRep

-typeCgRep = primRepToCgRep . typePrimRep
+typeCgRep = primRepToCgRep . typePrimRep 

 
 typeHint :: Type -> MachHint
 typeHint = primRepHint . typePrimRep
 
 typeHint :: Type -> MachHint
 typeHint = primRepHint . typePrimRep

@@ -200,11 +200,6 @@ isFloatingArg DoubleArg = True
 isFloatingArg FloatArg  = True
 isFloatingArg _         = False
 
 isFloatingArg FloatArg  = True
 isFloatingArg _         = False
 

-isNonPtrArg :: CgRep -> Bool
--- Identify anything which is one word large and not a pointer.
-isNonPtrArg NonPtrArg = True
-isNonPtrArg other     = False
-

 is64BitArg :: CgRep -> Bool
 is64BitArg LongArg = True
 is64BitArg _       = False
 is64BitArg :: CgRep -> Bool
 is64BitArg LongArg = True
 is64BitArg _       = False

@@ -294,16 +289,6 @@ thunkHdrSize = fixedHdrSize + smp_hdr
 \end{code}
 
 \begin{code}
 \end{code}
 
 \begin{code}

--- IA64 mangler doesn't place tables next to code
-tablesNextToCode :: Bool
-#if defined(ia64_TARGET_ARCH) || defined(powerpc64_TARGET_ARCH)
-tablesNextToCode = False
-#else
-tablesNextToCode = not opt_Unregisterised
-#endif
-\end{code}
-
-\begin{code}

 isStaticRep :: SMRep -> Bool
 isStaticRep (GenericRep is_static _ _ _) = is_static
 isStaticRep BlackHoleRep                = False
 isStaticRep :: SMRep -> Bool
 isStaticRep (GenericRep is_static _ _ _) = is_static
 isStaticRep BlackHoleRep                = False

@@ -313,12 +298,13 @@ isStaticRep BlackHoleRep           = False
 #include "../includes/ClosureTypes.h"
 -- Defines CONSTR, CONSTR_1_0 etc
 
 #include "../includes/ClosureTypes.h"
 -- Defines CONSTR, CONSTR_1_0 etc
 

+-- krc: only called by tickyDynAlloc in CgTicky; return
+-- Nothing for a black hole so we can at least make something work.
+smRepClosureType :: SMRep -> Maybe ClosureType
+smRepClosureType (GenericRep _ _ _ ty) = Just ty
+smRepClosureType BlackHoleRep         = Nothing

 
 

-smRepClosureType :: SMRep -> ClosureType
-smRepClosureType (GenericRep _ _ _ ty) = ty
-smRepClosureType BlackHoleRep         = panic "smRepClosureType: black hole"
-
-smRepClosureTypeInt :: SMRep -> Int
+smRepClosureTypeInt :: SMRep -> StgHalfWord

 smRepClosureTypeInt (GenericRep False 1 0 Constr) = CONSTR_1_0
 smRepClosureTypeInt (GenericRep False 0 1 Constr) = CONSTR_0_1
 smRepClosureTypeInt (GenericRep False 2 0 Constr) = CONSTR_2_0
 smRepClosureTypeInt (GenericRep False 1 0 Constr) = CONSTR_1_0
 smRepClosureTypeInt (GenericRep False 0 1 Constr) = CONSTR_0_1
 smRepClosureTypeInt (GenericRep False 2 0 Constr) = CONSTR_2_0

@@ -353,9 +339,7 @@ smRepClosureTypeInt rep = panic "smRepClosuretypeint"
 
 
 -- We export these ones
 
 
 -- We export these ones

-rET_SMALL     = (RET_SMALL     :: Int)
-rET_VEC_SMALL = (RET_VEC_SMALL :: Int)
-rET_BIG       = (RET_BIG       :: Int)
-rET_VEC_BIG   = (RET_VEC_BIG   :: Int)
+rET_SMALL     = (RET_SMALL     :: StgHalfWord)
+rET_BIG       = (RET_BIG       :: StgHalfWord)

 \end{code}
 
 \end{code}