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

add syntax support for extended data segments

Browse Source
This commit is contained in:
Ilya Rezvov
2022-06-09 20:21:57 -06:00
parent c743e11ffd
commit 32392dcc29
7 changed files with 52 additions and 23 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Language/Wasm/Binary.hs
+2 -2
View File
@@ -881,7 +881,7 @@ instance Serialize Function where
return $ Function 0 locals body
instance Serialize DataSegment where
put (DataSegment memIdx offset init) = do
put (DataSegment (ActiveData memIdx offset) init) = do
putULEB128 memIdx
putExpression offset
putULEB128 $ LBS.length init
@@ -891,7 +891,7 @@ instance Serialize DataSegment where
offset <- getExpression
len <- getULEB128 32
init <- getLazyByteString len
return $ DataSegment memIdx offset init
return $ DataSegment (ActiveData memIdx offset) init
instance Serialize Module where
put mod = do
src/Language/Wasm/Builder.hs
+1 -1
View File
@@ -975,7 +975,7 @@ table min max = do
dataSegment :: (Producer offset, OutType offset ~ Proxy I32) => offset -> LBS.ByteString -> GenMod ()
dataSegment offset bytes =
modify $ \(st@GenModState { target = m }) -> st {
target = m { datas = datas m ++ [DataSegment 0 (genExpr 0 (produce offset)) bytes] }
target = m { datas = datas m ++ [DataSegment (ActiveData 0 (genExpr 0 (produce offset))) bytes] }
}
asWord32 :: Int32 -> Word32
src/Language/Wasm/Interpreter.hs
+3 -1
View File
@@ -571,7 +571,7 @@ initialize inst Module {elems, datas, start} = do
Monad.forM_ (zip [from..] funcs) $ uncurry $ MVector.unsafeWrite elems
checkData :: DataSegment -> Initialize (Int, MemoryStore, LBS.ByteString)
checkData DataSegment {memIndex, offset, chunk} = do
checkData DataSegment {dataMode = ActiveData memIndex offset, chunk} = do
st <- State.get
VI32 val <- liftIO $ evalConstExpr inst st offset
let from = fromIntegral val
@@ -582,6 +582,8 @@ initialize inst Module {elems, datas, start} = do
len <- ByteArray.getSizeofMutableByteArray mem
Monad.when (last > len) $ throwError "data segment does not fit"
return (from, mem, chunk)
checkData DataSegment {dataMode = ActiveData memIndex offset, chunk} =
error "passive data segments are not implemented yet"
initData :: (Int, MemoryStore, LBS.ByteString) -> Initialize ()
initData (from, mem, chunk) =
src/Language/Wasm/Parser.y
+36 -15
View File
@@ -898,9 +898,11 @@ memory_limits_export_import1 :: { Maybe Ident -> [ModuleField] }
| 'data' datastring ')' ')' {
\ident ->
let m = fromIntegral $ LBS.length $2 in
-- TODO: unhardcode memory index
let memIdx = fromMaybe (Index 0) $ Named `fmap` ident in
[
MFMem $ Memory [] ident $ Limit m $ Just m,
MFData $ DataSegment (fromMaybe (Index 0) $ Named `fmap` ident) [PlainInstr $ I32Const 0] $2
MFData $ DataSegment Nothing (ActiveData memIdx [PlainInstr $ I32Const 0]) $2
]
}
@@ -933,6 +935,7 @@ limits_elemtype_elem :: { Maybe Ident -> [ModuleField] }
\ident ->
let funcsLen = fromIntegral $ length $4 in [
MFTable $ Table [] ident $ TableType (Limit funcsLen (Just funcsLen)) $1,
-- TODO: unhardcode table index
let tableIndex = (fromMaybe (Index 0) $ Named `fmap` ident) in
let offset = [PlainInstr $ I32Const 0] in
let elements = $4 in
@@ -972,10 +975,6 @@ export :: { Export }
start :: { StartFunction }
: 'start' index ')' { StartFunction $2 }
offsetexpr :: { [Instruction] }
: 'offset' mixed_instruction_list(')') { snd $2 }
| folded_instr1 { $1 }
elem :: { ElemSegment }
: 'elem' opt(ident) elem1 { $3{ ident = $2 } }
@@ -1007,8 +1006,20 @@ elemexpr :: { [Instruction] }
| '(' 'item' mixed_instruction_list(')') { snd $3 }
| '(' folded_instr1 { $2 }
offsetexpr1 :: { [Instruction] }
: 'offset' mixed_instruction_list(')') { snd $2 }
| folded_instr1 { $1 }
memory_offsetexpr1 :: { (MemoryIndex, [Instruction]) }
: offsetexpr1 { (Index 0, $1)}
| 'memory' index ')' '(' offsetexpr1 { ($2, $5) }
memory_mode :: { DataMode }
: '(' memory_offsetexpr1 { uncurry ActiveData $2 }
| {- empty -} { PassiveData }
datasegment :: { DataSegment }
: 'data' opt(index) '(' offsetexpr datastring ')' { DataSegment (fromMaybe (Index 0) $2) $4 $5 }
: 'data' opt(ident) memory_mode datastring ')' { DataSegment $2 $3 $4 }
modulefield1_single :: { ModuleField }
: typedef { MFType $1 }
@@ -1207,6 +1218,7 @@ type GlobalIndex = Index
type TableIndex = Index
type MemoryIndex = Index
type ElemIndex = Index
type DataIndex = Index
data PlainInstr =
-- Control instructions
@@ -1403,9 +1415,14 @@ data ElemSegment = ElemSegment {
}
deriving (Show, Eq)
data DataMode =
PassiveData
| ActiveData MemoryIndex [Instruction]
deriving (Show, Eq)
data DataSegment = DataSegment {
memIndex :: MemoryIndex,
offset :: [Instruction],
ident :: Maybe Ident,
dataMode :: DataMode,
datastring :: LBS.ByteString
}
deriving (Show, Eq)
@@ -1591,8 +1608,6 @@ desugarize fields = do
extractTypeDefFromInstructions (matchTypeUse defs funcType) body
extractTypeDef defs (MFGlobal Global { initializer }) =
extractTypeDefFromInstructions defs initializer
extractTypeDef defs (MFData DataSegment { offset }) =
extractTypeDefFromInstructions defs offset
extractTypeDef defs _ = defs
extractTypeDefFromInstructions :: [TypeDef] -> [Instruction] -> [TypeDef]
@@ -2089,11 +2104,17 @@ desugarize fields = do
-- data segment
synDataToStruct :: Module -> DataSegment -> Either String S.DataSegment
synDataToStruct mod DataSegment { memIndex, offset, datastring } =
let ctx = FunCtx mod [] [] [] in
let offsetInstrs = mapM (synInstrToStruct ctx) offset in
let idx = fromJust $ getMemIndex mod memIndex in
S.DataSegment idx <$> offsetInstrs <*> return datastring
synDataToStruct mod DataSegment { dataMode, datastring } = do
m <- case dataMode of
PassiveData -> return S.PassiveData
ActiveData memIndex offset -> do
let ctx = FunCtx mod [] [] []
offsetInstrs <- mapM (synInstrToStruct ctx) offset
idx <- case getMemIndex mod memIndex of
Just idx -> return idx
Nothing -> throwError "unknown memory"
return $ S.ActiveData idx offsetInstrs
return $ S.DataSegment m datastring
extractDataSegment :: [DataSegment] -> ModuleField -> [DataSegment]
extractDataSegment datas (MFData dataSegment) = dataSegment : datas
src/Language/Wasm/Structure.hs
+8 -2
View File
@@ -4,6 +4,7 @@
module Language.Wasm.Structure (
Module(..),
DataMode(..),
DataSegment(..),
ElemSegment(..),
ElemMode(..),
@@ -103,6 +104,7 @@ type LocalIndex = Natural
type GlobalIndex = Natural
type MemoryIndex = Natural
type TableIndex = Natural
type DataIndex = Natural
type ElemIndex = Natural
data ValueType =
@@ -252,9 +254,13 @@ data ElemSegment = ElemSegment {
elements :: [Expression]
} deriving (Show, Eq, Generic, NFData)
data DataMode =
PassiveData
| ActiveData MemoryIndex Expression
deriving (Show, Eq, Generic, NFData)
data DataSegment = DataSegment {
memIndex :: MemoryIndex,
offset :: Expression,
dataMode :: DataMode,
chunk :: LBS.ByteString
} deriving (Show, Eq, Generic, NFData)
src/Language/Wasm/Validate.hs
+1 -1
View File
@@ -700,7 +700,7 @@ datasShouldBeValid m@Module { datas, mems, imports } =
foldMap (isDataValid ctx) datas
where
isDataValid :: Ctx -> DataSegment -> ValidationResult
isDataValid ctx (DataSegment memIdx offset _) =
isDataValid ctx (DataSegment (ActiveData memIdx offset) _) =
let check = runChecker ctx $ do
isConstExpression offset
t <- getExpressionType offset
tests/Test.hs
+1 -1
View File
@@ -19,7 +19,7 @@ main = do
files <-
filter (not . List.isPrefixOf "simd") . filter (List.isSuffixOf ".wast")
<$> Directory.listDirectory "tests/spec"
-- let files = ["select.wast"]
let files = ["data.wast"]
scriptTestCases <- (`mapM` files) $ \file -> do
test <- LBS.readFile ("tests/spec/" ++ file)
return $ testCase file $ do