Commit 98acdf08 authored by Ian Lynagh's avatar Ian Lynagh

Add a Word add-with-carry primop

No special-casing in any NCGs yet
parent 7d8b2c18
......@@ -37,7 +37,7 @@ get_conv (PrimTarget _) = NativeNodeCall -- JD: SUSPICIOUS
get_conv (ForeignTarget _ fc) = Foreign fc
cmm_target :: ForeignTarget -> Old.CmmCallTarget
cmm_target (PrimTarget op) = Old.CmmPrim op
cmm_target (PrimTarget op) = Old.CmmPrim op Nothing
cmm_target (ForeignTarget e (ForeignConvention cc _ _)) = Old.CmmCallee e cc
ofZgraph :: CmmGraph -> Old.ListGraph Old.CmmStmt
......
......@@ -442,6 +442,7 @@ data CallishMachOp
| MO_S_QuotRem Width
| MO_U_QuotRem Width
| MO_Add2 Width
| MO_WriteBarrier
| MO_Touch -- Keep variables live (when using interior pointers)
......
......@@ -61,7 +61,7 @@ cmmEliminateDeadBlocks blocks@(BasicBlock base_id _:_) =
stmt m (CmmStore e1 e2) = expr (expr m e1) e2
stmt m (CmmCall c _ as _) = f (actuals m as) c
where f m (CmmCallee e _) = expr m e
f m (CmmPrim _) = m
f m (CmmPrim _ _) = m
stmt m (CmmBranch b) = b:m
stmt m (CmmCondBranch e b) = b:(expr m e)
stmt m (CmmSwitch e bs) = catMaybes bs ++ expr m e
......@@ -269,7 +269,7 @@ inlineStmt u a (CmmStore e1 e2) = CmmStore (inlineExpr u a e1) (inlineExpr u a e
inlineStmt u a (CmmCall target regs es ret)
= CmmCall (infn target) regs es' ret
where infn (CmmCallee fn cconv) = CmmCallee (inlineExpr u a fn) cconv
infn (CmmPrim p) = CmmPrim p
infn (CmmPrim p m) = CmmPrim p m
es' = [ (CmmHinted (inlineExpr u a e) hint) | (CmmHinted e hint) <- es ]
inlineStmt u a (CmmCondBranch e d) = CmmCondBranch (inlineExpr u a e) d
inlineStmt u a (CmmSwitch e d) = CmmSwitch (inlineExpr u a e) d
......
......@@ -912,13 +912,13 @@ primCall results_code name args_code vols safety
case safety of
CmmUnsafe ->
code (emitForeignCall' PlayRisky results
(CmmPrim p) args vols NoC_SRT CmmMayReturn)
(CmmPrim p Nothing) args vols NoC_SRT CmmMayReturn)
CmmSafe srt ->
code (emitForeignCall' PlaySafe results
(CmmPrim p) args vols NoC_SRT CmmMayReturn) where
(CmmPrim p Nothing) args vols NoC_SRT CmmMayReturn) where
CmmInterruptible ->
code (emitForeignCall' PlayInterruptible results
(CmmPrim p) args vols NoC_SRT CmmMayReturn)
(CmmPrim p Nothing) args vols NoC_SRT CmmMayReturn)
doStore :: CmmType -> ExtFCode CmmExpr -> ExtFCode CmmExpr -> ExtCode
doStore rep addr_code val_code
......
......@@ -10,6 +10,7 @@ module CmmType
, Width(..)
, widthInBits, widthInBytes, widthInLog, widthFromBytes
, wordWidth, halfWordWidth, cIntWidth, cLongWidth
, halfWordMask
, narrowU, narrowS
)
where
......@@ -163,6 +164,11 @@ halfWordWidth | wORD_SIZE == 4 = W16
| wORD_SIZE == 8 = W32
| otherwise = panic "MachOp.halfWordRep: Unknown word size"
halfWordMask :: Integer
halfWordMask | wORD_SIZE == 4 = 0xFFFF
| wORD_SIZE == 8 = 0xFFFFFFFF
| otherwise = panic "MachOp.halfWordMask: Unknown word size"
-- cIntRep is the Width for a C-language 'int'
cIntWidth, cLongWidth :: Width
#if SIZEOF_INT == 4
......
......@@ -293,5 +293,8 @@ data CmmCallTarget
| CmmPrim -- Call a "primitive" (eg. sin, cos)
CallishMachOp -- These might be implemented as inline
-- code by the backend.
deriving Eq
-- If we don't know how to implement the
-- mach op, then we can replace it with
-- this list of statements:
(Maybe ([HintedCmmFormal] -> [HintedCmmActual] -> [CmmStmt]))
......@@ -12,8 +12,6 @@ module OldCmmUtils(
maybeAssignTemp, loadArgsIntoTemps,
expandCallishMachOp,
module CmmUtils,
) where
......@@ -99,15 +97,3 @@ maybeAssignTemp uniques e
| otherwise = (tail uniques, [CmmAssign local e], CmmReg local)
where local = CmmLocal (LocalReg (head uniques) (cmmExprType e))
expandCallishMachOp :: CallishMachOp -> [HintedCmmFormal] -> [HintedCmmActual]
-> Maybe [CmmStmt]
expandCallishMachOp (MO_S_QuotRem width) [CmmHinted res_q _, CmmHinted res_r _] args
= Just [CmmAssign (CmmLocal res_q) (CmmMachOp (MO_S_Quot width) args'),
CmmAssign (CmmLocal res_r) (CmmMachOp (MO_S_Rem width) args')]
where args' = map hintlessCmm args
expandCallishMachOp (MO_U_QuotRem width) [CmmHinted res_q _, CmmHinted res_r _] args
= Just [CmmAssign (CmmLocal res_q) (CmmMachOp (MO_U_Quot width) args'),
CmmAssign (CmmLocal res_r) (CmmMachOp (MO_U_Rem width) args')]
where args' = map hintlessCmm args
expandCallishMachOp _ _ _ = Nothing
......@@ -139,7 +139,7 @@ pprStmt platform stmt = case stmt of
_ -> ptext (sLit("foreign")) <+> doubleQuotes (ppr cconv)
-- Call a CallishMachOp, like sin or cos that might be implemented as a library call.
CmmCall (CmmPrim op) results args ret ->
CmmCall (CmmPrim op _) results args ret ->
pprStmt platform (CmmCall (CmmCallee (CmmLit lbl) CCallConv)
results args ret)
where
......
......@@ -28,7 +28,6 @@ import BlockId
import CLabel
import ForeignCall
import OldCmm
import OldCmmUtils
import OldPprCmm ()
-- Utils
......@@ -238,11 +237,10 @@ pprStmt platform stmt = case stmt of
pprCall platform cast_fn cconv results args <> semi)
-- for a dynamic call, no declaration is necessary.
CmmCall (CmmPrim op) results args _ret
| Just stmts <- expandCallishMachOp op results args ->
vcat $ map (pprStmt platform) stmts
CmmCall (CmmPrim _ (Just mkStmts)) results args _ret ->
vcat $ map (pprStmt platform) (mkStmts results args)
CmmCall (CmmPrim op) results args _ret ->
CmmCall (CmmPrim op _) results args _ret ->
pprCall platform ppr_fn CCallConv results args'
where
ppr_fn = pprCallishMachOp_for_C op
......@@ -665,6 +663,7 @@ pprCallishMachOp_for_C mop
MO_S_QuotRem {} -> unsupported
MO_U_QuotRem {} -> unsupported
MO_Add2 {} -> unsupported
MO_Touch -> unsupported
where unsupported = panic ("pprCallishMachOp_for_C: " ++ show mop
++ " not supported!")
......
......@@ -485,7 +485,7 @@ emitBlackHoleCode is_single_entry = do
stmtsC [
CmmStore (cmmOffsetW (CmmReg nodeReg) fixedHdrSize)
(CmmReg (CmmGlobal CurrentTSO)),
CmmCall (CmmPrim MO_WriteBarrier) [] [] CmmMayReturn,
CmmCall (CmmPrim MO_WriteBarrier Nothing) [] [] CmmMayReturn,
CmmStore (CmmReg nodeReg) (CmmReg (CmmGlobal EagerBlackholeInfo))
]
\end{code}
......
......@@ -430,7 +430,7 @@ emitPrimOp [res] op args live
= do vols <- getVolatileRegs live
emitForeignCall' PlayRisky
[CmmHinted res NoHint]
(CmmPrim prim)
(CmmPrim prim Nothing)
[CmmHinted a NoHint | a<-args] -- ToDo: hints?
(Just vols)
NoC_SRT -- No SRT b/c we do PlayRisky
......@@ -441,7 +441,14 @@ emitPrimOp [res] op args live
stmtC stmt
emitPrimOp [res_q, res_r] IntQuotRemOp [arg_x, arg_y] _
= let stmt = CmmCall (CmmPrim (MO_S_QuotRem wordWidth))
= let genericImpl [CmmHinted res_q _, CmmHinted res_r _]
[CmmHinted arg_x _, CmmHinted arg_y _]
= [CmmAssign (CmmLocal res_q)
(CmmMachOp (MO_S_Quot wordWidth) [arg_x, arg_y]),
CmmAssign (CmmLocal res_r)
(CmmMachOp (MO_S_Rem wordWidth) [arg_x, arg_y])]
genericImpl _ _ = panic "emitPrimOp IntQuotRemOp generic: bad lengths"
stmt = CmmCall (CmmPrim (MO_S_QuotRem wordWidth) (Just genericImpl))
[CmmHinted res_q NoHint,
CmmHinted res_r NoHint]
[CmmHinted arg_x NoHint,
......@@ -449,17 +456,60 @@ emitPrimOp [res_q, res_r] IntQuotRemOp [arg_x, arg_y] _
CmmMayReturn
in stmtC stmt
emitPrimOp [res_q, res_r] WordQuotRemOp [arg_x, arg_y] _
= let stmt = CmmCall (CmmPrim (MO_U_QuotRem wordWidth))
= let genericImpl [CmmHinted res_q _, CmmHinted res_r _]
[CmmHinted arg_x _, CmmHinted arg_y _]
= [CmmAssign (CmmLocal res_q)
(CmmMachOp (MO_U_Quot wordWidth) [arg_x, arg_y]),
CmmAssign (CmmLocal res_r)
(CmmMachOp (MO_U_Rem wordWidth) [arg_x, arg_y])]
genericImpl _ _ = panic "emitPrimOp WordQuotRemOp generic: bad lengths"
stmt = CmmCall (CmmPrim (MO_U_QuotRem wordWidth) (Just genericImpl))
[CmmHinted res_q NoHint,
CmmHinted res_r NoHint]
[CmmHinted arg_x NoHint,
CmmHinted arg_y NoHint]
CmmMayReturn
in stmtC stmt
emitPrimOp [res_h, res_l] WordAdd2Op [arg_x, arg_y] _
= do r1 <- newLocalReg (cmmExprType arg_x)
r2 <- newLocalReg (cmmExprType arg_x)
-- This generic implementation is very simple and slow. We might
-- well be able to do better, but for now this at least works.
let genericImpl [CmmHinted res_h _, CmmHinted res_l _]
[CmmHinted arg_x _, CmmHinted arg_y _]
= [CmmAssign (CmmLocal r1)
(add (bottomHalf arg_x) (bottomHalf arg_y)),
CmmAssign (CmmLocal r2)
(add (topHalf (CmmReg (CmmLocal r1)))
(add (topHalf arg_x) (topHalf arg_y))),
CmmAssign (CmmLocal res_h)
(topHalf (CmmReg (CmmLocal r2))),
CmmAssign (CmmLocal res_l)
(or (toTopHalf (CmmReg (CmmLocal r2)))
(bottomHalf (CmmReg (CmmLocal r1))))]
where topHalf x = CmmMachOp (MO_U_Shr wordWidth) [x, hww]
toTopHalf x = CmmMachOp (MO_Shl wordWidth) [x, hww]
bottomHalf x = CmmMachOp (MO_And wordWidth) [x, hwm]
add x y = CmmMachOp (MO_Add wordWidth) [x, y]
or x y = CmmMachOp (MO_Or wordWidth) [x, y]
hww = CmmLit (CmmInt (fromIntegral (widthInBits halfWordWidth))
wordWidth)
hwm = CmmLit (CmmInt halfWordMask wordWidth)
genericImpl _ _ = panic "emitPrimOp WordAdd2Op generic: bad lengths"
stmt = CmmCall (CmmPrim (MO_Add2 wordWidth) (Just genericImpl))
[CmmHinted res_h NoHint,
CmmHinted res_l NoHint]
[CmmHinted arg_x NoHint,
CmmHinted arg_y NoHint]
CmmMayReturn
stmtC stmt
emitPrimOp _ op _ _
= pprPanic "emitPrimOp: can't translate PrimOp" (ppr op)
newLocalReg :: CmmType -> FCode LocalReg
newLocalReg t = do u <- newUnique
return $ LocalReg u t
-- These PrimOps are NOPs in Cmm
......@@ -906,7 +956,7 @@ emitMemcpyCall dst src n align live = do
vols <- getVolatileRegs live
emitForeignCall' PlayRisky
[{-no results-}]
(CmmPrim MO_Memcpy)
(CmmPrim MO_Memcpy Nothing)
[ (CmmHinted dst AddrHint)
, (CmmHinted src AddrHint)
, (CmmHinted n NoHint)
......@@ -923,7 +973,7 @@ emitMemmoveCall dst src n align live = do
vols <- getVolatileRegs live
emitForeignCall' PlayRisky
[{-no results-}]
(CmmPrim MO_Memmove)
(CmmPrim MO_Memmove Nothing)
[ (CmmHinted dst AddrHint)
, (CmmHinted src AddrHint)
, (CmmHinted n NoHint)
......@@ -941,7 +991,7 @@ emitMemsetCall dst c n align live = do
vols <- getVolatileRegs live
emitForeignCall' PlayRisky
[{-no results-}]
(CmmPrim MO_Memset)
(CmmPrim MO_Memset Nothing)
[ (CmmHinted dst AddrHint)
, (CmmHinted c NoHint)
, (CmmHinted n NoHint)
......@@ -973,7 +1023,7 @@ emitPopCntCall res x width live = do
vols <- getVolatileRegs live
emitForeignCall' PlayRisky
[CmmHinted res NoHint]
(CmmPrim (MO_PopCnt width))
(CmmPrim (MO_PopCnt width) Nothing)
[(CmmHinted x NoHint)]
(Just vols)
NoC_SRT -- No SRT b/c we do PlayRisky
......
......@@ -15,7 +15,6 @@ import BlockId
import CgUtils ( activeStgRegs, callerSaves )
import CLabel
import OldCmm
import OldCmmUtils
import qualified OldPprCmm as PprCmm
import DynFlags
......@@ -173,7 +172,7 @@ genCall :: LlvmEnv -> CmmCallTarget -> [HintedCmmFormal] -> [HintedCmmActual]
-- Write barrier needs to be handled specially as it is implemented as an LLVM
-- intrinsic function.
genCall env (CmmPrim MO_WriteBarrier) _ _ _
genCall env (CmmPrim MO_WriteBarrier _) _ _ _
| platformArch (getLlvmPlatform env) `elem` [ArchX86, ArchX86_64, ArchSPARC]
= return (env, nilOL, [])
| getLlvmVer env > 29 = barrier env
......@@ -183,7 +182,7 @@ genCall env (CmmPrim MO_WriteBarrier) _ _ _
-- types and things like Word8 are backed by an i32 and just present a logical
-- i8 range. So we must handle conversions from i32 to i8 explicitly as LLVM
-- is strict about types.
genCall env t@(CmmPrim (MO_PopCnt w)) [CmmHinted dst _] args _ = do
genCall env t@(CmmPrim (MO_PopCnt w) _) [CmmHinted dst _] args _ = do
let width = widthToLlvmInt w
dstTy = cmmToLlvmType $ localRegType dst
funTy = \n -> LMFunction $ LlvmFunctionDecl n ExternallyVisible
......@@ -203,9 +202,9 @@ genCall env t@(CmmPrim (MO_PopCnt w)) [CmmHinted dst _] args _ = do
-- Handle memcpy function specifically since llvm's intrinsic version takes
-- some extra parameters.
genCall env t@(CmmPrim op) [] args CmmMayReturn | op == MO_Memcpy ||
op == MO_Memset ||
op == MO_Memmove = do
genCall env t@(CmmPrim op _) [] args CmmMayReturn | op == MO_Memcpy ||
op == MO_Memset ||
op == MO_Memmove = do
let (isVolTy, isVolVal) = if getLlvmVer env >= 28
then ([i1], [mkIntLit i1 0]) else ([], [])
argTy | op == MO_Memset = [i8Ptr, i8, llvmWord, i32] ++ isVolTy
......@@ -223,9 +222,8 @@ genCall env t@(CmmPrim op) [] args CmmMayReturn | op == MO_Memcpy ||
`appOL` trashStmts `snocOL` call
return (env2, stmts, top1 ++ top2)
genCall env (CmmPrim op) results args _
| Just stmts <- expandCallishMachOp op results args
= stmtsToInstrs env stmts (nilOL, [])
genCall env (CmmPrim _ (Just mkStmts)) results args _
= stmtsToInstrs env (mkStmts results args) (nilOL, [])
-- Handle all other foreign calls and prim ops.
genCall env target res args ret = do
......@@ -245,7 +243,7 @@ genCall env target res args ret = do
-- extract Cmm call convention
let cconv = case target of
CmmCallee _ conv -> conv
CmmPrim _ -> PrimCallConv
CmmPrim _ _ -> PrimCallConv
-- translate to LLVM call convention
let lmconv = case cconv of
......@@ -342,7 +340,7 @@ getFunPtr env funTy targ = case targ of
(v2,s1) <- doExpr (pLift fty) $ Cast cast v1 (pLift fty)
return (env', v2, stmts `snocOL` s1, top)
CmmPrim mop -> litCase $ cmmPrimOpFunctions env mop
CmmPrim mop _ -> litCase $ cmmPrimOpFunctions env mop
where
litCase name = do
......@@ -476,6 +474,7 @@ cmmPrimOpFunctions env mop
MO_S_QuotRem {} -> unsupported
MO_U_QuotRem {} -> unsupported
MO_Add2 {} -> unsupported
MO_WriteBarrier -> unsupported
MO_Touch -> unsupported
......
......@@ -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
......
......@@ -39,7 +39,6 @@ import NCGMonad
-- Our intermediate code:
import BlockId
import OldCmm
import OldCmmUtils
import PIC
import Reg
import CLabel
......@@ -381,17 +380,16 @@ genCCall
--
-- In the SPARC case we don't need a barrier.
--
genCCall (CmmPrim (MO_WriteBarrier)) _ _
genCCall (CmmPrim (MO_WriteBarrier) _) _ _
= do return nilOL
genCCall (CmmPrim op) results args
| Just stmts <- expandCallishMachOp op results args
= stmtsToInstrs stmts
genCCall (CmmPrim _ (Just mkStmts)) results args
= stmtsToInstrs (mkStmts results args)
genCCall target dest_regs argsAndHints
= do
-- need to remove alignment information
let argsAndHints' | (CmmPrim mop) <- target,
let argsAndHints' | (CmmPrim mop _) <- target,
(mop == MO_Memcpy ||
mop == MO_Memset ||
mop == MO_Memmove)
......@@ -423,7 +421,7 @@ genCCall target dest_regs argsAndHints
-> do (dyn_c, [dyn_r]) <- arg_to_int_vregs expr
return (dyn_c `snocOL` CALL (Right dyn_r) n_argRegs_used False)
CmmPrim mop
CmmPrim mop _
-> do res <- outOfLineMachOp mop
lblOrMopExpr <- case res of
Left lbl -> do
......@@ -644,6 +642,7 @@ outOfLineMachOp_table mop
MO_S_QuotRem {} -> unsupported
MO_U_QuotRem {} -> unsupported
MO_Add2 {} -> unsupported
MO_WriteBarrier -> unsupported
MO_Touch -> unsupported
where unsupported = panic ("outOfLineCmmOp: " ++ show mop
......
......@@ -41,7 +41,6 @@ import BlockId
import Module ( primPackageId )
import PprCmm ()
import OldCmm
import OldCmmUtils
import OldPprCmm ()
import CLabel
......@@ -1520,7 +1519,7 @@ genCCall
-- Unroll memcpy calls if the source and destination pointers are at
-- least DWORD aligned and the number of bytes to copy isn't too
-- large. Otherwise, call C's memcpy.
genCCall is32Bit (CmmPrim MO_Memcpy) _
genCCall is32Bit (CmmPrim MO_Memcpy _) _
[CmmHinted dst _, CmmHinted src _,
CmmHinted (CmmLit (CmmInt n _)) _,
CmmHinted (CmmLit (CmmInt align _)) _]
......@@ -1563,7 +1562,7 @@ genCCall is32Bit (CmmPrim MO_Memcpy) _
dst_addr = AddrBaseIndex (EABaseReg dst) EAIndexNone
(ImmInteger (n - i))
genCCall _ (CmmPrim MO_Memset) _
genCCall _ (CmmPrim MO_Memset _) _
[CmmHinted dst _,
CmmHinted (CmmLit (CmmInt c _)) _,
CmmHinted (CmmLit (CmmInt n _)) _,
......@@ -1602,11 +1601,11 @@ genCCall _ (CmmPrim MO_Memset) _
dst_addr = AddrBaseIndex (EABaseReg dst) EAIndexNone
(ImmInteger (n - i))
genCCall _ (CmmPrim MO_WriteBarrier) _ _ = return nilOL
genCCall _ (CmmPrim MO_WriteBarrier _) _ _ = return nilOL
-- write barrier compiles to no code on x86/x86-64;
-- we keep it this long in order to prevent earlier optimisations.
genCCall is32Bit (CmmPrim (MO_PopCnt width)) dest_regs@[CmmHinted dst _]
genCCall is32Bit (CmmPrim (MO_PopCnt width) _) dest_regs@[CmmHinted dst _]
args@[CmmHinted src _] = do
sse4_2 <- sse4_2Enabled
if sse4_2
......@@ -1642,10 +1641,10 @@ genCCall32 :: CmmCallTarget -- function to call
genCCall32 target dest_regs args =
case (target, dest_regs) of
-- void return type prim op
(CmmPrim op, []) ->
(CmmPrim op _, []) ->
outOfLineCmmOp op Nothing args
-- we only cope with a single result for foreign calls
(CmmPrim op, [r_hinted@(CmmHinted r _)]) -> do
(CmmPrim op _, [r_hinted@(CmmHinted r _)]) -> do
l1 <- getNewLabelNat
l2 <- getNewLabelNat
sse2 <- sse2Enabled
......@@ -1677,9 +1676,8 @@ genCCall32 target dest_regs args =
= panic $ "genCCall.actuallyInlineFloatOp: bad number of arguments! ("
++ show (length args) ++ ")"
(CmmPrim op, results)
| Just stmts <- expandCallishMachOp op results args ->
stmtsToInstrs stmts
(CmmPrim _ (Just mkStmts), results) ->
stmtsToInstrs (mkStmts results args)
_ -> do
let
......@@ -1710,7 +1708,7 @@ genCCall32 target dest_regs args =
-> do { (dyn_r, dyn_c) <- getSomeReg expr
; ASSERT( isWord32 (cmmExprType expr) )
return (dyn_c `snocOL` CALL (Right dyn_r) [], conv) }
CmmPrim _
CmmPrim _ _
-> panic $ "genCCall: Can't handle CmmPrim call type here, error "
++ "probably because too many return values."
......@@ -1833,20 +1831,19 @@ genCCall64 :: CmmCallTarget -- function to call
genCCall64 target dest_regs args =
case (target, dest_regs) of
(CmmPrim op, []) ->
(CmmPrim op _, []) ->
-- void return type prim op
outOfLineCmmOp op Nothing args
(CmmPrim op, [res]) ->
(CmmPrim op _, [res]) ->
-- we only cope with a single result for foreign calls
outOfLineCmmOp op (Just res) args
(CmmPrim (MO_S_QuotRem width), _) -> divOp True width dest_regs args
(CmmPrim (MO_U_QuotRem width), _) -> divOp False width dest_regs args
(CmmPrim (MO_S_QuotRem width) _, _) -> divOp True width dest_regs args
(CmmPrim (MO_U_QuotRem width) _, _) -> divOp False width dest_regs args
(CmmPrim op, results)
| Just stmts <- expandCallishMachOp op results args ->
stmtsToInstrs stmts
(CmmPrim _ (Just mkStmts), results) ->
stmtsToInstrs (mkStmts results args)
_ -> genCCall64' target dest_regs args
......@@ -1915,7 +1912,7 @@ genCCall64' target dest_regs args = do
CmmCallee expr conv
-> do (dyn_r, dyn_c) <- getSomeReg expr
return (dyn_c `snocOL` CALL (Right dyn_r) arg_regs, conv)
CmmPrim _
CmmPrim _ _
-> panic $ "genCCall: Can't handle CmmPrim call type here, error "
++ "probably because too many return values."
......@@ -2091,6 +2088,7 @@ outOfLineCmmOp mop res args
MO_S_QuotRem {} -> unsupported
MO_U_QuotRem {} -> unsupported
MO_Add2 {} -> unsupported
MO_WriteBarrier -> unsupported
MO_Touch -> unsupported
unsupported = panic ("outOfLineCmmOp: " ++ show mop
......
......@@ -269,6 +269,10 @@ primtype Word#
primop WordAddOp "plusWord#" Dyadic Word# -> Word# -> Word#
with commutable = True
primop WordAdd2Op "plusWord2#" GenPrimOp
Word# -> Word# -> (# Word#, Word# #)
with commutable = True
primop WordSubOp "minusWord#" Dyadic Word# -> Word# -> Word#
primop WordMulOp "timesWord#" Dyadic Word# -> Word# -> Word#
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment