Commit 805653f6 authored by John Ericson's avatar John Ericson Committed by Marge Bot
Browse files

Get rid of wildcard patterns in prim Cmm emitting code

This way, we can be sure we don't miss a case.
parent e3418e96
Pipeline #11045 failed with stages
in 215 minutes and 24 seconds
......@@ -576,7 +576,7 @@ isSimpleOp (StgPrimOp op) stg_args = do
arg_exprs <- getNonVoidArgAmodes stg_args
dflags <- getDynFlags
-- See Note [Inlining out-of-line primops and heap checks]
return $! isJust $ shouldInlinePrimOp dflags op arg_exprs
return $! shouldInlinePrimOp dflags op arg_exprs
isSimpleOp (StgPrimCallOp _) _ = return False
-----------------
......
{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
#if __GLASGOW_HASKELL__ <= 808
-- GHC 8.10 deprecates this flag, but GHC 8.8 needs it
......@@ -101,7 +102,7 @@ cgOpApp (StgPrimOp TagToEnumOp) [arg] res_ty
cgOpApp (StgPrimOp primop) args res_ty = do
dflags <- getDynFlags
cmm_args <- getNonVoidArgAmodes args
case shouldInlinePrimOp dflags primop cmm_args of
case emitPrimOp dflags primop cmm_args of
Nothing -> do -- out-of-line
let fun = CmmLit (CmmLabel (mkRtsPrimOpLabel primop))
emitCall (NativeNodeCall, NativeReturn) fun cmm_args
......@@ -146,226 +147,244 @@ cgOpApp (StgPrimCallOp primcall) args _res_ty
asUnsigned :: Width -> Integer -> Integer
asUnsigned w n = n .&. (bit (widthInBits w) - 1)
-- TODO: Several primop implementations (e.g. 'doNewByteArrayOp') use
-- ByteOff (or some other fixed width signed type) to represent
-- array sizes or indices. This means that these will overflow for
-- large enough sizes.
-- | Decide whether an out-of-line primop should be replaced by an
-- inline implementation. This might happen e.g. if there's enough
-- static information, such as statically know arguments, to emit a
-- more efficient implementation inline.
--
-- Returns 'Nothing' if this primop should use its out-of-line
-- implementation (defined elsewhere) and 'Just' together with a code
-- generating function that takes the output regs as arguments
-- otherwise.
shouldInlinePrimOp :: DynFlags
-> PrimOp -- ^ The primop
-> [CmmExpr] -- ^ The primop arguments
-> Maybe ([LocalReg] -> FCode ())
shouldInlinePrimOp dflags NewByteArrayOp_Char [(CmmLit (CmmInt n w))]
| asUnsigned w n <= fromIntegral (maxInlineAllocSize dflags) =
Just $ \ [res] -> doNewByteArrayOp res (fromInteger n)
shouldInlinePrimOp dflags NewArrayOp [(CmmLit (CmmInt n w)), init]
| wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags) =
Just $ \ [res] ->
doNewArrayOp res (arrPtrsRep dflags (fromInteger n)) mkMAP_DIRTY_infoLabel
[ (mkIntExpr dflags (fromInteger n),
fixedHdrSize dflags + oFFSET_StgMutArrPtrs_ptrs dflags)
, (mkIntExpr dflags (nonHdrSizeW (arrPtrsRep dflags (fromInteger n))),
fixedHdrSize dflags + oFFSET_StgMutArrPtrs_size dflags)
]
(fromInteger n) init
shouldInlinePrimOp _ CopyArrayOp
[src, src_off, dst, dst_off, (CmmLit (CmmInt n _))] =
Just $ \ [] -> doCopyArrayOp src src_off dst dst_off (fromInteger n)
shouldInlinePrimOp _ CopyMutableArrayOp
[src, src_off, dst, dst_off, (CmmLit (CmmInt n _))] =
Just $ \ [] -> doCopyMutableArrayOp src src_off dst dst_off (fromInteger n)
shouldInlinePrimOp _ CopyArrayArrayOp
[src, src_off, dst, dst_off, (CmmLit (CmmInt n _))] =
Just $ \ [] -> doCopyArrayOp src src_off dst dst_off (fromInteger n)
shouldInlinePrimOp _ CopyMutableArrayArrayOp
[src, src_off, dst, dst_off, (CmmLit (CmmInt n _))] =
Just $ \ [] -> doCopyMutableArrayOp src src_off dst dst_off (fromInteger n)
shouldInlinePrimOp dflags CloneArrayOp [src, src_off, (CmmLit (CmmInt n w))]
| wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags) =
Just $ \ [res] -> emitCloneArray mkMAP_FROZEN_CLEAN_infoLabel res src src_off (fromInteger n)
shouldInlinePrimOp dflags CloneMutableArrayOp [src, src_off, (CmmLit (CmmInt n w))]
| wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags) =
Just $ \ [res] -> emitCloneArray mkMAP_DIRTY_infoLabel res src src_off (fromInteger n)
shouldInlinePrimOp dflags FreezeArrayOp [src, src_off, (CmmLit (CmmInt n w))]
| wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags) =
Just $ \ [res] -> emitCloneArray mkMAP_FROZEN_CLEAN_infoLabel res src src_off (fromInteger n)
shouldInlinePrimOp dflags ThawArrayOp [src, src_off, (CmmLit (CmmInt n w))]
| wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags) =
Just $ \ [res] -> emitCloneArray mkMAP_DIRTY_infoLabel res src src_off (fromInteger n)
shouldInlinePrimOp dflags NewSmallArrayOp [(CmmLit (CmmInt n w)), init]
| wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags) =
Just $ \ [res] ->
doNewArrayOp res (smallArrPtrsRep (fromInteger n)) mkSMAP_DIRTY_infoLabel
[ (mkIntExpr dflags (fromInteger n),
fixedHdrSize dflags + oFFSET_StgSmallMutArrPtrs_ptrs dflags)
]
(fromInteger n) init
shouldInlinePrimOp _ CopySmallArrayOp
[src, src_off, dst, dst_off, (CmmLit (CmmInt n _))] =
Just $ \ [] -> doCopySmallArrayOp src src_off dst dst_off (fromInteger n)
shouldInlinePrimOp _ CopySmallMutableArrayOp
[src, src_off, dst, dst_off, (CmmLit (CmmInt n _))] =
Just $ \ [] -> doCopySmallMutableArrayOp src src_off dst dst_off (fromInteger n)
shouldInlinePrimOp dflags CloneSmallArrayOp [src, src_off, (CmmLit (CmmInt n w))]
| wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags) =
Just $ \ [res] -> emitCloneSmallArray mkSMAP_FROZEN_CLEAN_infoLabel res src src_off (fromInteger n)
shouldInlinePrimOp dflags CloneSmallMutableArrayOp [src, src_off, (CmmLit (CmmInt n w))]
| wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags) =
Just $ \ [res] -> emitCloneSmallArray mkSMAP_DIRTY_infoLabel res src src_off (fromInteger n)
shouldInlinePrimOp dflags FreezeSmallArrayOp [src, src_off, (CmmLit (CmmInt n w))]
| wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags) =
Just $ \ [res] -> emitCloneSmallArray mkSMAP_FROZEN_CLEAN_infoLabel res src src_off (fromInteger n)
shouldInlinePrimOp dflags ThawSmallArrayOp [src, src_off, (CmmLit (CmmInt n w))]
| wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags) =
Just $ \ [res] -> emitCloneSmallArray mkSMAP_DIRTY_infoLabel res src src_off (fromInteger n)
shouldInlinePrimOp dflags primop args
| primOpOutOfLine primop = Nothing
| otherwise = Just $ \ regs -> emitPrimOp dflags regs primop args
-- TODO: Several primops, such as 'copyArray#', only have an inline
-- implementation (below) but could possibly have both an inline
-- implementation and an out-of-line implementation, just like
-- 'newArray#'. This would lower the amount of code generated,
-- hopefully without a performance impact (needs to be measured).
---------------------------------------------------
cgPrimOp :: [LocalReg] -- where to put the results
-> PrimOp -- the op
-> [StgArg] -- arguments
-> FCode ()
cgPrimOp results op args
= do dflags <- getDynFlags
arg_exprs <- getNonVoidArgAmodes args
emitPrimOp dflags results op arg_exprs
cgPrimOp results op args = do
dflags <- getDynFlags
arg_exprs <- getNonVoidArgAmodes args
case emitPrimOp dflags op arg_exprs of
Nothing -> panic "External prim op"
Just f -> f results
------------------------------------------------------------------------
-- Emitting code for a primop
------------------------------------------------------------------------
emitPrimOp :: DynFlags
-> [LocalReg] -- where to put the results
-> PrimOp -- the op
-> [CmmExpr] -- arguments
-> FCode ()
shouldInlinePrimOp :: DynFlags -> PrimOp -> [CmmExpr] -> Bool
shouldInlinePrimOp dflags op args = isJust $ emitPrimOp dflags op args
-- First we handle various awkward cases specially. The remaining
-- easy cases are then handled by translateOp, defined below.
-- TODO: Several primop implementations (e.g. 'doNewByteArrayOp') use
-- ByteOff (or some other fixed width signed type) to represent
-- array sizes or indices. This means that these will overflow for
-- large enough sizes.
emitPrimOp _ [res] ParOp [arg]
=
-- for now, just implement this in a C function
-- later, we might want to inline it.
-- TODO: Several primops, such as 'copyArray#', only have an inline
-- implementation (below) but could possibly have both an inline
-- implementation and an out-of-line implementation, just like
-- 'newArray#'. This would lower the amount of code generated,
-- hopefully without a performance impact (needs to be measured).
-- | The big function handling all the primops. The 'OpDest' function type
-- abstracts over a few common cases, and the "most manual" fallback.
--
-- In the simple case, there is just one implementation, and we emit that.
--
-- In more complex cases, there is a foreign call (out of line) fallback. This
-- might happen e.g. if there's enough static information, such as statically
-- know arguments.
dispatchPrimop
:: DynFlags
-> PrimOp -- ^ The primop
-> [CmmExpr] -- ^ The primop arguments
-> OpDest
dispatchPrimop dflags = \case
NewByteArrayOp_Char -> \case
[(CmmLit (CmmInt n w))]
| asUnsigned w n <= fromIntegral (maxInlineAllocSize dflags)
-> OpDest_AllDone $ \ [res] -> doNewByteArrayOp res (fromInteger n)
_ -> OpDest_External
NewArrayOp -> \case
[(CmmLit (CmmInt n w)), init]
| wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags)
-> OpDest_AllDone $ \[res] -> doNewArrayOp res (arrPtrsRep dflags (fromInteger n)) mkMAP_DIRTY_infoLabel
[ (mkIntExpr dflags (fromInteger n),
fixedHdrSize dflags + oFFSET_StgMutArrPtrs_ptrs dflags)
, (mkIntExpr dflags (nonHdrSizeW (arrPtrsRep dflags (fromInteger n))),
fixedHdrSize dflags + oFFSET_StgMutArrPtrs_size dflags)
]
(fromInteger n) init
_ -> OpDest_External
CopyArrayOp -> \case
[src, src_off, dst, dst_off, (CmmLit (CmmInt n _))] ->
OpDest_AllDone $ \ [] -> doCopyArrayOp src src_off dst dst_off (fromInteger n)
_ -> OpDest_External
CopyMutableArrayOp -> \case
[src, src_off, dst, dst_off, (CmmLit (CmmInt n _))] ->
OpDest_AllDone $ \ [] -> doCopyMutableArrayOp src src_off dst dst_off (fromInteger n)
_ -> OpDest_External
CopyArrayArrayOp -> \case
[src, src_off, dst, dst_off, (CmmLit (CmmInt n _))] ->
OpDest_AllDone $ \ [] -> doCopyArrayOp src src_off dst dst_off (fromInteger n)
_ -> OpDest_External
CopyMutableArrayArrayOp -> \case
[src, src_off, dst, dst_off, (CmmLit (CmmInt n _))] ->
OpDest_AllDone $ \ [] -> doCopyMutableArrayOp src src_off dst dst_off (fromInteger n)
_ -> OpDest_External
CloneArrayOp -> \case
[src, src_off, (CmmLit (CmmInt n w))]
| wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags)
-> OpDest_AllDone $ \ [res] -> emitCloneArray mkMAP_FROZEN_CLEAN_infoLabel res src src_off (fromInteger n)
_ -> OpDest_External
CloneMutableArrayOp -> \case
[src, src_off, (CmmLit (CmmInt n w))]
| wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags)
-> OpDest_AllDone $ \ [res] -> emitCloneArray mkMAP_DIRTY_infoLabel res src src_off (fromInteger n)
_ -> OpDest_External
FreezeArrayOp -> \case
[src, src_off, (CmmLit (CmmInt n w))]
| wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags)
-> OpDest_AllDone $ \ [res] -> emitCloneArray mkMAP_FROZEN_CLEAN_infoLabel res src src_off (fromInteger n)
_ -> OpDest_External
ThawArrayOp -> \case
[src, src_off, (CmmLit (CmmInt n w))]
| wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags)
-> OpDest_AllDone $ \ [res] -> emitCloneArray mkMAP_DIRTY_infoLabel res src src_off (fromInteger n)
_ -> OpDest_External
NewSmallArrayOp -> \case
[(CmmLit (CmmInt n w)), init]
| wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags)
-> OpDest_AllDone $ \ [res] ->
doNewArrayOp res (smallArrPtrsRep (fromInteger n)) mkSMAP_DIRTY_infoLabel
[ (mkIntExpr dflags (fromInteger n),
fixedHdrSize dflags + oFFSET_StgSmallMutArrPtrs_ptrs dflags)
]
(fromInteger n) init
_ -> OpDest_External
CopySmallArrayOp -> \case
[src, src_off, dst, dst_off, (CmmLit (CmmInt n _))] ->
OpDest_AllDone $ \ [] -> doCopySmallArrayOp src src_off dst dst_off (fromInteger n)
_ -> OpDest_External
CopySmallMutableArrayOp -> \case
[src, src_off, dst, dst_off, (CmmLit (CmmInt n _))] ->
OpDest_AllDone $ \ [] -> doCopySmallMutableArrayOp src src_off dst dst_off (fromInteger n)
_ -> OpDest_External
CloneSmallArrayOp -> \case
[src, src_off, (CmmLit (CmmInt n w))]
| wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags)
-> OpDest_AllDone $ \ [res] -> emitCloneSmallArray mkSMAP_FROZEN_CLEAN_infoLabel res src src_off (fromInteger n)
_ -> OpDest_External
CloneSmallMutableArrayOp -> \case
[src, src_off, (CmmLit (CmmInt n w))]
| wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags)
-> OpDest_AllDone $ \ [res] -> emitCloneSmallArray mkSMAP_DIRTY_infoLabel res src src_off (fromInteger n)
_ -> OpDest_External
FreezeSmallArrayOp -> \case
[src, src_off, (CmmLit (CmmInt n w))]
| wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags)
-> OpDest_AllDone $ \ [res] -> emitCloneSmallArray mkSMAP_FROZEN_CLEAN_infoLabel res src src_off (fromInteger n)
_ -> OpDest_External
ThawSmallArrayOp -> \case
[src, src_off, (CmmLit (CmmInt n w))]
| wordsToBytes dflags (asUnsigned w n) <= fromIntegral (maxInlineAllocSize dflags)
-> OpDest_AllDone $ \ [res] -> emitCloneSmallArray mkSMAP_DIRTY_infoLabel res src src_off (fromInteger n)
_ -> OpDest_External
-- First we handle various awkward cases specially.
ParOp -> \[arg] -> OpDest_AllDone $ \[res] -> do
-- for now, just implement this in a C function
-- later, we might want to inline it.
emitCCall
[(res,NoHint)]
(CmmLit (CmmLabel (mkForeignLabel (fsLit "newSpark") Nothing ForeignLabelInExternalPackage IsFunction)))
[(baseExpr, AddrHint), (arg,AddrHint)]
emitPrimOp dflags [res] SparkOp [arg]
= do
-- returns the value of arg in res. We're going to therefore
-- refer to arg twice (once to pass to newSpark(), and once to
-- assign to res), so put it in a temporary.
tmp <- assignTemp arg
tmp2 <- newTemp (bWord dflags)
emitCCall
[(tmp2,NoHint)]
(CmmLit (CmmLabel (mkForeignLabel (fsLit "newSpark") Nothing ForeignLabelInExternalPackage IsFunction)))
[(baseExpr, AddrHint), ((CmmReg (CmmLocal tmp)), AddrHint)]
emitAssign (CmmLocal res) (CmmReg (CmmLocal tmp))
emitPrimOp dflags [res] GetCCSOfOp [arg]
= emitAssign (CmmLocal res) val
where
val
| gopt Opt_SccProfilingOn dflags = costCentreFrom dflags (cmmUntag dflags arg)
| otherwise = CmmLit (zeroCLit dflags)
emitPrimOp _ [res] GetCurrentCCSOp [_dummy_arg]
= emitAssign (CmmLocal res) cccsExpr
emitPrimOp _ [res] MyThreadIdOp []
= emitAssign (CmmLocal res) currentTSOExpr
emitPrimOp dflags [res] ReadMutVarOp [mutv]
= emitAssign (CmmLocal res) (cmmLoadIndexW dflags mutv (fixedHdrSizeW dflags) (gcWord dflags))
emitPrimOp dflags res@[] WriteMutVarOp [mutv,var]
= do -- Without this write barrier, other CPUs may see this pointer before
-- the writes for the closure it points to have occurred.
emitPrimCall res MO_WriteBarrier []
emitStore (cmmOffsetW dflags mutv (fixedHdrSizeW dflags)) var
emitCCall
[{-no results-}]
(CmmLit (CmmLabel mkDirty_MUT_VAR_Label))
[(baseExpr, AddrHint), (mutv,AddrHint)]
SparkOp -> \[arg] -> OpDest_AllDone $ \[res] -> do
-- returns the value of arg in res. We're going to therefore
-- refer to arg twice (once to pass to newSpark(), and once to
-- assign to res), so put it in a temporary.
tmp <- assignTemp arg
tmp2 <- newTemp (bWord dflags)
emitCCall
[(tmp2,NoHint)]
(CmmLit (CmmLabel (mkForeignLabel (fsLit "newSpark") Nothing ForeignLabelInExternalPackage IsFunction)))
[(baseExpr, AddrHint), ((CmmReg (CmmLocal tmp)), AddrHint)]
emitAssign (CmmLocal res) (CmmReg (CmmLocal tmp))
GetCCSOfOp -> \[arg] -> OpDest_AllDone $ \[res] -> do
let
val
| gopt Opt_SccProfilingOn dflags = costCentreFrom dflags (cmmUntag dflags arg)
| otherwise = CmmLit (zeroCLit dflags)
emitAssign (CmmLocal res) val
GetCurrentCCSOp -> \[_] -> OpDest_AllDone $ \[res] -> do
emitAssign (CmmLocal res) cccsExpr
MyThreadIdOp -> \[] -> OpDest_AllDone $ \[res] -> do
emitAssign (CmmLocal res) currentTSOExpr
ReadMutVarOp -> \[mutv] -> OpDest_AllDone $ \[res] -> do
emitAssign (CmmLocal res) (cmmLoadIndexW dflags mutv (fixedHdrSizeW dflags) (gcWord dflags))
WriteMutVarOp -> \[mutv, var] -> OpDest_AllDone $ \res@[] -> do
-- Without this write barrier, other CPUs may see this pointer before
-- the writes for the closure it points to have occurred.
emitPrimCall res MO_WriteBarrier []
emitStore (cmmOffsetW dflags mutv (fixedHdrSizeW dflags)) var
emitCCall
[{-no results-}]
(CmmLit (CmmLabel mkDirty_MUT_VAR_Label))
[(baseExpr, AddrHint), (mutv,AddrHint)]
-- #define sizzeofByteArrayzh(r,a) \
-- r = ((StgArrBytes *)(a))->bytes
emitPrimOp dflags [res] SizeofByteArrayOp [arg]
= emit $ mkAssign (CmmLocal res) (cmmLoadIndexW dflags arg (fixedHdrSizeW dflags) (bWord dflags))
SizeofByteArrayOp -> \[arg] -> OpDest_AllDone $ \[res] -> do
emit $ mkAssign (CmmLocal res) (cmmLoadIndexW dflags arg (fixedHdrSizeW dflags) (bWord dflags))
-- #define sizzeofMutableByteArrayzh(r,a) \
-- r = ((StgArrBytes *)(a))->bytes
emitPrimOp dflags [res] SizeofMutableByteArrayOp [arg]
= emitPrimOp dflags [res] SizeofByteArrayOp [arg]
SizeofMutableByteArrayOp -> dispatchPrimop dflags SizeofByteArrayOp
-- #define getSizzeofMutableByteArrayzh(r,a) \
-- r = ((StgArrBytes *)(a))->bytes
emitPrimOp dflags [res] GetSizeofMutableByteArrayOp [arg]
= emitAssign (CmmLocal res) (cmmLoadIndexW dflags arg (fixedHdrSizeW dflags) (bWord dflags))
GetSizeofMutableByteArrayOp -> \[arg] -> OpDest_AllDone $ \[res] -> do
emitAssign (CmmLocal res) (cmmLoadIndexW dflags arg (fixedHdrSizeW dflags) (bWord dflags))
-- #define touchzh(o) /* nothing */
emitPrimOp _ res@[] TouchOp args@[_arg]
= do emitPrimCall res MO_Touch args
TouchOp -> \args@[_] -> OpDest_AllDone $ \res@[] -> do
emitPrimCall res MO_Touch args
-- #define byteArrayContentszh(r,a) r = BYTE_ARR_CTS(a)
emitPrimOp dflags [res] ByteArrayContents_Char [arg]
= emitAssign (CmmLocal res) (cmmOffsetB dflags arg (arrWordsHdrSize dflags))
ByteArrayContents_Char -> \[arg] -> OpDest_AllDone $ \[res] -> do
emitAssign (CmmLocal res) (cmmOffsetB dflags arg (arrWordsHdrSize dflags))
-- #define stableNameToIntzh(r,s) (r = ((StgStableName *)s)->sn)
emitPrimOp dflags [res] StableNameToIntOp [arg]
= emitAssign (CmmLocal res) (cmmLoadIndexW dflags arg (fixedHdrSizeW dflags) (bWord dflags))
StableNameToIntOp -> \[arg] -> OpDest_AllDone $ \[res] -> do
emitAssign (CmmLocal res) (cmmLoadIndexW dflags arg (fixedHdrSizeW dflags) (bWord dflags))
emitPrimOp dflags [res] ReallyUnsafePtrEqualityOp [arg1,arg2]
= emitAssign (CmmLocal res) (CmmMachOp (mo_wordEq dflags) [arg1,arg2])
ReallyUnsafePtrEqualityOp -> \[arg1, arg2] -> OpDest_AllDone $ \[res] -> do
emitAssign (CmmLocal res) (CmmMachOp (mo_wordEq dflags) [arg1,arg2])
-- #define addrToHValuezh(r,a) r=(P_)a
emitPrimOp _ [res] AddrToAnyOp [arg]
= emitAssign (CmmLocal res) arg
AddrToAnyOp -> \[arg] -> OpDest_AllDone $ \[res] -> do
emitAssign (CmmLocal res) arg
-- #define hvalueToAddrzh(r, a) r=(W_)a
emitPrimOp _ [res] AnyToAddrOp [arg]
= emitAssign (CmmLocal res) arg
AnyToAddrOp -> \[arg] -> OpDest_AllDone $ \[res] -> do
emitAssign (CmmLocal res) arg
{- Freezing arrays-of-ptrs requires changing an info table, for the
benefit of the generational collector. It needs to scavenge mutable
......@@ -377,305 +396,489 @@ emitPrimOp _ [res] AnyToAddrOp [arg]
-- SET_INFO((StgClosure *)a,&stg_MUT_ARR_PTRS_FROZEN_DIRTY_info);
-- r = a;
-- }
emitPrimOp _ [res] UnsafeFreezeArrayOp [arg]
= emit $ catAGraphs
[ setInfo arg (CmmLit (CmmLabel mkMAP_FROZEN_DIRTY_infoLabel)),
mkAssign (CmmLocal res) arg ]
emitPrimOp _ [res] UnsafeFreezeArrayArrayOp [arg]
= emit $ catAGraphs
[ setInfo arg (CmmLit (CmmLabel mkMAP_FROZEN_DIRTY_infoLabel)),
mkAssign (CmmLocal res) arg ]
emitPrimOp _ [res] UnsafeFreezeSmallArrayOp [arg]
= emit $ catAGraphs
[ setInfo arg (CmmLit (CmmLabel mkSMAP_FROZEN_DIRTY_infoLabel)),
mkAssign (CmmLocal res) arg ]
UnsafeFreezeArrayOp -> \[arg] -> OpDest_AllDone $ \[res] -> do
emit $ catAGraphs
[ setInfo arg (CmmLit (CmmLabel mkMAP_FROZEN_DIRTY_infoLabel)),
mkAssign (CmmLocal res) arg ]
UnsafeFreezeArrayArrayOp -> \[arg] -> OpDest_AllDone $ \[res] -> do
emit $ catAGraphs
[ setInfo arg (CmmLit (CmmLabel mkMAP_FROZEN_DIRTY_infoLabel)),
mkAssign (CmmLocal res) arg ]
UnsafeFreezeSmallArrayOp -> \[arg] -> OpDest_AllDone $ \[res] -> do
emit $ catAGraphs
[ setInfo arg (CmmLit (CmmLabel mkSMAP_FROZEN_DIRTY_infoLabel)),
mkAssign (CmmLocal res) arg ]
-- #define unsafeFreezzeByteArrayzh(r,a) r=(a)
emitPrimOp _ [res] UnsafeFreezeByteArrayOp [arg]
= emitAssign (CmmLocal res) arg
UnsafeFreezeByteArrayOp -> \[arg] -> OpDest_AllDone $ \[res] -> do
emitAssign (CmmLocal res) arg
-- Reading/writing pointer arrays
emitPrimOp _ [res] ReadArrayOp [obj,ix] = doReadPtrArrayOp res obj ix
emitPrimOp _ [res] IndexArrayOp [obj,ix] = doReadPtrArrayOp res obj ix
emitPrimOp _ [] WriteArrayOp [obj,ix,v] = doWritePtrArrayOp obj ix v
emitPrimOp _ [res] IndexArrayArrayOp_ByteArray [obj,ix] = doReadPtrArrayOp res obj ix
emitPrimOp _ [res] IndexArrayArrayOp_ArrayArray [obj,ix] = doReadPtrArrayOp res obj ix
emitPrimOp _ [res] ReadArrayArrayOp_ByteArray [obj,ix] = doReadPtrArrayOp res obj ix
emitPrimOp _ [res] ReadArrayArrayOp_MutableByteArray [obj,ix] = doReadPtrArrayOp res obj ix
emitPrimOp _ [res] ReadArrayArrayOp_ArrayArray [obj,ix] = doReadPtrArrayOp res obj ix
emitPrimOp _ [res] ReadArrayArrayOp_MutableArrayArray [obj,ix] = doReadPtrArrayOp res obj ix
emitPrimOp _ [] WriteArrayArrayOp_ByteArray [obj,ix,v] = doWritePtrArrayOp obj ix v
emitPrimOp _ [] WriteArrayArrayOp_MutableByteArray [obj,ix,v] = doWritePtrArrayOp obj ix v
emitPrimOp _ [] WriteArrayArrayOp_ArrayArray [obj,ix,v] = doWritePtrArrayOp obj ix v
emitPrimOp _ [] WriteArrayArrayOp_MutableArrayArray [obj,ix,v] = doWritePtrArrayOp obj ix v
emitPrimOp _ [res] ReadSmallArrayOp [obj,ix] = doReadSmallPtrArrayOp res obj ix
emitPrimOp _ [res] IndexSmallArrayOp [obj,ix] = doReadSmallPtrArrayOp res obj ix
emitPrimOp _ [] WriteSmallArrayOp [obj,ix,v] = doWriteSmallPtrArrayOp obj ix v
ReadArrayOp -> \[obj, ix] -> OpDest_AllDone $ \[res] -> do
doReadPtrArrayOp res obj ix
IndexArrayOp -> \[obj, ix] -> OpDest_AllDone $ \[res] -> do
doReadPtrArrayOp res obj ix
WriteArrayOp -> \[obj, ix, v] -> OpDest_AllDone $ \[] -> do
doWritePtrArrayOp obj ix v
IndexArrayArrayOp_ByteArray -> \[obj, ix] -> OpDest_AllDone $ \[res] -> do
doReadPtrArrayOp res obj ix
IndexArrayArrayOp_ArrayArray -> \[obj, ix] -> OpDest_AllDone $ \[res] -> do
doReadPtrArrayOp res obj ix
ReadArrayArrayOp_ByteArray -> \[obj, ix] -> OpDest_AllDone $ \[res] -> do
doReadPtrArrayOp res obj ix
ReadArrayArrayOp_MutableByteArray -> \[obj, ix] -> OpDest_AllDone $ \[res] -> do
doReadPtrArrayOp res obj ix
ReadArrayArrayOp_ArrayArray -> \[obj, ix] -> OpDest_AllDone $ \[res] -> do
doReadPtrArrayOp res obj ix
ReadArrayArrayOp_MutableArrayArray -> \[obj, ix] -> OpDest_AllDone $ \[res] -> do
doReadPtrArrayOp res obj ix
WriteArrayArrayOp_ByteArray -> \[obj,ix,v] -> OpDest_AllDone $ \[] -> do
doWritePtrArrayOp obj ix v
WriteArrayArrayOp_MutableByteArray -> \[obj,ix,v] -> OpDest_AllDone $ \[] -> do
doWritePtrArrayOp obj ix v
WriteArrayArrayOp_ArrayArray -> \[obj,ix,v] -> OpDest_AllDone $ \[] -> do
doWritePtrArrayOp obj ix v
WriteArrayArrayOp_MutableArrayArray -> \[obj,ix,v] -> OpDest_AllDone $ \[] -> do
doWritePtrArrayOp obj ix v
ReadSmallArrayOp -> \[obj, ix] -> OpDest_AllDone $ \[res] -> do
doReadSmallPtrArrayOp res obj ix
IndexSmallArrayOp -> \[obj, ix] -> OpDest_AllDone $ \[res] -> do
doReadSmallPtrArrayOp res obj ix
WriteSmallArrayOp -> \[obj,ix,v] -> OpDest_AllDone $ \[] -> do
doWriteSmallPtrArrayOp obj ix v
-- Getting the size of pointer arrays
emitPrimOp dflags [res] SizeofArrayOp [arg]
= emit $ mkAssign (CmmLocal res) (cmmLoadIndexW dflags arg
(fixedHdrSizeW dflags + bytesToWordsRoundUp dflags (oFFSET_StgMutArrPtrs_ptrs dflags))
SizeofArrayOp -> \[arg] -> OpDest_AllDone $ \[res] -> do
emit $ mkAssign (CmmLocal res) (cmmLoadIndexW dflags arg
(fixedHdrSizeW dflags + bytesToWordsRoundUp dflags (oFFSET_StgMutArrPtrs_ptrs dflags))
(bWord dflags))
emitPrimOp dflags [res] SizeofMutableArrayOp [arg]
= emitPrimOp dflags [res] SizeofArrayOp [arg]
emitPrimOp dflags [res] SizeofArrayArrayOp [arg]
= emitPrimOp dflags [res] SizeofArrayOp [arg]
emitPrimOp dflags [res] SizeofMutableArrayArrayOp [arg]
= emitPrimOp dflags [res] SizeofArrayOp [arg]
emitPrimOp dflags [res] SizeofSmallArrayOp [arg] =
SizeofMutableArrayOp -> dispatchPrimop dflags SizeofArrayOp
SizeofArrayArrayOp -> dispatchPrimop dflags SizeofArrayOp
SizeofMutableArrayArrayOp -> dispatchPrimop dflags SizeofArrayOp
SizeofSmallArrayOp -> \[arg] -> OpDest_AllDone $ \[res] -> do
emit $ mkAssign (CmmLocal res)
(cmmLoadIndexW dflags arg
(cmmLoadIndexW dflags arg
(fixedHdrSizeW dflags + bytesToWordsRoundUp dflags (oFFSET_StgSmallMutArrPtrs_ptrs dflags))
(bWord dflags))
emitPrimOp dflags [res] SizeofSmallMutableArrayOp [arg] =
emitPrimOp dflags [res] SizeofSmallArrayOp [arg]
SizeofSmallMutableArrayOp -> dispatchPrimop dflags SizeofSmallArrayOp
-- IndexXXXoffAddr
emitPrimOp dflags res IndexOffAddrOp_Char args = doIndexOffAddrOp (Just (mo_u_8ToWord dflags)) b8 res args