Merge pull request #17 from X-R-G-B/vm

VM

lvtrun/app/Loader.hs

@@ -0,0 +1,31 @@
+{-
+-- EPITECH PROJECT, 2023
+-- Leviator Run
+-- File description:
+-- Loader
+-}
+
+module Loader
+(
+  loadModule
+)
+where
+
+import System.Environment (getArgs)
+import Control.Exception (throw)
+
+import Types (WasmModule)
+import IO (getFileContent)
+import Parsing.Parser (parseModule)
+import Errors (CustomException(..))
+
+getFilePath :: IO String
+getFilePath = getArgs >>= \args ->
+  case args of
+    [path] -> return path
+    _ -> throw $ UsageError "Usage: ./run <file.wasm>"
+
+loadModule :: IO WasmModule
+loadModule = getFilePath >>= \filePath ->
+  getFileContent filePath >>= \bytes ->
+    return $ parseModule bytes

lvtrun/app/Main.hs

@@ -7,7 +7,14 @@
 
 module Main (main) where
 
-import Lib
+import Control.Exception (try)
+
+import Loader (loadModule)
+import Errors (handleException)
+import Run.Start (startExecution)
 
 main :: IO ()
-main = someFunc
+main = try (startExecution =<< loadModule) >>= \result ->
+  case result of
+    Left err -> handleException err
+    Right _ -> return ()

lvtrun/lvtrun.cabal

@@ -25,7 +25,26 @@ source-repository head
 
 library
   exposed-modules:
-      Lib
+      Errors
+      IO
+      Leb128
+      OpCodes
+      Parsing.Code
+      Parsing.Exports
+      Parsing.Functions
+      Parsing.FuncTypes
+      Parsing.Global
+      Parsing.Header
+      Parsing.Memory
+      Parsing.Parser
+      Parsing.Sections
+      Run.Functions
+      Run.Locals
+      Run.Stack
+      Run.Start
+      Run.Types
+      Run.Vm
+      Types
   other-modules:
       Paths_lvtrun
   autogen-modules:
@@ -35,11 +54,14 @@ library
   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
   build-depends:
       base >=4.7 && <5
+    , binary
+    , bytestring
   default-language: Haskell2010
 
 executable lvtrun-exe
   main-is: Main.hs
   other-modules:
+      Loader
       Paths_lvtrun
   autogen-modules:
       Paths_lvtrun
@@ -48,6 +70,8 @@ executable lvtrun-exe
   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
   build-depends:
       base >=4.7 && <5
+    , binary
+    , bytestring
     , lvtrun
   default-language: Haskell2010
 
@@ -63,5 +87,7 @@ test-suite lvtrun-test
   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
   build-depends:
       base >=4.7 && <5
+    , binary
+    , bytestring
     , lvtrun
   default-language: Haskell2010

lvtrun/package.yaml

@@ -21,6 +21,8 @@ description:         Please see the README on GitHub at <https://github.com/gith
 
 dependencies:
 - base >= 4.7 && < 5
+- bytestring
+- binary
 
 ghc-options:
 - -Wall

lvtrun/scripts/build.ps1

@@ -0,0 +1 @@
+stack build --copy-bins --local-bin-path .

lvtrun/src/Errors.hs

@@ -0,0 +1,27 @@
+{-
+-- EPITECH PROJECT, 2023
+-- Leviator Run
+-- File description:
+-- Errors
+-}
+
+module Errors
+(
+  CustomException(..),
+  handleException
+)
+where
+
+import Control.Exception (Exception(..), SomeException, displayException)
+
+data CustomException =
+    ParseError String
+    | WasmError String
+    | RuntimeError String
+    | UsageError String
+  deriving (Show, Eq)
+
+instance Exception CustomException
+
+handleException :: SomeException -> IO ()
+handleException e = putStrLn $ "Error: " ++ displayException e

lvtrun/src/IO.hs

@@ -0,0 +1,19 @@
+{-
+-- EPITECH PROJECT, 2023
+-- Leviator Run
+-- File description:
+-- IO
+-}
+
+module IO
+(
+  getFileContent
+)
+where
+
+import qualified Data.ByteString.Lazy as BSL (readFile)
+
+import Types
+
+getFileContent :: String -> IO FileContent
+getFileContent path = BSL.readFile path

lvtrun/src/Leb128.hs

