diff --git a/src/Language/Wasm/Binary.hs b/src/Language/Wasm/Binary.hs index 83a6854..86a07a3 100644 --- a/src/Language/Wasm/Binary.hs +++ b/src/Language/Wasm/Binary.hs @@ -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 diff --git a/src/Language/Wasm/Builder.hs b/src/Language/Wasm/Builder.hs index 31d959b..476e768 100644 --- a/src/Language/Wasm/Builder.hs +++ b/src/Language/Wasm/Builder.hs @@ -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 diff --git a/src/Language/Wasm/Interpreter.hs b/src/Language/Wasm/Interpreter.hs index 9ce065b..a4b81fa 100644 --- a/src/Language/Wasm/Interpreter.hs +++ b/src/Language/Wasm/Interpreter.hs @@ -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) = diff --git a/src/Language/Wasm/Parser.y b/src/Language/Wasm/Parser.y index a24e2f3..7452361 100644 --- a/src/Language/Wasm/Parser.y +++ b/src/Language/Wasm/Parser.y @@ -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 diff --git a/src/Language/Wasm/Structure.hs b/src/Language/Wasm/Structure.hs index e1c812e..3468a37 100644 --- a/src/Language/Wasm/Structure.hs +++ b/src/Language/Wasm/Structure.hs @@ -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) diff --git a/src/Language/Wasm/Validate.hs b/src/Language/Wasm/Validate.hs index 0dec6d3..0e7b215 100644 --- a/src/Language/Wasm/Validate.hs +++ b/src/Language/Wasm/Validate.hs @@ -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 diff --git a/tests/Test.hs b/tests/Test.hs index 7392cab..1879bc9 100644 --- a/tests/Test.hs +++ b/tests/Test.hs @@ -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