diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -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.
diff --git a/README b/README
new file mode 100644
--- /dev/null
+++ b/README
@@ -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
+
+
diff --git a/Setup.lhs b/Setup.lhs
new file mode 100644
--- /dev/null
+++ b/Setup.lhs
@@ -0,0 +1,8 @@
+#! /usr/bin/env runhaskell
+
+> module Main (main) where
+>
+> import Distribution.Simple (defaultMain)
+>
+> main :: IO ()
+> main = defaultMain
diff --git a/ecu.cabal b/ecu.cabal
new file mode 100644
--- /dev/null
+++ b/ecu.cabal
@@ -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
+
diff --git a/src/CAN.hs b/src/CAN.hs
new file mode 100644
--- /dev/null
+++ b/src/CAN.hs
@@ -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]) ]
+
diff --git a/src/CANSend.hs b/src/CANSend.hs
new file mode 100644
--- /dev/null
+++ b/src/CANSend.hs
@@ -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."
+  , ""
+  ]
+
diff --git a/src/CANView.hs b/src/CANView.hs
new file mode 100644
--- /dev/null
+++ b/src/CANView.hs
@@ -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."
+  , ""
+  ]
+
diff --git a/src/Probe.hs b/src/Probe.hs
new file mode 100644
--- /dev/null
+++ b/src/Probe.hs
@@ -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
+
diff --git a/src/ToVCD.hs b/src/ToVCD.hs
new file mode 100644
--- /dev/null
+++ b/src/ToVCD.hs
@@ -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)   
+
+
+
diff --git a/src/kvaser.c b/src/kvaser.c
new file mode 100644
--- /dev/null
+++ b/src/kvaser.c
@@ -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); }