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

fix serialization/deserialization and complete saturated data conversions

Browse Source
This commit is contained in:
Ilya Rezvov
2021-04-12 23:01:39 -07:00
parent 8f698df5f2
commit 0bf74253cb
3 changed files with 94 additions and 7 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Language/Wasm/Binary.hs
+29 -2
View File
@@ -130,7 +130,10 @@ getSection sectionType parser def = do
where
parseSection op
| op == 0 = skipCustomSection >> getSection sectionType parser def
| op == fromEnum sectionType = getWord8 >> (getULEB128 32 :: Get Natural) >> parser
| op == fromEnum sectionType = do
getWord8
len <- getULEB128 32
isolate len parser
| op > fromEnum DataSection = fail "invalid section id"
| op > fromEnum sectionType = return def
| otherwise =
@@ -522,6 +525,15 @@ instance Serialize (Instruction Natural) where
put (IUnOp BS64 IExtend16S) = putWord8 0xC3
put (IUnOp BS64 IExtend32S) = putWord8 0xC4
put (ITruncSatFS BS32 BS32) = putWord8 0xFC >> putULEB128 (0x00 :: Word32)
put (ITruncSatFU BS32 BS32) = putWord8 0xFC >> putULEB128 (0x01 :: Word32)
put (ITruncSatFS BS32 BS64) = putWord8 0xFC >> putULEB128 (0x02 :: Word32)
put (ITruncSatFU BS32 BS64) = putWord8 0xFC >> putULEB128 (0x03 :: Word32)
put (ITruncSatFS BS64 BS32) = putWord8 0xFC >> putULEB128 (0x04 :: Word32)
put (ITruncSatFU BS64 BS32) = putWord8 0xFC >> putULEB128 (0x05 :: Word32)
put (ITruncSatFS BS64 BS64) = putWord8 0xFC >> putULEB128 (0x06 :: Word32)
put (ITruncSatFU BS64 BS64) = putWord8 0xFC >> putULEB128 (0x07 :: Word32)
get = do
op <- getWord8
case op of
@@ -711,6 +723,18 @@ instance Serialize (Instruction Natural) where
0xC2 -> return $ IUnOp BS64 IExtend8S
0xC3 -> return $ IUnOp BS64 IExtend16S
0xC4 -> return $ IUnOp BS64 IExtend32S
0xFC -> do -- misc
ext <- getULEB128 32
case (ext :: Word32) of
0x00 -> return $ ITruncSatFS BS32 BS32
0x01 -> return $ ITruncSatFU BS32 BS32
0x02 -> return $ ITruncSatFS BS32 BS64
0x03 -> return $ ITruncSatFU BS32 BS64
0x04 -> return $ ITruncSatFS BS64 BS32
0x05 -> return $ ITruncSatFU BS64 BS32
0x06 -> return $ ITruncSatFS BS64 BS64
0x07 -> return $ ITruncSatFU BS64 BS64
_ -> fail "Unknown byte value after misc instruction byte"
_ -> fail "Unknown byte value in place of instruction opcode"
putExpression :: Expression -> Put
@@ -792,7 +816,10 @@ instance Serialize Function where
putByteString bs
get = do
_size <- getULEB128 32 :: Get Natural
locals <- concat . map (\(LocalTypeRange n val) -> replicate (fromIntegral n) val) <$> getVec
localRanges <- getVec
let localLen = sum $ map (\(LocalTypeRange n _) -> n) localRanges
if localLen < 2^32 then return () else fail "too many locals"
let locals = concat $ map (\(LocalTypeRange n val) -> replicate (fromIntegral n) val) localRanges
body <- getExpression
return $ Function 0 locals body
src/Language/Wasm/Interpreter.hs
+64 -4
View File
@@ -1079,21 +1079,81 @@ eval budget store FunctionInstance { funcType, moduleInstance, code = Function {
then return Trap
else return $ Done ctx { stack = VI64 (truncate v) : rest }
step ctx@EvalCtx{ stack = (VF32 v:rest) } (ITruncFS BS32 BS32) =
if isNaN v || isInfinite v || v >= 2^31 || v < -2^31
if isNaN v || isInfinite v || v >= 2^31 || v < -2^31 - 1
then return Trap
else return $ Done ctx { stack = VI32 (asWord32 $ truncate v) : rest }
step ctx@EvalCtx{ stack = (VF64 v:rest) } (ITruncFS BS32 BS64) =
if isNaN v || isInfinite v || v >= 2^31 || v < -2^31
if isNaN v || isInfinite v || v >= 2^31 || v <= -2^31 - 1
then return Trap
else return $ Done ctx { stack = VI32 (asWord32 $ truncate v) : rest }
step ctx@EvalCtx{ stack = (VF32 v:rest) } (ITruncFS BS64 BS32) =
if isNaN v || isInfinite v || v >= 2^63 || v < -2^63
if isNaN v || isInfinite v || v >= 2^63 || v < -2^63 - 1
then return Trap
else return $ Done ctx { stack = VI64 (asWord64 $ truncate v) : rest }
step ctx@EvalCtx{ stack = (VF64 v:rest) } (ITruncFS BS64 BS64) =
if isNaN v || isInfinite v || v >= 2^63 || v < -2^63
if isNaN v || isInfinite v || v >= 2^63 || v < -2^63 - 1
then return Trap
else return $ Done ctx { stack = VI64 (asWord64 $ truncate v) : rest }
step ctx@EvalCtx{ stack = (VF32 v:rest) } (ITruncSatFS BS32 BS32) | isNaN v =
return $ Done ctx { stack = VI32 0 : rest }
step ctx@EvalCtx{ stack = (VF64 v:rest) } (ITruncSatFS BS32 BS64) | isNaN v =
return $ Done ctx { stack = VI32 0 : rest }
step ctx@EvalCtx{ stack = (VF32 v:rest) } (ITruncSatFS BS64 BS32) | isNaN v =
return $ Done ctx { stack = VI64 0 : rest }
step ctx@EvalCtx{ stack = (VF64 v:rest) } (ITruncSatFS BS64 BS64) | isNaN v =
return $ Done ctx { stack = VI64 0 : rest }
step ctx@EvalCtx{ stack = (VF32 v:rest) } (ITruncSatFU BS32 BS32) | v <= -1 || isNaN v =
return $ Done ctx { stack = VI32 0 : rest }
step ctx@EvalCtx{ stack = (VF64 v:rest) } (ITruncSatFU BS32 BS64) | v <= -1 || isNaN v =
return $ Done ctx { stack = VI32 0 : rest }
step ctx@EvalCtx{ stack = (VF32 v:rest) } (ITruncSatFU BS64 BS32) | v <= -1 || isNaN v =
return $ Done ctx { stack = VI64 0 : rest }
step ctx@EvalCtx{ stack = (VF64 v:rest) } (ITruncSatFU BS64 BS64) | v <= -1 || isNaN v =
return $ Done ctx { stack = VI64 0 : rest }
step ctx@EvalCtx{ stack = (VF32 v:rest) } (ITruncSatFS BS32 BS32) | v >= 2^31 =
return $ Done ctx { stack = VI32 0x7fffffff : rest }
step ctx@EvalCtx{ stack = (VF64 v:rest) } (ITruncSatFS BS32 BS64) | v >= 2^31 =
return $ Done ctx { stack = VI32 0x7fffffff : rest }
step ctx@EvalCtx{ stack = (VF32 v:rest) } (ITruncSatFS BS64 BS32) | v >= 2^63 =
return $ Done ctx { stack = VI64 0x7fffffffffffffff : rest }
step ctx@EvalCtx{ stack = (VF64 v:rest) } (ITruncSatFS BS64 BS64) | v >= 2^63 =
return $ Done ctx { stack = VI64 0x7fffffffffffffff : rest }
step ctx@EvalCtx{ stack = (VF32 v:rest) } (ITruncSatFU BS32 BS32) | v >= 2^32 =
return $ Done ctx { stack = VI32 0xffffffff : rest }
step ctx@EvalCtx{ stack = (VF64 v:rest) } (ITruncSatFU BS32 BS64) | v >= 2^32 =
return $ Done ctx { stack = VI32 0xffffffff : rest }
step ctx@EvalCtx{ stack = (VF32 v:rest) } (ITruncSatFU BS64 BS32) | v >= 2^64 =
return $ Done ctx { stack = VI64 0xffffffffffffffff : rest }
step ctx@EvalCtx{ stack = (VF64 v:rest) } (ITruncSatFU BS64 BS64) | v >= 2^64 =
return $ Done ctx { stack = VI64 0xffffffffffffffff : rest }
step ctx@EvalCtx{ stack = (VF32 v:rest) } (ITruncSatFS BS32 BS32) | v <= -2^31 - 1 =
return $ Done ctx { stack = VI32 0x80000000 : rest }
step ctx@EvalCtx{ stack = (VF64 v:rest) } (ITruncSatFS BS32 BS64) | v <= -2^31 - 1 =
return $ Done ctx { stack = VI32 0x80000000 : rest }
step ctx@EvalCtx{ stack = (VF32 v:rest) } (ITruncSatFS BS64 BS32) | v <= -2^63 - 1 =
return $ Done ctx { stack = VI64 0x8000000000000000 : rest }
step ctx@EvalCtx{ stack = (VF64 v:rest) } (ITruncSatFS BS64 BS64) | v <= -2^63 - 1 =
return $ Done ctx { stack = VI64 0x8000000000000000 : rest }
step ctx@EvalCtx{ stack = (VF32 v:rest) } (ITruncSatFU BS32 BS32) =
return $ Done ctx { stack = VI32 (truncate v) : rest }
step ctx@EvalCtx{ stack = (VF64 v:rest) } (ITruncSatFU BS32 BS64) =
return $ Done ctx { stack = VI32 (truncate v) : rest }
step ctx@EvalCtx{ stack = (VF32 v:rest) } (ITruncSatFU BS64 BS32) =
return $ Done ctx { stack = VI64 (truncate v) : rest }
step ctx@EvalCtx{ stack = (VF64 v:rest) } (ITruncSatFU BS64 BS64) =
return $ Done ctx { stack = VI64 (truncate v) : rest }
step ctx@EvalCtx{ stack = (VF32 v:rest) } (ITruncSatFS BS32 BS32) =
return $ Done ctx { stack = VI32 (asWord32 $ truncate v) : rest }
step ctx@EvalCtx{ stack = (VF64 v:rest) } (ITruncSatFS BS32 BS64) =
return $ Done ctx { stack = VI32 (asWord32 $ truncate v) : rest }
step ctx@EvalCtx{ stack = (VF32 v:rest) } (ITruncSatFS BS64 BS32) =
return $ Done ctx { stack = VI64 (asWord64 $ truncate v) : rest }
step ctx@EvalCtx{ stack = (VF64 v:rest) } (ITruncSatFS BS64 BS64) =
return $ Done ctx { stack = VI64 (asWord64 $ truncate v) : rest }
step ctx@EvalCtx{ stack = (VI32 v:rest) } I64ExtendUI32 =
return $ Done ctx { stack = VI64 (fromIntegral v) : rest }
step ctx@EvalCtx{ stack = (VI32 v:rest) } I64ExtendSI32 =
tests/Test.hs
+1 -1
View File
@@ -17,7 +17,7 @@ import qualified Data.List as List
main :: IO ()
main = do
files <- filter (List.isSuffixOf ".wast") <$> Directory.listDirectory "tests/spec"
-- let files = ["select.wast"]
-- let files = ["conversions.wast"]
scriptTestCases <- (`mapM` files) $ \file -> do
test <- LBS.readFile ("tests/spec/" ++ file)
return $ testCase file $ do