From 1fe669e7621fd8b2d554be391b17141f2c04c636 Mon Sep 17 00:00:00 2001 From: Ilya Rezvov Date: Tue, 10 Apr 2018 20:50:26 -0700 Subject: [PATCH] use correct signed int representation --- src/Language/Wasm/Interpreter.hs | 36 ++++++++++++++++---------------- src/Language/Wasm/Parser.y | 4 ++-- src/Language/Wasm/Script.hs | 4 ++-- tests/Test.hs | 2 +- 4 files changed, 23 insertions(+), 23 deletions(-) diff --git a/src/Language/Wasm/Interpreter.hs b/src/Language/Wasm/Interpreter.hs index 9da393c..c068ce9 100644 --- a/src/Language/Wasm/Interpreter.hs +++ b/src/Language/Wasm/Interpreter.hs @@ -67,25 +67,25 @@ data Value = asInt32 :: Word32 -> Int32 asInt32 w = - let base = fromIntegral $ w .&. 0x7FFFFFFF in - let sign = w .&. 0x80000000 in - if sign /= 0 then -base else base + if w < 0x80000000 + then fromIntegral w + else -1 * fromIntegral (0xFFFFFFFF - w + 1) asInt64 :: Word64 -> Int64 asInt64 w = - let base = fromIntegral $ w .&. 0x7FFFFFFFFFFFFFFF in - let sign = w .&. 0x8000000000000000 in - if sign /= 0 then -base else base + if w < 0x8000000000000000 + then fromIntegral w + else -1 * fromIntegral (0xFFFFFFFFFFFFFFFF - w + 1) asWord32 :: Int32 -> Word32 asWord32 i | i >= 0 = fromIntegral i - | otherwise = 0x80000000 .|. (fromIntegral (abs i)) + | otherwise = 0xFFFFFFFF - (fromIntegral (abs i)) + 1 asWord64 :: Int64 -> Word64 asWord64 i | i >= 0 = fromIntegral i - | otherwise = 0x8000000000000000 .|. (fromIntegral (abs i)) + | otherwise = 0xFFFFFFFFFFFFFFFF - (fromIntegral (abs i)) + 1 -- brough from https://stackoverflow.com/questions/6976684/converting-ieee-754-floating-point-in-haskell-word32-64-to-and-from-haskell-floa wordToFloat :: Word32 -> Float @@ -810,15 +810,15 @@ eval store FunctionInstance { funcType, moduleInstance, code = Function { localT step ctx (F32Const v) = return $ Done ctx { stack = VF32 v : stack ctx } step ctx (F64Const v) = return $ Done ctx { stack = VF64 v : stack ctx } step ctx@EvalCtx{ stack = (VI32 v2:VI32 v1:rest) } (IBinOp BS32 IAdd) = - return $ Done ctx { stack = VI32 (asWord32 $ asInt32 v1 + asInt32 v2) : rest } + return $ Done ctx { stack = VI32 (v1 + v2) : rest } step ctx@EvalCtx{ stack = (VI32 v2:VI32 v1:rest) } (IBinOp BS32 ISub) = - return $ Done ctx { stack = VI32 (asWord32 $ asInt32 v1 - asInt32 v2) : rest } + return $ Done ctx { stack = VI32 (v1 - v2) : rest } step ctx@EvalCtx{ stack = (VI32 v2:VI32 v1:rest) } (IBinOp BS32 IMul) = - return $ Done ctx { stack = VI32 (asWord32 $ asInt32 v1 * asInt32 v2) : rest } + return $ Done ctx { stack = VI32 (v1 * v2) : rest } step ctx@EvalCtx{ stack = (VI32 v2:VI32 v1:rest) } (IBinOp BS32 IDivU) = - return $ Done ctx { stack = VI32 (v1 `div` v2) : rest } + return $ Done ctx { stack = VI32 (v1 `quot` v2) : rest } step ctx@EvalCtx{ stack = (VI32 v2:VI32 v1:rest) } (IBinOp BS32 IDivS) = - return $ Done ctx { stack = VI32 (asWord32 $ asInt32 v1 `div` asInt32 v2) : rest } + return $ Done ctx { stack = VI32 (asWord32 $ asInt32 v1 `quot` asInt32 v2) : rest } step ctx@EvalCtx{ stack = (VI32 v2:VI32 v1:rest) } (IBinOp BS32 IRemU) = return $ Done ctx { stack = VI32 (v1 `rem` v2) : rest } step ctx@EvalCtx{ stack = (VI32 v2:VI32 v1:rest) } (IBinOp BS32 IRemS) = @@ -868,15 +868,15 @@ eval store FunctionInstance { funcType, moduleInstance, code = Function { localT step ctx@EvalCtx{ stack = (VI32 v:rest) } (IUnOp BS32 IPopcnt) = return $ Done ctx { stack = VI32 (fromIntegral $ popCount v) : rest } step ctx@EvalCtx{ stack = (VI64 v2:VI64 v1:rest) } (IBinOp BS64 IAdd) = - return $ Done ctx { stack = VI64 (asWord64 $ asInt64 v1 + asInt64 v2) : rest } + return $ Done ctx { stack = VI64 (v1 + v2) : rest } step ctx@EvalCtx{ stack = (VI64 v2:VI64 v1:rest) } (IBinOp BS64 ISub) = - return $ Done ctx { stack = VI64 (asWord64 $ asInt64 v1 - asInt64 v2) : rest } + return $ Done ctx { stack = VI64 (v1 - v2) : rest } step ctx@EvalCtx{ stack = (VI64 v2:VI64 v1:rest) } (IBinOp BS64 IMul) = - return $ Done ctx { stack = VI64 (asWord64 $ asInt64 v1 * asInt64 v2) : rest } + return $ Done ctx { stack = VI64 (v1 * v2) : rest } step ctx@EvalCtx{ stack = (VI64 v2:VI64 v1:rest) } (IBinOp BS64 IDivU) = - return $ Done ctx { stack = VI64 (v1 `div` v2) : rest } + return $ Done ctx { stack = VI64 (v1 `quot` v2) : rest } step ctx@EvalCtx{ stack = (VI64 v2:VI64 v1:rest) } (IBinOp BS64 IDivS) = - return $ Done ctx { stack = VI64 (asWord64 $ asInt64 v1 `div` asInt64 v2) : rest } + return $ Done ctx { stack = VI64 (asWord64 $ asInt64 v1 `quot` asInt64 v2) : rest } step ctx@EvalCtx{ stack = (VI64 v2:VI64 v1:rest) } (IBinOp BS64 IRemU) = return $ Done ctx { stack = VI64 (v1 `rem` v2) : rest } step ctx@EvalCtx{ stack = (VI64 v2:VI64 v1:rest) } (IBinOp BS64 IRemS) = diff --git a/src/Language/Wasm/Parser.y b/src/Language/Wasm/Parser.y index 0b66ca9..e14e88a 100644 --- a/src/Language/Wasm/Parser.y +++ b/src/Language/Wasm/Parser.y @@ -1130,13 +1130,13 @@ eitherToMaybe = either (const Nothing) Just integerToWord32 :: Integer -> Word32 integerToWord32 i | i >= 0 && i <= 2 ^ 32 = fromIntegral i - | i < 0 && i >= -(2 ^ 31) = 0x80000000 .|. (fromIntegral (abs i)) + | i < 0 && i >= -(2 ^ 31) = 0xFFFFFFFF - (fromIntegral (abs i)) + 1 | otherwise = error "I32 is out of bounds." integerToWord64 :: Integer -> Word64 integerToWord64 i | i >= 0 && i <= 2 ^ 64 = fromIntegral i - | i < 0 && i >= -(2 ^ 63) = 0x8000000000000000 .|. (fromIntegral (abs i)) + | i < 0 && i >= -(2 ^ 63) = 0xFFFFFFFFFFFFFFFF - (fromIntegral (abs i)) + 1 | otherwise = error "I64 is out of bounds." data FuncType = FuncType { params :: [ParamType], results :: [ValueType] } deriving (Show, Eq) diff --git a/src/Language/Wasm/Script.hs b/src/Language/Wasm/Script.hs index 6259346..4085262 100644 --- a/src/Language/Wasm/Script.hs +++ b/src/Language/Wasm/Script.hs @@ -8,7 +8,7 @@ import qualified Data.Map as Map import qualified Data.Vector as Vector import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TLEncoding -import Numeric.IEEE (identicalIEEE, copySign) +import Numeric.IEEE (identicalIEEE) import Language.Wasm.Parser ( Ident(..), @@ -61,7 +61,7 @@ runScript onAssertFail script = do ] go script $ emptyState { store = st, moduleRegistery = Map.singleton "spectest" inst } where - hostPrint paramTypes = Interpreter.HostFunction (Struct.FuncType paramTypes []) (\args -> return []) + hostPrint paramTypes = Interpreter.HostFunction (Struct.FuncType paramTypes []) (\args -> print args >> return []) hostGlobals = do globI32 <- Interpreter.makeMutGlobal $ Interpreter.VI32 666 globF32 <- Interpreter.makeMutGlobal $ Interpreter.VF32 666 diff --git a/tests/Test.hs b/tests/Test.hs index 6ee8299..6e8bb08 100644 --- a/tests/Test.hs +++ b/tests/Test.hs @@ -34,7 +34,7 @@ compile file = do main :: IO () main = do files <- Directory.listDirectory "tests/samples" - let files = ["float_misc.wast"] + let files = ["i32.wast"] scriptTestCases <- (`mapM` files) $ \file -> do content <- LBS.readFile $ "tests/samples/" ++ file let Right script = Parser.parseScript <$> Lexer.scanner content