diff --git a/compiler/cmm/CmmMachOp.hs b/compiler/cmm/CmmMachOp.hs index aa16684..199cc4d 100644 --- a/compiler/cmm/CmmMachOp.hs +++ b/compiler/cmm/CmmMachOp.hs @@ -102,6 +102,9 @@ data MachOp | MO_SS_Conv Width Width -- Signed int -> Signed int | MO_UU_Conv Width Width -- unsigned int -> unsigned int | MO_FF_Conv Width Width -- Float -> Float + + | MO_FU_Coerce Width -- coerce IEEE 754 float to unsigned int + | MO_UF_Coerce Width -- coerce unsigned int to IEEE 754 float deriving (Eq, Show) pprMachOp :: MachOp -> SDoc @@ -337,6 +340,9 @@ machOpResultType mop tys = MO_FS_Conv _ to -> cmmBits to MO_SF_Conv _ to -> cmmFloat to MO_FF_Conv _ to -> cmmFloat to + + MO_UF_Coerce to -> cmmFloat to + MO_FU_Coerce to -> cmmBits to where (ty1:_) = tys @@ -404,6 +410,9 @@ machOpArgReps op = MO_FS_Conv from _ -> [from] MO_FF_Conv from _ -> [from] + MO_UF_Coerce to -> [to] + MO_FU_Coerce to -> [to] + ----------------------------------------------------------------------------- -- CallishMachOp ----------------------------------------------------------------------------- diff --git a/compiler/codeGen/CgPrimOp.hs b/compiler/codeGen/CgPrimOp.hs index c2a57a4..9baa3d1 100644 --- a/compiler/codeGen/CgPrimOp.hs +++ b/compiler/codeGen/CgPrimOp.hs @@ -374,6 +374,21 @@ emitPrimOp [] CopyByteArrayOp [src,src_off,dst,dst_off,n] live = emitPrimOp [] CopyMutableByteArrayOp [src,src_off,dst,dst_off,n] live = doCopyMutableByteArrayOp src src_off dst dst_off n live +emitPrimOp [res] CoerceDoubleToWord64 [arg] _ + = stmtC (CmmAssign (CmmLocal res) (CmmMachOp (MO_FU_Coerce W64) [arg])) +emitPrimOp [res] CoerceWord64ToDouble [arg] _ + = stmtC (CmmAssign (CmmLocal res) (CmmMachOp (MO_UF_Coerce W64) [arg])) + +emitPrimOp [res] CoerceFloatToWord32 [arg] _ + = stmtC (CmmAssign (CmmLocal res) + (CmmMachOp (MO_UU_Conv W32 wordWidth) + [CmmMachOp (MO_FU_Coerce W32) [arg]])) + +emitPrimOp [res] CoerceWord32ToFloat [arg] _ + = stmtC (CmmAssign (CmmLocal res) + (CmmMachOp (MO_UF_Coerce W32) + [CmmMachOp (MO_UU_Conv wordWidth W32) [arg]])) + -- The rest just translate straightforwardly emitPrimOp [res] op [arg] _ diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs index 49ac543..efa7d1a 100644 --- a/compiler/nativeGen/X86/CodeGen.hs +++ b/compiler/nativeGen/X86/CodeGen.hs @@ -580,13 +580,16 @@ getRegister' is32Bit (CmmMachOp mop [x]) = do -- unary MachOps -- the form of a movzl and print it as a movl later. MO_FF_Conv W32 W64 - | sse2 -> coerceFP2FP W64 x + | sse2 -> convertFP2FP W64 x | otherwise -> conversionNop FF80 x - MO_FF_Conv W64 W32 -> coerceFP2FP W32 x + MO_FF_Conv W64 W32 -> convertFP2FP W32 x - MO_FS_Conv from to -> coerceFP2Int from to x - MO_SF_Conv from to -> coerceInt2FP from to x + MO_FS_Conv from to -> convertFP2Int from to x + MO_SF_Conv from to -> convertInt2FP from to x + + MO_FU_Coerce w -> coerceFP2Word w x + MO_UF_Coerce w -> coerceWord2FP w x _other -> pprPanic "getRegister" (pprMachOp mop) where @@ -2292,8 +2295,8 @@ trivialUFCode size instr x = do -------------------------------------------------------------------------------- -coerceInt2FP :: Width -> Width -> CmmExpr -> NatM Register -coerceInt2FP from to x = if_sse2 coerce_sse2 coerce_x87 +convertInt2FP :: Width -> Width -> CmmExpr -> NatM Register +convertInt2FP from to x = if_sse2 coerce_sse2 coerce_x87 where coerce_x87 = do (x_reg, x_code) <- getSomeReg x @@ -2317,8 +2320,8 @@ coerceInt2FP from to x = if_sse2 coerce_sse2 coerce_x87 -- works even if the destination rep is Width -> CmmExpr -> NatM Register -coerceFP2Int from to x = if_sse2 coerceFP2Int_sse2 coerceFP2Int_x87 +convertFP2Int :: Width -> Width -> CmmExpr -> NatM Register +convertFP2Int from to x = if_sse2 coerceFP2Int_sse2 coerceFP2Int_x87 where coerceFP2Int_x87 = do (x_reg, x_code) <- getSomeReg x @@ -2342,10 +2345,41 @@ coerceFP2Int from to x = if_sse2 coerceFP2Int_sse2 coerceFP2Int_x87 return (Any (intSize to) code) -- works even if the destination rep is CmmExpr -> NatM Register +coerceFP2Word width x = if_sse2 coerceFP2Word_sse2 coerceFP2Word_x87 + where + coerceFP2Word_x87 = do + (x_reg, x_code) <- getSomeReg x + let code dst = x_code `snocOL` GCOFTOI (intSize width) x_reg dst + return (Any (intSize width) code) + + coerceFP2Word_sse2 = do + (x_op, x_code) <- getSomeReg x + tmp_loc <- newTempLocNat -- question is how to implement this + let code dst = x_code `snocOL` MOV (intSize width) x_op (OpAddr tmp_loc) + `snocOL` MOV (intSize width) (OpAddr tmp_loc) (OpReg dst) + return (Any (intSize width) code) + +-------------------------------------------------------------------------------- +coerceWord2FP :: Width -> CmmExpr -> NatM Register +coerceWord2FP width x = if_sse2 coerceWord2FP_sse2 coerceWord2FP_x87 + where + coerceWord2FP_x87 = do + (x_reg, x_code) <- getSomeReg x + let code dst = x_code `snocOL` GCOITOF (floatSize width) x_reg dst + return (Any (intSize width) code) + + coerceWord2FP_sse2 = do + (x_op, x_code) <- getSomeReg x + tmp_loc <- newTempLocNat -- question is how to implement this + let code dst = x_code `snocOL` MOV (floatSize width) x_op (OpAddr tmp_loc) + `snocOL` MOV (intSize width) (OpAddr tmp_loc) (OpReg dst) + return (Any (intSize width) code) -------------------------------------------------------------------------------- -coerceFP2FP :: Width -> CmmExpr -> NatM Register -coerceFP2FP to x = do +convertFP2FP :: Width -> CmmExpr -> NatM Register +convertFP2FP to x = do use_sse2 <- sse2Enabled (x_reg, x_code) <- getSomeReg x let diff --git a/compiler/nativeGen/X86/Instr.hs b/compiler/nativeGen/X86/Instr.hs index 0e70dbb..19482b9 100644 --- a/compiler/nativeGen/X86/Instr.hs +++ b/compiler/nativeGen/X86/Instr.hs @@ -230,7 +230,10 @@ data Instr | GDTOF Reg Reg -- src(fpreg), dst(fpreg) - | GADD Size Reg Reg Reg -- src1, src2, dst + | GCOFTOI Size Reg Reg -- coerce float to int + | GCOITOF Size Reg Reg -- coerce int to float + + | GADD Size Reg Reg Reg -- src1, src2, dst | GDIV Size Reg Reg Reg -- src1, src2, dst | GSUB Size Reg Reg Reg -- src1, src2, dst | GMUL Size Reg Reg Reg -- src1, src2, dst diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp index 4949846..8fcc0cc 100644 --- a/compiler/prelude/primops.txt.pp +++ b/compiler/prelude/primops.txt.pp @@ -479,6 +479,15 @@ primop DoubleDecode_2IntOp "decodeDouble_2Int#" GenPrimOp respectively, and the last is the exponent.} with out_of_line = True +primop CoerceDoubleToWord64 "coerceDoubleToWord64#" GenPrimOp + Double# -> WORD64 + {Place the literal IEEE-754 representation of a Double# in a + Word64# (or Word# on a 64-bit platform).} + +primop CoerceWord64ToDouble "coerceWord64ToDouble#" GenPrimOp + WORD64 -> Double# + {Convert a {\tt Word64#} ({\tt Word#} on a 64-bit platform) containing an IEEE-754 double into a {\tt Double#}.} + ------------------------------------------------------------------------ section "Float#" {Operations on single-precision (32-bit) floating-point numbers.} @@ -597,6 +606,15 @@ primop FloatDecode_IntOp "decodeFloat_Int#" GenPrimOp First {\tt Int\#} in result is the mantissa; second is the exponent.} with out_of_line = True +primop CoerceFloatToWord32 "coerceFloatToWord32#" GenPrimOp + Float# -> Word# + {Place the literal IEEE-754 representation of a Float# in a + Word#. On a 64-bit platform, the upper 32 bits of the Word# will be zero.} + +primop CoerceWord32ToFloat "coerceWord32ToFloat#" GenPrimOp + Word# -> Float# + {Convert a {\tt Word#} containing an IEEE-754 float into a {\tt Float#}.} + ------------------------------------------------------------------------ section "Arrays" {Operations on {\tt Array\#}.}