hocd 0.1.2.0 → 0.1.3.0
raw patch · 10 files changed
+355/−42 lines, 10 filesdep +attoparsecdep +containersdep +raw-strings-qq
Dependencies added: attoparsec, containers, raw-strings-qq
Files
- CHANGELOG.md +5/−0
- README.lhs +11/−2
- README.md +11/−2
- hocd.cabal +8/−2
- src/HOCD/Command.hs +100/−30
- src/HOCD/Error.hs +4/−2
- src/HOCD/Monad.hs +53/−1
- src/HOCD/Parse.hs +76/−0
- src/HOCD/Types.hs +17/−1
- test/ParseSpec.hs +70/−2
CHANGELOG.md view
@@ -1,3 +1,8 @@+# Version [0.1.3.0](https://github.com/DistRap/hocd/compare/0.1.2.0...0.1.3.0) (2024-01-18)++* Add `registers`, `readReg`, `writeReg` commands+* Add `raw` command (escape hatch)+ # Version [0.1.2.0](https://github.com/DistRap/hocd/compare/0.1.1.1...0.1.2.0) (2024-01-03) * Add execution control commands
README.lhs view
@@ -17,6 +17,7 @@ ## Example ```haskell+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} import Data.Word (Word32)@@ -28,10 +29,18 @@ -- | For STM32G474 example :: MonadOCD m- => m ([Word32], Word32)+ => m ([Word32], Word32, Word32) example = do+ -- Note that halting a target is not required+ -- for writing or reading memory, only for reading+ -- CPU registers halt' + -- Read pc CPU register+ pc <- readReg $ regName "pc"+ -- Write back same value+ writeReg @Word32 (regName "pc") pc+ -- Read RCC.CR register rccCr <- readMemCount @Word32 0x40021000 2 @@ -43,7 +52,7 @@ resume - pure (rccCr, r)+ pure (rccCr, r, pc) ``` This example is runnable from git repository using:
README.md view
@@ -17,6 +17,7 @@ ## Example ```haskell+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} import Data.Word (Word32)@@ -28,10 +29,18 @@ -- | For STM32G474 example :: MonadOCD m- => m ([Word32], Word32)+ => m ([Word32], Word32, Word32) example = do+ -- Note that halting a target is not required+ -- for writing or reading memory, only for reading+ -- CPU registers halt' + -- Read pc CPU register+ pc <- readReg $ regName "pc"+ -- Write back same value+ writeReg @Word32 (regName "pc") pc+ -- Read RCC.CR register rccCr <- readMemCount @Word32 0x40021000 2 @@ -43,7 +52,7 @@ resume - pure (rccCr, r)+ pure (rccCr, r, pc) ``` This example is runnable from git repository using:
hocd.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: hocd-version: 0.1.2.0+version: 0.1.3.0 synopsis: OpenOCD Haskell interface description: Support for OpenOCDs TCL interface homepage: https://github.com/DistRap/hocd@@ -32,15 +32,17 @@ , HOCD.Command , HOCD.Error , HOCD.Monad+ , HOCD.Parse , HOCD.Types build-depends: base >= 4.7 && < 5+ , attoparsec , bytestring+ , containers , data-default-class , exceptions , mtl , network , transformers- , text default-language: Haskell2010 executable hocd-read-mem@@ -73,7 +75,11 @@ hspec-discover:hspec-discover build-depends: base >= 4.7 && < 5 , hocd+ , attoparsec+ , bytestring+ , containers , hspec+ , raw-strings-qq default-language: Haskell2010 source-repository head
src/HOCD/Command.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-}@@ -15,24 +16,27 @@ , Capture(..) , ReadMemory(..) , WriteMemory(..)+ , Registers(..)+ , ReadRegister(..)+ , WriteRegister(..) , Version(..)+ , Raw(..) , subChar- , parseMem ) where import Data.Bits (FiniteBits(..))-import Data.Kind (Type) import Data.ByteString (ByteString)+import Data.Kind (Type)+import Data.Map (Map) import HOCD.Error (OCDError(..))-import HOCD.Types (MemAddress(..))+import HOCD.Types (MemAddress(..), RegisterInfo, RegisterName(..)) import Text.Printf (PrintfArg) import qualified Control.Monad+import qualified Data.Attoparsec.ByteString.Char8 import qualified Data.ByteString.Char8-import qualified Data.Either import qualified Data.List-import qualified Data.Text-import qualified Data.Text.Read+import qualified HOCD.Parse import qualified Text.Printf class Command req where@@ -149,30 +153,14 @@ , Integral a ) => Command (ReadMemory a) where type Reply (ReadMemory a) = [a]- reply _ r = ocdReply r >>= parseMem--parseMem- :: ( FiniteBits a- , Integral a- )- => ByteString- -> Either OCDError [a]-parseMem =- (\case- xs | any Data.Either.isLeft xs ->- Left (OCDError_ParseMemory $ Data.Either.lefts xs)- xs | otherwise ->- pure (Data.Either.rights xs)- )- . map- ( either- (Left . OCDError_CantReadHex)- (pure . fst)- . Data.Text.Read.hexadecimal- . Data.Text.pack- )- . words- . Data.ByteString.Char8.unpack+ reply _ r =+ ocdReply r+ >>= (\case+ Left e -> Left $ OCDError_ParseMemory e+ Right rs -> pure rs+ )+ . Data.Attoparsec.ByteString.Char8.parseOnly+ HOCD.Parse.parseMem data WriteMemory a = WriteMemory { writeMemoryAddr :: MemAddress@@ -207,6 +195,78 @@ type Reply (WriteMemory a) = () reply _ = ocdReply >>= pure . Control.Monad.void +data Registers = Registers++instance Show Registers where+ show = pure "reg"++instance Command Registers where+ type Reply Registers = Map RegisterName RegisterInfo+ reply _ r =+ ocdReply r+ >>= (\case+ Left e -> Left $ OCDError_ParseRegisters e+ Right rs -> pure rs+ )+ . Data.Attoparsec.ByteString.Char8.parseOnly+ HOCD.Parse.parseRegisters++data ReadRegister a = ReadRegister RegisterName++instance ( FiniteBits a+ , Num a+ ) => Show (ReadRegister a) where+ show (ReadRegister (RegisterName rn)) =+ unwords+ [ "get_reg"+ , Data.ByteString.Char8.unpack rn+ ]++instance ( FiniteBits a+ , Integral a+ ) => Command (ReadRegister a) where+ type Reply (ReadRegister a) = a+ reply (ReadRegister rn) r =+ ocdReply r+ >>= (\case+ Left e -> Left $ OCDError_ParseRegisters e+ Right rs -> pure rs+ )+ . Data.Attoparsec.ByteString.Char8.parseOnly+ (HOCD.Parse.parseGetReg rn)++data WriteRegister a = WriteRegister+ { writeRegisterName :: RegisterName+ , writeRegisterValue :: a+ }++instance ( FiniteBits a+ , Num a+ , PrintfArg a+ ) => Show (WriteRegister a) where+ show WriteRegister{..} =+ unwords+ [ "set_reg"+ , "{"+ <> Data.ByteString.Char8.unpack (unRegisterName writeRegisterName)+ <> " "+ <> Text.Printf.printf "0x%x" writeRegisterValue+ <> "}"+ ]++instance ( FiniteBits a+ , Integral a+ , PrintfArg a+ ) => Command (WriteRegister a) where+ type Reply (WriteRegister a) = ()+ reply WriteRegister{..} r =+ ocdReply r+ >>= (\case+ msg | "failed to set" `Data.ByteString.Char8.isPrefixOf` msg+ -> Left $ OCDError_FailedToSetRegister writeRegisterName+ _ -> pure ()+ )+ data Version = Version instance Show Version where@@ -214,6 +274,16 @@ instance Command Version where type Reply Version = ByteString+ reply _ = ocdReply++data Raw = Raw ByteString++instance Show Raw where+ show (Raw cmd) =+ Data.ByteString.Char8.unpack cmd++instance Command Raw where+ type Reply Raw = ByteString reply _ = ocdReply ocdReply :: ByteString -> Either OCDError ByteString
src/HOCD/Error.hs view
@@ -3,11 +3,13 @@ ) where import Data.ByteString (ByteString)+import HOCD.Types (RegisterName) data OCDError = OCDError_ReplyMissingSubOnEnd ByteString- | OCDError_CantReadHex String+ | OCDError_FailedToSetRegister RegisterName | OCDError_GetAddrInfoFailed- | OCDError_ParseMemory [OCDError]+ | OCDError_ParseMemory String+ | OCDError_ParseRegisters String | OCDError_ExpectedOneButGotMore deriving (Eq, Show)
src/HOCD/Monad.hs view
@@ -25,7 +25,11 @@ , readMemCount , writeMem , writeMem32+ , registers+ , readReg+ , writeReg , version+ , raw ) where import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)@@ -38,6 +42,7 @@ import Control.Monad.Trans.State (StateT) import Data.Bits (FiniteBits(..)) import Data.ByteString (ByteString)+import Data.Map (Map) import Data.Word (Word32) import HOCD.Command ( Command(..)@@ -49,11 +54,15 @@ , Step(..) , ReadMemory(..) , WriteMemory(..)+ , Registers(..)+ , ReadRegister(..)+ , WriteRegister(..) , Version(..)+ , Raw(..) , subChar ) import HOCD.Error (OCDError(..))-import HOCD.Types (MemAddress)+import HOCD.Types (MemAddress, RegisterInfo, RegisterName) import Network.Socket (Socket) import Text.Printf (PrintfArg) @@ -268,8 +277,51 @@ -> m () writeMem32 = writeMem @Word32 +registers+ :: MonadOCD m+ => m (Map RegisterName RegisterInfo)+registers = rpc Registers++-- | Read a CPU register+readReg+ :: forall a m+ . ( MonadOCD m+ , FiniteBits a+ , Integral a+ )+ => RegisterName -- ^ Name of the register to query+ -> m a+readReg = rpc . ReadRegister++-- | Write a CPU register+writeReg+ :: forall a m+ . ( MonadOCD m+ , FiniteBits a+ , Integral a+ , PrintfArg a+ )+ => RegisterName -- ^ Name of the register to write to+ -> a -- ^ Value to write+ -> m ()+writeReg rn x =+ rpc+ $ WriteRegister+ { writeRegisterName = rn+ , writeRegisterValue = x+ }+ -- | Query OpenOCD version version :: MonadOCD m => m ByteString version = rpc Version++-- | Send raw OpenOCD command+-- Escape hatch for commands that are not+-- part defined as part of hocd api+raw+ :: MonadOCD m+ => ByteString+ -> m ByteString+raw = rpc . Raw
+ src/HOCD/Parse.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+module HOCD.Parse+ ( parseMem+ , parseRegisters+ , parseGetReg+ ) where++import HOCD.Types (RegisterInfo(..), RegisterName(..))+import Control.Applicative (optional)+import Data.Attoparsec.ByteString.Char8+import Data.Bits (FiniteBits(..))+import Data.ByteString (ByteString)+import Data.Map (Map)++import qualified Data.Map.Strict++parseMem+ :: ( FiniteBits a+ , Integral a+ )+ => Parser [a]+parseMem = ("0x" *> hexadecimal) `sepBy1` space++parseRegisters :: Parser (Map RegisterName RegisterInfo)+parseRegisters =+ Data.Map.Strict.fromList+ . concat+ <$> many1 parseRegisterGroups++parseRegisterGroups :: Parser [(RegisterName, RegisterInfo)]+parseRegisterGroups = do+ group <- parseRegisterGroup <?> "Register group"+ endOfLine+ rgs <- parseRegister group `sepBy1` endOfLine+ endOfLine+ pure rgs++parseRegisterGroup :: Parser ByteString+parseRegisterGroup =+ ("=====" <?> "Prefix")+ *> space+ *> takeWhile1 (not . inClass "\n\r")++parseRegister+ :: ByteString+ -> Parser (RegisterName, RegisterInfo)+parseRegister group = do+ _regId <- "(" *> (decimal :: Parser Int) <* ")"+ _ <- space+ regName <- RegisterName <$> takeTill isSpace+ _ <- space+ registerInfoSize <- "(/" *> decimal <* ")"+ registerInfoValue <- optional (": 0x" *> hexadecimal)+ dirty <- optional " (dirty)"+ let+ registerInfoDirty =+ case dirty of+ Nothing -> False+ Just _ -> True+ registerInfoGroup = group+ pure (regName, RegisterInfo{..})++ <* skipWhile (not . inClass "\n\r")++parseGetReg+ :: ( FiniteBits a+ , Integral a+ )+ => RegisterName+ -> Parser a+parseGetReg (RegisterName rName) =+ string rName+ *> space+ *> "0x"+ *> hexadecimal
src/HOCD/Types.hs view
@@ -3,10 +3,14 @@ ( MemAddress(..) , memAddr , OCDConfig(..)+ , RegisterName(..)+ , regName+ , RegisterInfo(..) ) where +import Data.ByteString (ByteString) import Data.Default.Class (Default(def))-import Data.Word (Word32)+import Data.Word (Word8, Word32, Word64) newtype MemAddress = MemAddress { unMemAddress :: Word32 }@@ -28,4 +32,16 @@ , ocdPort = 6666 } +newtype RegisterName = RegisterName+ { unRegisterName :: ByteString }+ deriving (Eq, Ord, Show) +regName :: ByteString -> RegisterName+regName = RegisterName++data RegisterInfo = RegisterInfo+ { registerInfoSize :: Word8+ , registerInfoValue :: Maybe Word64+ , registerInfoDirty :: Bool+ , registerInfoGroup :: ByteString+ } deriving (Eq, Ord, Show)
test/ParseSpec.hs view
@@ -1,15 +1,83 @@+{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-} module ParseSpec where +import Data.ByteString (ByteString) import Data.Word (Word32)-import HOCD.Command (parseMem)+import HOCD.Parse (parseGetReg, parseMem, parseRegisters)+import HOCD.Types (RegisterInfo(..), RegisterName(..)) import Test.Hspec (Spec, it, shouldBe)+import Text.RawString.QQ +import qualified Data.Attoparsec.ByteString.Char8+import qualified Data.Map.Strict+ spec :: Spec spec = do it "parses read-memory sample" $ do- parseMem "ABCDFF 001122"+ Data.Attoparsec.ByteString.Char8.parseOnly+ parseMem+ "0xABCDFF 0x001122" `shouldBe` (Right [0xABCDFF, 0x1122 :: Word32]) + it "parses registers sample" $ do+ Data.Attoparsec.ByteString.Char8.parseOnly+ parseRegisters+ regsSample+ `shouldBe`+ ( Right+ $ Data.Map.Strict.fromList+ [ ( RegisterName "primask"+ , RegisterInfo+ { registerInfoSize = 1+ , registerInfoValue = Nothing+ , registerInfoDirty = False+ , registerInfoGroup = "arm v7m registers"+ }+ )+ , ( RegisterName "test"+ , RegisterInfo+ { registerInfoSize = 32+ , registerInfoValue = Nothing+ , registerInfoDirty = False+ , registerInfoGroup = "Cortex-M DWT registers"+ }+ )+ , ( RegisterName "r0"+ , RegisterInfo+ { registerInfoSize = 32+ , registerInfoValue = pure 0x0000D3C2+ , registerInfoDirty = True+ , registerInfoGroup = "arm v7m registers"+ }+ )+ , ( RegisterName "r1"+ , RegisterInfo+ { registerInfoSize = 32+ , registerInfoValue = pure 0xFD61F31C+ , registerInfoDirty = False+ , registerInfoGroup = "arm v7m registers"+ }+ )+ ]+ )++ it "parses get_reg response" $ do+ Data.Attoparsec.ByteString.Char8.parseOnly+ (parseGetReg (RegisterName "pc"))+ "pc 0x1234"+ `shouldBe`+ Right (0x1234 :: Word32)+++regsSample :: ByteString+regsSample = [r|===== arm v7m registers+(0) r0 (/32): 0x0000D3C2 (dirty)+(1) r1 (/32): 0xFD61F31C+(20) primask (/1)+===== Cortex-M DWT registers+(123) test (/32)+|]