\begin{code}
module SMRep (
+ -- Words and bytes
+ StgWord, StgHalfWord,
+ hALF_WORD_SIZE, hALF_WORD_SIZE_IN_BITS,
+ WordOff, ByteOff,
+
+ -- Argument/return representations
+ CgRep(..), nonVoidArg,
+ argMachRep, primRepToCgRep, primRepHint,
+ isFollowableArg, isVoidArg,
+ isFloatingArg, isNonPtrArg, is64BitArg,
+ separateByPtrFollowness,
+ cgRepSizeW, cgRepSizeB,
+ retAddrSizeW,
+
+ typeCgRep, idCgRep, tyConCgRep, typeHint,
+
+ -- Closure repesentation
SMRep(..), ClosureType(..),
isStaticRep,
fixedHdrSize, arrWordsHdrSize, arrPtrsHdrSize,
- fixedItblSize, pprSMRep
-
-#ifndef OMIT_NATIVE_CODEGEN
- , getSMRepClosureTypeInt
- , cONSTR
- , cONSTR_1_0
- , cONSTR_0_1
- , cONSTR_2_0
- , cONSTR_1_1
- , cONSTR_0_2
- , cONSTR_STATIC
- , cONSTR_NOCAF_STATIC
- , fUN
- , fUN_1_0
- , fUN_0_1
- , fUN_2_0
- , fUN_1_1
- , fUN_0_2
- , fUN_STATIC
- , tHUNK
- , tHUNK_1_0
- , tHUNK_0_1
- , tHUNK_2_0
- , tHUNK_1_1
- , tHUNK_0_2
- , tHUNK_STATIC
- , tHUNK_SELECTOR
- , rET_SMALL
- , rET_VEC_SMALL
- , rET_BIG
- , rET_VEC_BIG
- , bLACKHOLE
-#endif
+ profHdrSize, thunkHdrSize,
+ tablesNextToCode,
+ smRepClosureType, smRepClosureTypeInt,
+
+ rET_SMALL, rET_VEC_SMALL, rET_BIG, rET_VEC_BIG
) where
#include "HsVersions.h"
-
-import CmdLineOpts
-import AbsCSyn ( Liveness(..) )
-import Constants ( sTD_HDR_SIZE, pROF_HDR_SIZE,
- gRAN_HDR_SIZE, tICKY_HDR_SIZE,
- aRR_WORDS_HDR_SIZE, aRR_PTRS_HDR_SIZE,
- sTD_ITBL_SIZE, pROF_ITBL_SIZE,
- gRAN_ITBL_SIZE, tICKY_ITBL_SIZE )
+#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 Constants
import Outputable
-import GlaExts ( Int(..), Int#, (<#), (==#), (<#), (>#) )
+
+import DATA_WORD
+\end{code}
+
+
+%************************************************************************
+%* *
+ Words and bytes
+%* *
+%************************************************************************
+
+\begin{code}
+type WordOff = Int -- Word offset, or word count
+type ByteOff = Int -- Byte offset, or byte count
+\end{code}
+
+StgWord is a type representing an StgWord on the target platform.
+
+\begin{code}
+#if SIZEOF_HSWORD == 4
+type StgWord = Word32
+type StgHalfWord = Word16
+hALF_WORD_SIZE = 2 :: ByteOff
+hALF_WORD_SIZE_IN_BITS = 16 :: Int
+#elif SIZEOF_HSWORD == 8
+type StgWord = Word64
+type StgHalfWord = Word32
+hALF_WORD_SIZE = 4 :: ByteOff
+hALF_WORD_SIZE_IN_BITS = 32 :: Int
+#else
+#error unknown SIZEOF_HSWORD
+#endif
+\end{code}
+
+
+%************************************************************************
+%* *
+ CgRep
+%* *
+%************************************************************************
+
+An CgRep is an abstraction of a Type which tells the code generator
+all it needs to know about the calling convention for arguments (and
+results) of that type. In particular, the ArgReps of a function's
+arguments are used to decide which of the RTS's generic apply
+functions to call when applying an unknown function.
+
+It contains more information than the back-end data type MachRep,
+so one can easily convert from CgRep -> MachRep. (Except that
+there's no MachRep for a VoidRep.)
+
+It distinguishes
+ pointers from non-pointers (we sort the pointers together
+ when building closures)
+
+ void from other types: a void argument is different from no argument
+
+All 64-bit types map to the same CgRep, because they're passed in the
+same register, but a PtrArg is still different from an NonPtrArg
+because the function's entry convention has to take into account the
+pointer-hood of arguments for the purposes of describing the stack on
+entry to the garbage collector.
+
+\begin{code}
+data CgRep
+ = VoidArg -- Void
+ | PtrArg -- Word-sized Ptr
+ | NonPtrArg -- Word-sized non-pointer
+ | 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
+argMachRep VoidArg = panic "argMachRep:VoidRep"
+
+primRepToCgRep :: PrimRep -> CgRep
+primRepToCgRep VoidRep = VoidArg
+primRepToCgRep PtrRep = PtrArg
+primRepToCgRep IntRep = NonPtrArg
+primRepToCgRep WordRep = NonPtrArg
+primRepToCgRep Int64Rep = LongArg
+primRepToCgRep Word64Rep = LongArg
+primRepToCgRep AddrRep = NonPtrArg
+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 = typeCgRep . idType
+
+tyConCgRep :: TyCon -> CgRep
+tyConCgRep = primRepToCgRep . tyConPrimRep
+
+typeCgRep :: Type -> CgRep
+typeCgRep = primRepToCgRep . typePrimRep
+
+typeHint :: Type -> MachHint
+typeHint = primRepHint . typePrimRep
+\end{code}
+
+Whether or not the thing is a pointer that the garbage-collector
+should follow. Or, to put it another (less confusing) way, whether
+the object in question is a heap object.
+
+Depending on the outcome, this predicate determines what stack
+the pointer/object possibly will have to be saved onto, and the
+computation of GC liveness info.
+
+\begin{code}
+isFollowableArg :: CgRep -> Bool -- True <=> points to a heap object
+isFollowableArg PtrArg = True
+isFollowableArg other = False
+
+isVoidArg :: CgRep -> Bool
+isVoidArg VoidArg = True
+isVoidArg other = False
+
+nonVoidArg :: CgRep -> Bool
+nonVoidArg VoidArg = False
+nonVoidArg other = True
+
+-- isFloatingArg is used to distinguish @Double@ and @Float@ which
+-- cause inadvertent numeric conversions if you aren't jolly careful.
+-- See codeGen/CgCon:cgTopRhsCon.
+
+isFloatingArg :: CgRep -> Bool
+isFloatingArg DoubleArg = True
+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
+\end{code}
+
+\begin{code}
+separateByPtrFollowness :: [(CgRep,a)] -> ([(CgRep,a)], [(CgRep,a)])
+-- Returns (ptrs, non-ptrs)
+separateByPtrFollowness things
+ = sep_things things [] []
+ -- accumulating params for follow-able and don't-follow things...
+ where
+ sep_things [] bs us = (reverse bs, reverse us)
+ sep_things ((PtrArg,a):ts) bs us = sep_things ts ((PtrArg,a):bs) us
+ sep_things (t :ts) bs us = sep_things ts bs (t:us)
+\end{code}
+
+\begin{code}
+cgRepSizeB :: CgRep -> ByteOff
+cgRepSizeB DoubleArg = dOUBLE_SIZE
+cgRepSizeB LongArg = wORD64_SIZE
+cgRepSizeB VoidArg = 0
+cgRepSizeB _ = wORD_SIZE
+
+cgRepSizeW :: CgRep -> ByteOff
+cgRepSizeW DoubleArg = dOUBLE_SIZE `quot` wORD_SIZE
+cgRepSizeW LongArg = wORD64_SIZE `quot` wORD_SIZE
+cgRepSizeW VoidArg = 0
+cgRepSizeW _ = 1
+
+retAddrSizeW :: WordOff
+retAddrSizeW = 1 -- One word
\end{code}
%************************************************************************
= GenericRep -- GC routines consult sizes in info tbl
Bool -- True <=> This is a static closure. Affects how
-- we garbage-collect it
- Int -- # ptr words
- Int -- # non-ptr words
+ !Int -- # ptr words
+ !Int -- # non-ptr words
ClosureType -- closure type
| BlackHoleRep
data ClosureType -- Corresponds 1-1 with the varieties of closures
-- implemented by the RTS. Compare with ghc/includes/ClosureTypes.h
- = CONSTR
- | CONSTR_p_n -- The p_n variants have more efficient GC, but we
- -- only provide them for dynamically-allocated closures
- -- (We could do them for static ones, but we don't)
- | CONSTR_NOCAF
- | FUN
- | FUN_p_n
- | THUNK
- | THUNK_p_n
- | THUNK_SELECTOR
- deriving (Eq,Ord)
+ = Constr
+ | ConstrNoCaf
+ | Fun
+ | Thunk
+ | ThunkSelector
\end{code}
Size of a closure header.
\begin{code}
-fixedHdrSize :: Int{-words-}
-fixedHdrSize = sTD_HDR_SIZE + profHdrSize + granHdrSize + tickyHdrSize
+fixedHdrSize :: WordOff
+fixedHdrSize = sTD_HDR_SIZE + profHdrSize + granHdrSize
-profHdrSize :: Int{-words-}
+profHdrSize :: WordOff
profHdrSize | opt_SccProfilingOn = pROF_HDR_SIZE
| otherwise = 0
-granHdrSize :: Int{-words-}
+granHdrSize :: WordOff
granHdrSize | opt_GranMacros = gRAN_HDR_SIZE
| otherwise = 0
-tickyHdrSize :: Int{-words-}
-tickyHdrSize | opt_DoTickyProfiling = tICKY_HDR_SIZE
- | otherwise = 0
+arrWordsHdrSize :: ByteOff
+arrWordsHdrSize = fixedHdrSize*wORD_SIZE + sIZEOF_StgArrWords_NoHdr
-arrWordsHdrSize :: Int{-words-}
-arrWordsHdrSize = fixedHdrSize + aRR_WORDS_HDR_SIZE
+arrPtrsHdrSize :: ByteOff
+arrPtrsHdrSize = fixedHdrSize*wORD_SIZE + sIZEOF_StgMutArrPtrs_NoHdr
-arrPtrsHdrSize :: Int{-words-}
-arrPtrsHdrSize = fixedHdrSize + aRR_PTRS_HDR_SIZE
+-- Thunks have an extra header word on SMP, so the update doesn't
+-- splat the payload.
+thunkHdrSize :: WordOff
+thunkHdrSize = fixedHdrSize + smp_hdr
+ where smp_hdr = sIZEOF_StgSMPThunkHeader `quot` wORD_SIZE
\end{code}
-Size of an info table.
-
\begin{code}
-fixedItblSize :: Int{-words-}
-fixedItblSize = sTD_ITBL_SIZE + profItblSize + granItblSize + tickyItblSize
-
-profItblSize :: Int{-words-}
-profItblSize | opt_SccProfilingOn = pROF_ITBL_SIZE
- | otherwise = 0
-
-granItblSize :: Int{-words-}
-granItblSize | opt_GranMacros = gRAN_ITBL_SIZE
- | otherwise = 0
-
-tickyItblSize :: Int{-words-}
-tickyItblSize | opt_DoTickyProfiling = tICKY_ITBL_SIZE
- | otherwise = 0
+-- 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}
\end{code}
\begin{code}
-instance Outputable SMRep where
- ppr rep = pprSMRep rep
-
-pprSMRep :: SMRep -> SDoc
-pprSMRep (GenericRep True ptrs nptrs clo_ty) = pprClosureType clo_ty ptrs nptrs <> ptext SLIT("_STATIC")
-pprSMRep (GenericRep False ptrs nptrs clo_ty) = pprClosureType clo_ty ptrs nptrs
-
-pprClosureType CONSTR p n = ptext SLIT("CONSTR")
-pprClosureType CONSTR_p_n p n = ptext SLIT("CONSTR_") <> int p <> char '_' <> int n
-pprClosureType CONSTR_NOCAF p n = ptext SLIT("CONSTR_NOCAF")
-pprClosureType FUN p n = ptext SLIT("FUN")
-pprClosureType FUN_p_n p n = ptext SLIT("FUN_") <> int p <> char '_' <> int n
-pprClosureType THUNK p n = ptext SLIT("THUNK")
-pprClosureType THUNK_p_n p n = ptext SLIT("THUNK_") <> int p <> char '_' <> int n
-pprClosureType THUNK_SELECTOR p n = ptext SLIT("THUNK_SELECTOR")
-
-#ifndef OMIT_NATIVE_CODEGEN
-getSMRepClosureTypeInt :: SMRep -> Int
-getSMRepClosureTypeInt (GenericRep False _ _ CONSTR) = cONSTR
-getSMRepClosureTypeInt (GenericRep False 1 0 CONSTR_p_n) = cONSTR_1_0
-getSMRepClosureTypeInt (GenericRep False 0 1 CONSTR_p_n) = cONSTR_0_1
-getSMRepClosureTypeInt (GenericRep False 2 0 CONSTR_p_n) = cONSTR_2_0
-getSMRepClosureTypeInt (GenericRep False 1 1 CONSTR_p_n) = cONSTR_1_1
-getSMRepClosureTypeInt (GenericRep False 0 2 CONSTR_p_n) = cONSTR_0_2
-
-getSMRepClosureTypeInt (GenericRep False _ _ FUN) = fUN
-getSMRepClosureTypeInt (GenericRep False 1 0 FUN_p_n) = fUN_1_0
-getSMRepClosureTypeInt (GenericRep False 0 1 FUN_p_n) = fUN_0_1
-getSMRepClosureTypeInt (GenericRep False 2 0 FUN_p_n) = fUN_2_0
-getSMRepClosureTypeInt (GenericRep False 1 1 FUN_p_n) = fUN_1_1
-getSMRepClosureTypeInt (GenericRep False 0 2 FUN_p_n) = fUN_0_2
-
-getSMRepClosureTypeInt (GenericRep False _ _ THUNK) = tHUNK
-getSMRepClosureTypeInt (GenericRep False 1 0 THUNK_p_n) = tHUNK_1_0
-getSMRepClosureTypeInt (GenericRep False 0 1 THUNK_p_n) = tHUNK_0_1
-getSMRepClosureTypeInt (GenericRep False 2 0 THUNK_p_n) = tHUNK_2_0
-getSMRepClosureTypeInt (GenericRep False 1 1 THUNK_p_n) = tHUNK_1_1
-getSMRepClosureTypeInt (GenericRep False 0 2 THUNK_p_n) = tHUNK_0_2
-
-getSMRepClosureTypeInt (GenericRep False _ _ THUNK_SELECTOR) = tHUNK_SELECTOR
-
-getSMRepClosureTypeInt (GenericRep True _ _ CONSTR) = cONSTR_STATIC
-getSMRepClosureTypeInt (GenericRep True _ _ CONSTR_NOCAF) = cONSTR_NOCAF_STATIC
-getSMRepClosureTypeInt (GenericRep True _ _ FUN) = fUN_STATIC
-getSMRepClosureTypeInt (GenericRep True _ _ THUNK) = tHUNK_STATIC
-
-getSMRepClosureTypeInt BlackHoleRep = bLACKHOLE
-
-getSMRepClosureTypeInt rep = pprPanic "getSMRepClosureTypeInt:" (pprSMRep rep)
-
-
--- Just the ones we need:
-
#include "../includes/ClosureTypes.h"
+-- Defines CONSTR, CONSTR_1_0 etc
+
+
+smRepClosureType :: SMRep -> ClosureType
+smRepClosureType (GenericRep _ _ _ ty) = ty
+smRepClosureType BlackHoleRep = panic "smRepClosureType: black hole"
+
+smRepClosureTypeInt :: SMRep -> Int
+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 1 Constr) = CONSTR_1_1
+smRepClosureTypeInt (GenericRep False 0 2 Constr) = CONSTR_0_2
+smRepClosureTypeInt (GenericRep False _ _ Constr) = CONSTR
+
+smRepClosureTypeInt (GenericRep False 1 0 Fun) = FUN_1_0
+smRepClosureTypeInt (GenericRep False 0 1 Fun) = FUN_0_1
+smRepClosureTypeInt (GenericRep False 2 0 Fun) = FUN_2_0
+smRepClosureTypeInt (GenericRep False 1 1 Fun) = FUN_1_1
+smRepClosureTypeInt (GenericRep False 0 2 Fun) = FUN_0_2
+smRepClosureTypeInt (GenericRep False _ _ Fun) = FUN
-cONSTR = (CONSTR :: Int)
-cONSTR_1_0 = (CONSTR_1_0 :: Int)
-cONSTR_0_1 = (CONSTR_0_1 :: Int)
-cONSTR_2_0 = (CONSTR_2_0 :: Int)
-cONSTR_1_1 = (CONSTR_1_1 :: Int)
-cONSTR_0_2 = (CONSTR_0_2 :: Int)
-cONSTR_STATIC = (CONSTR_STATIC :: Int)
-cONSTR_NOCAF_STATIC = (CONSTR_NOCAF_STATIC :: Int)
-fUN = (FUN :: Int)
-fUN_1_0 = (FUN_1_0 :: Int)
-fUN_0_1 = (FUN_0_1 :: Int)
-fUN_2_0 = (FUN_2_0 :: Int)
-fUN_1_1 = (FUN_1_1 :: Int)
-fUN_0_2 = (FUN_0_2 :: Int)
-fUN_STATIC = (FUN_STATIC :: Int)
-tHUNK = (THUNK :: Int)
-tHUNK_1_0 = (THUNK_1_0 :: Int)
-tHUNK_0_1 = (THUNK_0_1 :: Int)
-tHUNK_2_0 = (THUNK_2_0 :: Int)
-tHUNK_1_1 = (THUNK_1_1 :: Int)
-tHUNK_0_2 = (THUNK_0_2 :: Int)
-tHUNK_STATIC = (THUNK_STATIC :: Int)
-tHUNK_SELECTOR = (THUNK_SELECTOR :: Int)
-rET_SMALL = (RET_SMALL :: Int)
-rET_VEC_SMALL = (RET_VEC_SMALL :: Int)
-rET_BIG = (RET_BIG :: Int)
-rET_VEC_BIG = (RET_VEC_BIG :: Int)
-bLACKHOLE = (BLACKHOLE :: Int)
-
-#endif OMIT_NATIVE_CODEGEN
+smRepClosureTypeInt (GenericRep False 1 0 Thunk) = THUNK_1_0
+smRepClosureTypeInt (GenericRep False 0 1 Thunk) = THUNK_0_1
+smRepClosureTypeInt (GenericRep False 2 0 Thunk) = THUNK_2_0
+smRepClosureTypeInt (GenericRep False 1 1 Thunk) = THUNK_1_1
+smRepClosureTypeInt (GenericRep False 0 2 Thunk) = THUNK_0_2
+smRepClosureTypeInt (GenericRep False _ _ Thunk) = THUNK
+
+smRepClosureTypeInt (GenericRep False _ _ ThunkSelector) = THUNK_SELECTOR
+
+smRepClosureTypeInt (GenericRep True _ _ Constr) = CONSTR_STATIC
+smRepClosureTypeInt (GenericRep True _ _ ConstrNoCaf) = CONSTR_NOCAF_STATIC
+smRepClosureTypeInt (GenericRep True _ _ Fun) = FUN_STATIC
+smRepClosureTypeInt (GenericRep True _ _ Thunk) = THUNK_STATIC
+
+smRepClosureTypeInt BlackHoleRep = BLACKHOLE
+
+smRepClosureTypeInt rep = panic "smRepClosuretypeint"
+
+
+-- 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)
\end{code}
+
projects / ghc-hetmet.git / blobdiff