-
Notifications
You must be signed in to change notification settings - Fork 1
/
Main.hs
88 lines (77 loc) · 2.74 KB
/
Main.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
module Main where
import Control.Monad (mzero, when)
import Control.Monad.Freer
import Control.Monad.Freer.Reader (runReader)
import Control.Monad.IO.Class (MonadIO (..))
import Control.Monad.Trans.Maybe
import Data.BitVector (BV, bitVec)
import Data.IORef (newIORef)
import Data.Int
import Data.Word
import LibRISCV
import LibRISCV.CmdLine
import LibRISCV.Effects.Decoding.Default.Interpreter
import LibRISCV.Effects.Expressions.Default.Interpreter
import qualified LibRISCV.Effects.Expressions.Expr as E
import LibRISCV.Effects.Logging.Default.Interpreter
import LibRISCV.Effects.Operations.Default.Interpreter
import LibRISCV.Effects.Operations.Default.Machine.Memory (storeByteString)
import qualified LibRISCV.Effects.Operations.Default.Machine.Register as REG
import LibRISCV.Effects.Operations.Language
import LibRISCV.Loader
import LibRISCV.Semantics (buildAST, readRegister)
import Numeric
import Options.Applicative
import System.Environment ()
import System.Exit
-- Syscall number for the newlib exit syscall (used by riscv-tests).
sys_exit :: Int32
sys_exit = 93
-- The riscv-tests repository uses a special ecall to communicate test
-- failures to the execution environment. This function implements the
-- ECALL instruction accordingly.
ecallHandler :: ArchState -> Operations BV ~> IO
ecallHandler env = \case
Ecall pc -> do
sys <- liftIO $ REG.readRegister (getReg env) A7
arg <- liftIO $ REG.readRegister (getReg env) A0
when (sys /= sys_exit) $
fail "unknown syscall"
liftIO $
if arg == 0
then exitSuccess
else exitWith (ExitFailure $ fromIntegral arg)
x -> defaultInstructions env x
main' :: BasicArgs -> IO ()
main' (BasicArgs memAddr memSize trace putReg fp) = do
state <- mkArchState memAddr memSize
elf <- readElf fp
loadElf elf $ storeByteString fromIntegral (getMem state)
entry <- startAddr elf
instRef <- newIORef (0 :: Word32)
let
evalEnv = ((== 1), evalE)
interpreter =
interpretM (ecallHandler state)
. interpretM (defaultEval evalEnv)
. interpretM (defaultDecoding @BV instRef)
. interpretM (if trace then defaultLogging else noLogging)
runM $ interpreter $ buildAST @32 (bitVec 32 entry)
when putReg $
dumpState state
main :: IO ()
main = main' =<< execParser opts
where
opts =
info
(basicArgs <**> helper)
( fullDesc
<> progDesc "Concrete execution of RV32I machine code"
)