ecu 0.0.1 → 0.0.2
raw patch · 5 files changed
+109/−25 lines, 5 filesdep ~basedep ~vcdnew-component:exe:ccp
Dependency ranges changed: base, vcd
Files
- README +1/−0
- ecu.cabal +21/−11
- src/CCP.hs +73/−0
- src/Probe.hs +12/−12
- src/ToVCD.hs +2/−2
README view
@@ -5,6 +5,7 @@ probe - Extracts configuration and probed signals from ECU. canview - View CAN traffic. cansend - Send CAN message.+ccp - CAN Configuration Protocol master. git2cc - Bridge Git repositories to ClearCase. commit - Git commits with ClearQuest activity annotations.
ecu.cabal view
@@ -1,7 +1,7 @@ name: ecu-version: 0.0.1+version: 0.0.2 -category: Utils+category: Embedded, Utils synopsis: Tools for automotive ECU development. @@ -28,9 +28,9 @@ executable tovcd hs-source-dirs: src main-is: ToVCD.hs- build-depends: base >= 4.2 && < 5,+ build-depends: base >= 4.0 && < 5, bytestring >= 0.9.1 && < 0.9.2,- vcd >= 0.1.4 && < 2+ vcd >= 0.2.0 && < 0.3.0 ghc-options: -W executable cansend@@ -39,7 +39,7 @@ other-modules: CAN c-sources: src/kvaser.c extra-libraries: canlib- build-depends: base >= 4.2 && < 5+ build-depends: base >= 4.0 && < 5 ghc-options: -W extensions: ForeignFunctionInterface @@ -49,26 +49,36 @@ other-modules: CAN c-sources: src/kvaser.c extra-libraries: canlib- build-depends: base >= 4.2 && < 5+ build-depends: base >= 4.0 && < 5 ghc-options: -W extensions: ForeignFunctionInterface +executable ccp+ hs-source-dirs: src+ main-is: CCP.hs+ other-modules: CAN+ c-sources: src/kvaser.c+ extra-libraries: canlib+ build-depends: base >= 4.0 && < 5+ ghc-options: -W+ extensions: ForeignFunctionInterface+ executable probe hs-source-dirs: src main-is: Probe.hs other-modules: CAN c-sources: src/kvaser.c extra-libraries: canlib- build-depends: base >= 4.2 && < 5,+ build-depends: base >= 4.0 && < 5, digest >= 0.0.0.8 && < 0.0.1,- vcd >= 0.1.4 && < 2+ vcd >= 0.2.0 && < 0.3.0 ghc-options: -W extensions: ForeignFunctionInterface executable toesb hs-source-dirs: src main-is: ToESB.hs- build-depends: base >= 4.2 && < 5,+ build-depends: base >= 4.0 && < 5, bytestring >= 0.9.1 && < 0.9.2, digest >= 0.0.0.8 && < 0.0.1 ghc-options: -W@@ -76,13 +86,13 @@ executable commit hs-source-dirs: src main-is: Commit.hs- build-depends: base >= 4.2 && < 5+ build-depends: base >= 4.0 && < 5 ghc-options: -W executable git2cc hs-source-dirs: src main-is: Git2CC.hs- build-depends: base >= 4.2 && < 5,+ build-depends: base >= 4.0 && < 5, directory >= 1.0.1 && < 1.1, process >= 1.0.1 && < 1.1 ghc-options: -W
+ src/CCP.hs view
@@ -0,0 +1,73 @@+module Main (main) where++import Control.Monad+import Data.Word+import System.Environment+import Text.Printf++import CAN++help :: IO ()+help = putStrLn $ unlines+ [ ""+ , "NAME"+ , " ccp - a CAN Configuration Protocol master"+ , ""+ , "SYNOPSIS"+ , " ccp command { option } { argument }"+ , ""+ , "COMMANDS"+ , " upload { option } address Upload 4 bytes from the ECU. Address must be 32-bit aligned."+ , " upload { option } address length Upload a memory region from the ECU. Address must be 32-bit aligned."+ , ""+ , "OPTIONS"+ , " --std Set to standard CAN with 500K. Default is extended CAN with 250K."+ , ""+ , "ENVIRONMENT VARIABLES"+ , " CCP_ID_MASTER CAN identifier for master device (this configuration tool)."+ , " CCP_ID_SLAVE CAN identifier for slave device (ecu)."+ , ""+ ]++main :: IO ()+main = getArgs >>= f+ where+ f args = case args of+ ["-h"] -> help+ ["--help"] -> help+ ["upload", addr] -> f ["upload", addr, "4"]+ ["upload", "--std", addr] -> f ["upload", "--std", addr, "4"]+ ["upload", "--std", addr, size] -> do+ initCAN+ bus <- openBus 0 Standard+ ids <- ids+ upload bus ids (read addr) (read size)+ closeBus bus+ ["upload", addr, size] -> do+ initCAN+ bus <- openBus 0 Extended+ ids <- ids+ upload bus ids (read addr) (read size)+ closeBus bus+ _ -> help++canview :: Bus -> [Word32] -> IO ()+canview bus ids = do+ m <- recvMsg bus+ case m of+ Nothing -> canview bus ids+ Just (t, m@(Msg id _)) -> do+ when (null ids || elem id ids) $ putStrLn $ printf "%10i " t ++ show m+ canview bus ids++ids :: IO (Word32, Word32)+ids = do+ master <- getEnv "CCP_ID_MASTER"+ slave <- getEnv "CCP_ID_SLAVE"+ return (read master, read slave)++upload :: Bus -> (Word32, Word32) -> Word32 -> Word32 -> IO ()+upload bus (master, slave) address size = do+ printf "%08x %08x\n" master slave+ return ()+
src/Probe.hs view
@@ -164,7 +164,7 @@ loop vcd sample lastTime = do m <- recvMsgWait bus 1000 case m of- Just (time, Msg id payload) | id .&. 0x180200EF == 0x180200EF -> do+ Just (time, Msg id payload) | id .&. 0xFFFF00FF == 0x180200EF -> do --printf "%-20d %-20d\n" time (time - lastTime) --hFlush stdout sample (fromIntegral $ shiftR id 8 .&. 0xFF) $ fromPayload payload@@ -190,37 +190,37 @@ f2 bit ((name, typ) : probes) = do a <- case typ of Bool -> do- f <- var vcd name False+ f <- var vcd [name] False return $ \ a -> f $ testBit a (bit - 1) Int8 -> do- f <- var vcd name (0 :: Int8 )+ f <- var vcd [name] (0 :: Int8 ) return $ \ a -> f $ fromIntegral $ shiftR a $ bit - 8 Int16 -> do- f <- var vcd name (0 :: Int16 )+ f <- var vcd [name] (0 :: Int16 ) return $ \ a -> f $ fromIntegral $ shiftR a $ bit - 16 Int32 -> do- f <- var vcd name (0 :: Int32 )+ f <- var vcd [name] (0 :: Int32 ) return $ \ a -> f $ fromIntegral $ shiftR a $ bit - 32 Int64 -> do- f <- var vcd name (0 :: Int64 )+ f <- var vcd [name] (0 :: Int64 ) return $ \ a -> f $ fromIntegral $ shiftR a $ bit - 64 Word8 -> do- f <- var vcd name (0 :: Word8 )+ f <- var vcd [name] (0 :: Word8 ) return $ \ a -> f $ fromIntegral $ shiftR a $ bit - 8 Word16 -> do- f <- var vcd name (0 :: Word16)+ f <- var vcd [name] (0 :: Word16) return $ \ a -> f $ fromIntegral $ shiftR a $ bit - 16 Word32 -> do- f <- var vcd name (0 :: Word32)+ f <- var vcd [name] (0 :: Word32) return $ \ a -> f $ fromIntegral $ shiftR a $ bit - 32 Word64 -> do- f <- var vcd name (0 :: Word64)+ f <- var vcd [name] (0 :: Word64) return $ \ a -> f $ fromIntegral $ shiftR a $ bit - 64 Float -> do- f <- var vcd name (0 :: Float )+ f <- var vcd [name] (0 :: Float ) return $ \ a -> f $ toFloat (fromIntegral $ shiftR a $ bit - 32 :: Word32) Double -> do- f <- var vcd name (0 :: Double)+ f <- var vcd [name] (0 :: Double) return $ \ a -> f $ toDouble (fromIntegral $ shiftR a $ bit - 64 :: Word64) b <- f2 (bit - width typ) probes return $ \ p -> a p >> b p
src/ToVCD.hs view
@@ -59,10 +59,10 @@ sampleField :: VCDHandle -> Field -> IO (Word64 -> IO ()) sampleField vcd field = case field of Bool name bit -> do- v <- var vcd name False+ v <- var vcd [name] False return $ \ payload -> v $ testBit payload $ 64 - bit Float name bit width gain bias -> do- v <- var vcd name (0 :: Float)+ v <- var vcd [name] (0 :: Float) return $ \ payload -> v $ fromIntegral (shiftR payload (71 - width - bit) .&. mask width) * gain + bias where mask :: Int -> Word64