Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/2e8c769422740c001e0a247bfec61d4f78598582 >--------------------------------------------------------------- commit 2e8c769422740c001e0a247bfec61d4f78598582 Author: Johan Tibell <johan.tib...@gmail.com> Date: Wed Dec 5 19:08:48 2012 -0800 Implement word2Float# and word2Double# >--------------------------------------------------------------- compiler/cmm/CmmMachOp.hs | 2 ++ compiler/cmm/PprC.hs | 1 + compiler/codeGen/StgCmmPrim.hs | 6 ++++++ compiler/llvmGen/LlvmCodeGen/CodeGen.hs | 12 ++++++++++++ compiler/nativeGen/CPrim.hs | 12 +++++++++++- compiler/nativeGen/PPC/CodeGen.hs | 2 ++ compiler/nativeGen/SPARC/CodeGen.hs | 2 ++ compiler/nativeGen/X86/CodeGen.hs | 13 +++++++++++++ compiler/prelude/primops.txt.pp | 3 +++ 9 files changed, 52 insertions(+), 1 deletions(-) diff --git a/compiler/cmm/CmmMachOp.hs b/compiler/cmm/CmmMachOp.hs index c00cdb5..a6c9bee 100644 --- a/compiler/cmm/CmmMachOp.hs +++ b/compiler/cmm/CmmMachOp.hs @@ -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 diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs index 927f7eb..bcfb5dc 100644 --- a/compiler/cmm/PprC.hs +++ b/compiler/cmm/PprC.hs @@ -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 diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs index fe2a021..66832c1 100644 --- a/compiler/codeGen/StgCmmPrim.hs +++ b/compiler/codeGen/StgCmmPrim.hs @@ -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 diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs index fd9d701..c510185 100644 --- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs +++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs @@ -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 diff --git a/compiler/nativeGen/CPrim.hs b/compiler/nativeGen/CPrim.hs index 09707ac..dd9d38f 100644 --- a/compiler/nativeGen/CPrim.hs +++ b/compiler/nativeGen/CPrim.hs @@ -1,5 +1,8 @@ -- | 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) diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs index 5e05047..e9a5b43 100644 --- a/compiler/nativeGen/PPC/CodeGen.hs +++ b/compiler/nativeGen/PPC/CodeGen.hs @@ -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) diff --git a/compiler/nativeGen/SPARC/CodeGen.hs b/compiler/nativeGen/SPARC/CodeGen.hs index f3b70e7..880b5c6 100644 --- a/compiler/nativeGen/SPARC/CodeGen.hs +++ b/compiler/nativeGen/SPARC/CodeGen.hs @@ -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" diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs index 36f9e2d..30cf060 100644 --- a/compiler/nativeGen/X86/CodeGen.hs +++ b/compiler/nativeGen/X86/CodeGen.hs @@ -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 diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp index c6e1b47..77236a1 100644 --- a/compiler/prelude/primops.txt.pp +++ b/compiler/prelude/primops.txt.pp @@ -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.} _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
