From 7ead2c02477425f01dc52a8f1d59a26316cb2113 Mon Sep 17 00:00:00 2001 From: Kevin Quick Date: Wed, 6 Feb 2019 14:41:18 -0800 Subject: [PATCH] [refinement] Use BlockLabel and StatementLabel type aliases. Both map to Word64 but the named aliases clarify which is intended to be used where. --- base/src/Data/Macaw/CFG/Block.hs | 11 +++++++---- base/src/Data/Macaw/Discovery.hs | 27 ++++++++++++++++++-------- base/src/Data/Macaw/Discovery/State.hs | 7 +++++-- 3 files changed, 31 insertions(+), 14 deletions(-) diff --git a/base/src/Data/Macaw/CFG/Block.hs b/base/src/Data/Macaw/CFG/Block.hs index 978023af..105d4d55 100644 --- a/base/src/Data/Macaw/CFG/Block.hs +++ b/base/src/Data/Macaw/CFG/Block.hs @@ -1,5 +1,5 @@ {-| -Copyright : (c) Galois, Inc 2017 +Copyright : (c) Galois, Inc 2017-2019 Maintainer : Joe Hendrix This exports the pre-classification term statement and block data @@ -9,7 +9,7 @@ types. {-# LANGUAGE UndecidableInstances #-} module Data.Macaw.CFG.Block - ( Block(..) + ( Block(..), BlockLabel , ppBlock , TermStmt(..) ) where @@ -33,7 +33,7 @@ data TermStmt arch ids -- | Fetch and execute the next instruction from the given processor state. = FetchAndExecute !(RegState (ArchReg arch) (Value arch ids)) -- | Branch and execute one block or another. - | Branch !(Value arch ids BoolType) !Word64 !Word64 + | Branch !(Value arch ids BoolType) !BlockLabel !BlockLabel -- | The block ended prematurely due to an error in instruction -- decoding or translation. -- @@ -65,11 +65,14 @@ instance ArchConstraints arch ------------------------------------------------------------------------ -- Block +-- | The type of labels for each block +type BlockLabel = Word64 + -- | The type for code blocks returned by the disassembler. -- -- The discovery process will attempt to map each block to a suitable ParsedBlock. data Block arch ids - = Block { blockLabel :: !Word64 + = Block { blockLabel :: !BlockLabel -- ^ Index of this block , blockStmts :: !([Stmt arch ids]) -- ^ List of statements in the block. diff --git a/base/src/Data/Macaw/Discovery.hs b/base/src/Data/Macaw/Discovery.hs index 7d87b03d..8ca367c4 100644 --- a/base/src/Data/Macaw/Discovery.hs +++ b/base/src/Data/Macaw/Discovery.hs @@ -798,7 +798,7 @@ data ParseContext arch ids = -- ^ Address of function this block is being parsed as , pctxAddr :: !(ArchSegmentOff arch) -- ^ Address of the current block - , pctxBlockMap :: !(Map Word64 (Block arch ids)) + , pctxBlockMap :: !(Map BlockLabel (Block arch ids)) -- ^ Map from block indices to block code at address. } @@ -906,8 +906,8 @@ containsAssignId droppedAssign = -- | This parses a block that ended with a fetch and execute instruction. parseFetchAndExecute :: forall arch ids . ParseContext arch ids - -> Word64 - -- ^ Index of this block + -> State.StatementLabel + -- ^ Index label of this block -> RegState (ArchReg arch) (Value arch ids) -- ^ Initial register values -> Seq (Stmt arch ids) @@ -915,7 +915,12 @@ parseFetchAndExecute :: forall arch ids -- ^ Abstract state of registers prior to blocks being executed. -> RegState (ArchReg arch) (Value arch ids) -- ^ Final register values - -> State (ParseState arch ids) (StatementList arch ids, Word64) + -> State (ParseState arch ids) (StatementList arch ids, StatementLabel) + -- ^ Returns the StatementList constructed from + -- the FetchAndExecute parsing, along with the + -- next StatementLabel to assign (StatementLists + -- can be a recursive tree, e.g. with a + -- 'ParsedIte' in 'ParsedTermStatement'). parseFetchAndExecute ctx idx initRegs stmts absProcState finalRegs = do let mem = pctxMemory ctx let ainfo = pctxArchInfo ctx @@ -1080,7 +1085,8 @@ parseFetchAndExecute ctx idx initRegs stmts absProcState finalRegs = do where finishWithTailCall :: RegisterInfo (ArchReg arch) => AbsProcessorState (ArchReg arch) ids - -> State (ParseState arch ids) (StatementList arch ids, Word64) + -> State (ParseState arch ids) ( StatementList arch ids + , State.StatementLabel) finishWithTailCall absProcState' = do let mem = pctxMemory ctx mapM_ (recordWriteStmt (pctxArchInfo ctx) mem absProcState') stmts @@ -1103,7 +1109,7 @@ parseFetchAndExecute ctx idx initRegs stmts absProcState finalRegs = do -- about control flow targets of this block. parseBlock :: ParseContext arch ids -- ^ Context for parsing blocks. - -> Word64 + -> State.StatementLabel -- ^ Index for next statements -> RegState (ArchReg arch) (Value arch ids) -- ^ Initial register values @@ -1111,7 +1117,12 @@ parseBlock :: ParseContext arch ids -- ^ Block to parse -> AbsProcessorState (ArchReg arch) ids -- ^ Abstract state at start of block - -> State (ParseState arch ids) (StatementList arch ids, Word64) + -> State (ParseState arch ids) ( StatementList arch ids + , State.StatementLabel) + -- ^ Returns the StatementList constructed from the + -- parsing, along with the next StatementLabel to assign + -- (StatementLists can be a recursive tree, e.g. with a + -- 'ParsedIte' in 'ParsedTermStatement'). parseBlock ctx idx initRegs b absProcState = do let mem = pctxMemory ctx let ainfo = pctxArchInfo ctx @@ -1182,7 +1193,7 @@ addBlocks :: ArchSegmentOff arch -> RegState (ArchReg arch) (Value arch ids) -> Int -- ^ Number of blocks covered - -> Map Word64 (Block arch ids) + -> Map BlockLabel (Block arch ids) -- ^ Map from labelIndex to associated block -> FunM arch s ids () addBlocks src finfo initRegs sz blockMap = diff --git a/base/src/Data/Macaw/Discovery/State.hs b/base/src/Data/Macaw/Discovery/State.hs index 239bbb45..071ef737 100644 --- a/base/src/Data/Macaw/Discovery/State.hs +++ b/base/src/Data/Macaw/Discovery/State.hs @@ -20,7 +20,7 @@ discovery. module Data.Macaw.Discovery.State ( GlobalDataInfo(..) , ParsedTermStmt(..) - , StatementList(..) + , StatementList(..), StatementLabel , ParsedBlock(..) -- * The interpreter state , DiscoveryState @@ -228,10 +228,13 @@ instance ArchConstraints arch => Show (ParsedTermStmt arch ids) where ------------------------------------------------------------------------ -- StatementList +-- | The type of label for each StatementList +type StatementLabel = Word64 + -- | This is a code block after we have classified the control flow -- statement(s) that the block ends with. data StatementList arch ids - = StatementList { stmtsIdent :: !Word64 + = StatementList { stmtsIdent :: !StatementLabel -- ^ An index for uniquely identifying the block. -- -- This is primarily used so that we can reference