X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fprelude%2FPrimRep.lhs;h=a58240bdc21440df2b5548d916e5b6a87367f418;hb=553e90d9a32ee1b1809430f260c401cc4169c6c7;hp=6317a13b762de9d7b68285f5a3a85f9b3c22075f;hpb=106d45f223f43d1565d96fade7293f7a1aeea210;p=ghc-hetmet.git diff --git a/ghc/compiler/prelude/PrimRep.lhs b/ghc/compiler/prelude/PrimRep.lhs index 6317a13..a58240b 100644 --- a/ghc/compiler/prelude/PrimRep.lhs +++ b/ghc/compiler/prelude/PrimRep.lhs @@ -1,5 +1,5 @@ % -% (c) The GRASP Project, Glasgow University, 1992-1996 +% (c) The GRASP Project, Glasgow University, 1992-1998 % \section[PrimRep]{Primitive machine-level kinds of things.} @@ -8,27 +8,24 @@ At various places in the back end, we want to be to tag things with a types. \begin{code} -#include "HsVersions.h" - module PrimRep ( PrimRep(..), + separateByPtrFollowness, + isFollowableRep, + isFloatingRep, + isNonPtrRep, + is64BitRep, + getPrimRepSize, + getPrimRepSizeInBytes, + retPrimRepSize, + + ArgRep(..), primRepToArgRep, + ) where - separateByPtrFollowness, isFollowableRep, isFloatingRep, - getPrimRepSize, retPrimRepSize, - showPrimRep, ppPrimRep, - guessPrimRep, decodePrimRep - ) where - -IMP_Ubiq() +#include "HsVersions.h" -import Pretty -- pretty-printing code -import Util -#if __GLASGOW_HASKELL__ >= 202 +import Constants ( dOUBLE_SIZE, iNT64_SIZE, wORD64_SIZE, wORD_SIZE ) import Outputable -#endif - --- Oh dear. -#include "../../includes/GhcConstants.h" \end{code} %************************************************************************ @@ -37,6 +34,8 @@ import Outputable %* * %************************************************************************ +These pretty much correspond to the C types declared in StgTypes.h. + \begin{code} data PrimRep = -- These pointer-kinds are all really the same, but we keep @@ -48,29 +47,29 @@ data PrimRep | CostCentreRep -- Pointer to a cost centre | CharRep -- Machine characters - | IntRep -- integers (at least 32 bits) - | WordRep -- ditto (but *unsigned*) - | AddrRep -- addresses ("C pointers") + | IntRep -- signed integers (same size as ptr on this arch) + | WordRep -- unsigned integers (same size as ptr on this arch) + | AddrRep -- addresses (C pointers) | FloatRep -- floats | DoubleRep -- doubles - | ForeignObjRep -- This has to be a special kind because ccall - -- generates special code when passing/returning - -- one of these. [ADR] + | Int8Rep -- 8 bit signed integers + | Int16Rep -- 16 bit signed integers + | Int32Rep -- 32 bit signed integers + | Int64Rep -- 64 bit signed integers + | Word8Rep -- 8 bit unsigned integers + | Word16Rep -- 16 bit unsigned integers + | Word32Rep -- 32 bit unsigned integers + | Word64Rep -- 64 bit unsigned integers - | StablePtrRep -- We could replace this with IntRep but maybe - -- there's some documentation gain from having - -- it special? [ADR] - - | ArrayRep -- Primitive array of Haskell pointers - | ByteArrayRep -- Primitive array of bytes (no Haskell pointers) + | StablePtrRep -- guaranteed to be represented by a pointer | VoidRep -- Occupies no space at all! -- (Primitive states are mapped onto this) deriving (Eq, Ord) - -- Kinds are used in PrimTyCons, which need both Eq and Ord \end{code} + %************************************************************************ %* * \subsection[PrimRep-predicates]{Follow-ness, sizes, and such---on @PrimitiveKinds@} @@ -86,26 +85,11 @@ the pointer/object possibly will have to be saved onto, and the computation of GC liveness info. \begin{code} -isFollowableRep :: PrimRep -> Bool - -isFollowableRep PtrRep = True -isFollowableRep ArrayRep = True -isFollowableRep ByteArrayRep = True --- why is a ForeignObj followable? 4/96 SOF --- --- A: they're followable because these objects --- should be lugged around by the storage manager --- (==> registers containing them are live) -- 3/97 SOF -isFollowableRep ForeignObjRep = True - -isFollowableRep StablePtrRep = False --- StablePtrs aren't followable because they are just indices into a --- table for which explicit allocation/ deallocation is required. - -isFollowableRep other = False +isFollowableRep :: PrimRep -> Bool -- True <=> points to a heap object +isFollowableRep PtrRep = True +isFollowableRep other = False separateByPtrFollowness :: (a -> PrimRep) -> [a] -> ([a], [a]) - separateByPtrFollowness kind_fun things = sep_things kind_fun things [] [] -- accumulating params for follow-able and don't-follow things... @@ -124,24 +108,99 @@ See codeGen/CgCon:cgTopRhsCon. \begin{code} isFloatingRep :: PrimRep -> Bool - isFloatingRep DoubleRep = True isFloatingRep FloatRep = True -isFloatingRep other = False +isFloatingRep _ = False \end{code} +Identify anything which is one word large and not a pointer. + \begin{code} -getPrimRepSize :: PrimRep -> Int +isNonPtrRep :: PrimRep -> Bool +isNonPtrRep PtrRep = False +isNonPtrRep VoidRep = False +isNonPtrRep r = not (isFloatingRep r) && not (is64BitRep r) +\end{code} -getPrimRepSize DoubleRep = DOUBLE_SIZE -- "words", of course ---getPrimRepSize FloatRep = 1 ---getPrimRepSize CharRep = 1 -- ToDo: count in bytes? ---getPrimRepSize ArrayRep = 1 -- Listed specifically for *documentation* ---getPrimRepSize ByteArrayRep = 1 -getPrimRepSize VoidRep = 0 -getPrimRepSize other = 1 +\begin{code} +is64BitRep :: PrimRep -> Bool +is64BitRep Int64Rep = True +is64BitRep Word64Rep = True +is64BitRep _ = False + +-- Size in words. + +getPrimRepSize :: PrimRep -> Int +getPrimRepSize DoubleRep = dOUBLE_SIZE +getPrimRepSize Word64Rep = wORD64_SIZE +getPrimRepSize Int64Rep = iNT64_SIZE +getPrimRepSize VoidRep = 0 +getPrimRepSize _ = 1 +retPrimRepSize :: Int retPrimRepSize = getPrimRepSize RetRep + +-- Sizes in bytes. (used in some settings to figure out how many +-- bytes we have to push onto the stack when calling external entry +-- points (e.g., stdcalling on win32) + +-- Note: the "size in bytes" is also the scaling factor used when we +-- have an array of these things. For example, a ByteArray# of +-- Int16Rep will use a scaling factor of 2 when accessing the +-- elements. + +getPrimRepSizeInBytes :: PrimRep -> Int +getPrimRepSizeInBytes PtrRep = wORD_SIZE +getPrimRepSizeInBytes CodePtrRep = wORD_SIZE +getPrimRepSizeInBytes DataPtrRep = wORD_SIZE +getPrimRepSizeInBytes RetRep = wORD_SIZE +getPrimRepSizeInBytes CostCentreRep = wORD_SIZE +getPrimRepSizeInBytes CharRep = 4 +getPrimRepSizeInBytes IntRep = wORD_SIZE +getPrimRepSizeInBytes WordRep = wORD_SIZE +getPrimRepSizeInBytes AddrRep = wORD_SIZE +getPrimRepSizeInBytes FloatRep = wORD_SIZE +getPrimRepSizeInBytes DoubleRep = dOUBLE_SIZE * wORD_SIZE +getPrimRepSizeInBytes Int8Rep = 1 +getPrimRepSizeInBytes Int16Rep = 2 +getPrimRepSizeInBytes Int32Rep = 4 +getPrimRepSizeInBytes Int64Rep = 8 +getPrimRepSizeInBytes Word8Rep = 1 +getPrimRepSizeInBytes Word16Rep = 2 +getPrimRepSizeInBytes Word32Rep = 4 +getPrimRepSizeInBytes Word64Rep = 8 +getPrimRepSizeInBytes StablePtrRep = wORD_SIZE +getPrimRepSizeInBytes other = pprPanic "getPrimRepSizeInBytes" (ppr other) +\end{code} + +%************************************************************************ +%* * +\subsection{ArgReps} +%* * +%************************************************************************ + +An ArgRep is similar to a PrimRep, except that it is slightly +narrower. It corresponds to the distinctions we make between +different type of function arguments for the purposes of a function's +calling convention. These reps are used to decide which of the RTS's +generic apply functions to call when applying an unknown function. + +All 64-bit PrimReps map to the same ArgRep, because they're passed in +the same register, but a PtrRep is still different from an IntRep +(RepP vs. RepN respectively) 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 ArgRep = RepV | RepP | RepN | RepF | RepD | RepL + +primRepToArgRep VoidRep = RepV +primRepToArgRep FloatRep = RepF +primRepToArgRep DoubleRep = RepD +primRepToArgRep r + | isFollowableRep r = RepP + | is64BitRep r = RepL + | otherwise = ASSERT(getPrimRepSize r == 1) RepN \end{code} %************************************************************************ @@ -152,111 +211,30 @@ retPrimRepSize = getPrimRepSize RetRep \begin{code} instance Outputable PrimRep where - ppr sty kind = text (showPrimRep kind) + ppr kind = text (showPrimRep kind) showPrimRep :: PrimRep -> String --- dumping PrimRep tag for unfoldings -ppPrimRep :: PrimRep -> Doc - -guessPrimRep :: String -> PrimRep -- a horrible "inverse" function -decodePrimRep :: Char -> PrimRep -- of equal nature - -ppPrimRep k = - char - (case k of - PtrRep -> 'P' - CodePtrRep -> 'p' - DataPtrRep -> 'd' - CostCentreRep -> 'c' -- Pointer to a cost centre - RetRep -> 'R' - CharRep -> 'C' - IntRep -> 'I' - WordRep -> 'W' - AddrRep -> 'A' - FloatRep -> 'F' - DoubleRep -> 'D' - ArrayRep -> 'a' - ByteArrayRep -> 'b' - StablePtrRep -> 'S' - ForeignObjRep -> 'f' - VoidRep -> 'V' - _ -> panic "ppPrimRep") - -showPrimRep PtrRep = "P_" -- short for StgPtr - -showPrimRep CodePtrRep = "P_" -- DEATH to StgFunPtr! (94/02/22 WDP) - -- but aren't code pointers and function pointers different sizes - -- on some machines (eg 80x86)? ADR - -- Are you trying to ruin my life, or what? (WDP) - -showPrimRep DataPtrRep = "D_" -showPrimRep RetRep = "StgRetAddr" -showPrimRep CostCentreRep = "CostCentre" -showPrimRep CharRep = "StgChar" -showPrimRep IntRep = "I_" -- short for StgInt -showPrimRep WordRep = "W_" -- short for StgWord -showPrimRep AddrRep = "StgAddr" -showPrimRep FloatRep = "StgFloat" -showPrimRep DoubleRep = "StgDouble" -showPrimRep ArrayRep = "StgArray" -- see comment below -showPrimRep ByteArrayRep = "StgByteArray" -showPrimRep StablePtrRep = "StgStablePtr" -showPrimRep ForeignObjRep = "StgPtr" -- see comment below -showPrimRep VoidRep = "!!VOID_KIND!!" - -decodePrimRep ch = - case ch of - 'P' -> PtrRep - 'p' -> CodePtrRep - 'd' -> DataPtrRep - 'c' -> CostCentreRep - 'R' -> RetRep - 'C' -> CharRep - 'I' -> IntRep - 'W' -> WordRep - 'A' -> AddrRep - 'F' -> FloatRep - 'D' -> DoubleRep - 'a' -> ArrayRep - 'b' -> ByteArrayRep - 'S' -> StablePtrRep - 'f' -> ForeignObjRep - 'V' -> VoidRep - _ -> panic "decodePrimRep" - -guessPrimRep "D_" = DataPtrRep -guessPrimRep "StgRetAddr" = RetRep -guessPrimRep "StgChar" = CharRep -guessPrimRep "I_" = IntRep -guessPrimRep "W_" = WordRep -guessPrimRep "StgAddr" = AddrRep -guessPrimRep "StgFloat" = FloatRep -guessPrimRep "StgDouble" = DoubleRep -guessPrimRep "StgArray" = ArrayRep -guessPrimRep "StgByteArray" = ByteArrayRep -guessPrimRep "StgStablePtr" = StablePtrRep +showPrimRep PtrRep = "P_" -- short for StgPtr +showPrimRep CodePtrRep = "P_" -- DEATH to StgFunPtr! (94/02/22 WDP) +showPrimRep DataPtrRep = "D_" +showPrimRep RetRep = "P_" +showPrimRep CostCentreRep = "CostCentre" +showPrimRep CharRep = "C_" +showPrimRep Int8Rep = "StgInt8" +showPrimRep Int16Rep = "StgInt16" +showPrimRep Int32Rep = "StgInt32" +showPrimRep Word8Rep = "StgWord8" +showPrimRep Word16Rep = "StgWord16" +showPrimRep Word32Rep = "StgWord32" +showPrimRep IntRep = "I_" -- short for StgInt +showPrimRep WordRep = "W_" -- short for StgWord +showPrimRep Int64Rep = "LI_" -- short for StgLongInt +showPrimRep Word64Rep = "LW_" -- short for StgLongWord +showPrimRep AddrRep = "StgAddr" +showPrimRep FloatRep = "StgFloat" +showPrimRep DoubleRep = "StgDouble" +showPrimRep StablePtrRep = "StgStablePtr" +showPrimRep VoidRep = "!!VOID_KIND!!" \end{code} -All local C variables of @ArrayRep@ are declared in C as type -@StgArray@. The coercion to a more precise C type is done just before -indexing (by the relevant C primitive-op macro). - -Nota Bene. There are three types associated with @ForeignObj@ (MallocPtr++): -\begin{itemize} -\item -@StgForeignObjClosure@ is the type of the thing the prim. op @mkForeignObj@ returns. -{- old comment for MallocPtr -(This typename is hardwired into @ppr_casm_results@ in -@PprAbsC.lhs@.) --} - -\item -@StgForeignObj@ is the type of the thing we give the C world. - -\item -@StgPtr@ is the type of the (pointer to the) heap object which we -pass around inside the STG machine. -\end{itemize} - -It is really easy to confuse the two. (I'm not sure this choice of -type names helps.) [ADR] +