Was this commit supposed to have made it to master? I don't see it, for some
reason...

Edward

Excerpts from David Terei's message of Tue Jun 14 21:17:43 -0400 2011:
> Repository : ssh://darcs.haskell.org//srv/darcs/ghc
> 
> On branch  : master
> 
> http://hackage.haskell.org/trac/ghc/changeset/6c7d2a946a96ed74799cf353f3f62c875f56639b
> 
> >---------------------------------------------------------------
> 
> commit 6c7d2a946a96ed74799cf353f3f62c875f56639b
> Author: Johan Tibell <[email protected]>
> Date:   Wed Jun 8 14:25:16 2011 +0200
> 
>     Use the new memcpy/memmove/memset MachOps
>     
>     Signed-off-by: David Terei <[email protected]>
> 
> >---------------------------------------------------------------
> 
>  compiler/codeGen/CgPrimOp.hs |   49 +++++++++++++++++++++--------------------
>  1 files changed, 25 insertions(+), 24 deletions(-)
> 
> diff --git a/compiler/codeGen/CgPrimOp.hs b/compiler/codeGen/CgPrimOp.hs
> index 99e5c26..f47fbe3 100644
> --- a/compiler/codeGen/CgPrimOp.hs
> +++ b/compiler/codeGen/CgPrimOp.hs
> @@ -655,7 +655,8 @@ doCopyArrayOp = emitCopyArray copy
>    where
>      -- Copy data (we assume the arrays aren't overlapping since
>      -- they're of different types)
> -    copy _src _dst = emitMemcpyCall
> +    copy _src _dst dst_p src_p bytes live =
> +        emitMemcpyCall dst_p src_p bytes (CmmLit (mkIntCLit wORD_SIZE)) live
>  
>  -- | Takes a source 'MutableArray#', an offset in the source array, a
>  -- destination 'MutableArray#', an offset into the destination array,
> @@ -670,8 +671,8 @@ doCopyMutableArrayOp = emitCopyArray copy
>      -- 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)
> +        (emitMemmoveCall dst_p src_p bytes (CmmLit (mkIntCLit wORD_SIZE)) 
> live)
> +        (emitMemcpyCall dst_p src_p bytes (CmmLit (mkIntCLit wORD_SIZE)) 
> live)
>  
>  emitCopyArray :: (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
>                    -> StgLiveVars -> Code)
> @@ -737,11 +738,13 @@ emitCloneArray info_p res_r src0 src_off0 n0 live = do
>      src_p <- assignTemp $ cmmOffsetExprW (cmmOffsetB src arrPtrsHdrSize)
>               src_off
>  
> -    emitMemcpyCall dst_p src_p (n `cmmMulWord` wordSize) live
> +    emitMemcpyCall dst_p src_p (n `cmmMulWord` wordSize)
> +        (CmmLit (mkIntCLit wORD_SIZE)) live
>  
>      emitMemsetCall (cmmOffsetExprW dst_p n)
>          (CmmLit (mkIntCLit 1))
>          (card_words `cmmMulWord` wordSize)
> +        (CmmLit (mkIntCLit wORD_SIZE))
>          live
>      stmtC $ CmmAssign (CmmLocal res_r) arr
>    where
> @@ -761,65 +764,63 @@ emitSetCards dst_start dst_cards_start n live = do
>          (CmmLit (mkIntCLit 1))
>          ((card (dst_start `cmmAddWord` n) `cmmSubWord` start_card)
>           `cmmAddWord` CmmLit (mkIntCLit 1))
> +        (CmmLit (mkIntCLit wORD_SIZE))
>          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
> +emitMemcpyCall :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> StgLiveVars
> +               -> Code
> +emitMemcpyCall dst src n align live = do
>      vols <- getVolatileRegs live
>      emitForeignCall' PlayRisky
>          [{-no results-}]
> -        (CmmCallee memcpy CCallConv)
> +        (CmmPrim MO_Memcpy)
>          [ (CmmHinted dst AddrHint)
>          , (CmmHinted src AddrHint)
>          , (CmmHinted n NoHint)
> +        , (CmmHinted align 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
> +emitMemmoveCall :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> StgLiveVars
> +                -> Code
> +emitMemmoveCall dst src n align live = do
>      vols <- getVolatileRegs live
>      emitForeignCall' PlayRisky
>          [{-no results-}]
> -        (CmmCallee memmove CCallConv)
> +        (CmmPrim MO_Memmove)
>          [ (CmmHinted dst AddrHint)
>          , (CmmHinted src AddrHint)
>          , (CmmHinted n NoHint)
> +        , (CmmHinted align 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
> +-- | Emit a call to @memset@.  The second argument must be a word but
> +-- its value must fit inside an unsigned char.
> +emitMemsetCall :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> StgLiveVars
> +               -> Code
> +emitMemsetCall dst c n align live = do
>      vols <- getVolatileRegs live
>      emitForeignCall' PlayRisky
>          [{-no results-}]
> -        (CmmCallee memset CCallConv)
> +        (CmmPrim MO_Memset)
>          [ (CmmHinted dst AddrHint)
>          , (CmmHinted c NoHint)
>          , (CmmHinted n NoHint)
> +        , (CmmHinted align 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
> 

_______________________________________________
Cvs-ghc mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/cvs-ghc

Reply via email to