diff options
| author | Ian Lynagh <igloo@earth.li> | 2012-02-23 19:57:57 +0000 |
|---|---|---|
| committer | Ian Lynagh <igloo@earth.li> | 2012-02-23 19:59:20 +0000 |
| commit | 98acdf083c119b018f25097593668a816dc68068 (patch) | |
| tree | 3ed98b700e687ed988519d54b574096e949a214e /compiler/nativeGen/PPC/CodeGen.hs | |
| parent | 7d8b2c18eeb166ea64504fb3a8022edd6b36e870 (diff) | |
| download | haskell-98acdf083c119b018f25097593668a816dc68068.tar.gz | |
Add a Word add-with-carry primop
No special-casing in any NCGs yet
Diffstat (limited to 'compiler/nativeGen/PPC/CodeGen.hs')
| -rw-r--r-- | compiler/nativeGen/PPC/CodeGen.hs | 13 |
1 files changed, 6 insertions, 7 deletions
diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs index 169cd0cac4..9974fb582b 100644 --- a/compiler/nativeGen/PPC/CodeGen.hs +++ b/compiler/nativeGen/PPC/CodeGen.hs @@ -42,7 +42,6 @@ import Platform import BlockId import PprCmm ( pprExpr ) import OldCmm -import OldCmmUtils import CLabel -- The rest: @@ -899,12 +898,11 @@ genCCall' -} -genCCall' _ (CmmPrim MO_WriteBarrier) _ _ +genCCall' _ (CmmPrim MO_WriteBarrier _) _ _ = return $ unitOL LWSYNC -genCCall' _ (CmmPrim op) results args - | Just stmts <- expandCallishMachOp op results args - = stmtsToInstrs stmts +genCCall' _ (CmmPrim _ (Just mkStmts)) results args + = stmtsToInstrs (mkStmts results args) genCCall' gcp target dest_regs argsAndHints = ASSERT (not $ any (`elem` [II16]) $ map cmmTypeSize argReps) @@ -919,7 +917,7 @@ genCCall' gcp target dest_regs argsAndHints (labelOrExpr, reduceToFF32) <- case target of CmmCallee (CmmLit (CmmLabel lbl)) _ -> return (Left lbl, False) CmmCallee expr _ -> return (Right expr, False) - CmmPrim mop -> outOfLineMachOp mop + CmmPrim mop _ -> outOfLineMachOp mop let codeBefore = move_sp_down finalStack `appOL` passArgumentsCode codeAfter = move_sp_up finalStack `appOL` moveResult reduceToFF32 @@ -948,7 +946,7 @@ genCCall' gcp target dest_regs argsAndHints GCPLinux -> roundTo 16 finalStack -- need to remove alignment information - argsAndHints' | (CmmPrim mop) <- target, + argsAndHints' | (CmmPrim mop _) <- target, (mop == MO_Memcpy || mop == MO_Memset || mop == MO_Memmove) @@ -1149,6 +1147,7 @@ genCCall' gcp target dest_regs argsAndHints MO_S_QuotRem {} -> unsupported MO_U_QuotRem {} -> unsupported + MO_Add2 {} -> unsupported MO_WriteBarrier -> unsupported MO_Touch -> unsupported unsupported = panic ("outOfLineCmmOp: " ++ show mop |