ecu (empty) → 0.0.0
raw patch · 10 files changed
+822/−0 lines, 10 filesdep +basedep +bytestringdep +digestsetup-changed
Dependencies added: base, bytestring, digest, vcd
Files
- LICENSE +27/−0
- README +13/−0
- Setup.lhs +8/−0
- ecu.cabal +71/−0
- src/CAN.hs +157/−0
- src/CANSend.hs +38/−0
- src/CANView.hs +46/−0
- src/Probe.hs +233/−0
- src/ToVCD.hs +152/−0
- src/kvaser.c +77/−0
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) Tom Hawkins 2010++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of his contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.
+ README view
@@ -0,0 +1,13 @@+Tools for Automotive ECU Development++tovcd - Converts several CAN formats to VCD.+todbc - Generate Vector DBC files from CAN specification.+probe - Extracts configuration and probed signals from ECU.+canview - View CAN traffic.+cansend - Send CAN message.+vcdgrep - Search VCD files for signal patterns and assertion violations.+brakedancer-layout - Generate a brakedancer signal layout from a VCD file.++http://hackage.haskell.org/package/ecu++
+ Setup.lhs view
@@ -0,0 +1,8 @@+#! /usr/bin/env runhaskell++> module Main (main) where+>+> import Distribution.Simple (defaultMain)+>+> main :: IO ()+> main = defaultMain
+ ecu.cabal view
@@ -0,0 +1,71 @@+name: ecu+version: 0.0.0++category: Utils++synopsis: Tools for automotive ECU development.++description:+ These are a collection of tools developed and used by Eaton's+ electro-hydraulic software engineers. Most tools is this + collection and for interacting with, and analyzing vehicle+ ECU data via a CAN bus.++ These tools require the Kvaser canlib library: http://www.kvaser.com/++author: Tom Hawkins <tomahawkins@gmail.com>+maintainer: Tom Hawkins <tomahawkins@gmail.com>++license: BSD3+license-file: LICENSE++build-type: Simple+cabal-version: >= 1.6++extra-source-files:+ README++executable tovcd+ hs-source-dirs: src+ main-is: ToVCD.hs+ build-depends: base >= 4.2 && < 5,+ bytestring >= 0.9.1 && < 0.9.2,+ vcd >= 0.1.4 && < 2+ ghc-options: -W++executable cansend+ hs-source-dirs: src+ main-is: CANSend.hs+ other-modules: CAN+ c-sources: src/kvaser.c+ extra-libraries: canlib+ build-depends: base >= 4.2 && < 5+ ghc-options: -W+ extensions: ForeignFunctionInterface++executable canview+ hs-source-dirs: src+ main-is: CANView.hs+ other-modules: CAN+ c-sources: src/kvaser.c+ extra-libraries: canlib+ build-depends: base >= 4.2 && < 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,+ digest >= 0.0.0.8 && < 0.0.1,+ vcd >= 0.1.4 && < 2+ ghc-options: -W+ extensions: ForeignFunctionInterface++source-repository head+ type: git+ location: git://github.com/tomahawkins/ecu.git+
+ src/CAN.hs view
@@ -0,0 +1,157 @@+module CAN+ ( Msg (..)+ , BusType (..)+ , Bus+ , initCAN+ , openBus+ , closeBus+ , recvMsg+ , recvMsgWait+ , sendMsg+ , busTime+ , busTime'+ , testBusStatus+ , testIFStatus+ , sendUntil+ , toWord64+ , fromWord64+ , toWord32+ , fromWord32+ , toPayload+ , fromPayload+ , flushRxQueue+ ) where++import Data.Bits+import Data.Char+import Data.Word+import Text.Printf++foreign import ccall unsafe initCAN :: IO ()+foreign import ccall unsafe canOpenExt_ :: Int -> IO Int+foreign import ccall unsafe canOpenStd_ :: Int -> IO Int+--foreign import ccall unsafe canOpenVirtual_ :: Int -> IO Int+foreign import ccall unsafe canClose_ :: Int -> IO ()+--foreign import ccall unsafe canRead_ :: Int -> IO Int+foreign import ccall unsafe canReadWait_ :: Int -> Int -> IO Int+foreign import ccall unsafe canReadId_ :: IO Int+foreign import ccall unsafe canReadTime_ :: IO Int+foreign import ccall unsafe canReadMsgLen_ :: IO Int+foreign import ccall unsafe canReadMsg_ :: Int -> IO Char+foreign import ccall unsafe canWriteByte_ :: Char -> Int -> IO ()+foreign import ccall unsafe canWrite_ :: Int -> Int -> Int -> IO ()+foreign import ccall unsafe canReadTimer_ :: Int -> IO Int+foreign import ccall unsafe canFlushReceiveQueue_ :: Int -> IO Int++newtype Bus = Bus Int++openBus :: Int -> BusType -> IO Bus+openBus channel busType = do+ h <- case busType of+ Standard -> canOpenStd_ channel+ Extended -> canOpenExt_ channel+ return $ Bus h++closeBus :: Bus -> IO ()+closeBus (Bus h) = canClose_ h++-- | Receive a message if a message is available. Includes receive time (ms). +recvMsg :: Bus -> IO (Maybe (Int, Msg))+recvMsg b = recvMsgWait b 0++-- | Waits a number of ms to receive a message. Includes receive time (ms). +recvMsgWait :: Bus -> Int -> IO (Maybe (Int, Msg))+recvMsgWait (Bus h) wait = do+ status <- canReadWait_ h wait+ id <- canReadId_+ if status /= 0 || id == 0 then return Nothing else do+ len <- canReadMsgLen_+ msg <- mapM canReadMsg_ [0 .. len - 1]+ t <- canReadTime_+ return $ Just (t, Msg (fromIntegral id) (map (fromIntegral . ord) msg))++-- | Send a message.+sendMsg :: Bus -> Msg -> IO ()+sendMsg (Bus h) (Msg id payload') = do+ mapM_ (\ (b, i) -> canWriteByte_ (chr $ fromIntegral b) i) $ zip payload [0..]+ canWrite_ h (fromIntegral id) $ length payload+ where+ payload = take 8 payload'++flushRxQueue :: Bus -> IO ()+flushRxQueue (Bus h) = do+ canFlushReceiveQueue_ h+ return ()++-- | Current driver time (ms).+busTime :: Bus -> IO (Maybe Int)+busTime (Bus h) = do+ status <- canReadTimer_ h+ if status /= 0 then return Nothing else do+ t <- canReadTime_+ return $ Just t++busTime' :: Bus -> IO Int+busTime' bus = do+ t <- busTime bus+ case t of+ Nothing -> busTime' bus+ Just t -> return t++testBusStatus :: Bus -> IO Int+testBusStatus (Bus h) = do+ status <- canReadWait_ h 500+ return status++testIFStatus :: Bus -> IO Int+testIFStatus (Bus h) = do+ status <- canReadTimer_ h+ return status++-- | Send a message periodically (in ms) until a certain message is received.+sendUntil :: Bus -> Int -> Msg -> (Msg -> Bool) -> IO Msg+sendUntil bus retryTime msg isAck = getStartTime >>= f1+ where+ f1 startTime = sendMsg bus msg >> f2 startTime startTime+ f2 startTime currentTime | currentTime - startTime > retryTime = f1 currentTime+ f2 startTime currentTime = do+ m <- recvMsgWait bus $ max 0 $ retryTime - (currentTime - startTime)+ case m of+ Nothing -> f1 currentTime+ Just (t, m) | isAck m -> return m+ | otherwise -> f2 startTime t++ getStartTime = do+ m <- recvMsg bus+ case m of+ Nothing -> getStartTime+ Just (t, _) -> return t+++data Msg = Msg Word32 [Word8] deriving (Eq, Ord)++data BusType = Extended | Standard++instance Show Msg where show (Msg id payload) = printf "0x%08X 0x%s" id $ concatMap formatByte payload++formatByte :: Word8 -> String+formatByte b = printf "%02X" b++toWord64 :: [Word8] -> Word64+toWord64 a = foldl1 (.|.) [ shiftL (fromIntegral a) $ i * 8 | (a, i) <- zip (a ++ [0..]) $ reverse [0..7] ]++fromWord64 :: Word64 -> [Word8]+fromWord64 a = [ fromIntegral ((shiftR a $ i * 8) .&. 0xFF) | i <- reverse [0..7] ]++toWord32 :: [Word8] -> Word32+toWord32 a = foldl1 (.|.) [ shiftL (fromIntegral a) $ i * 8 | (a, i) <- zip (a ++ [0..]) $ reverse [0..3] ]++fromWord32 :: Word32 -> [Word8]+fromWord32 a = [ fromIntegral ((shiftR a $ i * 8) .&. 0xFF) | i <- reverse [0..3] ]++toPayload :: Word64 -> [Word8]+toPayload payload = [ fromIntegral (shiftR payload (b * 8) .&. 0xFF) | b <- reverse [0..7] ]++fromPayload :: [Word8] -> Word64+fromPayload payload = foldr1 (.|.) [ shiftL (fromIntegral x .&. 0xFF) (b * 8) | (x, b) <- zip payload (reverse [0..7]) ]+
+ src/CANSend.hs view
@@ -0,0 +1,38 @@+module Main (main) where++import System.Environment++import CAN++main :: IO ()+main = do+ args <- getArgs+ case args of+ "-h" : _ -> help+ "--help" : _ -> help+ ["--std", id, payload] -> do+ initCAN+ bus <- openBus 0 Standard+ sendMsg bus $ Msg (read id) (toPayload $ read payload)+ closeBus bus+ [id, payload] -> do+ initCAN+ bus <- openBus 0 Extended+ sendMsg bus $ Msg (read id) (toPayload $ read payload)+ closeBus bus+ _ -> help++help :: IO ()+help = putStrLn $ unlines+ [ ""+ , "NAME"+ , " cansend - puts a message on a CAN bus"+ , ""+ , "SYNOPSIS"+ , " cansend [--std] id payload"+ , ""+ , "ARGUMENTS"+ , " --std Set to standard CAN with 500K. Default is extended CAN with 250K."+ , ""+ ]+
+ src/CANView.hs view
@@ -0,0 +1,46 @@+module Main (main) where++import System.Environment+import Text.Printf++import CAN++main :: IO ()+main = do+ args <- getArgs+ case args of+ ["--std"] -> do+ initCAN+ bus <- openBus 0 Standard+ flushRxQueue bus+ canview bus+ [] -> do+ initCAN+ bus <- openBus 0 Extended+ flushRxQueue bus+ canview bus+ _ -> help++canview :: Bus -> IO ()+canview bus = do+ m <- recvMsg bus+ case m of+ Nothing -> canview bus+ Just (t, m) -> do+ putStrLn $ printf "%10i " t ++ show m+ canview bus++help :: IO ()+help = putStrLn $ unlines+ [ ""+ , "NAME"+ , " canview - listens to a CAN bus"+ , ""+ , "SYNOPSIS"+ , " canview {argument}"+ , ""+ , "ARGUMENTS"+ , " --std Set to standard CAN with 500K. Default is extended CAN with 250K."+ , ""+ ]+
+ src/Probe.hs view
@@ -0,0 +1,233 @@+module Main (main) where++import Control.Monad+import Data.Bits+import Data.Char+import Data.Digest.CRC32+import Data.Int+import Data.VCD hiding (Bool, Double)+import Data.Word+import System.Environment+import System.IO+import Text.Printf+import Unsafe.Coerce++import CAN++main :: IO ()+main = do+ args <- getArgs+ case args of+ ["config", file] -> do+ initCAN+ bus <- openBus 0 Extended+ flushRxQueue bus+ saveConfig bus file+ closeBus bus+ [file] -> do+ initCAN+ bus <- openBus 0 Extended+ flushRxQueue bus+ startProbes bus file+ closeBus bus+ _ -> help++help :: IO ()+help = putStrLn $ unlines+ [ ""+ , "NAME"+ , " probe - Extracts configuration and signal probes from an ECU."+ , ""+ , "SYNOPSIS"+ , " probe [config] <file>"+ , ""+ , "COMMANDS"+ , " config <file> Download probe configuration from ECU."+ , " <file> Given probe config file, pipe probes from ECU to VCD on stdin."+ , ""+ ]++data Type+ = Bool+ | Int8+ | Int16+ | Int32+ | Int64+ | Word8+ | Word16+ | Word32+ | Word64+ | Float+ | Double+ deriving (Show, Read)++data Const+ = CBool Bool+ | CInt8 Int8+ | CInt16 Int16+ | CInt32 Int32+ | CInt64 Int64+ | CWord8 Word8+ | CWord16 Word16+ | CWord32 Word32+ | CWord64 Word64+ | CFloat Float+ | CDouble Double+ deriving (Eq, Ord)++instance Show Const where+ show c = case c of+ CBool True -> "true"+ CBool False -> "false"+ CInt8 c -> show c+ CInt16 c -> show c+ CInt32 c -> show c+ CInt64 c -> show c+ CWord8 c -> show c+ CWord16 c -> show c+ CWord32 c -> show c+ CWord64 c -> show c+ CFloat c -> show c+ CDouble c -> show c++width :: Type -> Int+width a = case a of+ Bool -> 1+ Int8 -> 8+ Int16 -> 16+ Int32 -> 32+ Int64 -> 64+ Word8 -> 8+ Word16 -> 16+ Word32 -> 32+ Word64 -> 64+ Float -> 32+ Double -> 64++++saveConfig :: Bus -> FilePath -> IO ()+saveConfig bus file = getConfig1 [] >>= writeFile file . format+ where+ format :: [Word8] -> String+ format bytes = [ chr $ fromIntegral a | a <- bytes, a /= 0 ]++ -- Capture messages before header is received.+ getConfig1 :: [Word8] -> IO [Word8]+ getConfig1 buf1 = do+ a <- recvMsg bus+ case a of + Just (_, Msg 0x180000EF payload) -> getConfig0 (header payload) [] buf1+ Just (_, Msg 0x180100EF payload) -> do+ printf "received %3d of ??? probed configuration packets ...\n" (div (length buf1) 8 + 1)+ getConfig1 (buf1 ++ payload)+ _ -> getConfig1 buf1++ -- Capture messages after header is received.+ getConfig0 :: (Int, Word32) -> [Word8] -> [Word8] -> IO [Word8]+ getConfig0 (n, crc) buf0 buf1+ | n * 8 == length buf && crc32 buf == crc = return buf+ | n * 8 == length buf = putStrLn "crc failed, restarting ..." >> getConfig1 []+ | n * 8 < length buf = putStrLn "received too many configuration packets, restarting ..." >> getConfig1 []+ | otherwise = do+ a <- recvMsg bus+ case a of + Just (_, Msg 0x180000EF payload) -> putStrLn "missing configuration packets, restarting ..." >> getConfig0 (header payload) [] []+ Just (_, Msg 0x180100EF payload) -> do+ printf "received %3d of %3d probed configuration packets ...\n" (div (length (buf0 ++ buf1)) 8 + 1) n+ getConfig0 (n, crc) (buf0 ++ payload) buf1+ _ -> getConfig0 (n, crc) buf0 buf1+ where+ buf = buf0 ++ buf1++header :: [Word8] -> (Int, Word32)+header payload' = (fromIntegral $ shiftR payload 32, fromIntegral payload)+ where+ payload = fromPayload payload'++startProbes :: Bus -> FilePath -> IO ()+startProbes bus file = do+ f <- readFile file+ vcd <- newVCD stdout MS+ sample <- sampleProbes vcd $ read f+ baseTime <- baseTime+ step vcd 0+ loop vcd sample baseTime+ where+ baseTime :: IO Int+ baseTime = do+ m <- recvMsgWait bus 1000+ case m of+ Just (t, _) -> return t+ _ -> baseTime+ loop :: VCDHandle -> (Int -> Word64 -> IO ()) -> Int -> IO ()+ loop vcd sample lastTime = do+ m <- recvMsgWait bus 1000+ case m of+ Just (time, Msg id payload) | id .&. 0x180200EF == 0x180200EF -> do+ --printf "%-20d %-20d\n" time (time - lastTime)+ --hFlush stdout+ sample (fromIntegral $ shiftR id 8 .&. 0xFF) $ fromPayload payload+ if time == lastTime+ then loop vcd sample lastTime+ else do+ step vcd $ time - lastTime+ loop vcd sample time+ _ -> loop vcd sample lastTime++sampleProbes :: VCDHandle -> [[(String, Type)]] -> IO (Int -> Word64 -> IO ())+sampleProbes vcd packedProbes = f1 0 packedProbes+ where+ f1 :: Int -> [[(String, Type)]] -> IO (Int -> Word64 -> IO ())+ f1 _ [] = return $ \ _ _ -> return ()+ f1 index (packet : probes) = do+ a <- f2 64 packet+ b <- f1 (index + 1) probes+ return $ \ i p -> when (i == index) (a p) >> b i p+ where+ f2 :: Int -> [(String, Type)] -> IO (Word64 -> IO ())+ f2 _ [] = return $ \ _ -> return ()+ f2 bit ((name, typ) : probes) = do+ a <- case typ of+ Bool -> do+ f <- var vcd name False+ return $ \ a -> f $ testBit a (bit - 1)+ Int8 -> do+ f <- var vcd name (0 :: Int8 )+ return $ \ a -> f $ fromIntegral $ shiftR a $ bit - 8+ Int16 -> do+ f <- var vcd name (0 :: Int16 )+ return $ \ a -> f $ fromIntegral $ shiftR a $ bit - 16+ Int32 -> do+ f <- var vcd name (0 :: Int32 )+ return $ \ a -> f $ fromIntegral $ shiftR a $ bit - 32+ Int64 -> do+ f <- var vcd name (0 :: Int64 )+ return $ \ a -> f $ fromIntegral $ shiftR a $ bit - 64+ Word8 -> do+ f <- var vcd name (0 :: Word8 )+ return $ \ a -> f $ fromIntegral $ shiftR a $ bit - 8+ Word16 -> do+ f <- var vcd name (0 :: Word16)+ return $ \ a -> f $ fromIntegral $ shiftR a $ bit - 16+ Word32 -> do+ f <- var vcd name (0 :: Word32)+ return $ \ a -> f $ fromIntegral $ shiftR a $ bit - 32+ Word64 -> do+ f <- var vcd name (0 :: Word64)+ return $ \ a -> f $ fromIntegral $ shiftR a $ bit - 64+ Float -> do+ f <- var vcd name (0 :: Float )+ return $ \ a -> f $ toFloat (fromIntegral $ shiftR a $ bit - 32 :: Word32)+ Double -> do+ 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++toFloat :: Word32 -> Float+toFloat = unsafeCoerce++toDouble :: Word64 -> Double+toDouble = unsafeCoerce+
+ src/ToVCD.hs view
@@ -0,0 +1,152 @@+module Main (main) where++import Data.Bits+import qualified Data.ByteString.Lazy as B+import Data.IORef+import Data.VCD hiding (Bool)+import Data.Word+import System.Environment+import System.IO+import Text.Printf++main :: IO ()+main = do+ args <- getArgs+ case args of+ ('-' : _) : _ -> help+ [dbc, "-"] -> do+ dbc <- readFile dbc+ cl <- B.getContents >>= return . B.unpack+ buildVCD (parseDBC dbc) (parseCL cl) stdout+ dbc : cls -> do+ dbc <- readFile dbc+ mapM_ (buildVCDFile $ parseDBC dbc) cls+ _ -> help++help :: IO ()+help = putStrLn $ unlines+ [ ""+ , " NAME"+ , " tovcd - converts dbc and cl files to vcd"+ , ""+ , " SYNOPSIS"+ , " tovcd <dbc-file> ( - | { <cl-file> } )"+ , ""+ , " OPTIONS"+ , " - Read cl from stdin, vcd written to stdout."+ , ""+ ]++-- Generate VCD to a handle.+buildVCD :: DBC -> [(Word32, Word32, Word64)] -> Handle -> IO ()+buildVCD dbc cl h = do+ vcd <- newVCD h MS+ sample <- mapM (sampleMsg vcd) dbc+ mapM_ (\ a -> sequence_ [ f a | f <- sample ]) cl++-- Sets up the VCD sampling functions for each field in each message.+sampleMsg :: VCDHandle -> Msg -> IO ((Word32, Word32, Word64) -> IO ())+sampleMsg vcd (Msg id fields) = do+ sampleFields <- mapM (sampleField vcd) fields+ t <- newIORef 0+ return $ \ (time, id', payload) -> if id /= id' then return () else do+ t' <- readIORef t+ step vcd $ fromIntegral (time - t')+ writeIORef t time+ sequence_ [ f payload | f <- sampleFields ]++-- Sample an individual field from a payload.+sampleField :: VCDHandle -> Field -> IO (Word64 -> IO ())+sampleField vcd field = case field of+ Bool name bit -> do+ 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)+ return $ \ payload -> v $ fromIntegral (shiftR payload (71 - width - bit) .&. mask width) * gain + bias+ where+ mask :: Int -> Word64+ mask n = if n <= 0 then 0 else 1 .|. shiftL (mask $ n - 1) 1++-- Generate a VCD to a file.+buildVCDFile :: DBC -> FilePath -> IO ()+buildVCDFile dbc clFile = do+ putStrLn $ "converting " ++ clFile ++ " to " ++ vcdFile ++ " ..."+ cl <- B.readFile clFile >>= return . B.unpack+ h <- openFile vcdFile WriteMode+ buildVCD dbc (parseCL cl) h+ hClose h+ where+ vcdFile = if elem '.' clFile then reverse (dropWhile (/= '.') (reverse clFile)) ++ "vcd" else clFile ++ ".vcd"++-- DBC is a list of messages.+type DBC = [Msg]++-- A message is a is a CAN ID and a list of fields.+data Msg = Msg Word32 [Field]++instance Show Msg where+ show (Msg id fields) = printf "Msg %08x\n" id ++ concat [ " " ++ show f ++ "\n" | f <- fields ]++-- A field is either a boolean (name, bit position) or a float (name, bit position, width, scaling, and offset).+data Field+ = Bool String Int+ | Float String Int Int Float Float+ deriving Show++parseDBC :: String -> DBC+parseDBC = parseMsgs . lines++parseMsgs :: [String] -> [Msg]+parseMsgs [] = []+parseMsgs (a : b)+ | not (null w) && head w == "BO_" = Msg (0x7fffffff .&. read (w !! 1)) fields : parseMsgs rest+ | otherwise = parseMsgs b+ where+ w = words a+ (fields, rest) = parseFields b++parseFields :: [String] -> ([Field], [String])+parseFields [] = ([], [])+parseFields (a : b)+ | not (null w) && head w == "SG_" = (field : fields, rest)+ | otherwise = ([], a : b)+ where+ w = words $ map (\ a -> if elem a "|@(,)" then ' ' else a) a+ (fields, rest) = parseFields b+ name = w !! 1+ bit = read $ w !! 3+ width = read $ w !! 4+ gain = read $ w !! 6+ bias = read $ w !! 7+ field = case width of+ 1 -> Bool name bit+ _ -> Float name bit width gain bias++parseCL :: [Word8] -> [(Word32, Word32, Word64)]+parseCL = f+ where+ f (a0:a1:a2:a3:a4:a5:a6:a7:a8:a9:aa:ab:ac:ad:ae:af:rest) =+ (word32 (a3, a2, a1, a0), word32 (a7, a6, a5, a4), word64 (a8, a9, aa, ab, ac, ad, ae, af)) : f rest+ f _ = []++-- | Assumes big endian. Flip order if data is little endian.+word32 :: (Word8, Word8, Word8, Word8) -> Word32+word32 (a0,a1,a2,a3) = shiftL (fromIntegral a0) 24+ .|. shiftL (fromIntegral a1) 16+ .|. shiftL (fromIntegral a2) 8+ .|. (fromIntegral a3) ++-- | Assumes big endian. Flip order if data is little endian.+word64 :: (Word8, Word8, Word8, Word8, Word8, Word8, Word8, Word8) -> Word64+word64 (a0,a1,a2,a3,a4,a5,a6,a7) = shiftL (fromIntegral a0) 56+ .|. shiftL (fromIntegral a1) 48+ .|. shiftL (fromIntegral a2) 40+ .|. shiftL (fromIntegral a3) 32+ .|. shiftL (fromIntegral a4) 24+ .|. shiftL (fromIntegral a5) 16+ .|. shiftL (fromIntegral a6) 8+ .|. (fromIntegral a7) +++
+ src/kvaser.c view
@@ -0,0 +1,77 @@+#include <canlib.h>++void initCAN() { canInitializeLibrary(); }++/* canOpenExt_+ * open channel for extended CAN frames+ * set baud rate to 250 Kbit/s+ * typically used for refuse (J1939)+ */+int canOpenExt_ (int channel) {+ int h;+ h = canOpenChannel(channel, canWANT_EXTENDED);+ canSetBusParams(h, BAUD_250K, 4, 3, 1, 1, 0);+ canSetBusOutputControl(h, canDRIVER_NORMAL);+ canBusOn(h);+ return h;+}++/* canOpenStd_+ * open channel for standard CAN frames+ * set baud rate to 500 Kbit/s+ * typically used for shuttle+ */+int canOpenStd_ (int channel) {+ int h;+ h = canOpenChannel(channel, 0);+ canSetBusParams(h, BAUD_500K, 4, 3, 1, 1, 0);+ canSetBusOutputControl(h, canDRIVER_NORMAL);+ canBusOn(h);+ return h;+}++/*+int canOpenVirtual_ (int channel) {+ int h;+ //h = canOpenChannel(channel, canOPEN_NO_INIT_ACCESS);+ h = canOpenChannel(channel, canOPEN_ACCEPT_VIRTUAL);+ //h = canOpenChannel(channel, 0);+ canSetBusParams(h, BAUD_250K, 6, 2, 1, 0, 0);+ //canSetBusOutputControl(h, canDRIVER_NORMAL);+ canBusOn(h);+ return h;+}+*/++void canClose_ (int h) {+ //canBusOff(h); + canClose(h); +}++long id;+unsigned long time;+unsigned int dlc;+unsigned int flags;+unsigned char msg[8];++int canRead_ (int handle) { return (int) canRead (handle, &id, msg, &dlc, &flags, &time); }+int canReadWait_ (int handle, long int w) { return (int) canReadWait (handle, &id, msg, &dlc, &flags, &time, w); }++int canReadId_() { return id; }+int canReadTime_() { return time; }+int canReadMsgLen_() { return (int) dlc; }+unsigned char canReadMsg_(int i) { return msg[i]; }++void canWriteByte_(char byte, int i) { msg[i] = byte; }++void canWrite_(int h, int id, int dlc) { canWrite(h, (long) id, msg, (unsigned int) dlc, canMSG_EXT); }++int canReadTimer_(int handle) {+#ifdef TARGET_MINGW+ return canReadTimer(handle);+#else+ return canReadTimer(handle, &time);+#endif+}++int canFlushReceiveQueue_(int handle) { return (int) canIoCtl(handle, canIOCTL_FLUSH_RX_BUFFER, NULL, 0); }