-
Notifications
You must be signed in to change notification settings - Fork 1
/
Main.hs
65 lines (58 loc) · 1.89 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
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-}
module Main where
import Control.Monad (when)
import Control.Monad.Freer
import Data.BitVector
import Data.IORef (newIORef)
import Data.Word (Word32)
import LibRISCV (RegIdx (SP), align)
import LibRISCV.CmdLine
import LibRISCV.Effects.Decoding.Default.Interpreter (
defaultDecoding,
)
import LibRISCV.Effects.Expressions.Default.Interpreter (defaultEval, evalE)
import qualified LibRISCV.Effects.Expressions.Expr as E
import LibRISCV.Effects.Logging.Default.Interpreter (
defaultLogging,
noLogging,
)
import LibRISCV.Effects.Operations.Default.Interpreter (
defaultInstructions,
dumpState,
getMem,
mkArchState,
)
import LibRISCV.Effects.Operations.Default.Machine.Memory (storeByteString)
import LibRISCV.Loader
import LibRISCV.Semantics (buildAST, writeRegister)
import Options.Applicative
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
initalSP = align (memAddr + memSize - 1)
evalEnv = ((== 1), evalE)
interpreter =
interpretM (defaultInstructions state)
. interpretM (defaultEval evalEnv)
. interpretM (defaultDecoding @BV instRef)
. interpretM (if trace then defaultLogging else noLogging)
runM $ interpreter $ do
writeRegister (bitVec 32 $ fromEnum SP) (E.FromInt 32 $ fromIntegral initalSP)
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"
)