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

check imported values types

Browse Source
This commit is contained in:
Ilya Rezvov
2018-04-20 19:11:09 -07:00
parent a8459fb541
commit 108eb0c0ee
1 changed files with 149 additions and 68 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Language/Wasm/Interpreter.hs
+149 -68
View File
@@ -24,7 +24,7 @@ module Language.Wasm.Interpreter (
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy as TL
import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString.Lazy as LBS
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe, isNothing)
import Data.Vector (Vector, (!), (!?), (//)) import Data.Vector (Vector, (!), (!?), (//))
import Data.Vector.Storable.Mutable (IOVector) import Data.Vector.Storable.Mutable (IOVector)
@@ -158,19 +158,25 @@ data Label = Label ResultType deriving (Show, Eq)
type Address = Int type Address = Int
data TableInstance = TableInstance { data TableInstance = TableInstance {
elements :: Vector (Maybe Address), lim :: Limit,
maxLen :: Maybe Int elements :: Vector (Maybe Address)
} }
data MemoryInstance = MemoryInstance { data MemoryInstance = MemoryInstance {
memory :: IOVector Word8, lim :: Limit,
maxLen :: Maybe Int -- in page size (64Ki) memory :: IORef (IOVector Word8)
} }
data GlobalInstance = GIConst Value | GIMut (IORef Value) data GlobalInstance = GIConst ValueType Value | GIMut ValueType (IORef Value)
makeMutGlobal :: Value -> IO GlobalInstance makeMutGlobal :: Value -> IO GlobalInstance
makeMutGlobal val = GIMut <$> newIORef val makeMutGlobal val = GIMut (getValueType val) <$> newIORef val
getValueType :: Value -> ValueType
getValueType (VI32 _) = I32
getValueType (VI64 _) = I64
getValueType (VF32 _) = F32
getValueType (VF64 _) = F64
data ExportInstance = ExportInstance TL.Text ExternalValue deriving (Eq, Show) data ExportInstance = ExportInstance TL.Text ExternalValue deriving (Eq, Show)
@@ -195,7 +201,7 @@ data FunctionInstance =
data Store = Store { data Store = Store {
funcInstances :: Vector FunctionInstance, funcInstances :: Vector FunctionInstance,
tableInstances :: Vector TableInstance, tableInstances :: Vector TableInstance,
memInstances :: Vector (IORef MemoryInstance), memInstances :: Vector MemoryInstance,
globalInstances :: Vector GlobalInstance globalInstances :: Vector GlobalInstance
} }
@@ -327,14 +333,10 @@ calcInstance (Store fs ts ms gs) imps Module {functions, types, tables, mems, gl
let tableLen = length ts let tableLen = length ts
let memLen = length ms let memLen = length ms
let globalLen = length gs let globalLen = length gs
let getImpIdx (Import m n _) = funImps <- mapM checkImportType $ filter isFuncImport imports
case Map.lookup (m, n) imps of tableImps <- mapM checkImportType $ filter isTableImport imports
Just idx -> Right idx memImps <- mapM checkImportType $ filter isMemImport imports
Nothing -> Left $ "Cannot find import from module " ++ show m ++ " with name " ++ show n globalImps <- mapM checkImportType $ filter isGlobalImport imports
funImps <- mapM getImpIdx $ filter isFuncImport imports
tableImps <- mapM getImpIdx $ filter isTableImport imports
memImps <- mapM getImpIdx $ filter isMemImport imports
globalImps <- mapM getImpIdx $ filter isGlobalImport imports
let funs = Vector.fromList $ map (\(ExternFunction i) -> i) funImps ++ [funLen..funLen + length functions - 1] let funs = Vector.fromList $ map (\(ExternFunction i) -> i) funImps ++ [funLen..funLen + length functions - 1]
let tbls = Vector.fromList $ map (\(ExternTable i) -> i) tableImps ++ [tableLen..tableLen + length tables - 1] let tbls = Vector.fromList $ map (\(ExternTable i) -> i) tableImps ++ [tableLen..tableLen + length tables - 1]
let memories = Vector.fromList $ map (\(ExternMemory i) -> i) memImps ++ [memLen..memLen + length mems - 1] let memories = Vector.fromList $ map (\(ExternMemory i) -> i) memImps ++ [memLen..memLen + length mems - 1]
@@ -356,6 +358,59 @@ calcInstance (Store fs ts ms gs) imps Module {functions, types, tables, mems, gl
globaladdrs = globs, globaladdrs = globs,
exports = Vector.fromList $ map refExport exports exports = Vector.fromList $ map refExport exports
} }
where
getImpIdx :: Import -> Either String ExternalValue
getImpIdx (Import m n _) =
case Map.lookup (m, n) imps of
Just idx -> Right idx
Nothing -> Left $ "Cannot find import from module " ++ show m ++ " with name " ++ show n
checkImportType :: Import -> Either String ExternalValue
checkImportType imp@(Import _ _ (ImportFunc typeIdx)) = do
idx <- getImpIdx imp
funcAddr <- case idx of
ExternFunction funcAddr -> Right funcAddr
other -> Left "incompatible import type"
let expectedType = types !! fromIntegral typeIdx
let actualType = Language.Wasm.Interpreter.funcType $ fs ! funcAddr
if expectedType == actualType
then Right idx
else Left "incompatible import type"
checkImportType imp@(Import _ _ (ImportGlobal globalType)) = do
let err = Left "incompatible import type"
idx <- getImpIdx imp
globalAddr <- case idx of
ExternGlobal globalAddr -> Right globalAddr
_ -> err
let globalInst = gs ! globalAddr
let vt = case globalType of
Const vt -> vt
Mut vt -> vt
let vt' = case globalInst of
GIConst vt _ -> vt
GIMut vt _ -> vt
if vt == vt' then Right idx else err
checkImportType imp@(Import _ _ (ImportMemory limit)) = do
idx <- getImpIdx imp
memAddr <- case idx of
ExternMemory memAddr -> Right memAddr
_ -> Left "incompatible import type"
let MemoryInstance { lim } = ms ! memAddr
if limitMatch lim limit
then Right idx
else Left "incompatible import type"
checkImportType imp@(Import _ _ (ImportTable (TableType limit _))) = do
idx <- getImpIdx imp
tableAddr <- case idx of
ExternTable tableAddr -> Right tableAddr
_ -> Left "incompatible import type"
let TableInstance { lim } = ts ! tableAddr
if limitMatch lim limit
then Right idx
else Left "incompatible import type"
limitMatch :: Limit -> Limit -> Bool
limitMatch (Limit n1 m1) (Limit n2 m2) = n1 >= n2 && (isNothing m2 || fromMaybe False ((<=) <$> m1 <*> m2))
type Imports = Map.Map (TL.Text, TL.Text) ExternalValue type Imports = Map.Map (TL.Text, TL.Text) ExternalValue
@@ -374,8 +429,8 @@ getGlobalValue inst store idx =
Nothing -> error "Global index is out of range. It can happen if initializer refs non-import global." Nothing -> error "Global index is out of range. It can happen if initializer refs non-import global."
in in
case globalInstances store ! addr of case globalInstances store ! addr of
GIConst v -> return v GIConst _ v -> return v
GIMut ref -> readIORef ref GIMut _ ref -> readIORef ref
-- due the validation there can be only these instructions -- due the validation there can be only these instructions
evalConstExpr :: ModuleInstance -> Store -> [Instruction] -> IO Value evalConstExpr :: ModuleInstance -> Store -> [Instruction] -> IO Value
@@ -395,33 +450,34 @@ allocAndInitGlobals inst store globs = Vector.fromList <$> mapM allocGlob globs
runIniter = evalConstExpr inst store runIniter = evalConstExpr inst store
allocGlob :: Global -> IO GlobalInstance allocGlob :: Global -> IO GlobalInstance
allocGlob (Global (Const _) initer) = GIConst <$> runIniter initer allocGlob (Global (Const vt) initer) = GIConst vt <$> runIniter initer
allocGlob (Global (Mut _) initer) = do allocGlob (Global (Mut vt) initer) = do
val <- runIniter initer val <- runIniter initer
GIMut <$> newIORef val GIMut vt <$> newIORef val
allocTables :: [Table] -> Vector TableInstance allocTables :: [Table] -> Vector TableInstance
allocTables tables = Vector.fromList $ map allocTable tables allocTables tables = Vector.fromList $ map allocTable tables
where where
allocTable :: Table -> TableInstance allocTable :: Table -> TableInstance
allocTable (Table (TableType (Limit from to) _)) = allocTable (Table (TableType lim@(Limit from to) _)) =
TableInstance { TableInstance {
elements = Vector.fromList $ replicate (fromIntegral from) Nothing, lim,
maxLen = fromIntegral <$> to elements = Vector.fromList $ replicate (fromIntegral from) Nothing
} }
pageSize :: Int pageSize :: Int
pageSize = 64 * 1024 pageSize = 64 * 1024
allocMems :: [Memory] -> IO (Vector (IORef MemoryInstance)) allocMems :: [Memory] -> IO (Vector MemoryInstance)
allocMems mems = Vector.fromList <$> mapM allocMem mems allocMems mems = Vector.fromList <$> mapM allocMem mems
where where
allocMem :: Memory -> IO (IORef MemoryInstance) allocMem :: Memory -> IO MemoryInstance
allocMem (Memory (Limit from to)) = do allocMem (Memory lim@(Limit from to)) = do
memory <- IOVector.replicate (fromIntegral from * pageSize) 0 mem <- IOVector.replicate (fromIntegral from * pageSize) 0
newIORef MemoryInstance { memory <- newIORef mem
memory, return MemoryInstance {
maxLen = fromIntegral <$> to lim,
memory
} }
initialize :: ModuleInstance -> Module -> Store -> IO (Either String Store) initialize :: ModuleInstance -> Module -> Store -> IO (Either String Store)
@@ -446,12 +502,12 @@ initialize inst Module {elems, datas, start} store = do
let funcs = map ((funcaddrs inst !) . fromIntegral) funcIndexes let funcs = map ((funcaddrs inst !) . fromIntegral) funcIndexes
let idx = tableaddrs inst ! fromIntegral tableIndex let idx = tableaddrs inst ! fromIntegral tableIndex
let last = from + length funcs let last = from + length funcs
let TableInstance elems maxLen = tableInstances st ! idx let TableInstance lim elems = tableInstances st ! idx
let len = Vector.length elems let len = Vector.length elems
if last > len if last > len
then return $ Left "elements segment does not fit" then return $ Left "elements segment does not fit"
else do else do
let table = TableInstance (elems // zip [from..] (map Just funcs)) maxLen let table = TableInstance lim (elems // zip [from..] (map Just funcs))
return $ Right st { tableInstances = tableInstances st Vector.// [(idx, table)] } return $ Right st { tableInstances = tableInstances st Vector.// [(idx, table)] }
initData :: Either String Store -> DataSegment -> IO (Either String Store) initData :: Either String Store -> DataSegment -> IO (Either String Store)
@@ -461,7 +517,8 @@ initialize inst Module {elems, datas, start} store = do
let from = fromIntegral val let from = fromIntegral val
let idx = memaddrs inst ! fromIntegral memIndex let idx = memaddrs inst ! fromIntegral memIndex
let last = from + (fromIntegral $ LBS.length chunk) let last = from + (fromIntegral $ LBS.length chunk)
MemoryInstance mem maxLen <- readIORef $ memInstances st ! idx let MemoryInstance _ memory = memInstances st ! idx
mem <- readIORef memory
let len = IOVector.length mem let len = IOVector.length mem
if last > len if last > len
then return $ Left "data segment does not fit" then return $ Left "data segment does not fit"
@@ -611,17 +668,18 @@ eval store FunctionInstance { funcType, moduleInstance, code = Function { localT
step ctx (GetGlobal i) = do step ctx (GetGlobal i) = do
let globalInst = globalInstances store ! (globaladdrs moduleInstance ! fromIntegral i) let globalInst = globalInstances store ! (globaladdrs moduleInstance ! fromIntegral i)
val <- case globalInst of val <- case globalInst of
GIConst v -> return v GIConst _ v -> return v
GIMut ref -> readIORef ref GIMut _ ref -> readIORef ref
return $ Done ctx { stack = val : stack ctx } return $ Done ctx { stack = val : stack ctx }
step ctx@EvalCtx{ stack = (v:rest) } (SetGlobal i) = do step ctx@EvalCtx{ stack = (v:rest) } (SetGlobal i) = do
let globalInst = globalInstances store ! (globaladdrs moduleInstance ! fromIntegral i) let globalInst = globalInstances store ! (globaladdrs moduleInstance ! fromIntegral i)
case globalInst of case globalInst of
GIConst v -> error "Attempt of mutation of constant global" GIConst _ v -> error "Attempt of mutation of constant global"
GIMut ref -> writeIORef ref v GIMut _ ref -> writeIORef ref v
return $ Done ctx { stack = rest } return $ Done ctx { stack = rest }
step ctx@EvalCtx{ stack = (VI32 v:rest) } (I32Load MemArg { offset }) = do step ctx@EvalCtx{ stack = (VI32 v:rest) } (I32Load MemArg { offset }) = do
MemoryInstance { memory } <- readIORef $ memInstances store ! (memaddrs moduleInstance ! 0) let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
memory <- readIORef memoryRef
let addr = fromIntegral $ v + fromIntegral offset let addr = fromIntegral $ v + fromIntegral offset
let readByte idx = do let readByte idx = do
byte <- IOVector.read memory $ addr + idx byte <- IOVector.read memory $ addr + idx
@@ -629,7 +687,8 @@ eval store FunctionInstance { funcType, moduleInstance, code = Function { localT
val <- sum <$> mapM readByte [0..3] val <- sum <$> mapM readByte [0..3]
return $ Done ctx { stack = VI32 val : rest } return $ Done ctx { stack = VI32 val : rest }
step ctx@EvalCtx{ stack = (VI32 v:rest) } (I64Load MemArg { offset }) = do step ctx@EvalCtx{ stack = (VI32 v:rest) } (I64Load MemArg { offset }) = do
MemoryInstance { memory } <- readIORef $ memInstances store ! (memaddrs moduleInstance ! 0) let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
memory <- readIORef memoryRef
let addr = fromIntegral $ v + fromIntegral offset let addr = fromIntegral $ v + fromIntegral offset
let readByte idx = do let readByte idx = do
byte <- IOVector.read memory $ addr + idx byte <- IOVector.read memory $ addr + idx
@@ -637,7 +696,8 @@ eval store FunctionInstance { funcType, moduleInstance, code = Function { localT
val <- sum <$> mapM readByte [0..7] val <- sum <$> mapM readByte [0..7]
return $ Done ctx { stack = VI64 val : rest } return $ Done ctx { stack = VI64 val : rest }
step ctx@EvalCtx{ stack = (VI32 v:rest) } (F32Load MemArg { offset }) = do step ctx@EvalCtx{ stack = (VI32 v:rest) } (F32Load MemArg { offset }) = do
MemoryInstance { memory } <- readIORef $ memInstances store ! (memaddrs moduleInstance ! 0) let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
memory <- readIORef memoryRef
let addr = fromIntegral $ v + fromIntegral offset let addr = fromIntegral $ v + fromIntegral offset
let readByte idx = do let readByte idx = do
byte <- IOVector.read memory $ addr + idx byte <- IOVector.read memory $ addr + idx
@@ -645,7 +705,8 @@ eval store FunctionInstance { funcType, moduleInstance, code = Function { localT
val <- wordToFloat . sum <$> mapM readByte [0..3] val <- wordToFloat . sum <$> mapM readByte [0..3]
return $ Done ctx { stack = VF32 val : rest } return $ Done ctx { stack = VF32 val : rest }
step ctx@EvalCtx{ stack = (VI32 v:rest) } (F64Load MemArg { offset }) = do step ctx@EvalCtx{ stack = (VI32 v:rest) } (F64Load MemArg { offset }) = do
MemoryInstance { memory } <- readIORef $ memInstances store ! (memaddrs moduleInstance ! 0) let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
memory <- readIORef memoryRef
let addr = fromIntegral $ v + fromIntegral offset let addr = fromIntegral $ v + fromIntegral offset
let readByte idx = do let readByte idx = do
byte <- IOVector.read memory $ addr + idx byte <- IOVector.read memory $ addr + idx
@@ -653,18 +714,21 @@ eval store FunctionInstance { funcType, moduleInstance, code = Function { localT
val <- wordToDouble . sum <$> mapM readByte [0..7] val <- wordToDouble . sum <$> mapM readByte [0..7]
return $ Done ctx { stack = VF64 val : rest } return $ Done ctx { stack = VF64 val : rest }
step ctx@EvalCtx{ stack = (VI32 v:rest) } (I32Load8U MemArg { offset }) = do step ctx@EvalCtx{ stack = (VI32 v:rest) } (I32Load8U MemArg { offset }) = do
MemoryInstance { memory } <- readIORef $ memInstances store ! (memaddrs moduleInstance ! 0) let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
memory <- readIORef memoryRef
let addr = fromIntegral $ v + fromIntegral offset let addr = fromIntegral $ v + fromIntegral offset
byte <- IOVector.read memory addr byte <- IOVector.read memory addr
return $ Done ctx { stack = VI32 (fromIntegral byte) : rest } return $ Done ctx { stack = VI32 (fromIntegral byte) : rest }
step ctx@EvalCtx{ stack = (VI32 v:rest) } (I32Load8S MemArg { offset }) = do step ctx@EvalCtx{ stack = (VI32 v:rest) } (I32Load8S MemArg { offset }) = do
MemoryInstance { memory } <- readIORef $ memInstances store ! (memaddrs moduleInstance ! 0) let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
memory <- readIORef memoryRef
let addr = fromIntegral $ v + fromIntegral offset let addr = fromIntegral $ v + fromIntegral offset
byte <- IOVector.read memory addr byte <- IOVector.read memory addr
let val = asWord32 $ if byte >= 128 then -1 * fromIntegral (0xFF - byte + 1) else fromIntegral byte let val = asWord32 $ if byte >= 128 then -1 * fromIntegral (0xFF - byte + 1) else fromIntegral byte
return $ Done ctx { stack = VI32 val : rest } return $ Done ctx { stack = VI32 val : rest }
step ctx@EvalCtx{ stack = (VI32 v:rest) } (I32Load16U MemArg { offset }) = do step ctx@EvalCtx{ stack = (VI32 v:rest) } (I32Load16U MemArg { offset }) = do
MemoryInstance { memory } <- readIORef $ memInstances store ! (memaddrs moduleInstance ! 0) let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
memory <- readIORef memoryRef
let addr = fromIntegral $ v + fromIntegral offset let addr = fromIntegral $ v + fromIntegral offset
let readByte idx = do let readByte idx = do
byte <- IOVector.read memory $ addr + idx byte <- IOVector.read memory $ addr + idx
@@ -672,7 +736,8 @@ eval store FunctionInstance { funcType, moduleInstance, code = Function { localT
val <- sum <$> mapM readByte [0..1] val <- sum <$> mapM readByte [0..1]
return $ Done ctx { stack = VI32 val : rest } return $ Done ctx { stack = VI32 val : rest }
step ctx@EvalCtx{ stack = (VI32 v:rest) } (I32Load16S MemArg { offset }) = do step ctx@EvalCtx{ stack = (VI32 v:rest) } (I32Load16S MemArg { offset }) = do
MemoryInstance { memory } <- readIORef $ memInstances store ! (memaddrs moduleInstance ! 0) let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
memory <- readIORef memoryRef
let addr = fromIntegral $ v + fromIntegral offset let addr = fromIntegral $ v + fromIntegral offset
let readByte idx = do let readByte idx = do
byte <- IOVector.read memory $ addr + idx byte <- IOVector.read memory $ addr + idx
@@ -681,18 +746,21 @@ eval store FunctionInstance { funcType, moduleInstance, code = Function { localT
let signed = asWord32 $ if val >= 2 ^ 15 then -1 * fromIntegral (0xFFFF - val + 1) else fromIntegral val let signed = asWord32 $ if val >= 2 ^ 15 then -1 * fromIntegral (0xFFFF - val + 1) else fromIntegral val
return $ Done ctx { stack = VI32 signed : rest } return $ Done ctx { stack = VI32 signed : rest }
step ctx@EvalCtx{ stack = (VI32 v:rest) } (I64Load8U MemArg { offset }) = do step ctx@EvalCtx{ stack = (VI32 v:rest) } (I64Load8U MemArg { offset }) = do
MemoryInstance { memory } <- readIORef $ memInstances store ! (memaddrs moduleInstance ! 0) let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
memory <- readIORef memoryRef
let addr = fromIntegral $ v + fromIntegral offset let addr = fromIntegral $ v + fromIntegral offset
byte <- IOVector.read memory addr byte <- IOVector.read memory addr
return $ Done ctx { stack = VI64 (fromIntegral byte) : rest } return $ Done ctx { stack = VI64 (fromIntegral byte) : rest }
step ctx@EvalCtx{ stack = (VI32 v:rest) } (I64Load8S MemArg { offset }) = do step ctx@EvalCtx{ stack = (VI32 v:rest) } (I64Load8S MemArg { offset }) = do
MemoryInstance { memory } <- readIORef $ memInstances store ! (memaddrs moduleInstance ! 0) let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
memory <- readIORef memoryRef
let addr = fromIntegral $ v + fromIntegral offset let addr = fromIntegral $ v + fromIntegral offset
byte <- IOVector.read memory addr byte <- IOVector.read memory addr
let val = asWord64 $ if byte >= 128 then -1 * fromIntegral (0xFF - byte + 1) else fromIntegral byte let val = asWord64 $ if byte >= 128 then -1 * fromIntegral (0xFF - byte + 1) else fromIntegral byte
return $ Done ctx { stack = VI64 val : rest } return $ Done ctx { stack = VI64 val : rest }
step ctx@EvalCtx{ stack = (VI32 v:rest) } (I64Load16U MemArg { offset }) = do step ctx@EvalCtx{ stack = (VI32 v:rest) } (I64Load16U MemArg { offset }) = do
MemoryInstance { memory } <- readIORef $ memInstances store ! (memaddrs moduleInstance ! 0) let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
memory <- readIORef memoryRef
let addr = fromIntegral $ v + fromIntegral offset let addr = fromIntegral $ v + fromIntegral offset
let readByte idx = do let readByte idx = do
byte <- IOVector.read memory $ addr + idx byte <- IOVector.read memory $ addr + idx
@@ -700,7 +768,8 @@ eval store FunctionInstance { funcType, moduleInstance, code = Function { localT
val <- sum <$> mapM readByte [0..1] val <- sum <$> mapM readByte [0..1]
return $ Done ctx { stack = VI64 val : rest } return $ Done ctx { stack = VI64 val : rest }
step ctx@EvalCtx{ stack = (VI32 v:rest) } (I64Load16S MemArg { offset }) = do step ctx@EvalCtx{ stack = (VI32 v:rest) } (I64Load16S MemArg { offset }) = do
MemoryInstance { memory } <- readIORef $ memInstances store ! (memaddrs moduleInstance ! 0) let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
memory <- readIORef memoryRef
let addr = fromIntegral $ v + fromIntegral offset let addr = fromIntegral $ v + fromIntegral offset
let readByte idx = do let readByte idx = do
byte <- IOVector.read memory $ addr + idx byte <- IOVector.read memory $ addr + idx
@@ -709,7 +778,8 @@ eval store FunctionInstance { funcType, moduleInstance, code = Function { localT
let signed = asWord64 $ if val >= 2 ^ 15 then -1 * fromIntegral (0xFFFF - val + 1) else fromIntegral val let signed = asWord64 $ if val >= 2 ^ 15 then -1 * fromIntegral (0xFFFF - val + 1) else fromIntegral val
return $ Done ctx { stack = VI64 signed : rest } return $ Done ctx { stack = VI64 signed : rest }
step ctx@EvalCtx{ stack = (VI32 v:rest) } (I64Load32U MemArg { offset }) = do step ctx@EvalCtx{ stack = (VI32 v:rest) } (I64Load32U MemArg { offset }) = do
MemoryInstance { memory } <- readIORef $ memInstances store ! (memaddrs moduleInstance ! 0) let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
memory <- readIORef memoryRef
let addr = fromIntegral $ v + fromIntegral offset let addr = fromIntegral $ v + fromIntegral offset
let readByte idx = do let readByte idx = do
byte <- IOVector.read memory $ addr + idx byte <- IOVector.read memory $ addr + idx
@@ -717,7 +787,8 @@ eval store FunctionInstance { funcType, moduleInstance, code = Function { localT
val <- sum <$> mapM readByte [0..3] val <- sum <$> mapM readByte [0..3]
return $ Done ctx { stack = VI64 val : rest } return $ Done ctx { stack = VI64 val : rest }
step ctx@EvalCtx{ stack = (VI32 v:rest) } (I64Load32S MemArg { offset }) = do step ctx@EvalCtx{ stack = (VI32 v:rest) } (I64Load32S MemArg { offset }) = do
MemoryInstance { memory } <- readIORef $ memInstances store ! (memaddrs moduleInstance ! 0) let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
memory <- readIORef memoryRef
let addr = fromIntegral $ v + fromIntegral offset let addr = fromIntegral $ v + fromIntegral offset
let readByte idx = do let readByte idx = do
byte <- IOVector.read memory $ addr + idx byte <- IOVector.read memory $ addr + idx
@@ -726,7 +797,8 @@ eval store FunctionInstance { funcType, moduleInstance, code = Function { localT
let signed = asWord64 $ fromIntegral $ asInt32 val let signed = asWord64 $ fromIntegral $ asInt32 val
return $ Done ctx { stack = VI64 signed : rest } return $ Done ctx { stack = VI64 signed : rest }
step ctx@EvalCtx{ stack = (VI32 v:VI32 va:rest) } (I32Store MemArg { offset }) = do step ctx@EvalCtx{ stack = (VI32 v:VI32 va:rest) } (I32Store MemArg { offset }) = do
MemoryInstance { memory } <- readIORef $ memInstances store ! (memaddrs moduleInstance ! 0) let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
memory <- readIORef memoryRef
let addr = fromIntegral $ va + fromIntegral offset let addr = fromIntegral $ va + fromIntegral offset
let writeByte idx = do let writeByte idx = do
let byte = fromIntegral $ v `shiftR` (idx * 8) .&. 0xFF let byte = fromIntegral $ v `shiftR` (idx * 8) .&. 0xFF
@@ -734,7 +806,8 @@ eval store FunctionInstance { funcType, moduleInstance, code = Function { localT
mapM_ writeByte [0..3] mapM_ writeByte [0..3]
return $ Done ctx { stack = rest } return $ Done ctx { stack = rest }
step ctx@EvalCtx{ stack = (VI64 v:VI32 va:rest) } (I64Store MemArg { offset }) = do step ctx@EvalCtx{ stack = (VI64 v:VI32 va:rest) } (I64Store MemArg { offset }) = do
MemoryInstance { memory } <- readIORef $ memInstances store ! (memaddrs moduleInstance ! 0) let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
memory <- readIORef memoryRef
let addr = fromIntegral $ va + fromIntegral offset let addr = fromIntegral $ va + fromIntegral offset
let writeByte idx = do let writeByte idx = do
let byte = fromIntegral $ v `shiftR` (idx * 8) .&. 0xFF let byte = fromIntegral $ v `shiftR` (idx * 8) .&. 0xFF
@@ -742,7 +815,8 @@ eval store FunctionInstance { funcType, moduleInstance, code = Function { localT
mapM_ writeByte [0..7] mapM_ writeByte [0..7]
return $ Done ctx { stack = rest } return $ Done ctx { stack = rest }
step ctx@EvalCtx{ stack = (VF32 f:VI32 va:rest) } (F32Store MemArg { offset }) = do step ctx@EvalCtx{ stack = (VF32 f:VI32 va:rest) } (F32Store MemArg { offset }) = do
MemoryInstance { memory } <- readIORef $ memInstances store ! (memaddrs moduleInstance ! 0) let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
memory <- readIORef memoryRef
let addr = fromIntegral $ va + fromIntegral offset let addr = fromIntegral $ va + fromIntegral offset
let v = floatToWord f let v = floatToWord f
let writeByte idx = do let writeByte idx = do
@@ -751,7 +825,8 @@ eval store FunctionInstance { funcType, moduleInstance, code = Function { localT
mapM_ writeByte [0..3] mapM_ writeByte [0..3]
return $ Done ctx { stack = rest } return $ Done ctx { stack = rest }
step ctx@EvalCtx{ stack = (VF64 f:VI32 va:rest) } (F64Store MemArg { offset }) = do step ctx@EvalCtx{ stack = (VF64 f:VI32 va:rest) } (F64Store MemArg { offset }) = do
MemoryInstance { memory } <- readIORef $ memInstances store ! (memaddrs moduleInstance ! 0) let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
memory <- readIORef memoryRef
let addr = fromIntegral $ va + fromIntegral offset let addr = fromIntegral $ va + fromIntegral offset
let v = doubleToWord f let v = doubleToWord f
let writeByte idx = do let writeByte idx = do
@@ -760,7 +835,8 @@ eval store FunctionInstance { funcType, moduleInstance, code = Function { localT
mapM_ writeByte [0..7] mapM_ writeByte [0..7]
return $ Done ctx { stack = rest } return $ Done ctx { stack = rest }
step ctx@EvalCtx{ stack = (VI32 v:VI32 va:rest) } (I32Store8 MemArg { offset }) = do step ctx@EvalCtx{ stack = (VI32 v:VI32 va:rest) } (I32Store8 MemArg { offset }) = do
MemoryInstance { memory } <- readIORef $ memInstances store ! (memaddrs moduleInstance ! 0) let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
memory <- readIORef memoryRef
let addr = fromIntegral $ va + fromIntegral offset let addr = fromIntegral $ va + fromIntegral offset
let writeByte idx = do let writeByte idx = do
let byte = fromIntegral $ v `shiftR` (idx * 8) .&. 0xFF let byte = fromIntegral $ v `shiftR` (idx * 8) .&. 0xFF
@@ -768,7 +844,8 @@ eval store FunctionInstance { funcType, moduleInstance, code = Function { localT
mapM_ writeByte [0] mapM_ writeByte [0]
return $ Done ctx { stack = rest } return $ Done ctx { stack = rest }
step ctx@EvalCtx{ stack = (VI32 v:VI32 va:rest) } (I32Store16 MemArg { offset }) = do step ctx@EvalCtx{ stack = (VI32 v:VI32 va:rest) } (I32Store16 MemArg { offset }) = do
MemoryInstance { memory } <- readIORef $ memInstances store ! (memaddrs moduleInstance ! 0) let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
memory <- readIORef memoryRef
let addr = fromIntegral $ va + fromIntegral offset let addr = fromIntegral $ va + fromIntegral offset
let writeByte idx = do let writeByte idx = do
let byte = fromIntegral $ v `shiftR` (idx * 8) .&. 0xFF let byte = fromIntegral $ v `shiftR` (idx * 8) .&. 0xFF
@@ -776,7 +853,8 @@ eval store FunctionInstance { funcType, moduleInstance, code = Function { localT
mapM_ writeByte [0, 1] mapM_ writeByte [0, 1]
return $ Done ctx { stack = rest } return $ Done ctx { stack = rest }
step ctx@EvalCtx{ stack = (VI64 v:VI32 va:rest) } (I64Store8 MemArg { offset }) = do step ctx@EvalCtx{ stack = (VI64 v:VI32 va:rest) } (I64Store8 MemArg { offset }) = do
MemoryInstance { memory } <- readIORef $ memInstances store ! (memaddrs moduleInstance ! 0) let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
memory <- readIORef memoryRef
let addr = fromIntegral $ va + fromIntegral offset let addr = fromIntegral $ va + fromIntegral offset
let writeByte idx = do let writeByte idx = do
let byte = fromIntegral $ v `shiftR` (idx * 8) .&. 0xFF let byte = fromIntegral $ v `shiftR` (idx * 8) .&. 0xFF
@@ -784,7 +862,8 @@ eval store FunctionInstance { funcType, moduleInstance, code = Function { localT
mapM_ writeByte [0] mapM_ writeByte [0]
return $ Done ctx { stack = rest } return $ Done ctx { stack = rest }
step ctx@EvalCtx{ stack = (VI64 v:VI32 va:rest) } (I64Store16 MemArg { offset }) = do step ctx@EvalCtx{ stack = (VI64 v:VI32 va:rest) } (I64Store16 MemArg { offset }) = do
MemoryInstance { memory } <- readIORef $ memInstances store ! (memaddrs moduleInstance ! 0) let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
memory <- readIORef memoryRef
let addr = fromIntegral $ va + fromIntegral offset let addr = fromIntegral $ va + fromIntegral offset
let writeByte idx = do let writeByte idx = do
let byte = fromIntegral $ v `shiftR` (idx * 8) .&. 0xFF let byte = fromIntegral $ v `shiftR` (idx * 8) .&. 0xFF
@@ -792,7 +871,8 @@ eval store FunctionInstance { funcType, moduleInstance, code = Function { localT
mapM_ writeByte [0, 1] mapM_ writeByte [0, 1]
return $ Done ctx { stack = rest } return $ Done ctx { stack = rest }
step ctx@EvalCtx{ stack = (VI64 v:VI32 va:rest) } (I64Store32 MemArg { offset }) = do step ctx@EvalCtx{ stack = (VI64 v:VI32 va:rest) } (I64Store32 MemArg { offset }) = do
MemoryInstance { memory } <- readIORef $ memInstances store ! (memaddrs moduleInstance ! 0) let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
memory <- readIORef memoryRef
let addr = fromIntegral $ va + fromIntegral offset let addr = fromIntegral $ va + fromIntegral offset
let writeByte idx = do let writeByte idx = do
let byte = fromIntegral $ v `shiftR` (idx * 8) .&. 0xFF let byte = fromIntegral $ v `shiftR` (idx * 8) .&. 0xFF
@@ -800,19 +880,20 @@ eval store FunctionInstance { funcType, moduleInstance, code = Function { localT
mapM_ writeByte [0..3] mapM_ writeByte [0..3]
return $ Done ctx { stack = rest } return $ Done ctx { stack = rest }
step ctx@EvalCtx{ stack = st } CurrentMemory = do step ctx@EvalCtx{ stack = st } CurrentMemory = do
MemoryInstance { memory } <- readIORef $ memInstances store ! (memaddrs moduleInstance ! 0) let MemoryInstance { memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
memory <- readIORef memoryRef
let size = fromIntegral $ IOVector.length memory `div` pageSize let size = fromIntegral $ IOVector.length memory `div` pageSize
return $ Done ctx { stack = VI32 size : st } return $ Done ctx { stack = VI32 size : st }
step ctx@EvalCtx{ stack = (VI32 n:rest) } GrowMemory = do step ctx@EvalCtx{ stack = (VI32 n:rest) } GrowMemory = do
let ref = memInstances store ! (memaddrs moduleInstance ! 0) let MemoryInstance { lim = limit@(Limit _ maxLen), memory = memoryRef } = memInstances store ! (memaddrs moduleInstance ! 0)
MemoryInstance { memory, maxLen } <- readIORef ref memory <- readIORef memoryRef
let size = fromIntegral $ IOVector.length memory `quot` pageSize let size = fromIntegral $ IOVector.length memory `quot` pageSize
let growTo = size + fromIntegral n let growTo = size + fromIntegral n
result <- ( result <- (
if fromMaybe True ((growTo <=) <$> maxLen) && growTo <= 0xFFFF if fromMaybe True ((growTo <=) . fromIntegral <$> maxLen) && growTo <= 0xFFFF
then do then do
mem' <- IOVector.grow memory $ fromIntegral n * pageSize mem' <- IOVector.grow memory $ fromIntegral n * pageSize
writeIORef ref $ MemoryInstance mem' maxLen writeIORef memoryRef mem'
return size return size
else return $ -1 else return $ -1
) )
@@ -1085,6 +1166,6 @@ getGlobalValueByName store ModuleInstance { exports } name =
Just (ExportInstance _ (ExternGlobal addr)) -> Just (ExportInstance _ (ExternGlobal addr)) ->
let globalInst = globalInstances store ! addr in let globalInst = globalInstances store ! addr in
case globalInst of case globalInst of
GIConst v -> return v GIConst _ v -> return v
GIMut ref -> readIORef ref GIMut _ ref -> readIORef ref
_ -> error $ "Function with name " ++ show name ++ " was not found in module's exports" _ -> error $ "Function with name " ++ show name ++ " was not found in module's exports"