add some fixes

lvtrun/app/Parsing/Code.hs

@@ -171,13 +171,13 @@ createInstruction [0x20] bytes = do
   (GetLocal value, rest)
 createInstruction [0x24] bytes = do
   let (value, rest) = extractLEB1282 bytes
-  (SetLocal value, rest)
+  (SetGlobal value, rest)
 createInstruction [0x23] bytes = do
   let (value, rest) = extractLEB1282 bytes
   (GetGlobal value, rest)
 createInstruction [0x21] bytes = do
   let (value, rest) = extractLEB1282 bytes
-  (SetGlobal value, rest)
+  (SetLocal value, rest)
 createInstruction [0x3f, 0x00] bytes = (MemorySize, bytes)
 createInstruction [0x40, 0x00] bytes = (MemoryGrow, bytes)
 createInstruction opCode _ = trace ("createInstruction: " ++ show opCode) throw $ WasmError "createInstruction: bad instruction"

lvtrun/app/Parsing/Exports.hs

@@ -17,6 +17,7 @@ import Data.Int (Int64, Int32)
 import Data.Word (Word8)
 import Numeric (showHex)
 import Data.Char (chr)
+import Control.Monad (when)
 
 import Leb128
 import Errors
@@ -48,7 +49,10 @@ parseExports idx maxIdx content
   | Bs.length content == 0 = []
   | otherwise = do
     let (nameLen, rest) = extractLEB128 content
+    when (nameLen == 0) (throw $ WasmError "parseExports: bad export")
+    when (Bs.length rest == 0) (throw $ WasmError "parseExports: bad export")
     let (name, rest2) = Bs.splitAt (fromIntegral nameLen) rest
+    when (Bs.length rest2 == 0) (throw $ WasmError "parseExports: bad export")
     let exportType = head (Bs.unpack rest2)
     let (exportValue, rest3) = extractLEB128 (Bs.drop 1 rest2)
     let export = createExport (Bs.unpack name) exportType (fromIntegral exportValue)

lvtrun/app/Parsing/Functions.hs

@@ -24,14 +24,14 @@ import Debug.Trace
 
 parseFunctionsIndex :: Int32 -> Int64 -> BSL.ByteString -> [Function]
 parseFunctionsIndex idx maxIdx content
-    | idx > (fromIntegral maxIdx) = []
-    | BSL.length content == 0 = []
-    | otherwise = do
-      let (typeIdx, rest) = extractLEB1282 content
-      Function {funcType = fromIntegral typeIdx, funcIdx = idx, body = []} : parseFunctionsIndex (idx + 1) maxIdx rest
+  | idx > (fromIntegral maxIdx) = []
+  | BSL.length content == 0 = []
+  | otherwise = do
+    let (typeIdx, rest) = extractLEB1282 content
+    Function {funcType = fromIntegral typeIdx, funcIdx = idx, body = []} : parseFunctionsIndex (idx + 1) maxIdx rest
 
 getFunctions :: Section -> [Function]
 getFunctions (Section FunctionID _ content) = do
   let (vecSize, rest) = extractLEB128 content
-  parseFunctionsIndex 1 vecSize rest
+  parseFunctionsIndex 0 vecSize rest
 getFunctions _ = throw $ WasmError "getFunctions: bad section"

lvtrun/app/Parsing/Global.hs

@@ -104,13 +104,13 @@ createInstruction [0x20] bytes = do
   (GetLocal value, rest)
 createInstruction [0x24] bytes = do
   let (value, rest) = extractLEB1282 bytes
-  (SetLocal value, rest)
+  (SetGlobal value, rest)
 createInstruction [0x23] bytes = do
   let (value, rest) = extractLEB1282 bytes
   (GetGlobal value, rest)
 createInstruction [0x21] bytes = do
   let (value, rest) = extractLEB1282 bytes
-  (SetGlobal value, rest)
+  (SetLocal value, rest)
 createInstruction [0x3f, 0x00] bytes = (MemorySize, bytes)
 createInstruction [0x40, 0x00] bytes = (MemoryGrow, bytes)
 createInstruction _ _ = throw $ WasmError "CreateInstruction: bad instruction"

lvtrun/app/Parsing/Parser.hs

@@ -32,5 +32,5 @@ parseModule bytes = do
         ((getFuncCode (getSectionWithId sections CodeID) (getFunctions (getSectionWithId sections FunctionID))))
           []
             (getMemories (getSectionWithId sections MemoryID))
-              (getGlobals (getSectionWithId sections GlobalID))
+              []
                 (getExports (getSectionWithId sections ExportID))

lvtrun/app/Run/Start.hs

@@ -22,7 +22,4 @@ import Run.Functions
 import Debug.Trace
 
 start :: WasmModule -> IO ()
-start wasmMod = do
-  print wasmMod
-  let res = startExecution (createVm wasmMod) (getStartFunctionId (exports wasmMod))
-  return ()
+start wasmMod = startExecution (createVm wasmMod) (getStartFunctionId (exports wasmMod))

lvtrun/app/Run/Vm.hs

@@ -90,6 +90,12 @@ getLocalFromId' idx id (x:xs)
 getLocalFromId :: CurrentExec -> LocalIdx -> Value
 getLocalFromId cEx id = getLocalFromId' 0 id (ceLocals cEx)
 
+setLocalWithId :: Locals -> Value -> LocalIdx -> Locals
+setLocalWithId [] _ _ = throw $ WasmError "setLocalWithId: bad id"
+setLocalWithId (x:xs) value id
+  | id == 0 = value : xs
+  | otherwise = x : setLocalWithId xs value (id - 1)
+
 -- pushResults StackToPushTo StackToPopFrom ResultTypes
 pushResults :: Stack -> Stack -> [TypeName] -> Stack
 pushResults stack1 stack2 [] = stack1
@@ -200,6 +206,10 @@ execOpCode vm cEx (Unreachable) = throw $ WasmError "execOpCode: unreachable"
 execOpCode vm cEx (GetLocal localIdx) = do
   let value = getLocalFromId cEx localIdx
   cEx { ceStack = stackPush (ceStack cEx) value }
+execOpCode vm cEx (SetLocal localIdx) = do
+  let (value, newStack) = stackPop (ceStack cEx)
+  let newLocals = setLocalWithId (ceLocals cEx) value localIdx
+  cEx { ceStack = newStack, ceLocals = newLocals }
 execOpCode vm cEx _ = cEx
 
 execOpCodes :: VM -> [Instruction] -> CurrentExec
@@ -243,7 +253,7 @@ startExecution vm funcIdx = do
   let function = getFunctionFromId funcIdx (functions (wasmModule vm))
   let funcTypee = getFuncTypeFromId (funcType function) (types (wasmModule vm))
   let cexec = CurrentExec {
-    ceLocals = [],
+    ceLocals = createEmptyLocals [] (locals function),
     ceStack = [],
     ceInstructions = body function,
     ceInstIdx = 0,