diff --git a/src/Language/Wasm/Interpreter.hs b/src/Language/Wasm/Interpreter.hs index ce7b364..63a6dc0 100644 --- a/src/Language/Wasm/Interpreter.hs +++ b/src/Language/Wasm/Interpreter.hs @@ -9,7 +9,7 @@ import qualified Data.Map as Map import qualified Data.Text.Lazy as TL import qualified Data.ByteString.Lazy as LBS -import Data.Vector (Vector, (!)) +import Data.Vector (Vector, (!), (!?)) import qualified Data.Vector as Vector import Data.IORef (IORef, newIORef, readIORef) import Data.Array.IO (IOArray, newArray, readArray, writeArray) @@ -41,12 +41,12 @@ type Address = Int data TableInstance = TableInstance { elements :: Vector (Maybe Address), - maxLen :: Int + maxLen :: Maybe Int } data MemoryInstance = MemoryInstance { memory :: IOArray Int Word32, - maxLen :: Int -- in page size (64Ki) + maxLen :: Maybe Int -- in page size (64Ki) } data GlobalInstance = GIConst Value | GIMut (IORef Value) @@ -143,41 +143,65 @@ allocFunctions inst@ModuleInstance {types} funs = getGlobalValue :: ModuleInstance -> Store -> Natural -> IO Value getGlobalValue inst store idx = - let addr = globaladdrs inst ! fromIntegral idx in + let addr = case globaladdrs inst !? fromIntegral idx of + Just a -> a + Nothing -> error "Global index is out of range. It can happen if initializer refs non-import global." + in case globalInstances store ! addr of GIConst v -> return v GIMut ref -> readIORef ref allocGlobals :: ModuleInstance -> Store -> [Global] -> IO (Vector GlobalInstance) -allocGlobals inst store globs = - let +allocGlobals inst store globs = Vector.fromList <$> mapM allocGlob globs + where + runIniter :: [Instruction] -> IO Value -- due the validation there can be only these instructions runIniter [I32Const v] = return $ VI32 v runIniter [I64Const v] = return $ VI64 v runIniter [F32Const v] = return $ VF32 v runIniter [F64Const v] = return $ VF64 v -- the spec says get global can ref only imported globals - -- it is implied by execution phase, but not validated in validation phase runIniter [GetGlobal i] = getGlobalValue inst store i runIniter instrs = error $ "Global initializer contains unsupported instructions: " ++ show instrs - in - let + + allocGlob :: Global -> IO GlobalInstance allocGlob (Global (Const _) initer) = GIConst <$> runIniter initer allocGlob (Global (Mut _) initer) = do val <- runIniter initer GIMut <$> newIORef val - in - Vector.fromList <$> mapM allocGlob globs +allocTables :: [Table] -> Vector TableInstance +allocTables tables = Vector.fromList $ map allocTable tables + where + allocTable :: Table -> TableInstance + allocTable (Table (TableType (Limit from to) _)) = + TableInstance { + elements = Vector.fromList $ replicate (fromIntegral from) Nothing, + maxLen = fromIntegral <$> to + } +allocMems :: [Memory] -> IO (Vector MemoryInstance) +allocMems mems = Vector.fromList <$> mapM allocMem mems + where + allocMem :: Memory -> IO MemoryInstance + allocMem (Memory (Limit from to)) = do + memory <- newArray (0, fromIntegral from * (16 * 1024{- 64 * 1024 bytes in Word32 -})) 0 + return $ MemoryInstance { + memory, + maxLen = fromIntegral <$> to + } instantiate :: Store -> Imports -> Module -> IO (ModuleInstance, Store) instantiate st imps m = do let inst = calcInstance st imps m - let funs = funcInstances st Vector.++ (allocFunctions inst $ Struct.functions m) - globs <- (globalInstances st Vector.++) <$> (allocGlobals inst st $ Struct.globals m) + let functions = funcInstances st Vector.++ (allocFunctions inst $ Struct.functions m) + globals <- (globalInstances st Vector.++) <$> (allocGlobals inst st $ Struct.globals m) + let tables = tableInstances st Vector.++ (allocTables $ Struct.tables m) + mems <- (memInstances st Vector.++) <$> (allocMems $ Struct.mems m) let st' = st { - funcInstances = funs, - globalInstances = globs + funcInstances = functions, + tableInstances = tables, + memInstances = mems, + globalInstances = globals } return $ (inst, st') diff --git a/src/Language/Wasm/Validate.hs b/src/Language/Wasm/Validate.hs index 4d290c0..a58b0e4 100644 --- a/src/Language/Wasm/Validate.hs +++ b/src/Language/Wasm/Validate.hs @@ -581,12 +581,6 @@ exportsShouldBeValid Module { exports, imports, functions, mems, tables, globals memImports = filter isMemImport imports globalImports = filter isGlobalImport imports - isFuncImport (Import _ _ (ImportFunc _)) = True - isFuncImport _ = False - - isGlobalImport (Import _ _ (ImportGlobal _)) = True - isGlobalImport _ = False - isExportValid :: Export -> ValidationResult isExportValid (Export _ (ExportFunc funIdx)) = isIndexValid funIdx $ length funcImports + length functions