Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/f141e108deade85c51bf064e9ccbca785ad8e1c1 >--------------------------------------------------------------- commit f141e108deade85c51bf064e9ccbca785ad8e1c1 Author: Johan Tibell <[email protected]> Date: Thu Jun 16 07:50:10 2011 +0200 Port "Add byte array copy primops" to the new code gen Signed-off-by: David Terei <[email protected]> >--------------------------------------------------------------- compiler/codeGen/StgCmmPrim.hs | 57 ++++++++++++++++++++++++++++++++++++++++ 1 files changed, 57 insertions(+), 0 deletions(-) diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs index 2cf7227..66730af 100644 --- a/compiler/codeGen/StgCmmPrim.hs +++ b/compiler/codeGen/StgCmmPrim.hs @@ -425,6 +425,11 @@ emitPrimOp res WriteByteArrayOp_Word16 args = doWriteByteArrayOp (Just mo_Wor emitPrimOp res WriteByteArrayOp_Word32 args = doWriteByteArrayOp (Just mo_WordTo32) res args emitPrimOp res WriteByteArrayOp_Word64 args = doWriteByteArrayOp Nothing res args +-- Copying byte arrays +emitPrimOp [] CopyByteArrayOp [src,src_off,dst,dst_off,n] = + doCopyByteArrayOp src src_off dst dst_off n +emitPrimOp [] CopyMutableByteArrayOp [src,src_off,dst,dst_off,n] = + doCopyMutableByteArrayOp src src_off dst dst_off n -- The rest just translate straightforwardly emitPrimOp [res] op [arg] @@ -704,6 +709,58 @@ setInfo :: CmmExpr -> CmmExpr -> CmmAGraph setInfo closure_ptr info_ptr = mkStore closure_ptr info_ptr -- ---------------------------------------------------------------------------- +-- Copying byte arrays + +-- | Takes a source 'ByteArray#', an offset in the source array, a +-- destination 'MutableByteArray#', an offset into the destination +-- array, and the number of bytes to copy. Copies the given number of +-- bytes from the source array to the destination array. +doCopyByteArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr + -> FCode () +doCopyByteArrayOp = emitCopyByteArray copy + where + -- Copy data (we assume the arrays aren't overlapping since + -- they're of different types) + copy _src _dst dst_p src_p bytes = + emitMemcpyCall dst_p src_p bytes (CmmLit (mkIntCLit 1)) + +-- | Takes a source 'MutableByteArray#', an offset in the source +-- array, a destination 'MutableByteArray#', an offset into the +-- destination array, and the number of bytes to copy. Copies the +-- given number of bytes from the source array to the destination +-- array. +doCopyMutableByteArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr + -> FCode () +doCopyMutableByteArrayOp = emitCopyByteArray 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 (CmmLit (mkIntCLit 1)), + getCode $ emitMemcpyCall dst_p src_p bytes (CmmLit (mkIntCLit 1)) + ] + emit $ mkCmmIfThenElse (cmmEqWord src dst) moveCall cpyCall + +emitCopyByteArray :: (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr + -> FCode ()) + -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr + -> FCode () +emitCopyByteArray 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 + + dst_p <- assignTempE $ cmmOffsetExpr (cmmOffsetB dst arrWordsHdrSize) dst_off + src_p <- assignTempE $ cmmOffsetExpr (cmmOffsetB src arrWordsHdrSize) src_off + + copy src dst dst_p src_p n + +-- ---------------------------------------------------------------------------- -- Copying pointer arrays -- EZY: This code has an unusually high amount of assignTemp calls, seen _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
