diff --git a/lvtrun/README.md b/lvtrun/README.md index 66f147e..cb22056 100644 --- a/lvtrun/README.md +++ b/lvtrun/README.md @@ -32,17 +32,21 @@ # ----------------------- 2 ----------------------- -02 +02 24 # 02 is the id of the import section -24 01 16 77 -61 73 69 5f -73 6e 61 70 -73 68 6f 74 -5f 70 72 65 -76 69 65 77 -31 09 70 72 -6f 63 5f 65 -78 69 74 00 +# 1 vector +01 +# name is 16hex = 22dec bytes long +16 +# name = "wasi_snapshot_preview1" +77 61 73 69 5f 73 6e 61 70 73 68 6f 74 5f 70 72 65 76 69 65 77 31 +# name is 09 +09 +# name = "proct_exit" +70 72 6f 63 5f 65 78 69 74 +# 00 = func = function +00 +# 00 = typeidx = 0 02 # ----------------------- 3 ----------------------- diff --git a/lvtrun/src/OpCodes.hs b/lvtrun/src/OpCodes.hs index a8788da..9c2030c 100644 --- a/lvtrun/src/OpCodes.hs +++ b/lvtrun/src/OpCodes.hs @@ -21,7 +21,6 @@ import Leb128 (getLEB128ToI32, getLEB128ToI64) import Types (Instruction(..), MemArg(..), BlockType(..)) extractOpCode' :: [Word8] -> ([Word8], BSL.ByteString) -extractOpCode' (0x03:rest) = ([0x03], BSL.pack rest) extractOpCode' (0x11:rest) = ([0x11], BSL.pack rest) extractOpCode' (0x00:rest) = ([0x00], BSL.pack rest) extractOpCode' (0x0b:rest) = ([0x0b], BSL.pack rest) @@ -58,21 +57,23 @@ extractOpCode' (0x4a:rest) = ([0x4a], BSL.pack rest) extractOpCode' (0x4c:rest) = ([0x4c], BSL.pack rest) extractOpCode' (0x4e:rest) = ([0x4e], BSL.pack rest) extractOpCode' (0x47:rest) = ([0x47], BSL.pack rest) +extractOpCode' (0x05:rest) = ([0x05], BSL.pack rest) extractOpCode' (0x3f:0x00:rest) = ([0x3f, 0x00], BSL.pack rest) extractOpCode' (0x40:0x00:rest) = ([0x40, 0x00], BSL.pack rest) extractOpCode' (0x04:0x40:rest) = ([0x04, 0x40], BSL.pack rest) -extractOpCode' _ = throw $ WasmError "ExtractOpCode: bad opcode" +extractOpCode' (0x03:0x40:rest) = ([0x03, 0x40], BSL.pack rest) +extractOpCode' idx = throw $ WasmError "ExtractOpCode: bad opcode" extractOpCode :: BSL.ByteString -> ([Word8], BSL.ByteString) extractOpCode bytes = extractOpCode' (BSL.unpack bytes) createInstruction :: [Word8] -> BSL.ByteString -> (Instruction, BSL.ByteString) -createInstruction [0x03] bytes = (Nop, bytes) createInstruction [0x11] bytes = (Nop, bytes) createInstruction [0x00] bytes = (Unreachable, bytes) createInstruction [0x01] bytes = (Nop, bytes) createInstruction [0x02] bytes = (Block EmptyType, bytes) createInstruction [0x0b] bytes = (End, bytes) +createInstruction [0x05] bytes = (Else, bytes) createInstruction [0x48] bytes = (I32Lts, bytes) createInstruction [0x0f] bytes = (Return, bytes) createInstruction [0x4b] bytes = (I32Gtu, bytes) @@ -89,6 +90,7 @@ createInstruction [0x4e] bytes = (I32Ges, bytes) createInstruction [0x4c] bytes = (I32Les, bytes) createInstruction [0x71] bytes = (I32And, bytes) createInstruction [0x04, 0x40] bytes = (If, bytes) +createInstruction [0x03, 0x40] bytes = (Loop, bytes) createInstruction [0x3f, 0x00] bytes = (MemorySize, bytes) createInstruction [0x40, 0x00] bytes = (MemoryGrow, bytes) createInstruction [0x0d] bytes = (\(value, rest) -> diff --git a/lvtrun/src/Run/Functions.hs b/lvtrun/src/Run/Functions.hs index 293a968..b85f113 100644 --- a/lvtrun/src/Run/Functions.hs +++ b/lvtrun/src/Run/Functions.hs @@ -21,16 +21,16 @@ import Errors (CustomException(..)) import Types (Export(..), ExportDesc(..), Function(..), FuncType(..)) getStartFunctionId :: [Export] -> Int32 -getStartFunctionId [] = throw $ WasmError "No start function" +getStartFunctionId [] = throw $ RuntimeError "No start function" getStartFunctionId (x:xs) | expName x == "start" = case expDesc x of ExportFunc idx -> idx - _ -> throw $ WasmError "getStartFunctionId: bad export" + _ -> throw $ RuntimeError "getStartFunctionId: bad export" | otherwise = getStartFunctionId xs getFunctionFromId :: Int32 -> [Function] -> Function -getFunctionFromId _ [] = throw $ WasmError "getFunctionFromId: bad id" +getFunctionFromId _ [] = throw $ RuntimeError "getFunctionFromId: bad id" getFunctionFromId id (x:xs) | funcIdx x == id = x | otherwise = getFunctionFromId id xs @@ -40,7 +40,7 @@ getStartFunction exports functions = getFunctionFromId (getStartFunctionId exports) functions getFuncTypeFromId :: Int32 -> [FuncType] -> FuncType -getFuncTypeFromId _ [] = throw $ WasmError "getFuncTypeFromId: bad id" +getFuncTypeFromId _ [] = throw $ RuntimeError "getFuncTypeFromId: bad id" getFuncTypeFromId id (x:xs) | typeId x == id = x | otherwise = getFuncTypeFromId id xs diff --git a/lvtrun/src/Run/Locals.hs b/lvtrun/src/Run/Locals.hs index 4c9c30f..8ee99f0 100644 --- a/lvtrun/src/Run/Locals.hs +++ b/lvtrun/src/Run/Locals.hs @@ -25,9 +25,9 @@ import Run.Stack (Stack, stackPopN) type Locals = [Value] getLocalFromId' :: Int32 -> LocalIdx -> Locals -> Value -getLocalFromId' _ _ [] = throw $ WasmError "getLocalFromId: bad id" +getLocalFromId' _ _ [] = throw $ RuntimeError "getLocalFromId: bad id" getLocalFromId' idx idntifier (x:xs) - | idx > idntifier = throw $ WasmError "getLocalFromId: bad id" + | idx > idntifier = throw $ RuntimeError "getLocalFromId: bad id" | idx == idntifier = x | otherwise = getLocalFromId' (idx + 1) idntifier xs @@ -35,9 +35,9 @@ getLocalFromId :: Locals -> LocalIdx -> Value getLocalFromId lcals idntifier = getLocalFromId' 0 idntifier lcals setLocalWithId :: Int32 -> Locals -> Value -> LocalIdx -> Locals -setLocalWithId _ [] _ _ = throw $ WasmError "setLocalWithId: bad id" +setLocalWithId _ [] _ _ = throw $ RuntimeError "setLocalWithId: bad id" setLocalWithId idx (x:xs) value idntifier - | idx > idntifier = throw $ WasmError "setLocalWithId: bad id" + | idx > idntifier = throw $ RuntimeError "setLocalWithId: bad id" | idx == idntifier = value : xs | otherwise = x : setLocalWithId (idx + 1) xs value idntifier @@ -64,7 +64,7 @@ createLocalsParams (F32:xs) (F_32 val:xs2) = (F_32 val : createLocalsParams xs xs2) createLocalsParams (F64:xs) (F_64 val:xs2) = (F_64 val : createLocalsParams xs xs2) -createLocalsParams _ _ = throw $ WasmError "createLocalsParams: bad type" +createLocalsParams _ _ = throw $ RuntimeError "createLocalsParams: bad type" initLocalsParams' :: (Locals, Stack) -> [TypeName] -> (Locals, Stack) initLocalsParams' ([], newStack) _ = ([], newStack) @@ -74,7 +74,7 @@ initLocalsParams' (values, newStack) prms = initLocalsParams :: [TypeName] -> Stack -> (Locals, Stack) initLocalsParams [] stack = ([], stack) initLocalsParams prms stack - | length prms > length stack = throw $ WasmError "initLocalsParam: bad nb" + | length prms > length stack = throw $ RuntimeError "initLocalsParam: bad nb" | otherwise = initLocalsParams' (stackPopN stack (length prms)) prms initLocals :: [Local] -> [TypeName] -> Stack -> (Locals, Stack) diff --git a/lvtrun/src/Run/Types.hs b/lvtrun/src/Run/Types.hs index e3f8de6..737efb7 100644 --- a/lvtrun/src/Run/Types.hs +++ b/lvtrun/src/Run/Types.hs @@ -13,22 +13,29 @@ module Run.Types createVm, incrementInstIdx, createEmptyExec, - decrementBlockIdx + decrementBlockIdx, + getLabelOpIdx, + addLabel, + incrementBlockIdx, + goToLabel ) where import Data.Word (Word8) +import Control.Exception (throw) import Types +import Data.Int (Int32) import Run.Stack (Stack) import Run.Locals (Locals) +import Errors (CustomException(..)) data CurrentExec = CurrentExec { ceLocals :: Locals, ceStack :: Stack, ceInstructions :: [Instruction], ceInstIdx :: Int, - ceLabels :: [Int], + ceLabels :: [Int32], ceParams :: [TypeName], ceResults :: [TypeName], crBlockIndents :: Int @@ -58,9 +65,35 @@ createVm wasmMod = VM { vmStack = [], wasmModule = wasmMod } +goToLabel :: CurrentExec -> LabelIdx -> CurrentExec +goToLabel cEx labelIdx = + cEx {ceInstIdx = fromIntegral (getLabelOpIdx cEx labelIdx)} + +getLabelOpIdx :: CurrentExec -> LabelIdx -> Int +getLabelOpIdx cEx labelIdx + | labelIdx >= fromIntegral (length (ceLabels cEx)) = + throw $ RuntimeError "getLabelOpIdx: bad index" + | otherwise = (fromIntegral (ceLabels cEx !! fromIntegral labelIdx)) + +doesLabelExist :: [Int32] -> LabelIdx -> Bool +doesLabelExist [] _ = False +doesLabelExist (x:xs) labelIdx + | x == labelIdx = True + | otherwise = doesLabelExist xs labelIdx + +addLabel :: CurrentExec -> CurrentExec +addLabel cEx + | doesLabelExist (ceLabels cEx) labelIdx = cEx + | otherwise = cEx { ceLabels = (ceLabels cEx) ++ [labelIdx] } + where + labelIdx = fromIntegral (ceInstIdx cEx) + incrementInstIdx :: CurrentExec -> CurrentExec incrementInstIdx cEx = cEx { ceInstIdx = ceInstIdx cEx + 1 } +incrementBlockIdx :: CurrentExec -> CurrentExec +incrementBlockIdx cEx = cEx { crBlockIndents = (crBlockIndents cEx) + 1 } + decrementBlockIdx :: CurrentExec -> CurrentExec decrementBlockIdx cEx = cEx { crBlockIndents = (crBlockIndents cEx) - 1 } diff --git a/lvtrun/src/Run/Vm.hs b/lvtrun/src/Run/Vm.hs index 6bee410..3fc31d9 100644 --- a/lvtrun/src/Run/Vm.hs +++ b/lvtrun/src/Run/Vm.hs @@ -102,20 +102,83 @@ execCall vm cEx funcIdx = cEx { ceStack = newStack } currentStack = ceStack cEx res = ceResults (currentExec newVm) +doesElseExist' :: [Instruction] -> Bool +doesElseExist' [] = False +doesElseExist' (Else:_) = True +doesElseExist' (_:rest) = doesElseExist' rest + +doesElseExist :: CurrentExec -> Bool +doesElseExist cEx = doesElseExist' (drop (ceInstIdx cEx) (ceInstructions cEx)) + +getElseIndex' :: [Instruction] -> Int -> Int +getElseIndex' [] _ = throw $ RuntimeError "getElseIndex: missing else" +getElseIndex' (Else:_) idx = idx +getElseIndex' (_:rest) idx = getElseIndex' rest (idx + 1) + +getElseIndex :: CurrentExec -> Int +getElseIndex cEx = getElseIndex' (drop (ceInstIdx cEx) (ceInstructions cEx)) 0 + +executeElse :: CurrentExec -> CurrentExec +executeElse cEx@(CurrentExec {ceStack = stack}) = + case doesElseExist cEx of + False -> cEx + True -> cEx { ceInstIdx = getElseIndex cEx } + execIf :: CurrentExec -> CurrentExec execIf cEx@(CurrentExec {ceStack = stack}) = case stackTop stack of I_32 0 -> goToEndInstruction cEx - I_32 1 -> cEx { crBlockIndents = (crBlockIndents cEx) + 1 } + I_32 1 -> executeElse (addLabel (cEx { crBlockIndents = (crBlockIndents cEx) + 1 })) I_32 _ -> throw $ RuntimeError "execIf: bad if statement" _ -> throw $ RuntimeError "execIf: bad type" +execI32GtS :: CurrentExec -> CurrentExec +execI32GtS cEx@(CurrentExec {ceStack = stack}) = + case (stackPopN stack 2) of + ([I_32 val2, I_32 val1], newStack) -> case (val1 > val2) of + True -> cEx { ceStack = stackPush newStack (I_32 1) } + False -> cEx { ceStack = stackPush newStack (I_32 0) } + +execI32GeS :: CurrentExec -> CurrentExec +execI32GeS cEx@(CurrentExec {ceStack = stack}) = + case (stackPopN stack 2) of + ([I_32 val2, I_32 val1], newStack) -> case (val1 >= val2) of + True -> cEx { ceStack = stackPush newStack (I_32 1) } + False -> cEx { ceStack = stackPush newStack (I_32 0) } + +execI32LtS :: CurrentExec -> CurrentExec +execI32LtS cEx@(CurrentExec {ceStack = stack}) = + case (stackPopN stack 2) of + ([I_32 val2, I_32 val1], newStack) -> case (val1 < val2) of + True -> cEx { ceStack = stackPush newStack (I_32 1) } + False -> cEx { ceStack = stackPush newStack (I_32 0) } + +execI32LeS :: CurrentExec -> CurrentExec +execI32LeS cEx@(CurrentExec {ceStack = stack}) = + case (stackPopN stack 2) of + ([I_32 val2, I_32 val1], newStack) -> case (val1 <= val2) of + True -> cEx { ceStack = stackPush newStack (I_32 1) } + False -> cEx { ceStack = stackPush newStack (I_32 0) } + +execI32GtU :: CurrentExec -> CurrentExec +execI32GtU cEx@(CurrentExec {ceStack = stack}) = + case (stackPopN stack 2) of + ([I_32 val2, I_32 val1], newStack) -> + case ((fromIntegral val1) > (fromIntegral val2)) of + True -> cEx { ceStack = stackPush newStack (I_32 1) } + False -> cEx { ceStack = stackPush newStack (I_32 0) } + +incrementBlockIndent :: CurrentExec -> CurrentExec +incrementBlockIndent cEx = cEx { crBlockIndents = (crBlockIndents cEx) + 1 } + +execBr :: CurrentExec -> LabelIdx -> CurrentExec +execBr cEx labelIdx = goToLabel cEx labelIdx + execOpCode :: VM -> CurrentExec -> Instruction -> CurrentExec execOpCode _ cEx (Unreachable) = throw $ RuntimeError "execOpCode: unreachable" execOpCode _ cEx (End) = decrementBlockIdx cEx execOpCode _ cEx (Return) = decrementBlockIdx cEx execOpCode _ cEx (I32Const val) = execI32Const cEx val execOpCode _ cEx (I32Eqz) = execI32Eqz cEx -execOpCode _ cEx (Block _) = cEx { crBlockIndents = (crBlockIndents cEx) + 1 } execOpCode _ cEx (I32Eq) = execI32Eq cEx execOpCode _ cEx (I32Add) = execI32Add cEx execOpCode _ cEx (I32Sub) = execI32Sub cEx @@ -126,7 +189,16 @@ execOpCode _ cEx (SetLocal localIdx) = execSetLocal cEx localIdx execOpCode _ cEx (BrIf labelIdx) = execBrIf cEx execOpCode vm cEx (Call funcIdx) = execCall vm cEx funcIdx execOpCode _ cEx (If) = execIf cEx -execOpCode _ cEx _ = cEx +execOpCode _ cEx (I32Gts) = execI32GtS cEx +execOpCode _ cEx (I32Ges) = execI32GeS cEx +execOpCode _ cEx (I32Lts) = execI32LtS cEx +execOpCode _ cEx (I32Les) = execI32LeS cEx +execOpCode _ cEx (I32Gtu) = execI32GtU cEx +execOpCode _ cEx (Block _) = incrementBlockIndent (addLabel cEx) +execOpCode _ cEx (Br labelIdx) = execBr cEx labelIdx +execOpCode _ cEx (Loop) = incrementBlockIndent (addLabel cEx) +execOpCode _ cEx (Else) = throw $ RuntimeError "elseWithoutIf" +execOpCode _ cEx _ = throw $ RuntimeError "execOpCode: not implemented" execOpCodes :: VM -> [Instruction] -> CurrentExec execOpCodes vm [] = currentExec vm diff --git a/lvtrun/src/Types.hs b/lvtrun/src/Types.hs index 6807b19..121c239 100644 --- a/lvtrun/src/Types.hs +++ b/lvtrun/src/Types.hs @@ -117,10 +117,12 @@ data Instruction = | I32Leu | I32Eq | I32Lts + | Else | I32Gts | I32Les | I32Ges | I32Ne + | Loop | LocalTee LocalIdx | BrIf LabelIdx | If @@ -130,6 +132,9 @@ data Instruction = | MemorySize | MemoryGrow deriving (Eq) +--IF/ELSE +--LOOP +--BR instance Show Instruction where show Unreachable = "\n\t\t\t\tunreachable" @@ -170,6 +175,7 @@ instance Show Instruction where show (Br idx) = "\n\t\t\t\tbr " ++ (show idx) show End = "\n\t\t\t\tend" show (Block blockType) = "\n\t\t\t\tblock " ++ (show blockType) + show (Loop) = "\n\t\t\t\tloop" -- Module section diff --git a/lvtrun/test/while.wasm b/lvtrun/test/while.wasm new file mode 100644 index 0000000..6e810de Binary files /dev/null and b/lvtrun/test/while.wasm differ