From 259be9ef2ecc354d52622479921634606d6d2832 Mon Sep 17 00:00:00 2001 From: simonmar Date: Fri, 2 Aug 2002 13:08:35 +0000 Subject: [PATCH] [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. --- ghc/compiler/absCSyn/AbsCSyn.lhs | 6 +- ghc/compiler/absCSyn/AbsCUtils.lhs | 4 +- ghc/compiler/absCSyn/PprAbsC.lhs | 44 ++---------- ghc/compiler/codeGen/CgCase.lhs | 6 +- ghc/compiler/codeGen/CgExpr.lhs | 36 ++++++++-- ghc/compiler/codeGen/CgRetConv.lhs | 14 +--- ghc/compiler/nativeGen/AbsCStixGen.lhs | 6 +- ghc/compiler/nativeGen/MachCode.lhs | 10 +-- ghc/compiler/nativeGen/MachMisc.lhs | 9 --- ghc/compiler/nativeGen/Stix.lhs | 3 +- ghc/compiler/nativeGen/StixPrim.lhs | 44 ++++++------ ghc/compiler/prelude/PrimRep.lhs | 120 ++++++-------------------------- ghc/compiler/prelude/TysPrim.lhs | 28 ++++---- 13 files changed, 113 insertions(+), 217 deletions(-) diff --git a/ghc/compiler/absCSyn/AbsCSyn.lhs b/ghc/compiler/absCSyn/AbsCSyn.lhs index 3f6bd24..cfc6f2a 100644 --- a/ghc/compiler/absCSyn/AbsCSyn.lhs +++ b/ghc/compiler/absCSyn/AbsCSyn.lhs @@ -1,7 +1,7 @@ % % (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: diff --git a/ghc/compiler/absCSyn/AbsCUtils.lhs b/ghc/compiler/absCSyn/AbsCUtils.lhs index 9271ba2..02a1d31 100644 --- a/ghc/compiler/absCSyn/AbsCUtils.lhs +++ b/ghc/compiler/absCSyn/AbsCUtils.lhs @@ -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 diff --git a/ghc/compiler/absCSyn/PprAbsC.lhs b/ghc/compiler/absCSyn/PprAbsC.lhs index 3259aca..782c45b 100644 --- a/ghc/compiler/absCSyn/PprAbsC.lhs +++ b/ghc/compiler/absCSyn/PprAbsC.lhs @@ -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} diff --git a/ghc/compiler/codeGen/CgCase.lhs b/ghc/compiler/codeGen/CgCase.lhs index df2e165..e76f517 100644 --- a/ghc/compiler/codeGen/CgCase.lhs +++ b/ghc/compiler/codeGen/CgCase.lhs @@ -1,7 +1,7 @@ % % (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 diff --git a/ghc/compiler/codeGen/CgExpr.lhs b/ghc/compiler/codeGen/CgExpr.lhs index 2894de2..519cb65 100644 --- a/ghc/compiler/codeGen/CgExpr.lhs +++ b/ghc/compiler/codeGen/CgExpr.lhs @@ -1,7 +1,7 @@ % % (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} diff --git a/ghc/compiler/codeGen/CgRetConv.lhs b/ghc/compiler/codeGen/CgRetConv.lhs index f3ef813..cfb18bc 100644 --- a/ghc/compiler/codeGen/CgRetConv.lhs +++ b/ghc/compiler/codeGen/CgRetConv.lhs @@ -1,7 +1,7 @@ % % (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 diff --git a/ghc/compiler/nativeGen/AbsCStixGen.lhs b/ghc/compiler/nativeGen/AbsCStixGen.lhs index 333f986..6a93c2b 100644 --- a/ghc/compiler/nativeGen/AbsCStixGen.lhs +++ b/ghc/compiler/nativeGen/AbsCStixGen.lhs @@ -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. diff --git a/ghc/compiler/nativeGen/MachCode.lhs b/ghc/compiler/nativeGen/MachCode.lhs index b4075a9..737f1fa 100644 --- a/ghc/compiler/nativeGen/MachCode.lhs +++ b/ghc/compiler/nativeGen/MachCode.lhs @@ -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)) diff --git a/ghc/compiler/nativeGen/MachMisc.lhs b/ghc/compiler/nativeGen/MachMisc.lhs index aa2e961..ff45ff1 100644 --- a/ghc/compiler/nativeGen/MachMisc.lhs +++ b/ghc/compiler/nativeGen/MachMisc.lhs @@ -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} %************************************************************************ diff --git a/ghc/compiler/nativeGen/Stix.lhs b/ghc/compiler/nativeGen/Stix.lhs index bae8b64..091107e 100644 --- a/ghc/compiler/nativeGen/Stix.lhs +++ b/ghc/compiler/nativeGen/Stix.lhs @@ -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. diff --git a/ghc/compiler/nativeGen/StixPrim.lhs b/ghc/compiler/nativeGen/StixPrim.lhs index 79d4da2..3086383 100644 --- a/ghc/compiler/nativeGen/StixPrim.lhs +++ b/ghc/compiler/nativeGen/StixPrim.lhs @@ -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 diff --git a/ghc/compiler/prelude/PrimRep.lhs b/ghc/compiler/prelude/PrimRep.lhs index f6cfd77..f3a066c 100644 --- a/ghc/compiler/prelude/PrimRep.lhs +++ b/ghc/compiler/prelude/PrimRep.lhs @@ -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. diff --git a/ghc/compiler/prelude/TysPrim.lhs b/ghc/compiler/prelude/TysPrim.lhs index f30fdac..9ba2887 100644 --- a/ghc/compiler/prelude/TysPrim.lhs +++ b/ghc/compiler/prelude/TysPrim.lhs @@ -224,11 +224,11 @@ statePrimTyCon = pcPrimTyCon statePrimTyConName vrcsZ VoidRep \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} @@ -244,10 +244,10 @@ defined in \tr{TysWiredIn.lhs}, not here. %************************************************************************ \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 @@ -262,7 +262,7 @@ mkMutableByteArrayPrimTy s = mkTyConApp mutableByteArrayPrimTyCon [s] %************************************************************************ \begin{code} -mutVarPrimTyCon = pcPrimTyCon mutVarPrimTyConName vrcsZP PrimPtrRep +mutVarPrimTyCon = pcPrimTyCon mutVarPrimTyConName vrcsZP PtrRep mkMutVarPrimTy s elt = mkTyConApp mutVarPrimTyCon [s, elt] \end{code} @@ -274,7 +274,7 @@ mkMutVarPrimTy s elt = mkTyConApp mutVarPrimTyCon [s, elt] %************************************************************************ \begin{code} -mVarPrimTyCon = pcPrimTyCon mVarPrimTyConName vrcsZP PrimPtrRep +mVarPrimTyCon = pcPrimTyCon mVarPrimTyConName vrcsZP PtrRep mkMVarPrimTy s elt = mkTyConApp mVarPrimTyCon [s, elt] \end{code} @@ -298,7 +298,7 @@ mkStablePtrPrimTy ty = mkTyConApp stablePtrPrimTyCon [ty] %************************************************************************ \begin{code} -stableNamePrimTyCon = pcPrimTyCon stableNamePrimTyConName vrcsP StableNameRep +stableNamePrimTyCon = pcPrimTyCon stableNamePrimTyConName vrcsP PtrRep mkStableNamePrimTy ty = mkTyConApp stableNamePrimTyCon [ty] \end{code} @@ -321,9 +321,9 @@ dead before it really was. \begin{code} foreignObjPrimTy = mkTyConTy foreignObjPrimTyCon -foreignObjPrimTyCon = pcPrimTyCon0 foreignObjPrimTyConName ForeignObjRep +foreignObjPrimTyCon = pcPrimTyCon0 foreignObjPrimTyConName PtrRep \end{code} - + %************************************************************************ %* * \subsection[TysPrim-BCOs]{The ``bytecode object'' type} @@ -332,7 +332,7 @@ foreignObjPrimTyCon = pcPrimTyCon0 foreignObjPrimTyConName ForeignObjRep \begin{code} bcoPrimTy = mkTyConTy bcoPrimTyCon -bcoPrimTyCon = pcPrimTyCon0 bcoPrimTyConName BCORep +bcoPrimTyCon = pcPrimTyCon0 bcoPrimTyConName PtrRep \end{code} %************************************************************************ @@ -342,7 +342,7 @@ bcoPrimTyCon = pcPrimTyCon0 bcoPrimTyConName BCORep %************************************************************************ \begin{code} -weakPrimTyCon = pcPrimTyCon weakPrimTyConName vrcsP WeakPtrRep +weakPrimTyCon = pcPrimTyCon weakPrimTyConName vrcsP PtrRep mkWeakPrimTy v = mkTyConApp weakPrimTyCon [v] \end{code} @@ -364,5 +364,5 @@ to the thread id internally. \begin{code} threadIdPrimTy = mkTyConTy threadIdPrimTyCon -threadIdPrimTyCon = pcPrimTyCon0 threadIdPrimTyConName ThreadIdRep +threadIdPrimTyCon = pcPrimTyCon0 threadIdPrimTyConName PtrRep \end{code} -- 1.7.10.4