%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: AbsCSyn.lhs,v 1.48 2002/07/16 14:56:09 simonmar Exp $
+% $Id: AbsCSyn.lhs,v 1.49 2002/08/02 13:08:33 simonmar Exp $
%
\section[AbstractC]{Abstract C: the last stop before machine code}
| GET_TAG -- get current constructor tag
| UPD_FRAME_UPDATEE
| CCS_HDR
-
+ | BYTE_ARR_CTS -- used when passing a ByteArray# to a ccall
+ | PTRS_ARR_CTS -- similarly for an Array#
+ | ForeignObj_CLOSURE_DATA -- and again for a ForeignObj#
\end{code}
Convenience functions:
magicIdPrimRep HpLim = PtrRep
magicIdPrimRep CurCostCentre = CostCentreRep
magicIdPrimRep VoidReg = VoidRep
-magicIdPrimRep CurrentTSO = ThreadIdRep
+magicIdPrimRep CurrentTSO = PtrRep
magicIdPrimRep CurrentNursery = PtrRep
magicIdPrimRep HpAlloc = WordRep
\end{code}
dscCOpStmt [] WriteOffAddrOp_Word [a,i,x] vols = doWriteOffAddrOp Nothing WordRep a i x
dscCOpStmt [] WriteOffAddrOp_Addr [a,i,x] vols = doWriteOffAddrOp Nothing AddrRep a i x
dscCOpStmt [] WriteOffAddrOp_Float [a,i,x] vols = doWriteOffAddrOp Nothing FloatRep a i x
-dscCOpStmt [] WriteOffAddrOp_ForeignObj [a,i,x] vols = doWriteOffAddrOp Nothing ForeignObjRep a i x
+dscCOpStmt [] WriteOffAddrOp_ForeignObj [a,i,x] vols = doWriteOffAddrOp Nothing PtrRep a i x
dscCOpStmt [] WriteOffAddrOp_Double [a,i,x] vols = doWriteOffAddrOp Nothing DoubleRep a i x
dscCOpStmt [] WriteOffAddrOp_StablePtr [a,i,x] vols = doWriteOffAddrOp Nothing StablePtrRep a i x
hcat (punctuate comma ccall_fun_args),
text "));"
])
-\end{code}
-If the argument is a heap object, we need to reach inside and pull out
-the bit the C world wants to see. The only heap objects which can be
-passed are @Array@s and @ByteArray@s.
-\begin{code}
ppr_casm_arg :: CAddrMode -> Int -> (SDoc, SDoc)
-- (a) decl and assignment, (b) local var to be used later
local_var = (<>) (ptext SLIT("_ccall_arg")) (int a_num)
- (arg_type, pp_amode2)
- = case a_kind of
-
- -- for array arguments, pass a pointer to the body of the array
- -- (PTRS_ARR_CTS skips over all the header nonsense)
- ArrayRep -> (pp_kind,
- hcat [ptext SLIT("PTRS_ARR_CTS"),char '(', pp_amode, rparen])
- ByteArrayRep -> (pp_kind,
- hcat [ptext SLIT("BYTE_ARR_CTS"),char '(', pp_amode, rparen])
-
- -- for ForeignObj, use FOREIGN_OBJ_DATA to fish out the contents.
- ForeignObjRep -> (pp_kind,
- hcat [ptext SLIT("ForeignObj_CLOSURE_DATA"),
- char '(', pp_amode, char ')'])
-
- other -> (pp_kind, pp_amode)
-
declare_local_var
- = hcat [ arg_type, space, local_var, equals, pp_amode2, semi ]
+ = hcat [ pp_kind, space, local_var, equals, pp_amode, semi ]
in
(declare_local_var, local_var)
\end{code}
text "(P_)(", -- Here is the cast
ppr_amode src, pp_paren_semi ]
-pprAssign ByteArrayRep dest src
- | mixedPtrLocn src
- -- Add in a cast iff the source is mixed
- = hcat [ ppr_amode dest, equals,
- text "(StgByteArray)(", -- Here is the cast
- ppr_amode src, pp_paren_semi ]
-
pprAssign kind other_dest src
= hcat [ ppr_amode other_dest, equals,
pprAmode src, semi ]
cExprMacroText GET_TAG = SLIT("GET_TAG")
cExprMacroText UPD_FRAME_UPDATEE = SLIT("UPD_FRAME_UPDATEE")
cExprMacroText CCS_HDR = SLIT("CCS_HDR")
+cExprMacroText BYTE_ARR_CTS = SLIT("BYTE_ARR_CTS")
+cExprMacroText PTRS_ARR_CTS = SLIT("PTRS_ARR_CTS")
+cExprMacroText ForeignObj_CLOSURE_DATA = SLIT("ForeignObj_CLOSURE_DATA")
cStmtMacroText ARGS_CHK = SLIT("ARGS_CHK")
cStmtMacroText ARGS_CHK_LOAD_NODE = SLIT("ARGS_CHK_LOAD_NODE")
pprUnionTag DoubleRep = panic "pprUnionTag:Double?"
pprUnionTag StablePtrRep = char 'p'
-pprUnionTag StableNameRep = char 'p'
-pprUnionTag WeakPtrRep = char 'p'
-pprUnionTag ForeignObjRep = char 'p'
-pprUnionTag PrimPtrRep = char 'p'
-
-pprUnionTag ThreadIdRep = char 't'
-
-pprUnionTag ArrayRep = char 'p'
-pprUnionTag ByteArrayRep = char 'b'
-pprUnionTag BCORep = char 'p'
pprUnionTag _ = panic "pprUnionTag:Odd kind"
\end{code}
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: CgCase.lhs,v 1.57 2002/04/29 14:03:41 simonmar Exp $
+% $Id: CgCase.lhs,v 1.58 2002/08/02 13:08:34 simonmar Exp $
%
%********************************************************
%* *
cgPrimEvalAlts bndr tycon alts deflt
= cgPrimAltsWithDefault bndr GCMayHappen (CReg reg) alts deflt [reg]
where
- reg = WARN( case kind of { PtrRep -> True; other -> False },
- text "cgPrimEE" <+> ppr bndr <+> ppr tycon )
- dataReturnConvPrim kind
+ reg = dataReturnConvPrim kind
kind = tyConPrimRep tycon
cgPrimAltsWithDefault bndr gc_flag scrutinee alts deflt regs
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: CgExpr.lhs,v 1.49 2002/06/18 13:58:23 simonpj Exp $
+% $Id: CgExpr.lhs,v 1.50 2002/08/02 13:08:34 simonmar Exp $
%
%********************************************************
%* *
import StgSyn
import CgMonad
import AbsCSyn
-import AbsCUtils ( mkAbstractCs )
+import AbsCUtils ( mkAbstractCs, getAmodeRep )
import CLabel ( mkClosureTblLabel )
import SMRep ( fixedHdrSize )
import CostCentre ( sccAbleCostCentre, isSccCountCostCentre )
import Id ( idPrimRep, idType, Id )
import VarSet
-import PrimOp ( primOpOutOfLine, getPrimOpResultInfo, PrimOp(..), PrimOpResultInfo(..) )
+import PrimOp ( primOpOutOfLine, getPrimOpResultInfo,
+ PrimOp(..), PrimOpResultInfo(..) )
+import TysPrim ( foreignObjPrimTyCon, arrayPrimTyCon,
+ byteArrayPrimTyCon, mutableByteArrayPrimTyCon,
+ mutableArrayPrimTyCon )
import PrimRep ( PrimRep(..), isFollowableRep )
import TyCon ( isUnboxedTupleTyCon, isEnumerationTyCon )
import Type ( Type, typePrimRep, tyConAppArgs, tyConAppTyCon, repType )
\begin{code}
primRetUnboxedTuple :: StgOp -> [StgArg] -> Type -> Code
primRetUnboxedTuple op args res_ty
- = getArgAmodes args `thenFC` \ arg_amodes ->
+ = getArgAmodes args `thenFC` \ arg_amodes1 ->
+ {-
+ For a foreign call, we might need to fiddle with some of the args:
+ for example, when passing a ByteArray#, we pass a ptr to the goods
+ rather than the heap object.
+ -}
+ let
+ arg_amodes
+ | StgFCallOp{} <- op = zipWith shimFCallArg args arg_amodes1
+ | otherwise = arg_amodes1
+ in
{-
put all the arguments in temporaries so they don't get stomped when
we push the return address.
let
n_args = length args
arg_uniqs = map mkBuiltinUnique [0 .. n_args-1]
- arg_reps = map getArgPrimRep args
+ arg_reps = map getAmodeRep arg_amodes
arg_temps = zipWith CTemp arg_uniqs arg_reps
in
absC (mkAbstractCs (zipWith CAssign arg_temps arg_amodes)) `thenC`
temp_amodes = zipWith CTemp temp_uniqs prim_reps
in
returnUnboxedTuple temp_amodes (absC (COpStmt temp_amodes op arg_temps []))
+
+shimFCallArg arg amode
+ | tycon == foreignObjPrimTyCon
+ = CMacroExpr AddrRep ForeignObj_CLOSURE_DATA [amode]
+ | tycon == arrayPrimTyCon || tycon == mutableArrayPrimTyCon
+ = CMacroExpr PtrRep PTRS_ARR_CTS [amode]
+ | tycon == byteArrayPrimTyCon || tycon == mutableByteArrayPrimTyCon
+ = CMacroExpr AddrRep BYTE_ARR_CTS [amode]
+ | otherwise = amode
+ where
+ -- should be a tycon app, since this is a foreign call
+ tycon = tyConAppTyCon (repType (stgArgType arg))
\end{code}
%
% (c) The GRASP Project, Glasgow University, 1992-1998
%
-% $Id: CgRetConv.lhs,v 1.31 2002/01/28 16:52:37 simonpj Exp $
+% $Id: CgRetConv.lhs,v 1.32 2002/08/02 13:08:34 simonmar Exp $
%
\section[CgRetConv]{Return conventions for the code generator}
\begin{code}
dataReturnConvPrim :: PrimRep -> MagicId
+dataReturnConvPrim PtrRep = VanillaReg PtrRep (_ILIT 1)
dataReturnConvPrim IntRep = VanillaReg IntRep (_ILIT 1)
dataReturnConvPrim WordRep = VanillaReg WordRep (_ILIT 1)
dataReturnConvPrim Int32Rep = VanillaReg Int32Rep (_ILIT 1)
dataReturnConvPrim Int8Rep = VanillaReg Int8Rep (_ILIT 1)
dataReturnConvPrim FloatRep = FloatReg (_ILIT 1)
dataReturnConvPrim DoubleRep = DoubleReg (_ILIT 1)
+dataReturnConvPrim StablePtrRep = VanillaReg StablePtrRep (_ILIT 1)
dataReturnConvPrim VoidRep = VoidReg
--- Return a primitive-array pointer in the usual register:
-dataReturnConvPrim ArrayRep = VanillaReg ArrayRep (_ILIT 1)
-dataReturnConvPrim ByteArrayRep = VanillaReg ByteArrayRep (_ILIT 1)
-dataReturnConvPrim PrimPtrRep = VanillaReg PrimPtrRep (_ILIT 1)
-dataReturnConvPrim ThreadIdRep = VanillaReg ThreadIdRep (_ILIT 1)
-
-dataReturnConvPrim StablePtrRep = VanillaReg StablePtrRep (_ILIT 1)
-dataReturnConvPrim ForeignObjRep = VanillaReg ForeignObjRep (_ILIT 1)
-dataReturnConvPrim WeakPtrRep = VanillaReg WeakPtrRep (_ILIT 1)
-
#ifdef DEBUG
dataReturnConvPrim rep = pprPanic "dataReturnConvPrim:" (ppr rep)
#endif
import StgSyn ( StgOp(..) )
import MachOp ( MachOp(..), resultRepOfMachOp )
import PrimRep ( isFloatingRep, is64BitRep,
- PrimRep(..), getPrimRepArrayElemSize )
+ PrimRep(..), getPrimRepSizeInBytes )
import StixInfo ( genCodeInfoTable, genBitmapInfoTable,
livenessIsSmall, bitmapToIntegers )
import StixMacro ( macroCode, checkCode )
-- We need to promote any item smaller than a word to a word
promote_to_word pk
- | getPrimRepArrayElemSize pk >= getPrimRepArrayElemSize IntRep = pk
- | otherwise = IntRep
+ | getPrimRepSizeInBytes pk >= getPrimRepSizeInBytes IntRep = pk
+ | otherwise = IntRep
\end{code}
Now the individual AbstractC statements.
#endif
import Maybes ( maybeToBool )
import PrimRep ( isFloatingRep, is64BitRep, PrimRep(..),
- getPrimRepArrayElemSize )
+ getPrimRepSizeInBytes )
import Stix ( getNatLabelNCG, StixStmt(..), StixExpr(..),
StixReg(..), pprStixReg, StixVReg(..), CodeSegment(..),
DestInfo, hasDestInfo,
-- the linker can handle simple arithmetic...
getData (StIndex rep (StCLbl lbl) (StInt off)) =
returnNat (nilOL,
- ImmIndex lbl (fromInteger off * getPrimRepArrayElemSize rep))
+ ImmIndex lbl (fromInteger off * getPrimRepSizeInBytes rep))
-- Top-level lifted-out string. The segment will already have been set
-- (see Stix.liftStrings).
mangleIndexTree (StIndex pk base (StInt i))
= StMachOp MO_Nat_Add [base, off]
where
- off = StInt (i * toInteger (getPrimRepArrayElemSize pk))
+ off = StInt (i * toInteger (getPrimRepSizeInBytes pk))
mangleIndexTree (StIndex pk base off)
= StMachOp MO_Nat_Add [
]
where
shift :: PrimRep -> Int
- shift rep = case getPrimRepArrayElemSize rep of
+ shift rep = case getPrimRepSizeInBytes rep of
1 -> 0
2 -> 1
4 -> 2
maybeImm (StCLbl l)
= Just (ImmCLbl l)
maybeImm (StIndex rep (StCLbl l) (StInt off))
- = Just (ImmIndex l (fromInteger off * getPrimRepArrayElemSize rep))
+ = Just (ImmIndex l (fromInteger off * getPrimRepSizeInBytes rep))
maybeImm (StInt i)
| i >= toInteger (minBound::Int) && i <= toInteger (maxBound::Int)
= Just (ImmInt (fromInteger i))
primRepToSize AddrRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, )))
primRepToSize FloatRep = IF_ARCH_alpha(TF, IF_ARCH_i386(F, IF_ARCH_sparc(F, )))
primRepToSize DoubleRep = IF_ARCH_alpha(TF, IF_ARCH_i386(DF, IF_ARCH_sparc(DF, )))
-primRepToSize ArrayRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, )))
-primRepToSize ByteArrayRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, )))
-primRepToSize PrimPtrRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, )))
-primRepToSize WeakPtrRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, )))
-primRepToSize ForeignObjRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, )))
-primRepToSize BCORep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, )))
primRepToSize StablePtrRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, )))
-primRepToSize StableNameRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, )))
-primRepToSize ThreadIdRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, )))
primRepToSize Word64Rep = primRepToSize_fail "Word64Rep"
primRepToSize Int64Rep = primRepToSize_fail "Int64Rep"
++ "Workaround: use -fvia-C.\n\t"
++ "Perhaps you should report it as a GHC bug,\n\t"
++ "to glasgow-haskell-bugs@haskell.org.")
-
\end{code}
%************************************************************************
isCloseEnoughTo r1 r2
= r1 == r2 || (wordIsh r1 && wordIsh r2)
wordIsh rep
- = rep `elem` [IntRep, WordRep, PtrRep, AddrRep, CodePtrRep,
- RetRep, ArrayRep, PrimPtrRep, StableNameRep, BCORep]
+ = rep `elem` [IntRep, WordRep, PtrRep, AddrRep, CodePtrRep, RetRep ]
-- determined by looking at PrimRep.showPrimRep
-- Stix trees which denote a value.
import SMRep ( fixedHdrSize )
import Literal ( Literal(..), word2IntLit )
import MachOp ( MachOp(..) )
-import PrimRep ( PrimRep(..), getPrimRepArrayElemSize )
+import PrimRep ( PrimRep(..), getPrimRepSizeInBytes )
import UniqSupply ( returnUs, thenUs, getUniqueUs, UniqSM )
import Constants ( wORD_SIZE,
mIN_INTLIKE, mIN_CHARLIKE, uF_UPDATEE, bLOCK_SIZE,
-> ncgPrimopMoan "Native code generator can't handle foreign call"
(ppr call)
- stix_args = map amodeCodeForCCall cargs
- amodeCodeForCCall x =
- let base = amodeToStix' x
- in
- case getAmodeRep x of
- ArrayRep -> StIndex PtrRep base arrPtrsHS
- ByteArrayRep -> StIndex IntRep base arrWordsHS
- ForeignObjRep -> StInd PtrRep (StIndex PtrRep base fixedHS)
- other -> base
+ stix_args = map amodeToStix' cargs
ccall = case lhs of
[] -> StVoidable (StCall stix_target cconv VoidRep stix_args)
_ -> panic "amodeToStix:core literal"
amodeToStix (CMacroExpr _ macro [arg])
- = case macro of
- ENTRY_CODE -> amodeToStix arg
- ARG_TAG -> amodeToStix arg -- just an integer no. of words
+ = let
+ arg_amode = amodeToStix arg
+ in
+ case macro of
+ ENTRY_CODE -> arg_amode
+ ARG_TAG -> arg_amode -- just an integer no. of words
GET_TAG ->
#ifdef WORDS_BIGENDIAN
StMachOp MO_Nat_And
- [StInd WordRep (StIndex PtrRep (amodeToStix arg)
+ [StInd WordRep (StIndex PtrRep arg_amode
(StInt (toInteger (-1)))),
StInt 65535]
#else
StMachOp MO_Nat_Shr
- [StInd WordRep (StIndex PtrRep (amodeToStix arg)
+ [StInd WordRep (StIndex PtrRep arg_amode
(StInt (toInteger (-1)))),
StInt 16]
#endif
UPD_FRAME_UPDATEE
- -> StInd PtrRep (StIndex PtrRep (amodeToStix arg)
+ -> StInd PtrRep (StIndex PtrRep arg_amode
(StInt (toInteger uF_UPDATEE)))
+ BYTE_ARR_CTS -> StIndex IntRep arg_amode arrWordsHS
+ PTRS_ARR_CTS -> StIndex PtrRep arg_amode arrPtrsHS
+ ForeignObj_CLOSURE_DATA -> StInd PtrRep (StIndex PtrRep arg_amode fixedHS)
+
+
amodeToStix other
= pprPanic "StixPrim.amodeToStix" (pprAmode other)
mutArrPtrsFrozen_info = StCLbl mkMAP_FROZEN_infoLabel
-- these are the sizes of charLike and intLike closures, in _bytes_.
-charLikeSize = (fixedHdrSize + 1) * (getPrimRepArrayElemSize PtrRep)
-intLikeSize = (fixedHdrSize + 1) * (getPrimRepArrayElemSize PtrRep)
+charLikeSize = (fixedHdrSize + 1) * (getPrimRepSizeInBytes PtrRep)
+intLikeSize = (fixedHdrSize + 1) * (getPrimRepSizeInBytes PtrRep)
\end{code}
\begin{code}
save_thread_state
= getUniqueUs `thenUs` \ tso_uq ->
- let tso = StixTemp (StixVReg tso_uq ThreadIdRep) in
+ let tso = StixTemp (StixVReg tso_uq PtrRep) in
returnUs (\xs ->
- StAssignReg ThreadIdRep tso (StReg stgCurrentTSO)
+ StAssignReg PtrRep tso (StReg stgCurrentTSO)
: StAssignMem PtrRep
(StMachOp MO_Nat_Add
[StReg tso, StInt (toInteger (TSO_SP*BYTES_PER_WORD))])
load_thread_state
= getUniqueUs `thenUs` \ tso_uq ->
- let tso = StixTemp (StixVReg tso_uq ThreadIdRep) in
+ let tso = StixTemp (StixVReg tso_uq PtrRep) in
returnUs (\xs ->
- StAssignReg ThreadIdRep tso (StReg stgCurrentTSO)
+ StAssignReg PtrRep tso (StReg stgCurrentTSO)
: StAssignReg PtrRep
stgSp
(StInd PtrRep
\begin{code}
module PrimRep
- (
- PrimRep(..)
+ ( PrimRep(..)
, separateByPtrFollowness
, isFollowableRep
, isFloatingRep
, is64BitRep
, getPrimRepSize
, getPrimRepSizeInBytes
- , getPrimRepArrayElemSize
, retPrimRepSize
) where
%* *
%************************************************************************
+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
| Word32Rep -- 32 bit unsigned integers
| Word64Rep -- 64 bit unsigned integers
- | WeakPtrRep
- | ForeignObjRep
- | BCORep
-
| StablePtrRep -- guaranteed to be represented by a pointer
- | StableNameRep -- A stable name is a real heap object, unpointed,
- -- with one field containing an index into the
- -- stable pointer table. It has to be a heap
- -- object so the garbage collector can track these
- -- objects and reclaim stable pointer entries.
-
- | ThreadIdRep -- Really a pointer to a TSO
-
- | ArrayRep -- Primitive array of Haskell pointers
- | ByteArrayRep -- Primitive array of bytes (no Haskell pointers)
-
- | PrimPtrRep -- Used for MutVars and MVars;
- -- a pointer to a primitive object
- -- ToDo: subsumes WeakPtrRep, ThreadIdRep,
- -- StableNameRep, ForeignObjRep, and BCORep ?
-
| 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}
-These pretty much correspond to the C types declared in StgTypes.h,
-with the following exceptions:
-
- - when an Array or ByteArray is passed to C, we again pass a pointer
- to the contents. The actual type that is passed is StgPtr for
- ArrayRep, and StgByteArray (probably a char *) for ByteArrayRep.
-
-These hacks are left until the final printing of the C, in
-PprAbsC.lhs.
%************************************************************************
%* *
computation of GC liveness info.
\begin{code}
-isFollowableRep :: PrimRep -> Bool
-
-isFollowableRep PtrRep = True
-isFollowableRep ArrayRep = True -- all heap objects:
-isFollowableRep ByteArrayRep = True -- ''
-isFollowableRep WeakPtrRep = True -- ''
-isFollowableRep ForeignObjRep = True -- ''
-isFollowableRep StableNameRep = True -- ''
-isFollowableRep PrimPtrRep = True -- ''
-isFollowableRep ThreadIdRep = True -- pointer to a TSO
-isFollowableRep BCORep = True
-
+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...
is64BitRep Int64Rep = True
is64BitRep Word64Rep = True
is64BitRep _ = False
-\end{code}
-\begin{code}
+-- Size in words.
+
getPrimRepSize :: PrimRep -> Int
-getPrimRepSize DoubleRep = dOUBLE_SIZE -- "words", of course
+getPrimRepSize DoubleRep = dOUBLE_SIZE
getPrimRepSize Word64Rep = wORD64_SIZE
getPrimRepSize Int64Rep = iNT64_SIZE
getPrimRepSize VoidRep = 0
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)
+-- 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 Word16Rep = 2
getPrimRepSizeInBytes Word32Rep = 4
getPrimRepSizeInBytes Word64Rep = 8
-getPrimRepSizeInBytes WeakPtrRep = wORD_SIZE
-getPrimRepSizeInBytes ForeignObjRep = wORD_SIZE
getPrimRepSizeInBytes StablePtrRep = wORD_SIZE
-getPrimRepSizeInBytes StableNameRep = wORD_SIZE
-getPrimRepSizeInBytes ArrayRep = wORD_SIZE
-getPrimRepSizeInBytes ByteArrayRep = wORD_SIZE
getPrimRepSizeInBytes other = pprPanic "getPrimRepSizeInBytes" (ppr other)
-
-
--- Sizes in bytes of things when they are array elements,
--- so that we can generate the correct indexing code
--- inside the compiler. This is not the same as the above
--- getPrimRepSizeInBytes, the rationale behind which is
--- unclear to me.
-getPrimRepArrayElemSize :: PrimRep -> Int
-getPrimRepArrayElemSize CharRep = 4
-getPrimRepArrayElemSize DataPtrRep = wORD_SIZE
-getPrimRepArrayElemSize PtrRep = wORD_SIZE
-getPrimRepArrayElemSize IntRep = wORD_SIZE
-getPrimRepArrayElemSize WordRep = wORD_SIZE
-getPrimRepArrayElemSize AddrRep = wORD_SIZE
-getPrimRepArrayElemSize StablePtrRep = wORD_SIZE
-getPrimRepArrayElemSize ForeignObjRep = wORD_SIZE
-getPrimRepArrayElemSize Word8Rep = 1
-getPrimRepArrayElemSize Word16Rep = 2
-getPrimRepArrayElemSize Word32Rep = 4
-getPrimRepArrayElemSize Word64Rep = 8
-getPrimRepArrayElemSize Int8Rep = 1
-getPrimRepArrayElemSize Int16Rep = 2
-getPrimRepArrayElemSize Int32Rep = 4
-getPrimRepArrayElemSize Int64Rep = 8
-getPrimRepArrayElemSize FloatRep = 4
-getPrimRepArrayElemSize DoubleRep = 8
-getPrimRepArrayElemSize other = pprPanic "getPrimRepArrayElemSize" (ppr other)
-
\end{code}
%************************************************************************
showPrimRep AddrRep = "StgAddr"
showPrimRep FloatRep = "StgFloat"
showPrimRep DoubleRep = "StgDouble"
-showPrimRep ArrayRep = "P_" -- see comment below
-showPrimRep PrimPtrRep = "P_"
-showPrimRep ByteArrayRep = "StgByteArray"
showPrimRep StablePtrRep = "StgStablePtr"
-showPrimRep StableNameRep = "P_"
-showPrimRep ThreadIdRep = "StgTSO*"
-showPrimRep WeakPtrRep = "P_"
-showPrimRep ForeignObjRep = "StgAddr"
showPrimRep VoidRep = "!!VOID_KIND!!"
-showPrimRep BCORep = "P_" -- not sure -- JRS 000708
\end{code}
-
-Foreign Objects and Arrays are treated specially by the code for
-_ccall_s: we pass a pointer to the contents of the object, not the
-object itself.
\end{code}
RealWorld is deeply magical. It is *primitive*, but it is not
-*unlifted* (hence PrimPtrRep). We never manipulate values of type
+*unlifted* (hence PtrRep). We never manipulate values of type
RealWorld; it's only used in the type system, to parameterise State#.
\begin{code}
-realWorldTyCon = mkLiftedPrimTyCon realWorldTyConName liftedTypeKind 0 [] PrimPtrRep
+realWorldTyCon = mkLiftedPrimTyCon realWorldTyConName liftedTypeKind 0 [] PtrRep
realWorldTy = mkTyConTy realWorldTyCon
realWorldStatePrimTy = mkStatePrimTy realWorldTy -- State# RealWorld
\end{code}
%************************************************************************
\begin{code}
-arrayPrimTyCon = pcPrimTyCon arrayPrimTyConName vrcsP ArrayRep
-mutableArrayPrimTyCon = pcPrimTyCon mutableArrayPrimTyConName vrcsZP ArrayRep
-mutableByteArrayPrimTyCon = pcPrimTyCon mutableByteArrayPrimTyConName vrcsZ ByteArrayRep
-byteArrayPrimTyCon = pcPrimTyCon0 byteArrayPrimTyConName ByteArrayRep
+arrayPrimTyCon = pcPrimTyCon arrayPrimTyConName vrcsP PtrRep
+mutableArrayPrimTyCon = pcPrimTyCon mutableArrayPrimTyConName vrcsZP PtrRep
+mutableByteArrayPrimTyCon = pcPrimTyCon mutableByteArrayPrimTyConName vrcsZ PtrRep
+byteArrayPrimTyCon = pcPrimTyCon0 byteArrayPrimTyConName PtrRep
mkArrayPrimTy elt = mkTyConApp arrayPrimTyCon [elt]
byteArrayPrimTy = mkTyConTy byteArrayPrimTyCon
%************************************************************************
\begin{code}
-mutVarPrimTyCon = pcPrimTyCon mutVarPrimTyConName vrcsZP PrimPtrRep
+mutVarPrimTyCon = pcPrimTyCon mutVarPrimTyConName vrcsZP PtrRep
mkMutVarPrimTy s elt = mkTyConApp mutVarPrimTyCon [s, elt]
\end{code}
%************************************************************************
\begin{code}
-mVarPrimTyCon = pcPrimTyCon mVarPrimTyConName vrcsZP PrimPtrRep
+mVarPrimTyCon = pcPrimTyCon mVarPrimTyConName vrcsZP PtrRep
mkMVarPrimTy s elt = mkTyConApp mVarPrimTyCon [s, elt]
\end{code}
%************************************************************************
\begin{code}
-stableNamePrimTyCon = pcPrimTyCon stableNamePrimTyConName vrcsP StableNameRep
+stableNamePrimTyCon = pcPrimTyCon stableNamePrimTyConName vrcsP PtrRep
mkStableNamePrimTy ty = mkTyConApp stableNamePrimTyCon [ty]
\end{code}
\begin{code}
foreignObjPrimTy = mkTyConTy foreignObjPrimTyCon
-foreignObjPrimTyCon = pcPrimTyCon0 foreignObjPrimTyConName ForeignObjRep
+foreignObjPrimTyCon = pcPrimTyCon0 foreignObjPrimTyConName PtrRep
\end{code}
-
+
%************************************************************************
%* *
\subsection[TysPrim-BCOs]{The ``bytecode object'' type}
\begin{code}
bcoPrimTy = mkTyConTy bcoPrimTyCon
-bcoPrimTyCon = pcPrimTyCon0 bcoPrimTyConName BCORep
+bcoPrimTyCon = pcPrimTyCon0 bcoPrimTyConName PtrRep
\end{code}
%************************************************************************
%************************************************************************
\begin{code}
-weakPrimTyCon = pcPrimTyCon weakPrimTyConName vrcsP WeakPtrRep
+weakPrimTyCon = pcPrimTyCon weakPrimTyConName vrcsP PtrRep
mkWeakPrimTy v = mkTyConApp weakPrimTyCon [v]
\end{code}
\begin{code}
threadIdPrimTy = mkTyConTy threadIdPrimTyCon
-threadIdPrimTyCon = pcPrimTyCon0 threadIdPrimTyConName ThreadIdRep
+threadIdPrimTyCon = pcPrimTyCon0 threadIdPrimTyConName PtrRep
\end{code}
projects / ghc-hetmet.git / commitdiff