module CmmCallConv (
ParamLocation(..),
- ArgumentFormat,
- assignArguments,
- assignArgumentsPos,
- argumentsSize,
+ assignArgumentsPos
) where
#include "HsVersions.h"
-- Calculate the 'GlobalReg' or stack locations for function call
-- parameters as used by the Cmm calling convention.
-data ParamLocation a
+data ParamLocation
= RegisterParam GlobalReg
- | StackParam a
+ | StackParam ByteOff
-instance (Outputable a) => Outputable (ParamLocation a) where
+instance Outputable ParamLocation where
ppr (RegisterParam g) = ppr g
ppr (StackParam p) = ppr p
-type ArgumentFormat a b = [(a, ParamLocation b)]
-
-assignArguments :: (a -> CmmType) -> [a] -> ArgumentFormat a WordOff
--- Stack parameters are returned as word offsets.
-assignArguments _ _ = panic "assignArguments only used in dead codegen" -- assignments
-
-- | JD: For the new stack story, I want arguments passed on the stack to manifest as
-- positive offsets in a CallArea, not negative offsets from the stack pointer.
-- Also, I want byte offsets, not word offsets.
-assignArgumentsPos :: (Outputable a) => Convention -> (a -> CmmType) -> [a] ->
- ArgumentFormat a ByteOff
+assignArgumentsPos :: Convention -> (a -> CmmType) -> [a] ->
+ [(a, ParamLocation)]
-- Given a list of arguments, and a function that tells their types,
-- return a list showing where each argument is passed
assignArgumentsPos conv arg_ty reps = assignments
where w = typeWidth (arg_ty r)
size = (((widthInBytes w - 1) `div` wORD_SIZE) + 1) * wORD_SIZE
off' = offset + size
-
-
-argumentsSize :: (a -> CmmType) -> [a] -> WordOff
-argumentsSize f reps = maximum (0 : map arg_top args)
- where
- args = assignArguments f reps
- arg_top (_, StackParam offset) = -offset
- arg_top (_, RegisterParam _) = 0
-----------------------------------------------------------------------------
-- Local information about the registers available
strip_hints :: [Old.CmmHinted a] -> [a]
strip_hints = map Old.hintlessCmm
-convert_target :: Old.CmmCallTarget -> Old.HintedCmmFormals -> Old.HintedCmmActuals -> ForeignTarget
+convert_target :: Old.CmmCallTarget -> [Old.HintedCmmFormal] -> [Old.HintedCmmActual] -> ForeignTarget
convert_target (Old.CmmCallee e cc) ress args = ForeignTarget e (ForeignConvention cc (map Old.cmmHint args) (map Old.cmmHint ress))
convert_target (Old.CmmPrim op) _ress _args = PrimTarget op
GenCmm(..), GenCmmTop(..),
CmmInfoTable(..), HasStaticClosure, ClosureTypeInfo(..), ConstrDescription,
ProfilingInfo(..), ClosureTypeTag,
- CmmActual, CmmActuals, CmmFormal, CmmFormals, ForeignHint(..),
+ CmmActual, CmmFormal, ForeignHint(..),
CmmStatic(..), Section(..),
) where
type CmmActual = CmmExpr
type CmmFormal = LocalReg
-type CmmActuals = [CmmActual]
-type CmmFormals = [CmmFormal]
data ForeignHint
= NoHint | AddrHint | SignedHint
-- Like a "fat machine instruction"; can occur
-- in the middle of a block
ForeignTarget -> -- call target
- CmmFormals -> -- zero or more results
- CmmActuals -> -- zero or more arguments
+ [CmmFormal] -> -- zero or more results
+ [CmmActual] -> -- zero or more arguments
CmmNode O O
-- Semantics: kills only result regs; all other regs (both GlobalReg
-- and LocalReg) are preserved. But there is a current
CmmForeignCall :: { -- A safe foreign call; see Note [Foreign calls]
-- Always the last node of a block
tgt :: ForeignTarget, -- call target and convention
- res :: CmmFormals, -- zero or more results
- args :: CmmActuals, -- zero or more arguments; see Note [Register parameter passing]
+ res :: [CmmFormal], -- zero or more results
+ args :: [CmmActual], -- zero or more arguments; see Note [Register parameter passing]
succ :: Label, -- Label of continuation
updfr :: UpdFrameOffset, -- where the update frame is (for building infotable)
intrbl:: Bool -- whether or not the call is interruptible
-}
-data Protocol = Protocol Convention CmmFormals Area
+data Protocol = Protocol Convention [CmmFormal] Area
deriving Eq
instance Outputable Protocol where
ppr (Protocol c fs a) = text "Protocol" <+> ppr c <+> ppr fs <+> ppr a
-- Custom node type we'll rewrite to. CmmAssign nodes to local
-- registers are replaced with AssignLocal nodes.
data WithRegUsage n e x where
+ -- Plain will not contain CmmAssign nodes immediately after
+ -- transformation, but as we rewrite assignments, we may have
+ -- assignments here: these are assignments that should not be
+ -- rewritten!
Plain :: n e x -> WithRegUsage n e x
AssignLocal :: LocalReg -> CmmExpr -> RegUsage -> WithRegUsage n O O
mkStore :: CmmExpr -> CmmExpr -> CmmAGraph
---------- Calls
-mkCall :: CmmExpr -> (Convention, Convention) -> CmmFormals -> CmmActuals ->
+mkCall :: CmmExpr -> (Convention, Convention) -> [CmmFormal] -> [CmmActual] ->
UpdFrameOffset -> CmmAGraph
-mkCmmCall :: CmmExpr -> CmmFormals -> CmmActuals ->
+mkCmmCall :: CmmExpr -> [CmmFormal] -> [CmmActual] ->
UpdFrameOffset -> CmmAGraph
-- Native C-- calling convention
-mkSafeCall :: ForeignTarget -> CmmFormals -> CmmActuals -> UpdFrameOffset -> Bool -> CmmAGraph
-mkUnsafeCall :: ForeignTarget -> CmmFormals -> CmmActuals -> CmmAGraph
-mkFinalCall :: CmmExpr -> CCallConv -> CmmActuals -> UpdFrameOffset -> CmmAGraph
+mkSafeCall :: ForeignTarget -> [CmmFormal] -> [CmmActual] -> UpdFrameOffset -> Bool -> CmmAGraph
+mkUnsafeCall :: ForeignTarget -> [CmmFormal] -> [CmmActual] -> CmmAGraph
+mkFinalCall :: CmmExpr -> CCallConv -> [CmmActual] -> UpdFrameOffset -> CmmAGraph
-- Never returns; like exit() or barf()
---------- Control transfer
-mkJump :: CmmExpr -> CmmActuals -> UpdFrameOffset -> CmmAGraph
-mkDirectJump :: CmmExpr -> CmmActuals -> UpdFrameOffset -> CmmAGraph
-mkJumpGC :: CmmExpr -> CmmActuals -> UpdFrameOffset -> CmmAGraph
-mkForeignJump :: Convention -> CmmExpr -> CmmActuals -> UpdFrameOffset -> CmmAGraph
+mkJump :: CmmExpr -> [CmmActual] -> UpdFrameOffset -> CmmAGraph
+mkDirectJump :: CmmExpr -> [CmmActual] -> UpdFrameOffset -> CmmAGraph
+mkJumpGC :: CmmExpr -> [CmmActual] -> UpdFrameOffset -> CmmAGraph
+mkForeignJump :: Convention -> CmmExpr -> [CmmActual] -> UpdFrameOffset -> CmmAGraph
mkCbranch :: CmmExpr -> BlockId -> BlockId -> CmmAGraph
mkSwitch :: CmmExpr -> [Maybe BlockId] -> CmmAGraph
-mkReturn :: CmmExpr -> CmmActuals -> UpdFrameOffset -> CmmAGraph
-mkReturnSimple :: CmmActuals -> UpdFrameOffset -> CmmAGraph
+mkReturn :: CmmExpr -> [CmmActual] -> UpdFrameOffset -> CmmAGraph
+mkReturnSimple :: [CmmActual] -> UpdFrameOffset -> CmmAGraph
mkBranch :: BlockId -> CmmAGraph
mkCmmIfThenElse :: CmmExpr -> CmmAGraph -> CmmAGraph -> CmmAGraph
-- the variables in their spill slots.
-- Therefore, for copying arguments and results, we provide different
-- functions to pass the arguments in an overflow area and to pass them in spill slots.
-copyInOflow :: Convention -> Area -> CmmFormals -> (Int, CmmAGraph)
-copyInSlot :: Convention -> CmmFormals -> [CmmNode O O]
+copyInOflow :: Convention -> Area -> [CmmFormal] -> (Int, CmmAGraph)
+copyInSlot :: Convention -> [CmmFormal] -> [CmmNode O O]
copyOutSlot :: Convention -> [LocalReg] -> [CmmNode O O]
copyInOflow conv area formals = (offset, catAGraphs $ map mkMiddle nodes)
type SlotCopier = Area -> (LocalReg, ByteOff) -> (ByteOff, [CmmNode O O]) ->
(ByteOff, [CmmNode O O])
-type CopyIn = SlotCopier -> Convention -> Area -> CmmFormals -> (ByteOff, [CmmNode O O])
+type CopyIn = SlotCopier -> Convention -> Area -> [CmmFormal] -> (ByteOff, [CmmNode O O])
-- Return the number of bytes used for copying arguments, as well as the
-- instructions to copy the arguments.
-- Factoring out the common parts of the copyout functions yielded something
-- more complicated:
-copyOutOflow :: Convention -> Transfer -> Area -> CmmActuals -> UpdFrameOffset ->
+copyOutOflow :: Convention -> Transfer -> Area -> [CmmActual] -> UpdFrameOffset ->
(Int, CmmAGraph)
-- Generate code to move the actual parameters into the locations
-- required by the calling convention. This includes a store for the return address.
else ([], 0)
Old -> ([], updfr_off)
- args :: [(CmmExpr, ParamLocation ByteOff)] -- The argument and where to put it
+ args :: [(CmmExpr, ParamLocation)] -- The argument and where to put it
args = assignArgumentsPos conv cmmExprType actuals
args' = foldl adjust setRA args
toExp r = CmmReg (CmmLocal r)
args = assignArgumentsPos conv localRegType actuals
-mkCallEntry :: Convention -> CmmFormals -> (Int, CmmAGraph)
+mkCallEntry :: Convention -> [CmmFormal] -> (Int, CmmAGraph)
mkCallEntry conv formals = copyInOflow conv (CallArea Old) formals
-lastWithArgs :: Transfer -> Area -> Convention -> CmmActuals -> UpdFrameOffset ->
+lastWithArgs :: Transfer -> Area -> Convention -> [CmmActual] -> UpdFrameOffset ->
(ByteOff -> CmmAGraph) -> CmmAGraph
lastWithArgs transfer area conv actuals updfr_off last =
let (outArgs, copies) = copyOutOflow conv transfer area actuals updfr_off in
cmmMapGraphM, cmmTopMapGraphM,
GenBasicBlock(..), CmmBasicBlock, blockId, blockStmts, mapBlockStmts,
CmmStmt(..), CmmReturnInfo(..), CmmHinted(..),
- HintedCmmFormal, HintedCmmFormals, HintedCmmActual, HintedCmmActuals,
+ HintedCmmFormal, HintedCmmActual,
CmmSafety(..), CmmCallTarget(..),
module CmmDecl,
module CmmExpr,
| CmmCall -- A call (foreign, native or primitive), with
CmmCallTarget
- HintedCmmFormals -- zero or more results
- HintedCmmActuals -- zero or more arguments
+ [HintedCmmFormal] -- zero or more results
+ [HintedCmmActual] -- zero or more arguments
CmmSafety -- whether to build a continuation
CmmReturnInfo
-- Some care is necessary when handling the arguments of these, see
-- Undefined outside range, and when there's a Nothing
| CmmJump CmmExpr -- Jump to another C-- function,
- HintedCmmActuals -- with these parameters. (parameters never used)
+ [HintedCmmActual] -- with these parameters. (parameters never used)
| CmmReturn -- Return from a native C-- function,
- HintedCmmActuals -- with these return values. (parameters never used)
+ [HintedCmmActual] -- with these return values. (parameters never used)
data CmmHinted a = CmmHinted { hintlessCmm :: a, cmmHint :: ForeignHint }
deriving( Eq )
-type HintedCmmActuals = [HintedCmmActual]
-type HintedCmmFormals = [HintedCmmFormal]
type HintedCmmFormal = CmmHinted CmmFormal
type HintedCmmActual = CmmHinted CmmActual
data CmmSafety = CmmUnsafe | CmmSafe C_SRT | CmmInterruptible
--- | enable us to fold used registers over 'CmmActuals' and 'CmmFormals'
+-- | enable us to fold used registers over '[CmmActual]' and '[CmmFormal]'
instance UserOfLocalRegs CmmStmt where
foldRegsUsed f (set::b) s = stmt s set
where
---------------------------------------------------
loadArgsIntoTemps :: [Unique]
- -> HintedCmmActuals
- -> ([Unique], [CmmStmt], HintedCmmActuals)
+ -> [HintedCmmActual]
+ -> ([Unique], [CmmStmt], [HintedCmmActual])
loadArgsIntoTemps uniques [] = (uniques, [], [])
loadArgsIntoTemps uniques ((CmmHinted e hint):args) =
(uniques'',
CmmJump lbl _params -> mkJMP_(pprExpr lbl) <> semi
CmmSwitch arg ids -> pprSwitch arg ids
-pprCFunType :: SDoc -> CCallConv -> HintedCmmFormals -> HintedCmmActuals -> SDoc
+pprCFunType :: SDoc -> CCallConv -> [HintedCmmFormal] -> [HintedCmmActual] -> SDoc
pprCFunType ppr_fn cconv ress args
= res_type ress <+>
parens (text (ccallConvAttribute cconv) <> ppr_fn) <>
-- -----------------------------------------------------------------------------
-- Foreign Calls
-pprCall :: SDoc -> CCallConv -> HintedCmmFormals -> HintedCmmActuals -> CmmSafety
+pprCall :: SDoc -> CCallConv -> [HintedCmmFormal] -> [HintedCmmActual] -> CmmSafety
-> SDoc
pprCall ppr_fn cconv results args _
More notes (June 11)\r
~~~~~~~~~~~~~~~~~~~~\r
-* Kill dead code assignArguments, argumentsSize in CmmCallConv.\r
- Bake in ByteOff to ParamLocation and ArgumentFormat\r
- CmmActuals -> [CmmActual] similary CmmFormals\r
-\r
* Possible refactoring: Nuke AGraph in favour of \r
mkIfThenElse :: Expr -> Graph -> Graph -> FCode Graph\r
or even\r
-- Code generation for Foreign Calls
cgForeignCall
- :: HintedCmmFormals -- where to put the results
+ :: [HintedCmmFormal] -- where to put the results
-> ForeignCall -- the op
-> [StgArg] -- arguments
-> StgLiveVars -- live vars, in case we need to save them
emitForeignCall
- :: HintedCmmFormals -- where to put the results
+ :: [HintedCmmFormal] -- where to put the results
-> ForeignCall -- the op
-> [CmmHinted CmmExpr] -- arguments
-> StgLiveVars -- live vars, in case we need to save them
-- alternative entry point, used by CmmParse
+-- the new code generator has utility function emitCCall and emitPrimCall
+-- which should be used instead of this (the equivalent emitForeignCall
+-- is not presently exported.)
emitForeignCall'
:: Safety
- -> HintedCmmFormals -- where to put the results
+ -> [HintedCmmFormal] -- where to put the results
-> CmmCallTarget -- the op
-> [CmmHinted CmmExpr] -- arguments
-> Maybe [GlobalReg] -- live vars, in case we need to save them
-- representation as a list of 'CmmAddr' is handled later
-- in the pipeline by 'cmmToRawCmm'.
-emitClosureCodeAndInfoTable :: ClosureInfo -> CmmFormals -> CgStmts -> Code
+emitClosureCodeAndInfoTable :: ClosureInfo -> [CmmFormal] -> CgStmts -> Code
emitClosureCodeAndInfoTable cl_info args body
= do { blks <- cgStmtsToBlocks body
; info <- mkCmmInfo cl_info
emitInfoTableAndCode
:: CLabel -- Label of entry or ret
-> CmmInfo -- ...the info table
- -> CmmFormals -- ...args
+ -> [CmmFormal] -- ...args
-> [CmmBasicBlock] -- ...and body
-> Code
whenC True code = code
whenC False _ = nopC
+-- Corresponds to 'emit' in new code generator with a smart constructor
+-- from cmm/MkGraph.hs
stmtC :: CmmStmt -> Code
stmtC stmt = emitCgStmt (CgStmt stmt)
where
data_block = CmmData sect lits
-emitProc :: CmmInfo -> CLabel -> CmmFormals -> [CmmBasicBlock] -> Code
+emitProc :: CmmInfo -> CLabel -> [CmmFormal] -> [CmmBasicBlock] -> Code
emitProc info lbl [] blocks
= do { let proc_block = CmmProc info lbl (ListGraph blocks)
; state <- getState
-- ---------------------------------------------------------------------------
-- Code generation for PrimOps
-cgPrimOp :: CmmFormals -- where to put the results
+cgPrimOp :: [CmmFormal] -- where to put the results
-> PrimOp -- the op
-> [StgArg] -- arguments
-> StgLiveVars -- live vars, in case we need to save them
emitPrimOp results op non_void_args live
-emitPrimOp :: CmmFormals -- where to put the results
+emitPrimOp :: [CmmFormal] -- where to put the results
-> PrimOp -- the op
-> [CmmExpr] -- arguments
-> StgLiveVars -- live vars, in case we need to save them
-- ----------------------------------------------------------------------------
-- Copying pointer arrays
+-- EZY: This code has an unusually high amount of assignTemp calls, seen
+-- nowhere else in the code generator. This is mostly because these
+-- "primitive" ops result in a surprisingly large amount of code. It
+-- will likely be worthwhile to optimize what is emitted here, so that
+-- our optimization passes don't waste time repeatedly optimizing the
+-- same bits of code.
+
-- | Takes a source 'Array#', an offset in the source array, a
-- destination 'MutableArray#', an offset into the destination array,
-- and the number of elements to copy. Copies the given number of
fc = ForeignConvention CCallConv arg_hints result_hints
-emitPrimCall :: CmmFormals -> CallishMachOp -> CmmActuals -> FCode ()
+emitPrimCall :: [CmmFormal] -> CallishMachOp -> [CmmActual] -> FCode ()
emitPrimCall res op args
= emitForeignCall PlayRisky res (PrimTarget op) args NoC_SRT CmmMayReturn
-- alternative entry point, used by CmmParse
emitForeignCall
- :: Safety
- -> CmmFormals -- where to put the results
- -> ForeignTarget -- the op
- -> CmmActuals -- arguments
+ :: Safety
+ -> [CmmFormal] -- where to put the results
+ -> ForeignTarget -- the op
+ -> [CmmActual] -- arguments
-> C_SRT -- the SRT of the calls continuation
- -> CmmReturnInfo -- This can say "never returns"
- -- only RTS procedures do this
- -> FCode ()
+ -> CmmReturnInfo -- This can say "never returns"
+ -- only RTS procedures do this
+ -> FCode ()
emitForeignCall safety results target args _srt _ret
| not (playSafe safety) = do
let (caller_save, caller_load) = callerSaveVolatileRegs
where
data_block = CmmData sect lits
-emitProcWithConvention :: Convention -> CmmInfoTable -> CLabel -> CmmFormals ->
+emitProcWithConvention :: Convention -> CmmInfoTable -> CLabel -> [CmmFormal] ->
CmmAGraph -> FCode ()
emitProcWithConvention conv info lbl args blocks
= do { us <- newUniqSupply
; state <- getState
; setState $ state { cgs_tops = cgs_tops state `snocOL` proc_block } }
-emitProc :: CmmInfoTable -> CLabel -> CmmFormals -> CmmAGraph -> FCode ()
+emitProc :: CmmInfoTable -> CLabel -> [CmmFormal] -> CmmAGraph -> FCode ()
emitProc = emitProcWithConvention NativeNodeCall
emitSimpleProc :: CLabel -> CmmAGraph -> FCode ()
import StgCmmEnv
import StgCmmMonad
import StgCmmUtils
+import StgCmmTicky
+import StgCmmHeap
+import StgCmmProf
+import BasicTypes
import MkGraph
import StgSyn
import CmmDecl
emitPrimOp [res] UnsafeFreezeByteArrayOp [arg]
= emit (mkAssign (CmmLocal res) arg)
+-- Copying pointer arrays
+
+emitPrimOp [] CopyArrayOp [src,src_off,dst,dst_off,n] =
+ doCopyArrayOp src src_off dst dst_off n
+emitPrimOp [] CopyMutableArrayOp [src,src_off,dst,dst_off,n] =
+ doCopyMutableArrayOp src src_off dst dst_off n
+emitPrimOp [res] CloneArrayOp [src,src_off,n] =
+ emitCloneArray mkMAP_FROZEN_infoLabel res src src_off n
+emitPrimOp [res] CloneMutableArrayOp [src,src_off,n] =
+ emitCloneArray mkMAP_DIRTY_infoLabel res src src_off n
+emitPrimOp [res] FreezeArrayOp [src,src_off,n] =
+ emitCloneArray mkMAP_FROZEN_infoLabel res src src_off n
+emitPrimOp [res] ThawArrayOp [src,src_off,n] =
+ emitCloneArray mkMAP_DIRTY_infoLabel res src src_off n
+
-- Reading/writing pointer arrays
emitPrimOp [r] ReadArrayOp [obj,ix] = doReadPtrArrayOp r obj ix
setInfo :: CmmExpr -> CmmExpr -> CmmAGraph
setInfo closure_ptr info_ptr = mkStore closure_ptr info_ptr
+-- ----------------------------------------------------------------------------
+-- Copying pointer arrays
+
+-- EZY: This code has an unusually high amount of assignTemp calls, seen
+-- nowhere else in the code generator. This is mostly because these
+-- "primitive" ops result in a surprisingly large amount of code. It
+-- will likely be worthwhile to optimize what is emitted here, so that
+-- our optimization passes don't waste time repeatedly optimizing the
+-- same bits of code.
+
+-- More closely imitates 'assignTemp' from the old code generator, which
+-- returns a CmmExpr rather than a LocalReg.
+assignTempE :: CmmExpr -> FCode CmmExpr
+assignTempE e = do
+ t <- assignTemp e
+ return (CmmReg (CmmLocal t))
+
+-- | Takes a source 'Array#', an offset in the source array, a
+-- destination 'MutableArray#', an offset into the destination array,
+-- and the number of elements to copy. Copies the given number of
+-- elements from the source array to the destination array.
+doCopyArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
+ -> FCode ()
+doCopyArrayOp = emitCopyArray copy
+ where
+ -- Copy data (we assume the arrays aren't overlapping since
+ -- they're of different types)
+ copy _src _dst = emitMemcpyCall
+
+-- | Takes a source 'MutableArray#', an offset in the source array, a
+-- destination 'MutableArray#', an offset into the destination array,
+-- and the number of elements to copy. Copies the given number of
+-- elements from the source array to the destination array.
+doCopyMutableArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
+ -> FCode ()
+doCopyMutableArrayOp = emitCopyArray copy
+ where
+ -- The only time the memory might overlap is when the two arrays
+ -- we were provided are the same array!
+ -- TODO: Optimize branch for common case of no aliasing.
+ copy src dst dst_p src_p bytes = do
+ [moveCall, cpyCall] <- forkAlts [
+ getCode $ emitMemmoveCall dst_p src_p bytes,
+ getCode $ emitMemcpyCall dst_p src_p bytes
+ ]
+ emit $ mkCmmIfThenElse (cmmEqWord src dst) moveCall cpyCall
+
+emitCopyArray :: (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
+ -> FCode ())
+ -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
+ -> FCode ()
+emitCopyArray copy src0 src_off0 dst0 dst_off0 n0 = do
+ -- Passed as arguments (be careful)
+ src <- assignTempE src0
+ src_off <- assignTempE src_off0
+ dst <- assignTempE dst0
+ dst_off <- assignTempE dst_off0
+ n <- assignTempE n0
+
+ -- Set the dirty bit in the header.
+ emit (setInfo dst (CmmLit (CmmLabel mkMAP_DIRTY_infoLabel)))
+
+ dst_elems_p <- assignTempE $ cmmOffsetB dst arrPtrsHdrSize
+ dst_p <- assignTempE $ cmmOffsetExprW dst_elems_p dst_off
+ src_p <- assignTempE $ cmmOffsetExprW (cmmOffsetB src arrPtrsHdrSize) src_off
+ bytes <- assignTempE $ cmmMulWord n (CmmLit (mkIntCLit wORD_SIZE))
+
+ copy src dst dst_p src_p bytes
+
+ -- The base address of the destination card table
+ dst_cards_p <- assignTempE $ cmmOffsetExprW dst_elems_p (loadArrPtrsSize dst)
+
+ emitSetCards dst_off dst_cards_p n
+
+-- | Takes an info table label, a register to return the newly
+-- allocated array in, a source array, an offset in the source array,
+-- and the number of elements to copy. Allocates a new array and
+-- initializes it form the source array.
+emitCloneArray :: CLabel -> CmmFormal -> CmmExpr -> CmmExpr -> CmmExpr
+ -> FCode ()
+emitCloneArray info_p res_r src0 src_off0 n0 = do
+ -- Passed as arguments (be careful)
+ src <- assignTempE src0
+ src_off <- assignTempE src_off0
+ n <- assignTempE n0
+
+ card_words <- assignTempE $ (n `cmmUShrWord`
+ (CmmLit (mkIntCLit mUT_ARR_PTRS_CARD_BITS)))
+ `cmmAddWord` CmmLit (mkIntCLit 1)
+ size <- assignTempE $ n `cmmAddWord` card_words
+ words <- assignTempE $ arrPtrsHdrSizeW `cmmAddWord` size
+
+ arr_r <- newTemp bWord
+ emitAllocateCall arr_r myCapability words
+ tickyAllocPrim (CmmLit (mkIntCLit arrPtrsHdrSize)) (n `cmmMulWord` wordSize)
+ (CmmLit $ mkIntCLit 0)
+
+ let arr = CmmReg (CmmLocal arr_r)
+ emitSetDynHdr arr (CmmLit (CmmLabel info_p)) curCCSAddr
+ emit $ mkStore (cmmOffsetB arr (fixedHdrSize * wORD_SIZE +
+ oFFSET_StgMutArrPtrs_ptrs)) n
+ emit $ mkStore (cmmOffsetB arr (fixedHdrSize * wORD_SIZE +
+ oFFSET_StgMutArrPtrs_size)) size
+
+ dst_p <- assignTempE $ cmmOffsetB arr arrPtrsHdrSize
+ src_p <- assignTempE $ cmmOffsetExprW (cmmOffsetB src arrPtrsHdrSize)
+ src_off
+
+ emitMemcpyCall dst_p src_p (n `cmmMulWord` wordSize)
+
+ emitMemsetCall (cmmOffsetExprW dst_p n)
+ (CmmLit (mkIntCLit 1))
+ (card_words `cmmMulWord` wordSize)
+ emit $ mkAssign (CmmLocal res_r) arr
+ where
+ arrPtrsHdrSizeW = CmmLit $ mkIntCLit $ fixedHdrSize +
+ (sIZEOF_StgMutArrPtrs_NoHdr `div` wORD_SIZE)
+ wordSize = CmmLit (mkIntCLit wORD_SIZE)
+ myCapability = CmmReg baseReg `cmmSubWord`
+ CmmLit (mkIntCLit oFFSET_Capability_r)
+
+-- | Takes and offset in the destination array, the base address of
+-- the card table, and the number of elements affected (*not* the
+-- number of cards). Marks the relevant cards as dirty.
+emitSetCards :: CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
+emitSetCards dst_start dst_cards_start n = do
+ start_card <- assignTempE $ card dst_start
+ emitMemsetCall (dst_cards_start `cmmAddWord` start_card)
+ (CmmLit (mkIntCLit 1))
+ ((card (dst_start `cmmAddWord` n) `cmmSubWord` start_card)
+ `cmmAddWord` CmmLit (mkIntCLit 1))
+ where
+ -- Convert an element index to a card index
+ card i = i `cmmUShrWord` (CmmLit (mkIntCLit mUT_ARR_PTRS_CARD_BITS))
+
+-- | Emit a call to @memcpy@.
+emitMemcpyCall :: CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
+emitMemcpyCall dst src n = do
+ emitCCall
+ [ {-no results-} ]
+ memcpy
+ [ (dst, AddrHint)
+ , (src, AddrHint)
+ , (n, NoHint)
+ ]
+ where
+ memcpy = CmmLit (CmmLabel (mkForeignLabel (fsLit "memcpy") Nothing
+ ForeignLabelInExternalPackage IsFunction))
+
+-- | Emit a call to @memmove@.
+emitMemmoveCall :: CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
+emitMemmoveCall dst src n = do
+ emitCCall
+ [ {- no results -} ]
+ memmove
+ [ (dst, AddrHint)
+ , (src, AddrHint)
+ , (n, NoHint)
+ ]
+ where
+ memmove = CmmLit (CmmLabel (mkForeignLabel (fsLit "memmove") Nothing
+ ForeignLabelInExternalPackage IsFunction))
+
+-- | Emit a call to @memset@. The second argument must fit inside an
+-- unsigned char.
+emitMemsetCall :: CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
+emitMemsetCall dst c n = do
+ emitCCall
+ [ {- no results -} ]
+ memset
+ [ (dst, AddrHint)
+ , (c, NoHint)
+ , (n, NoHint)
+ ]
+ where
+ memset = CmmLit (CmmLabel (mkForeignLabel (fsLit "memset") Nothing
+ ForeignLabelInExternalPackage IsFunction))
+
+-- | Emit a call to @allocate@.
+emitAllocateCall :: LocalReg -> CmmExpr -> CmmExpr -> FCode ()
+emitAllocateCall res cap n = do
+ emitCCall
+ [ (res, AddrHint) ]
+ allocate
+ [ (cap, AddrHint)
+ , (n, NoHint)
+ ]
+ where
+ allocate = CmmLit (CmmLabel (mkForeignLabel (fsLit "allocate") Nothing
+ ForeignLabelInExternalPackage IsFunction))
callerSaves, callerSaveVolatileRegs, get_GlobalReg_addr,
cmmAndWord, cmmOrWord, cmmNegate, cmmEqWord, cmmNeWord,
- cmmUGtWord,
+ cmmUGtWord, cmmSubWord, cmmMulWord, cmmAddWord, cmmUShrWord,
cmmOffsetExprW, cmmOffsetExprB,
cmmRegOffW, cmmRegOffB,
cmmLabelOffW, cmmLabelOffB,
-----------------------
cmmULtWord, cmmUGeWord, cmmUGtWord, cmmSubWord,
- cmmNeWord, cmmEqWord, cmmOrWord, cmmAndWord
+ cmmNeWord, cmmEqWord, cmmOrWord, cmmAndWord,
+ cmmUShrWord, cmmAddWord, cmmMulWord
:: CmmExpr -> CmmExpr -> CmmExpr
cmmOrWord e1 e2 = CmmMachOp mo_wordOr [e1, e2]
cmmAndWord e1 e2 = CmmMachOp mo_wordAnd [e1, e2]
cmmUGeWord e1 e2 = CmmMachOp mo_wordUGe [e1, e2]
cmmUGtWord e1 e2 = CmmMachOp mo_wordUGt [e1, e2]
--cmmShlWord e1 e2 = CmmMachOp mo_wordShl [e1, e2]
---cmmUShrWord e1 e2 = CmmMachOp mo_wordUShr [e1, e2]
+cmmUShrWord e1 e2 = CmmMachOp mo_wordUShr [e1, e2]
+cmmAddWord e1 e2 = CmmMachOp mo_wordAdd [e1, e2]
cmmSubWord e1 e2 = CmmMachOp mo_wordSub [e1, e2]
+cmmMulWord e1 e2 = CmmMachOp mo_wordMul [e1, e2]
cmmNegate :: CmmExpr -> CmmExpr
cmmNegate (CmmLit (CmmInt n rep)) = CmmLit (CmmInt (-n) rep)
-------------------------------------------------------------------------
assignTemp :: CmmExpr -> FCode LocalReg
--- Make sure the argument is in a local register
+-- Make sure the argument is in a local register.
+-- We don't bother being particularly aggressive with avoiding
+-- unnecessary local registers, since we can rely on a later
+-- optimization pass to inline as necessary (and skipping out
+-- on things like global registers can be a little dangerous
+-- due to them being trashed on foreign calls--though it means
+-- the optimization pass doesn't have to do as much work)
assignTemp (CmmReg (CmmLocal reg)) = return reg
assignTemp e = do { uniq <- newUnique
; let reg = LocalReg uniq (cmmExprType e)
-- | Foreign Calls
-genCall :: LlvmEnv -> CmmCallTarget -> HintedCmmFormals -> HintedCmmActuals
+genCall :: LlvmEnv -> CmmCallTarget -> [HintedCmmFormal] -> [HintedCmmActual]
-> CmmReturnInfo -> UniqSM StmtData
-- Write barrier needs to be handled specially as it is implemented as an LLVM
-- | Conversion of call arguments.
arg_vars :: LlvmEnv
- -> HintedCmmActuals
+ -> [HintedCmmActual]
-> ([LlvmVar], LlvmStatements, [LlvmCmmTop])
-> UniqSM (LlvmEnv, [LlvmVar], LlvmStatements, [LlvmCmmTop])
-- register allocator.
genCCall :: CmmCallTarget -- function to call
- -> HintedCmmFormals -- where to put the result
- -> HintedCmmActuals -- arguments (of mixed type)
+ -> [HintedCmmFormal] -- where to put the result
+ -> [HintedCmmActual] -- arguments (of mixed type)
-> NatM InstrBlock
genCCall target dest_regs argsAndHints
= do dflags <- getDynFlagsNat
genCCall'
:: GenCCallPlatform
-> CmmCallTarget -- function to call
- -> HintedCmmFormals -- where to put the result
- -> HintedCmmActuals -- arguments (of mixed type)
+ -> [HintedCmmFormal] -- where to put the result
+ -> [HintedCmmActual] -- arguments (of mixed type)
-> NatM InstrBlock
{-
-}
genCCall
- :: CmmCallTarget -- function to call
- -> HintedCmmFormals -- where to put the result
- -> HintedCmmActuals -- arguments (of mixed type)
+ :: CmmCallTarget -- function to call
+ -> [HintedCmmFormal] -- where to put the result
+ -> [HintedCmmActual] -- arguments (of mixed type)
-> NatM InstrBlock
-- register allocator.
genCCall
- :: CmmCallTarget -- function to call
- -> HintedCmmFormals -- where to put the result
- -> HintedCmmActuals -- arguments (of mixed type)
+ :: CmmCallTarget -- function to call
+ -> [HintedCmmFormal] -- where to put the result
+ -> [HintedCmmActual] -- arguments (of mixed type)
-> NatM InstrBlock
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#endif /* x86_64_TARGET_ARCH */
-outOfLineCmmOp :: CallishMachOp -> Maybe HintedCmmFormal -> HintedCmmActuals -> NatM InstrBlock
+outOfLineCmmOp :: CallishMachOp -> Maybe HintedCmmFormal -> [HintedCmmActual] -> NatM InstrBlock
outOfLineCmmOp mop res args
= do
dflags <- getDynFlagsNat
projects / ghc-hetmet.git / commitdiff