Commit 259be9ef authored by simonmar's avatar simonmar
Browse files

[project @ 2002-08-02 13:08:33 by simonmar]

PrimRep Cleanup

   - Remove all PrimReps which were just different flavours of
     PtrRep.  Now, everything which is a pointer to a closure of
     some kind is always a PtrRep.

   - Three of the deleted PrimReps, namely ArrayRep, ByteArrayRep,
     and ForeignObj rep, had a subtle reason for their existence:
     the abstract C pretty-printer(!) used them to decide whether
     to apply a shim to an outgoing C-call argument: a ByteArrayRep
     argument would be adjusted to point past the object header,
     for example.

     I've changed this to happen in a much more reasonable and
     obvious way: there are now explict macros in AbsCSyn to do the
     adjustment, and the code generator makes calls to these as
     necessary.  Slightly less hackery is necessary in the NCG as
     a result.
parent 226413e1
%
% (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}
......@@ -392,7 +392,9 @@ data CExprMacro
| 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:
......
......@@ -150,7 +150,7 @@ magicIdPrimRep Hp = PtrRep
magicIdPrimRep HpLim = PtrRep
magicIdPrimRep CurCostCentre = CostCentreRep
magicIdPrimRep VoidReg = VoidRep
magicIdPrimRep CurrentTSO = ThreadIdRep
magicIdPrimRep CurrentTSO = PtrRep
magicIdPrimRep CurrentNursery = PtrRep
magicIdPrimRep HpAlloc = WordRep
\end{code}
......@@ -1120,7 +1120,7 @@ dscCOpStmt [] WriteOffAddrOp_Int [a,i,x] vols = doWriteOffAddrOp Nothing
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
......
......@@ -991,13 +991,8 @@ pprFCall call@(CCall (CCallSpec target cconv safety)) uniq args results vol_regs
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
......@@ -1009,25 +1004,8 @@ ppr_casm_arg amode a_num
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}
......@@ -1182,13 +1160,6 @@ pprAssign kind dest src
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 ]
......@@ -1305,6 +1276,9 @@ cExprMacroText ARG_TAG = SLIT("ARG_TAG")
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")
......@@ -1480,16 +1454,6 @@ pprUnionTag FloatRep = char 'f'
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 $
%
%********************************************************
%* *
......@@ -677,9 +677,7 @@ cgPrimInlineAlts bndr tycon alts deflt
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 $
%
%********************************************************
%* *
......@@ -18,7 +18,7 @@ import Constants ( mAX_SPEC_SELECTEE_SIZE, mAX_SPEC_AP_SIZE )
import StgSyn
import CgMonad
import AbsCSyn
import AbsCUtils ( mkAbstractCs )
import AbsCUtils ( mkAbstractCs, getAmodeRep )
import CLabel ( mkClosureTblLabel )
import SMRep ( fixedHdrSize )
......@@ -39,7 +39,11 @@ import ClosureInfo ( mkClosureLFInfo, mkSelectorLFInfo,
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 )
......@@ -451,7 +455,17 @@ Little helper for primitives that return unboxed tuples.
\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.
......@@ -459,7 +473,7 @@ primRetUnboxedTuple op args res_ty
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`
......@@ -473,4 +487,16 @@ primRetUnboxedTuple op args res_ty
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}
......@@ -79,6 +79,7 @@ ctrlReturnConvAlg tycon
\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)
......@@ -90,18 +91,9 @@ dataReturnConvPrim CharRep = VanillaReg CharRep (_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
......
......@@ -33,7 +33,7 @@ import Maybes ( maybeToBool )
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 )
......@@ -243,8 +243,8 @@ Here we handle top-level things, like @CCodeBlock@s and
-- 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.
......
......@@ -29,7 +29,7 @@ import CLabel ( isAsmTemp )
#endif
import Maybes ( maybeToBool )
import PrimRep ( isFloatingRep, is64BitRep, PrimRep(..),
getPrimRepArrayElemSize )
getPrimRepSizeInBytes )
import Stix ( getNatLabelNCG, StixStmt(..), StixExpr(..),
StixReg(..), pprStixReg, StixVReg(..), CodeSegment(..),
DestInfo, hasDestInfo,
......@@ -131,7 +131,7 @@ stmtToInstrs stmt = case stmt of
-- 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).
......@@ -185,7 +185,7 @@ mangleIndexTree :: StixExpr -> StixExpr
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 [
......@@ -196,7 +196,7 @@ mangleIndexTree (StIndex pk base off)
]
where
shift :: PrimRep -> Int
shift rep = case getPrimRepArrayElemSize rep of
shift rep = case getPrimRepSizeInBytes rep of
1 -> 0
2 -> 1
4 -> 2
......@@ -211,7 +211,7 @@ maybeImm :: StixExpr -> Maybe Imm
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))
......
......@@ -296,15 +296,7 @@ primRepToSize WordRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W,
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"
......@@ -315,7 +307,6 @@ primRepToSize_fail str
++ "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}
%************************************************************************
......
......@@ -125,8 +125,7 @@ mkStAssign rep (StInd rep' addr) rhs
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.
......
......@@ -17,7 +17,7 @@ import AbsCUtils ( getAmodeRep, mixedTypeLocn )
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,
......@@ -100,15 +100,7 @@ foreignCallCode lhs call@(CCall (CCallSpec ctarget cconv safety)) rhs
-> 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)
......@@ -201,25 +193,33 @@ amodeToStix (CLit core)
_ -> 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)
......@@ -244,17 +244,17 @@ cHARLIKE_closure = StCLbl mkCharlikeClosureLabel
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))])
......@@ -274,9 +274,9 @@ save_thread_state
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
......
......@@ -9,15 +9,13 @@ types.
\begin{code}
module PrimRep
(
PrimRep(..)
( PrimRep(..)
, separateByPtrFollowness
, isFollowableRep
, isFloatingRep
, is64BitRep
, getPrimRepSize
, getPrimRepSizeInBytes
, getPrimRepArrayElemSize
, retPrimRepSize
) where
......@@ -33,6 +31,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
......@@ -59,43 +59,13 @@ data PrimRep
| 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.
%************************************************************************
%* *
......@@ -112,22 +82,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 -- 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...
......@@ -156,11 +115,11 @@ is64BitRep :: PrimRep -> Bool
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
......@@ -169,11 +128,21 @@ 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)
-- 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
......@@ -188,41 +157,8 @@ getPrimRepSizeInBytes Word8Rep = 1
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}
%************************************************************************
......@@ -255,18 +191,6 @@ showPrimRep Word64Rep = "LW_" -- short for StgLongWord
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.
......@@ -224,11 +224,11 @@ statePrimTyCon = pcPrimTyCon statePrimTyConName vrcsZ VoidRep
\end{code}