GitHub/haskell-wasm
1
0
Fork 1
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix corner cases for float instructions

Browse Source
This commit is contained in:
Ilya Rezvov
2018-04-11 11:08:41 -07:00
parent e0d9eeb51f
commit 82c0433e5d
2 changed files with 54 additions and 22 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Language/Wasm/Interpreter.hs
+53 -21
View File
@@ -52,7 +52,7 @@ import Data.Bits (
import Data.Array.ST (newArray, readArray, MArray, STUArray) import Data.Array.ST (newArray, readArray, MArray, STUArray)
import Data.Array.Unsafe (castSTUArray) import Data.Array.Unsafe (castSTUArray)
import GHC.ST (runST, ST) import GHC.ST (runST, ST)
import Numeric.IEEE (copySign) import Numeric.IEEE (IEEE, copySign, minNum, maxNum, identicalIEEE)
import Debug.Trace as Debug import Debug.Trace as Debug
@@ -105,22 +105,54 @@ cast :: (MArray (STUArray s) a (ST s),
MArray (STUArray s) b (ST s)) => a -> ST s b MArray (STUArray s) b (ST s)) => a -> ST s b
cast x = newArray (0 :: Int, 0) x >>= castSTUArray >>= flip readArray 0 cast x = newArray (0 :: Int, 0) x >>= castSTUArray >>= flip readArray 0
nearest :: (Floating a, RealFrac a) => a -> a nearest :: (IEEE a) => a -> a
nearest f nearest f
| f >= 0 && f <= 0.5 = 0 | f >= 0 && f <= 0.5 = copySign 0 f
| f < 0 && f >= -0.5 = -0 | f < 0 && f >= -0.5 = -0
| otherwise = | otherwise =
let i = floor f :: Int64 in let i = floor f :: Integer in
let fi = fromIntegral i in let fi = fromIntegral i in
let r = abs f - abs fi in let r = abs f - abs fi in
if r == 0.5 flip copySign f $ (
then ( if r == 0.5
case (even i, f < 0) of then (
(True, _) -> fi case (even i, f < 0) of
(_, True) -> fi - 1.0 (True, _) -> fi
(_, False) -> fi + 1.0 (_, True) -> fi - 1.0
(_, False) -> fi + 1.0
)
else fromIntegral (round f :: Integer)
) )
else fromIntegral (round f :: Int64)
zeroAwareMin :: IEEE a => a -> a -> a
zeroAwareMin a b =
if identicalIEEE a 0 && identicalIEEE b (-0)
then b
else minNum a b
zeroAwareMax :: IEEE a => a -> a -> a
zeroAwareMax a b =
if identicalIEEE a (-0) && identicalIEEE b 0
then b
else maxNum a b
floatFloor :: Float -> Float
floatFloor a = copySign (fromIntegral (floor a :: Integer)) a
doubleFloor :: Double -> Double
doubleFloor a = copySign (fromIntegral (floor a :: Integer)) a
floatCeil :: Float -> Float
floatCeil a = copySign (fromIntegral (ceiling a :: Integer)) a
doubleCeil :: Double -> Double
doubleCeil a = copySign (fromIntegral (ceiling a :: Integer)) a
floatTrunc :: Float -> Float
floatTrunc a = copySign (fromIntegral (truncate a :: Integer)) a
doubleTrunc :: Double -> Double
doubleTrunc a = copySign (fromIntegral (truncate a :: Integer)) a
data Label = Label ResultType deriving (Show, Eq) data Label = Label ResultType deriving (Show, Eq)
@@ -930,11 +962,11 @@ eval store FunctionInstance { funcType, moduleInstance, code = Function { localT
step ctx@EvalCtx{ stack = (VF32 v:rest) } (FUnOp BS32 FNeg) = step ctx@EvalCtx{ stack = (VF32 v:rest) } (FUnOp BS32 FNeg) =
return $ Done ctx { stack = VF32 (negate v) : rest } return $ Done ctx { stack = VF32 (negate v) : rest }
step ctx@EvalCtx{ stack = (VF32 v:rest) } (FUnOp BS32 FCeil) = step ctx@EvalCtx{ stack = (VF32 v:rest) } (FUnOp BS32 FCeil) =
return $ Done ctx { stack = VF32 (fromIntegral (ceiling v :: Int)) : rest } return $ Done ctx { stack = VF32 (floatCeil v) : rest }
step ctx@EvalCtx{ stack = (VF32 v:rest) } (FUnOp BS32 FFloor) = step ctx@EvalCtx{ stack = (VF32 v:rest) } (FUnOp BS32 FFloor) =
return $ Done ctx { stack = VF32 (fromIntegral (floor v :: Int)) : rest } return $ Done ctx { stack = VF32 (floatFloor v) : rest }
step ctx@EvalCtx{ stack = (VF32 v:rest) } (FUnOp BS32 FTrunc) = step ctx@EvalCtx{ stack = (VF32 v:rest) } (FUnOp BS32 FTrunc) =
return $ Done ctx { stack = VF32 (fromIntegral (truncate v :: Int)) : rest } return $ Done ctx { stack = VF32 (floatTrunc v) : rest }
step ctx@EvalCtx{ stack = (VF32 v:rest) } (FUnOp BS32 FNearest) = step ctx@EvalCtx{ stack = (VF32 v:rest) } (FUnOp BS32 FNearest) =
return $ Done ctx { stack = VF32 (nearest v) : rest } return $ Done ctx { stack = VF32 (nearest v) : rest }
step ctx@EvalCtx{ stack = (VF32 v:rest) } (FUnOp BS32 FSqrt) = step ctx@EvalCtx{ stack = (VF32 v:rest) } (FUnOp BS32 FSqrt) =
@@ -944,11 +976,11 @@ eval store FunctionInstance { funcType, moduleInstance, code = Function { localT
step ctx@EvalCtx{ stack = (VF64 v:rest) } (FUnOp BS64 FNeg) = step ctx@EvalCtx{ stack = (VF64 v:rest) } (FUnOp BS64 FNeg) =
return $ Done ctx { stack = VF64 (negate v) : rest } return $ Done ctx { stack = VF64 (negate v) : rest }
step ctx@EvalCtx{ stack = (VF64 v:rest) } (FUnOp BS64 FCeil) = step ctx@EvalCtx{ stack = (VF64 v:rest) } (FUnOp BS64 FCeil) =
return $ Done ctx { stack = VF64 (fromIntegral (ceiling v :: Int64)) : rest } return $ Done ctx { stack = VF64 (doubleCeil v) : rest }
step ctx@EvalCtx{ stack = (VF64 v:rest) } (FUnOp BS64 FFloor) = step ctx@EvalCtx{ stack = (VF64 v:rest) } (FUnOp BS64 FFloor) =
return $ Done ctx { stack = VF64 (fromIntegral (floor v :: Int64)) : rest } return $ Done ctx { stack = VF64 (doubleFloor v) : rest }
step ctx@EvalCtx{ stack = (VF64 v:rest) } (FUnOp BS64 FTrunc) = step ctx@EvalCtx{ stack = (VF64 v:rest) } (FUnOp BS64 FTrunc) =
return $ Done ctx { stack = VF64 (fromIntegral (truncate v :: Int64)) : rest } return $ Done ctx { stack = VF64 (doubleTrunc v) : rest }
step ctx@EvalCtx{ stack = (VF64 v:rest) } (FUnOp BS64 FNearest) = step ctx@EvalCtx{ stack = (VF64 v:rest) } (FUnOp BS64 FNearest) =
return $ Done ctx { stack = VF64 (nearest v) : rest } return $ Done ctx { stack = VF64 (nearest v) : rest }
step ctx@EvalCtx{ stack = (VF64 v:rest) } (FUnOp BS64 FSqrt) = step ctx@EvalCtx{ stack = (VF64 v:rest) } (FUnOp BS64 FSqrt) =
@@ -962,9 +994,9 @@ eval store FunctionInstance { funcType, moduleInstance, code = Function { localT
step ctx@EvalCtx{ stack = (VF32 v2:VF32 v1:rest) } (FBinOp BS32 FDiv) = step ctx@EvalCtx{ stack = (VF32 v2:VF32 v1:rest) } (FBinOp BS32 FDiv) =
return $ Done ctx { stack = VF32 (v1 / v2) : rest } return $ Done ctx { stack = VF32 (v1 / v2) : rest }
step ctx@EvalCtx{ stack = (VF32 v2:VF32 v1:rest) } (FBinOp BS32 FMin) = step ctx@EvalCtx{ stack = (VF32 v2:VF32 v1:rest) } (FBinOp BS32 FMin) =
return $ Done ctx { stack = VF32 (min v1 v2) : rest } return $ Done ctx { stack = VF32 (zeroAwareMin v1 v2) : rest }
step ctx@EvalCtx{ stack = (VF32 v2:VF32 v1:rest) } (FBinOp BS32 FMax) = step ctx@EvalCtx{ stack = (VF32 v2:VF32 v1:rest) } (FBinOp BS32 FMax) =
return $ Done ctx { stack = VF32 (max v1 v2) : rest } return $ Done ctx { stack = VF32 (zeroAwareMax v1 v2) : rest }
step ctx@EvalCtx{ stack = (VF32 v2:VF32 v1:rest) } (FBinOp BS32 FCopySign) = step ctx@EvalCtx{ stack = (VF32 v2:VF32 v1:rest) } (FBinOp BS32 FCopySign) =
return $ Done ctx { stack = VF32 (copySign v1 v2) : rest } return $ Done ctx { stack = VF32 (copySign v1 v2) : rest }
step ctx@EvalCtx{ stack = (VF64 v2:VF64 v1:rest) } (FBinOp BS64 FAdd) = step ctx@EvalCtx{ stack = (VF64 v2:VF64 v1:rest) } (FBinOp BS64 FAdd) =
@@ -976,9 +1008,9 @@ eval store FunctionInstance { funcType, moduleInstance, code = Function { localT
step ctx@EvalCtx{ stack = (VF64 v2:VF64 v1:rest) } (FBinOp BS64 FDiv) = step ctx@EvalCtx{ stack = (VF64 v2:VF64 v1:rest) } (FBinOp BS64 FDiv) =
return $ Done ctx { stack = VF64 (v1 / v2) : rest } return $ Done ctx { stack = VF64 (v1 / v2) : rest }
step ctx@EvalCtx{ stack = (VF64 v2:VF64 v1:rest) } (FBinOp BS64 FMin) = step ctx@EvalCtx{ stack = (VF64 v2:VF64 v1:rest) } (FBinOp BS64 FMin) =
return $ Done ctx { stack = VF64 (min v1 v2) : rest } return $ Done ctx { stack = VF64 (zeroAwareMin v1 v2) : rest }
step ctx@EvalCtx{ stack = (VF64 v2:VF64 v1:rest) } (FBinOp BS64 FMax) = step ctx@EvalCtx{ stack = (VF64 v2:VF64 v1:rest) } (FBinOp BS64 FMax) =
return $ Done ctx { stack = VF64 (max v1 v2) : rest } return $ Done ctx { stack = VF64 (zeroAwareMax v1 v2) : rest }
step ctx@EvalCtx{ stack = (VF64 v2:VF64 v1:rest) } (FBinOp BS64 FCopySign) = step ctx@EvalCtx{ stack = (VF64 v2:VF64 v1:rest) } (FBinOp BS64 FCopySign) =
return $ Done ctx { stack = VF64 (copySign v1 v2) : rest } return $ Done ctx { stack = VF64 (copySign v1 v2) : rest }
step ctx@EvalCtx{ stack = (VF32 v2:VF32 v1:rest) } (FRelOp BS32 FEq) = step ctx@EvalCtx{ stack = (VF32 v2:VF32 v1:rest) } (FRelOp BS32 FEq) =
tests/samples/float_misc.wast
+1 -1
View File
@@ -660,7 +660,7 @@
(assert_return (invoke "f64.nearest" (f64.const 0x1.0000000000001p+52)) (f64.const 0x1.0000000000001p+52)) (assert_return (invoke "f64.nearest" (f64.const 0x1.0000000000001p+52)) (f64.const 0x1.0000000000001p+52))
(assert_return (invoke "f64.nearest" (f64.const 0x1.0000000000002p+52)) (f64.const 0x1.0000000000002p+52)) (assert_return (invoke "f64.nearest" (f64.const 0x1.0000000000002p+52)) (f64.const 0x1.0000000000002p+52))
(assert_return (invoke "f64.nearest" (f64.const 0x1.fffffffffffffp-2)) (f64.const 0.0)) (assert_return (invoke "f64.nearest" (f64.const 0x1.fffffffffffffp-2)) (f64.const 0.0))
;; (assert_return (invoke "f64.nearest" (f64.const 0x1.fffffffffffffp+105)) (f64.const 0x1.fffffffffffffp+105)) (assert_return (invoke "f64.nearest" (f64.const 0x1.fffffffffffffp+105)) (f64.const 0x1.fffffffffffffp+105))
;; Nearest should not round halfway cases away from zero (as C's round(3) does) ;; Nearest should not round halfway cases away from zero (as C's round(3) does)
;; or up (as JS's Math.round does). ;; or up (as JS's Math.round does).