module Hardware.KansasLava.RS232 (rs232out, rs232in) where
import Data.Ratio
import Data.Sized.Unsigned
import Data.Sized.Signed
import Data.Sized.Ix
import Data.Sized.Unsigned as U
import Data.Sized.Matrix as M
import Hardware.KansasLava.Rate
import Hardware.KansasLava.FIFO(fifo)
import Language.KansasLava
import qualified Language.KansasLava as KL
import Data.Maybe as Maybe
import Data.Char as Char
import Control.Monad
import Data.Default
import Data.Word
import Debug.Trace
type SAMPLE_RATE = X16
data RS232_TX
= TX_Idle
| TX_Send X10
deriving (Show,Eq,Ord)
isTX_Idle :: (sig ~ Signal c) => sig RS232_TX -> sig Bool
isTX_Idle = funMap $ \ tx -> return $ tx == TX_Idle
withTX_Send :: (sig ~ Signal c) => sig RS232_TX -> sig (Enabled X10)
withTX_Send = funMap $ \ tx -> return $ case tx of
TX_Send i -> Just i
_ -> Nothing
instance BitRep RS232_TX where
bitRep =
[ (TX_Idle, 0) ] ++
[ (TX_Send v, fromIntegral $ fromIntegral v + 1) | v <- [0..9] ]
$(repBitRep ''RS232_TX 4)
(.*&.) :: (sig ~ Signal c, Rep a) => sig (Enabled a) -> sig Bool -> sig (Enabled a)
(.*&.) en_a bool = packEnabled (en .&&. bool) a
where
(en,a) = unpackEnabled en_a
resize :: (sig ~ Signal c, Integral x, Rep x, Num y, Rep y) => sig x -> sig y
resize = funMap $ \ x -> return (fromIntegral x)
findBit :: forall sig c . (sig ~ Signal c) => (Num (sig X10)) => sig U8 -> sig X10 -> sig Bool
findBit byte x = (bitwise) byte .!. ((unsigned) (loopingDecS x) :: sig X8)
rs232out :: forall clk sig a . (Clock clk, sig ~ Signal clk)
=> Integer
-> Integer
-> Patch (sig (Enabled U8)) (sig Bool)
(sig Ack) ()
rs232out baudRate clkRate ~(inp0,()) = (toAck (ready .&&. in_en),out)
where
fastTick :: Signal clk Bool
fastTick = rate (Witness :: Witness X16) $
(fromIntegral baudRate / fromIntegral clkRate)
(in_en,in_val) = unpack inp0
(ready,out) = runRTL $ do
state <- newReg (TX_Idle :: RS232_TX)
char <- newReg (0 :: U8)
output <- newReg (True :: Bool)
let ready = isTX_Idle (reg state)
CASE [ IF (ready .&&. in_en) $ do
state := pureS (TX_Send 0)
char := in_val
]
WHEN fastTick $ CASE
[ match (withTX_Send (reg state)) $ \ ix -> do
CASE [ IF (ix .==. maxBound) $ do
state := pureS TX_Idle
, OTHERWISE $ do
state := funMap (\ x -> if x == maxBound
then return (TX_Send 0)
else return (TX_Send (x + 1))) ix
]
CASE [ IF (ix .==. 0) $ do
output := low
, IF (ix .==. 9) $ do
output := high
, OTHERWISE $ do
output := findBit (reg char) ix
]
]
return (ready,reg output)
rs232in :: forall clk sig a . (Clock clk, sig ~ Signal clk)
=> Integer
-> Integer
-> Patch (sig Bool) (sig (Enabled U8))
() ()
rs232in baudRate clkRate ~(in_val0,()) = ((),out)
where
fastTick :: Signal clk Bool
fastTick = rate (Witness :: Witness X16) $
(16 * fromIntegral baudRate / fromIntegral clkRate)
inp = in_val0
findByte :: [sig Bool] -> sig U8
findByte xs = bitwise (pack (matrix xs :: M.Matrix X8 (sig Bool)) :: sig (M.Matrix X8 Bool))
out = runRTL $ do
reading <- newReg False
theByte <- newArr (Witness :: Witness X16)
outVal <- newReg (Nothing :: Enabled U8)
ready <- newReg (False :: Bool)
counter <- newReg (0 :: U8)
let lowCounter, highCounter :: sig U4
(lowCounter,highCounter) = unappendS (reg counter)
WHEN fastTick $ do
CASE [ IF ((reg reading .==. low) .&&. (inp .==. low)) $ do
counter := 0
reading := high
, OTHERWISE $ do
counter := reg counter + 1
]
WHEN ((reg reading .==. high) .&&. (lowCounter .==. 8)) $ CASE
[ IF (highCounter .<. 9) $ do
theByte ((unsigned) highCounter) := inp
, IF ((highCounter .==. 9) .&&.
(reg (theByte 0) .==. low) .&&.
(inp .==. high)
) $ do
outVal := enabledS
$ findByte [ reg (theByte (fromIntegral i))
| i <- [1..8] :: [Int]
]
counter := 0
reading := low
, OTHERWISE $ do
counter := 0
reading := low
]
WHEN (isEnabled (reg outVal)) $ do
outVal := pureS Nothing
return $ (reg outVal)