Commit 2e8c7694 authored by tibbe's avatar tibbe

Implement word2Float# and word2Double#

parent 589b628b
......@@ -441,6 +441,8 @@ data CallishMachOp
| MO_F32_Exp
| MO_F32_Sqrt
| MO_UF_Conv Width
| MO_S_QuotRem Width
| MO_U_QuotRem Width
| MO_U_QuotRem2 Width
......
......@@ -681,6 +681,7 @@ pprCallishMachOp_for_C mop
MO_Memset -> ptext (sLit "memset")
MO_Memmove -> ptext (sLit "memmove")
(MO_PopCnt w) -> ptext (sLit $ popCntLabel w)
(MO_UF_Conv w) -> ptext (sLit $ word2FloatLabel w)
MO_S_QuotRem {} -> unsupported
MO_U_QuotRem {} -> unsupported
......
......@@ -491,6 +491,12 @@ emitPrimOp _ [res] PopCnt32Op [w] = emitPopCntCall res w W32
emitPrimOp _ [res] PopCnt64Op [w] = emitPopCntCall res w W64
emitPrimOp dflags [res] PopCntOp [w] = emitPopCntCall res w (wordWidth dflags)
-- Unsigned int to floating point conversions
emitPrimOp _ [res] Word2FloatOp [w] = emitPrimCall [res]
(MO_UF_Conv W32) [w]
emitPrimOp _ [res] Word2DoubleOp [w] = emitPrimCall [res]
(MO_UF_Conv W64) [w]
-- The rest just translate straightforwardly
emitPrimOp dflags [res] op [arg]
| nopOp op
......
......@@ -187,6 +187,17 @@ genCall env (PrimTarget MO_WriteBarrier) _ _
genCall env (PrimTarget MO_Touch) _ _
= return (env, nilOL, [])
genCall env (PrimTarget (MO_UF_Conv w)) [dst] [e] = do
let (env1, dstV, stmts1, top1) = getCmmReg env (CmmLocal dst)
width = widthToLlvmFloat w
(env2, ve, stmts2, top2) <- exprToVar env1 e
let stmt = Assignment dstV $ Cast LM_Uitofp ve width
stmts = stmts1 `appOL` stmts2 `snocOL` stmt
return (env2, stmts, top1 ++ top2)
genCall _ (PrimTarget (MO_UF_Conv _)) [_] args =
panic $ "genCall: Too many arguments to MO_UF_Conv. " ++
"Can only handle 1, given" ++ show (length args) ++ "."
-- Handle popcnt function specifically since GHC only really has i32 and i64
-- 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
......@@ -513,6 +524,7 @@ cmmPrimOpFunctions env mop
MO_U_Mul2 {} -> unsupported
MO_WriteBarrier -> unsupported
MO_Touch -> unsupported
MO_UF_Conv _ -> unsupported
where
dflags = getDflags env
......
-- | Generating C symbol names emitted by the compiler.
module CPrim (popCntLabel) where
module CPrim
( popCntLabel
, word2FloatLabel
) where
import CmmType
import Outputable
......@@ -12,3 +15,10 @@ popCntLabel w = "hs_popcnt" ++ pprWidth w
pprWidth W32 = "32"
pprWidth W64 = "64"
pprWidth w = pprPanic "popCntLabel: Unsupported word width " (ppr w)
word2FloatLabel :: Width -> String
word2FloatLabel w = "hs_word2float" ++ pprWidth w
where
pprWidth W32 = "32"
pprWidth W64 = "64"
pprWidth w = pprPanic "word2FloatLabel: Unsupported word width " (ppr w)
......@@ -1149,6 +1149,8 @@ genCCall' dflags gcp target dest_regs args0
MO_F64_Tanh -> (fsLit "tanh", False)
MO_F64_Pwr -> (fsLit "pow", False)
MO_UF_Conv w -> (fsLit $ word2FloatLabel w, False)
MO_Memcpy -> (fsLit "memcpy", False)
MO_Memset -> (fsLit "memset", False)
MO_Memmove -> (fsLit "memmove", False)
......
......@@ -641,6 +641,8 @@ outOfLineMachOp_table mop
MO_F64_Cosh -> fsLit "cosh"
MO_F64_Tanh -> fsLit "tanh"
MO_UF_Conv w -> fsLit $ word2FloatLabel w
MO_Memcpy -> fsLit "memcpy"
MO_Memset -> fsLit "memset"
MO_Memmove -> fsLit "memmove"
......
......@@ -1659,6 +1659,17 @@ genCCall is32Bit (PrimTarget (MO_PopCnt width)) dest_regs@[dst]
size = intSize width
lbl = mkCmmCodeLabel primPackageId (fsLit (popCntLabel width))
genCCall is32Bit (PrimTarget (MO_UF_Conv width)) dest_regs args = do
dflags <- getDynFlags
targetExpr <- cmmMakeDynamicReference dflags addImportNat
CallReference lbl
let target = ForeignTarget targetExpr (ForeignConvention CCallConv
[NoHint] [NoHint]
CmmMayReturn)
genCCall is32Bit target dest_regs args
where
lbl = mkCmmCodeLabel primPackageId (fsLit (word2FloatLabel width))
genCCall is32Bit target dest_regs args
| is32Bit = genCCall32 target dest_regs args
| otherwise = genCCall64 target dest_regs args
......@@ -2280,6 +2291,8 @@ outOfLineCmmOp mop res args
MO_PopCnt _ -> fsLit "popcnt"
MO_UF_Conv _ -> unsupported
MO_S_QuotRem {} -> unsupported
MO_U_QuotRem {} -> unsupported
MO_U_QuotRem2 {} -> unsupported
......
......@@ -259,6 +259,9 @@ primop Int2WordOp "int2Word#" GenPrimOp Int# -> Word#
primop Int2FloatOp "int2Float#" GenPrimOp Int# -> Float#
primop Int2DoubleOp "int2Double#" GenPrimOp Int# -> Double#
primop Word2FloatOp "word2Float#" GenPrimOp Word# -> Float#
primop Word2DoubleOp "word2Double#" GenPrimOp Word# -> Double#
primop ISllOp "uncheckedIShiftL#" GenPrimOp Int# -> Int# -> Int#
{Shift left. Result undefined if shift amount is not
in the range 0 to word size - 1 inclusive.}
......
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