Merge in new code generator branch.

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

diff --git a/compiler/codeGen/SMRep.lhs b/compiler/codeGen/SMRep.lhs
index c807703..f35118d 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.

@@ -15,39 +17,38 @@ module SMRep (
 
        -- Argument/return representations
        CgRep(..), nonVoidArg,
 
        -- Argument/return representations
        CgRep(..), nonVoidArg,

-       argMachRep, primRepToCgRep, primRepHint,
+       argMachRep, primRepToCgRep, 
+-- Temp primRepHint, typeHint,

        isFollowableArg, isVoidArg, 
        isFollowableArg, isVoidArg, 

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

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

-       typeCgRep, idCgRep, tyConCgRep, typeHint,
+       typeCgRep, idCgRep, tyConCgRep, 

 
        -- Closure repesentation
        SMRep(..), ClosureType(..),
        isStaticRep,
        fixedHdrSize, arrWordsHdrSize, arrPtrsHdrSize,
        profHdrSize, thunkHdrSize,
 
        -- Closure repesentation
        SMRep(..), ClosureType(..),
        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
 
     ) where
 

-#include "HsVersions.h"

 #include "../includes/MachDeps.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 CmmType
+import Id
+import Type
+import TyCon
+import StaticFlags

 import Constants
 import Outputable
 import Constants
 import Outputable

+import FastString

 
 

-import DATA_WORD
+import Data.Word

 \end{code}
 
 
 \end{code}
 
 

@@ -68,13 +69,17 @@ StgWord is a type representing an StgWord on the target platform.
 #if SIZEOF_HSWORD == 4
 type StgWord     = Word32
 type StgHalfWord = Word16
 #if SIZEOF_HSWORD == 4
 type StgWord     = Word32
 type StgHalfWord = Word16

-hALF_WORD_SIZE = 2 :: ByteOff
-hALF_WORD_SIZE_IN_BITS = 16 :: Int
+hALF_WORD_SIZE :: ByteOff
+hALF_WORD_SIZE = 2
+hALF_WORD_SIZE_IN_BITS :: Int
+hALF_WORD_SIZE_IN_BITS = 16

 #elif SIZEOF_HSWORD == 8
 type StgWord     = Word64
 type StgHalfWord = Word32
 #elif SIZEOF_HSWORD == 8
 type StgWord     = Word64
 type StgHalfWord = Word32

-hALF_WORD_SIZE = 4 :: ByteOff
-hALF_WORD_SIZE_IN_BITS = 32 :: Int
+hALF_WORD_SIZE :: ByteOff
+hALF_WORD_SIZE = 4
+hALF_WORD_SIZE_IN_BITS :: Int
+hALF_WORD_SIZE_IN_BITS = 32

 #else
 #error unknown SIZEOF_HSWORD
 #endif
 #else
 #error unknown SIZEOF_HSWORD
 #endif

@@ -112,27 +117,29 @@ entry to the garbage collector.
 \begin{code}
 data CgRep 
   = VoidArg    -- Void
 \begin{code}
 data CgRep 
   = VoidArg    -- Void

-  | PtrArg     -- Word-sized Ptr
+  | PtrArg     -- Word-sized heap pointer, followed
+               -- by the garbage collector

   | NonPtrArg  -- Word-sized non-pointer
   | NonPtrArg  -- Word-sized non-pointer

+               -- (including addresses not followed by GC)

   | LongArg    -- 64-bit non-pointer
   | FloatArg   -- 32-bit float
   | DoubleArg  -- 64-bit float
   deriving Eq
 
 instance Outputable CgRep where
   | LongArg    -- 64-bit non-pointer
   | FloatArg   -- 32-bit float
   | DoubleArg  -- 64-bit float
   deriving Eq
 
 instance Outputable CgRep where

-    ppr VoidArg   = ptext SLIT("V_")
-    ppr PtrArg    = ptext SLIT("P_")
-    ppr NonPtrArg = ptext SLIT("I_")
-    ppr LongArg   = ptext SLIT("L_")
-    ppr FloatArg  = ptext SLIT("F_")
-    ppr DoubleArg = ptext SLIT("D_")
-
-argMachRep :: CgRep -> MachRep
-argMachRep PtrArg    = wordRep
-argMachRep NonPtrArg = wordRep
-argMachRep LongArg   = I64
-argMachRep FloatArg  = F32
-argMachRep DoubleArg = F64
+    ppr VoidArg   = ptext (sLit "V_")
+    ppr PtrArg    = ptext (sLit "P_")
+    ppr NonPtrArg = ptext (sLit "I_")
+    ppr LongArg   = ptext (sLit "L_")
+    ppr FloatArg  = ptext (sLit "F_")
+    ppr DoubleArg = ptext (sLit "D_")
+
+argMachRep :: CgRep -> CmmType
+argMachRep PtrArg    = gcWord
+argMachRep NonPtrArg = bWord
+argMachRep LongArg   = b64
+argMachRep FloatArg  = f32
+argMachRep DoubleArg = f64

 argMachRep VoidArg   = panic "argMachRep:VoidRep"
 
 primRepToCgRep :: PrimRep -> CgRep
 argMachRep VoidArg   = panic "argMachRep:VoidRep"
 
 primRepToCgRep :: PrimRep -> CgRep

