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

use correct signed int representation

Browse Source
This commit is contained in:
Ilya Rezvov
2018-04-10 20:50:26 -07:00
parent 8514232513
commit 1fe669e762
4 changed files with 23 additions and 23 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Language/Wasm/Interpreter.hs
+18 -18
View File
@@ -67,25 +67,25 @@ data Value =
asInt32 :: Word32 -> Int32 asInt32 :: Word32 -> Int32
asInt32 w = asInt32 w =
let base = fromIntegral $ w .&. 0x7FFFFFFF in if w < 0x80000000
let sign = w .&. 0x80000000 in then fromIntegral w
if sign /= 0 then -base else base else -1 * fromIntegral (0xFFFFFFFF - w + 1)
asInt64 :: Word64 -> Int64 asInt64 :: Word64 -> Int64
asInt64 w = asInt64 w =
let base = fromIntegral $ w .&. 0x7FFFFFFFFFFFFFFF in if w < 0x8000000000000000
let sign = w .&. 0x8000000000000000 in then fromIntegral w
if sign /= 0 then -base else base else -1 * fromIntegral (0xFFFFFFFFFFFFFFFF - w + 1)
asWord32 :: Int32 -> Word32 asWord32 :: Int32 -> Word32
asWord32 i asWord32 i
| i >= 0 = fromIntegral i | i >= 0 = fromIntegral i
| otherwise = 0x80000000 .|. (fromIntegral (abs i)) | otherwise = 0xFFFFFFFF - (fromIntegral (abs i)) + 1
asWord64 :: Int64 -> Word64 asWord64 :: Int64 -> Word64
asWord64 i asWord64 i
| i >= 0 = fromIntegral 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 -- brough from https://stackoverflow.com/questions/6976684/converting-ieee-754-floating-point-in-haskell-word32-64-to-and-from-haskell-floa
wordToFloat :: Word32 -> Float 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 (F32Const v) = return $ Done ctx { stack = VF32 v : stack ctx }
step ctx (F64Const v) = return $ Done ctx { stack = VF64 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) = 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) = 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) = 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) = 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) = 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) = step ctx@EvalCtx{ stack = (VI32 v2:VI32 v1:rest) } (IBinOp BS32 IRemU) =
return $ Done ctx { stack = VI32 (v1 `rem` v2) : rest } return $ Done ctx { stack = VI32 (v1 `rem` v2) : rest }
step ctx@EvalCtx{ stack = (VI32 v2:VI32 v1:rest) } (IBinOp BS32 IRemS) = 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) = step ctx@EvalCtx{ stack = (VI32 v:rest) } (IUnOp BS32 IPopcnt) =
return $ Done ctx { stack = VI32 (fromIntegral $ popCount v) : rest } return $ Done ctx { stack = VI32 (fromIntegral $ popCount v) : rest }
step ctx@EvalCtx{ stack = (VI64 v2:VI64 v1:rest) } (IBinOp BS64 IAdd) = 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) = 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) = 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) = 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) = 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) = step ctx@EvalCtx{ stack = (VI64 v2:VI64 v1:rest) } (IBinOp BS64 IRemU) =
return $ Done ctx { stack = VI64 (v1 `rem` v2) : rest } return $ Done ctx { stack = VI64 (v1 `rem` v2) : rest }
step ctx@EvalCtx{ stack = (VI64 v2:VI64 v1:rest) } (IBinOp BS64 IRemS) = step ctx@EvalCtx{ stack = (VI64 v2:VI64 v1:rest) } (IBinOp BS64 IRemS) =
src/Language/Wasm/Parser.y
+2 -2
View File
@@ -1130,13 +1130,13 @@ eitherToMaybe = either (const Nothing) Just
integerToWord32 :: Integer -> Word32 integerToWord32 :: Integer -> Word32
integerToWord32 i integerToWord32 i
| i >= 0 && i <= 2 ^ 32 = fromIntegral 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." | otherwise = error "I32 is out of bounds."
integerToWord64 :: Integer -> Word64 integerToWord64 :: Integer -> Word64
integerToWord64 i integerToWord64 i
| i >= 0 && i <= 2 ^ 64 = fromIntegral 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." | otherwise = error "I64 is out of bounds."
data FuncType = FuncType { params :: [ParamType], results :: [ValueType] } deriving (Show, Eq) data FuncType = FuncType { params :: [ParamType], results :: [ValueType] } deriving (Show, Eq)
src/Language/Wasm/Script.hs
+2 -2
View File
@@ -8,7 +8,7 @@ import qualified Data.Map as Map
import qualified Data.Vector as Vector import qualified Data.Vector as Vector
import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TLEncoding import qualified Data.Text.Lazy.Encoding as TLEncoding
import Numeric.IEEE (identicalIEEE, copySign) import Numeric.IEEE (identicalIEEE)
import Language.Wasm.Parser ( import Language.Wasm.Parser (
Ident(..), Ident(..),
@@ -61,7 +61,7 @@ runScript onAssertFail script = do
] ]
go script $ emptyState { store = st, moduleRegistery = Map.singleton "spectest" inst } go script $ emptyState { store = st, moduleRegistery = Map.singleton "spectest" inst }
where where
hostPrint paramTypes = Interpreter.HostFunction (Struct.FuncType paramTypes []) (\args -> return []) hostPrint paramTypes = Interpreter.HostFunction (Struct.FuncType paramTypes []) (\args -> print args >> return [])
hostGlobals = do hostGlobals = do
globI32 <- Interpreter.makeMutGlobal $ Interpreter.VI32 666 globI32 <- Interpreter.makeMutGlobal $ Interpreter.VI32 666
globF32 <- Interpreter.makeMutGlobal $ Interpreter.VF32 666 globF32 <- Interpreter.makeMutGlobal $ Interpreter.VF32 666
tests/Test.hs
+1 -1
View File
@@ -34,7 +34,7 @@ compile file = do
main :: IO () main :: IO ()
main = do main = do
files <- Directory.listDirectory "tests/samples" files <- Directory.listDirectory "tests/samples"
let files = ["float_misc.wast"] let files = ["i32.wast"]
scriptTestCases <- (`mapM` files) $ \file -> do scriptTestCases <- (`mapM` files) $ \file -> do
content <- LBS.readFile $ "tests/samples/" ++ file content <- LBS.readFile $ "tests/samples/" ++ file
let Right script = Parser.parseScript <$> Lexer.scanner content let Right script = Parser.parseScript <$> Lexer.scanner content