@@ -0,0 +1,52 @@
+{-
+-- EPITECH PROJECT, 2023
+-- Leviator Run
+-- File description:
+-- Leb128
+-}
+
+module Leb128
+(
+  getLEB128ToI64,
+  getLEB128ToI32,
+)
+where
+
+import Data.Int (Int64, Int32)
+import Data.Binary.Get (Get, getWord8, runGet)
+import Data.Bits ((.&.), (.|.), shiftL, testBit)
+import qualified Data.ByteString.Lazy as BS (ByteString, drop)
+
+--------------------- TO INT64 ---------------------
+
+getLEB128ToI64' :: Get (Int64, Int64)
+getLEB128ToI64' = do
+  byte <- getWord8
+  let value = fromIntegral (byte .&. 0x7F)
+  case byte `testBit` 7 of
+    True -> do
+      (next, size) <- getLEB128ToI64'
+      return (value .|. (next `shiftL` 7), size + 1)
+    False -> return (value, 1)
+
+getLEB128ToI64 :: BS.ByteString -> (Int64, BS.ByteString)
+getLEB128ToI64 bytes = (value, BS.drop size bytes)
+  where
+    (value, size) = runGet getLEB128ToI64' bytes
+
+--------------------- TO INT32 ---------------------
+
+getLEB128ToI32' :: Get (Int32, Int64)
+getLEB128ToI32' = do
+  byte <- getWord8
+  let value = fromIntegral (byte .&. 0x7F)
+  case byte `testBit` 7 of
+    True -> do
+      (next, size) <- getLEB128ToI32'
+      return (value .|. (next `shiftL` 7), size + 1)
+    False -> return (value, 1)
+
+getLEB128ToI32 :: BS.ByteString -> (Int32, BS.ByteString)
+getLEB128ToI32 bytes = (value, BS.drop size bytes)
+  where
+    (value, size) = runGet getLEB128ToI32' bytes

lvtrun/src/OpCodes.hs