@@ -146,28 +153,14 @@ primRepToCgRep AddrRep    = NonPtrArg
 primRepToCgRep FloatRep   = FloatArg
 primRepToCgRep DoubleRep  = DoubleArg
 
 primRepToCgRep FloatRep   = FloatArg
 primRepToCgRep DoubleRep  = DoubleArg
 

-primRepHint :: PrimRep -> MachHint
-primRepHint VoidRep    = panic "primRepHint:VoidRep"
-primRepHint PtrRep     = PtrHint
-primRepHint IntRep     = SignedHint
-primRepHint WordRep    = NoHint
-primRepHint Int64Rep   = SignedHint
-primRepHint Word64Rep  = NoHint
-primRepHint AddrRep     = PtrHint -- NB! PtrHint, but NonPtrArg
-primRepHint FloatRep   = FloatHint
-primRepHint DoubleRep  = FloatHint
-

 idCgRep :: Id -> CgRep
 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
-
-typeHint :: Type -> MachHint
-typeHint = primRepHint . typePrimRep
+typeCgRep = primRepToCgRep . typePrimRep 

 \end{code}
 
 Whether or not the thing is a pointer that the garbage-collector
 \end{code}
 
 Whether or not the thing is a pointer that the garbage-collector

@@ -181,15 +174,15 @@ computation of GC liveness info.
 \begin{code}
 isFollowableArg :: CgRep -> Bool  -- True <=> points to a heap object
 isFollowableArg PtrArg  = True
 \begin{code}
 isFollowableArg :: CgRep -> Bool  -- True <=> points to a heap object
 isFollowableArg PtrArg  = True

-isFollowableArg other = False
+isFollowableArg _       = False

 
 isVoidArg :: CgRep -> Bool
 isVoidArg VoidArg = True
 
 isVoidArg :: CgRep -> Bool
 isVoidArg VoidArg = True

-isVoidArg other   = False
+isVoidArg _       = False

 
 nonVoidArg :: CgRep -> Bool
 nonVoidArg VoidArg = False
 
 nonVoidArg :: CgRep -> Bool
 nonVoidArg VoidArg = False

-nonVoidArg other   = True
+nonVoidArg _       = True

 
 -- isFloatingArg is used to distinguish @Double@ and @Float@ which
 -- cause inadvertent numeric conversions if you aren't jolly careful.
 
 -- isFloatingArg is used to distinguish @Double@ and @Float@ which
 -- cause inadvertent numeric conversions if you aren't jolly careful.

@@ -200,11 +193,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

@@ -258,7 +246,7 @@ data SMRep
   | BlackHoleRep
 
 data ClosureType       -- Corresponds 1-1 with the varieties of closures
   | BlackHoleRep
 
 data ClosureType       -- Corresponds 1-1 with the varieties of closures

-                       -- implemented by the RTS.  Compare with ghc/includes/ClosureTypes.h
+                       -- implemented by the RTS.  Compare with includes/rts/storage/ClosureTypes.h

     = Constr
     | ConstrNoCaf
     | Fun
     = Constr
     | ConstrNoCaf
     | Fun

@@ -270,16 +258,12 @@ Size of a closure header.
 
 \begin{code}
 fixedHdrSize :: WordOff
 
 \begin{code}
 fixedHdrSize :: WordOff

-fixedHdrSize = sTD_HDR_SIZE + profHdrSize + granHdrSize
+fixedHdrSize = sTD_HDR_SIZE + profHdrSize

 
 profHdrSize  :: WordOff
 profHdrSize  | opt_SccProfilingOn   = pROF_HDR_SIZE
             | otherwise            = 0
 
 
 profHdrSize  :: WordOff
 profHdrSize  | opt_SccProfilingOn   = pROF_HDR_SIZE
             | otherwise            = 0
 

-granHdrSize  :: WordOff
-granHdrSize  | opt_GranMacros      = gRAN_HDR_SIZE
-            | otherwise            = 0
-

 arrWordsHdrSize   :: ByteOff
 arrWordsHdrSize   = fixedHdrSize*wORD_SIZE + sIZEOF_StgArrWords_NoHdr
 
 arrWordsHdrSize   :: ByteOff
 arrWordsHdrSize   = fixedHdrSize*wORD_SIZE + sIZEOF_StgArrWords_NoHdr
 

@@ -294,31 +278,22 @@ 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
 \end{code}
 
 \begin{code}
 isStaticRep :: SMRep -> Bool
 isStaticRep (GenericRep is_static _ _ _) = is_static
 isStaticRep BlackHoleRep                = False
 \end{code}
 
 \begin{code}

-#include "../includes/ClosureTypes.h"
+#include "../includes/rts/storage/ClosureTypes.h"

 -- Defines CONSTR, CONSTR_1_0 etc
 
 -- 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

@@ -349,13 +324,12 @@ smRepClosureTypeInt (GenericRep True _ _ Thunk)       = THUNK_STATIC
 
 smRepClosureTypeInt BlackHoleRep = BLACKHOLE
 
 
 smRepClosureTypeInt BlackHoleRep = BLACKHOLE
 

-smRepClosureTypeInt rep = panic "smRepClosuretypeint"
+smRepClosureTypeInt _ = 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_BIG :: StgHalfWord
+rET_SMALL     = RET_SMALL
+rET_BIG       = RET_BIG

 \end{code}
 
 \end{code}