module STM32.STLinkUSB.MemRW
where
import Control.Monad
import qualified Data.ByteString as BS
import Data.Binary
import Control.Monad.Trans.Reader
import STM32.STLinkUSB.Commands
import STM32.STLinkUSB.Env
import STM32.STLinkUSB.USBXfer
checkRWStatus :: STL ()
checkRWStatus = do
api <- asks dongleAPI
case api of
APIV1 -> return ()
APIV2 -> do
msg <- xfer (DEBUG_COMMAND GETLASTRWSTATUS)
let dongleStatus = toStatus $ BS.head msg
if (dongleStatus == DEBUG_ERR_OK)
then return ()
else do
let err = show ("checkRWStatus", dongleStatus)
debugSTL Error err
error err
maxTransferBlocksize :: Word16
maxTransferBlocksize = 64
newtype TransferBlock
= TransferBlock {_unTransferBlock :: BS.ByteString} deriving Show
unsafeToTransferBlock :: BS.ByteString -> TransferBlock
unsafeToTransferBlock bs
= if len <= fromIntegral maxTransferBlocksize
then TransferBlock bs
else error msg
where
msg = "unsafeToTransferBlock :" ++ show len ++ "> maxTransferBlockSize"
len = BS.length bs
newtype TransferLen = TransferLen {_unTransferLen :: Word16} deriving Show
unsafeToTransferLen :: Word16 -> TransferLen
unsafeToTransferLen len
= if len <= maxTransferBlocksize
then TransferLen len
else error msg
where
msg = "unsafeToTransferLen :" ++ show len ++ "> maxTransferBlocksize"
writeMem8' :: Addr -> TransferBlock -> STL ()
writeMem8' addr (TransferBlock block) = do
void $ xferBulkWrite (DEBUG_COMMAND $ WRITEMEM_8BIT addr len) block
checkRWStatus
where
len = fromIntegral $ BS.length block
writeMem32' :: Addr -> TransferBlock -> STL ()
writeMem32' addr (TransferBlock block) = do
void $ xferBulkWrite (DEBUG_COMMAND $ WRITEMEM_32BIT addr len) block
checkRWStatus
where
len = fromIntegral $ BS.length block
readMem8' :: Addr -> TransferLen -> STL BS.ByteString
readMem8' addr (TransferLen len) = do
bs <- xfer (DEBUG_COMMAND $ READMEM_8BIT addr len)
checkRWStatus
return bs
readMem32' :: Addr -> TransferLen -> STL BS.ByteString
readMem32' addr (TransferLen len) = do
bs <- xfer (DEBUG_COMMAND $ READMEM_32BIT addr len)
checkRWStatus
return bs
writeMem8 :: Addr -> BS.ByteString -> STL ()
writeMem8 = writeChunks writeMem8'
writeMem32 :: Addr -> BS.ByteString -> STL ()
writeMem32 = writeChunks writeMem32'
writeChunks
:: (Addr -> TransferBlock -> STL () ) -> Addr -> BS.ByteString -> STL ()
writeChunks action addr bs
= forM_ (chunkBS addr bs) $ uncurry action
chunkBS :: Addr -> BS.ByteString -> [(Addr,TransferBlock)]
chunkBS addr bs
= if BS.length bs <= chunkSize
then [h]
else h : (chunkBS (addr + fromIntegral chunkSize)
(BS.drop chunkSize bs))
where
h = (addr, unsafeToTransferBlock $ BS.take chunkSize bs)
chunkSize = fromIntegral maxTransferBlocksize
chunkAddr :: Addr -> Int -> [(Addr,TransferLen)]
chunkAddr addr len
= if len <= chunkSize
then [h]
else h : (chunkAddr (addr + fromIntegral chunkSize)
(len chunkSize))
where
h = (addr, unsafeToTransferLen
(min (fromIntegral len) (fromIntegral maxTransferBlocksize)))
chunkSize = fromIntegral maxTransferBlocksize
readChunks
:: (Addr -> TransferLen -> STL BS.ByteString )
-> Addr -> Int -> STL BS.ByteString
readChunks action addr len
= liftM BS.concat $ forM (chunkAddr addr len) $ uncurry action
readMem8 :: Addr -> Int -> STL BS.ByteString
readMem8 = readChunks readMem8'
readMem32 :: Addr -> Int -> STL BS.ByteString
readMem32 = readChunks readMem32'