@@ -0,0 +1,130 @@
+{-
+-- EPITECH PROJECT, 2023
+-- Leviator Run
+-- File description:
+-- OpCodes
+-}
+
+module OpCodes
+(
+  extractOpCode,
+  createInstruction
+)
+where
+
+import Data.Word (Word8)
+import Control.Exception (throw)
+import qualified Data.ByteString.Lazy as BSL
+
+import Errors (CustomException(..))
+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)
+extractOpCode' (0x0d:rest) = ([0x0d], BSL.pack rest)
+extractOpCode' (0x0c:rest) = ([0x0c], BSL.pack rest)
+extractOpCode' (0x02:rest) = ([0x02], BSL.pack rest)
+extractOpCode' (0x01:rest) = ([0x01], BSL.pack rest)
+extractOpCode' (0x0f:rest) = ([0x0f], BSL.pack rest)
+extractOpCode' (0x10:rest) = ([0x10], BSL.pack rest)
+extractOpCode' (0x41:rest) = ([0x41], BSL.pack rest)
+extractOpCode' (0x42:rest) = ([0x42], BSL.pack rest)
+extractOpCode' (0x6c:rest) = ([0x6c], BSL.pack rest)
+extractOpCode' (0x6d:rest) = ([0x6d], BSL.pack rest)
+extractOpCode' (0x43:rest) = ([0x43], BSL.pack rest)
+extractOpCode' (0x44:rest) = ([0x44], BSL.pack rest)
+extractOpCode' (0x28:rest) = ([0x28], BSL.pack rest)
+extractOpCode' (0x29:rest) = ([0x29], BSL.pack rest)
+extractOpCode' (0x22:rest) = ([0x22], BSL.pack rest)
+extractOpCode' (0x36:rest) = ([0x36], BSL.pack rest)
+extractOpCode' (0x37:rest) = ([0x37], BSL.pack rest)
+extractOpCode' (0x4b:rest) = ([0x4b], BSL.pack rest)
+extractOpCode' (0x20:rest) = ([0x20], BSL.pack rest)
+extractOpCode' (0x4d:rest) = ([0x4d], BSL.pack rest)
+extractOpCode' (0x21:rest) = ([0x21], BSL.pack rest)
+extractOpCode' (0x23:rest) = ([0x23], BSL.pack rest)
+extractOpCode' (0x24:rest) = ([0x24], BSL.pack rest)
+extractOpCode' (0x6a:rest) = ([0x6a], BSL.pack rest)
+extractOpCode' (0x6b:rest) = ([0x6b], BSL.pack rest)
+extractOpCode' (0x45:rest) = ([0x45], BSL.pack rest)
+extractOpCode' (0x46:rest) = ([0x46], BSL.pack rest)
+extractOpCode' (0x71:rest) = ([0x71], BSL.pack rest)
+extractOpCode' (0x48:rest) = ([0x48], BSL.pack rest)
+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' (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 :: 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 [0x48] bytes = (I32Lts, bytes)
+createInstruction [0x0f] bytes = (Return, bytes)
+createInstruction [0x4b] bytes = (I32Gtu, bytes)
+createInstruction [0x6a] bytes = (I32Add, bytes)
+createInstruction [0x6c] bytes = (I32Mul, bytes)
+createInstruction [0x6d] bytes = (I32Divs, bytes)
+createInstruction [0x47] bytes = (I32Ne, bytes)
+createInstruction [0x6b] bytes = (I32Sub, bytes)
+createInstruction [0x4a] bytes = (I32Gts, bytes)
+createInstruction [0x46] bytes = (I32Eq, bytes)
+createInstruction [0x45] bytes = (I32Eqz, bytes)
+createInstruction [0x4d] bytes = (I32Leu, bytes)
+createInstruction [0x4e] bytes = (I32Ges, bytes)
+createInstruction [0x4c] bytes = (I32Les, bytes)
+createInstruction [0x71] bytes = (I32And, bytes)
+createInstruction [0x04, 0x40] bytes = (If, bytes)
+createInstruction [0x3f, 0x00] bytes = (MemorySize, bytes)
+createInstruction [0x40, 0x00] bytes = (MemoryGrow, bytes)
+createInstruction [0x0d] bytes = (\(value, rest) ->
+  (BrIf value, rest)) (getLEB128ToI32 bytes)
+createInstruction [0x0c] bytes = (\(value, rest) ->
+  (Br value, rest)) (getLEB128ToI32 bytes)
+createInstruction [0x22] bytes = (\(value, rest) ->
+  (LocalTee value, rest)) (getLEB128ToI32 bytes)
+createInstruction [0x10] bytes = (\(value, rest) ->
+  (Call value, rest)) (getLEB128ToI32 bytes)
+createInstruction [0x41] bytes = (\(value, rest) ->
+  (I32Const value, rest)) (getLEB128ToI32 bytes)
+createInstruction [0x42] bytes = (\(value, rest) ->
+  (I64Const value, rest)) (getLEB128ToI64 bytes)
+createInstruction [0x43] bytes = (\(value, rest) ->
+  (F32Const (fromIntegral value), rest)) (getLEB128ToI32 bytes)
+createInstruction [0x20] bytes = (\(value, rest) ->
+  (GetLocal value, rest)) (getLEB128ToI32 bytes)
+createInstruction [0x24] bytes = (\(value, rest) ->
+  (SetGlobal value, rest)) (getLEB128ToI32 bytes)
+createInstruction [0x23] bytes = (\(value, rest) ->
+  (GetGlobal value, rest)) (getLEB128ToI32 bytes)
+createInstruction [0x21] bytes = (\(value, rest) ->
+  (SetLocal value, rest)) (getLEB128ToI32 bytes)
+createInstruction [0x44] bytes = (\(value, rest) ->
+  (F64Const (fromIntegral value), rest)) (getLEB128ToI64 bytes)
+createInstruction [0x28] bytes = (\(align, rest) ->
+  (\(offset, rest2) -> (I32Load (MemArg offset align), rest2))
+    (getLEB128ToI32 rest)) (getLEB128ToI32 bytes)
+createInstruction [0x29] bytes = (\(align, rest) ->
+  (\(offset, rest2) -> (I64Load (MemArg offset align), rest2))
+    (getLEB128ToI32 rest)) (getLEB128ToI32 bytes)
+createInstruction [0x36] bytes = (\(align, rest) ->
+  (\(offset, rest2) -> (I32Store (MemArg offset align), rest2))
+    (getLEB128ToI32 rest)) (getLEB128ToI32 bytes)
+createInstruction [0x37] bytes = (\(align, rest) ->
+  (\(offset, rest2) -> (I64Store (MemArg offset align), rest2))
+    (getLEB128ToI32 rest)) (getLEB128ToI32 bytes)
+createInstruction _ _ = throw $ WasmError "createInstruction: bad instruction"