+-- ----------------------------------------------------------------------------
+-- 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
+-- elements from the source array to the destination array.
+doCopyArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
+ -> StgLiveVars -> Code
+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
+ -> StgLiveVars -> Code
+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 live =
+ emitIfThenElse (cmmEqWord src dst)
+ (emitMemmoveCall dst_p src_p bytes live)
+ (emitMemcpyCall dst_p src_p bytes live)
+
+emitCopyArray :: (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
+ -> StgLiveVars -> Code)
+ -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
+ -> StgLiveVars
+ -> Code
+emitCopyArray copy src0 src_off0 dst0 dst_off0 n0 live = do
+ -- Assign the arguments to temporaries so the code generator can
+ -- calculate liveness for us.
+ src <- assignTemp_ src0
+ src_off <- assignTemp_ src_off0
+ dst <- assignTemp_ dst0
+ dst_off <- assignTemp_ dst_off0
+ n <- assignTemp_ n0
+
+ -- Set the dirty bit in the header.
+ stmtC (setInfo dst (CmmLit (CmmLabel mkMAP_DIRTY_infoLabel)))
+
+ dst_elems_p <- assignTemp $ cmmOffsetB dst arrPtrsHdrSize
+ dst_p <- assignTemp $ cmmOffsetExprW dst_elems_p dst_off
+ src_p <- assignTemp $ cmmOffsetExprW (cmmOffsetB src arrPtrsHdrSize) src_off
+ bytes <- assignTemp $ cmmMulWord n (CmmLit (mkIntCLit wORD_SIZE))
+
+ copy src dst dst_p src_p bytes live
+
+ -- The base address of the destination card table
+ dst_cards_p <- assignTemp $ cmmOffsetExprW dst_elems_p (loadArrPtrsSize dst)
+
+ emitSetCards dst_off dst_cards_p n live
+
+-- | 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
+ -> StgLiveVars -> Code
+emitCloneArray info_p res_r src0 src_off0 n0 live = do
+ -- Assign the arguments to temporaries so the code generator can
+ -- calculate liveness for us.
+ src <- assignTemp_ src0
+ src_off <- assignTemp_ src_off0
+ n <- assignTemp_ n0
+
+ card_words <- assignTemp $ (n `cmmUShrWord`
+ (CmmLit (mkIntCLit mUT_ARR_PTRS_CARD_BITS)))
+ `cmmAddWord` CmmLit (mkIntCLit 1)
+ size <- assignTemp $ n `cmmAddWord` card_words
+ words <- assignTemp $ arrPtrsHdrSizeW `cmmAddWord` size
+
+ arr_r <- newTemp bWord
+ emitAllocateCall arr_r myCapability words live
+ tickyAllocPrim (CmmLit (mkIntCLit arrPtrsHdrSize)) (n `cmmMulWord` wordSize)
+ (CmmLit $ mkIntCLit 0)
+
+ let arr = CmmReg (CmmLocal arr_r)
+ emitSetDynHdr arr (CmmLit (CmmLabel info_p)) curCCSAddr
+ stmtC $ CmmStore (cmmOffsetB arr (fixedHdrSize * wORD_SIZE +
+ oFFSET_StgMutArrPtrs_ptrs)) n
+ stmtC $ CmmStore (cmmOffsetB arr (fixedHdrSize * wORD_SIZE +
+ oFFSET_StgMutArrPtrs_size)) size
+
+ dst_p <- assignTemp $ cmmOffsetB arr arrPtrsHdrSize
+ src_p <- assignTemp $ cmmOffsetExprW (cmmOffsetB src arrPtrsHdrSize)
+ src_off
+
+ emitMemcpyCall dst_p src_p (n `cmmMulWord` wordSize) live
+
+ emitMemsetCall (cmmOffsetExprW dst_p n)
+ (CmmLit (mkIntCLit 1))
+ (card_words `cmmMulWord` wordSize)
+ live
+ stmtC $ CmmAssign (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 -> StgLiveVars -> Code
+emitSetCards dst_start dst_cards_start n live = do
+ start_card <- assignTemp $ 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))
+ live
+ 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 -> StgLiveVars -> Code
+emitMemcpyCall dst src n live = do
+ vols <- getVolatileRegs live
+ emitForeignCall' PlayRisky
+ [{-no results-}]
+ (CmmCallee memcpy CCallConv)
+ [ (CmmHinted dst AddrHint)
+ , (CmmHinted src AddrHint)
+ , (CmmHinted n NoHint)
+ ]
+ (Just vols)
+ NoC_SRT -- No SRT b/c we do PlayRisky
+ CmmMayReturn
+ where
+ memcpy = CmmLit (CmmLabel (mkForeignLabel (fsLit "memcpy") Nothing
+ ForeignLabelInExternalPackage IsFunction))
+
+-- | Emit a call to @memmove@.
+emitMemmoveCall :: CmmExpr -> CmmExpr -> CmmExpr -> StgLiveVars -> Code
+emitMemmoveCall dst src n live = do
+ vols <- getVolatileRegs live
+ emitForeignCall' PlayRisky
+ [{-no results-}]
+ (CmmCallee memmove CCallConv)
+ [ (CmmHinted dst AddrHint)
+ , (CmmHinted src AddrHint)
+ , (CmmHinted n NoHint)
+ ]
+ (Just vols)
+ NoC_SRT -- No SRT b/c we do PlayRisky
+ CmmMayReturn
+ 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 -> StgLiveVars -> Code
+emitMemsetCall dst c n live = do
+ vols <- getVolatileRegs live
+ emitForeignCall' PlayRisky
+ [{-no results-}]
+ (CmmCallee memset CCallConv)
+ [ (CmmHinted dst AddrHint)
+ , (CmmHinted c NoHint)
+ , (CmmHinted n NoHint)
+ ]
+ (Just vols)
+ NoC_SRT -- No SRT b/c we do PlayRisky
+ CmmMayReturn
+ where
+ memset = CmmLit (CmmLabel (mkForeignLabel (fsLit "memset") Nothing
+ ForeignLabelInExternalPackage IsFunction))
+
+-- | Emit a call to @allocate@.
+emitAllocateCall :: LocalReg -> CmmExpr -> CmmExpr -> StgLiveVars -> Code
+emitAllocateCall res cap n live = do
+ vols <- getVolatileRegs live
+ emitForeignCall' PlayRisky
+ [CmmHinted res AddrHint]
+ (CmmCallee allocate CCallConv)
+ [ (CmmHinted cap AddrHint)
+ , (CmmHinted n NoHint)
+ ]
+ (Just vols)
+ NoC_SRT -- No SRT b/c we do PlayRisky
+ CmmMayReturn
+ where
+ allocate = CmmLit (CmmLabel (mkForeignLabel (fsLit "allocate") Nothing
+ ForeignLabelInExternalPackage IsFunction))