converted to bluespec haskell

bs/ClkDivider.bs

@@ -0,0 +1,40 @@
+package ClkDivider(mkClkDivider, ClkDivider(..)) where
+
+interface (ClkDivider :: # -> *) hi =
+  {
+  reset :: Action
+  ;isAdvancing :: Bool
+  ;isHalfCycle :: Bool
+  }
+
+mkClkDivider :: Handle -> Module (ClkDivider hi)
+mkClkDivider fileHandle = do
+    counter <- mkReg(0 :: UInt (TLog hi))   
+    let hi_value :: UInt (TLog hi) = (fromInteger $ valueOf hi)
+    let half_hi_value :: UInt (TLog hi) = (fromInteger $ valueOf (TDiv hi 2))
+
+    let val :: Real = (fromInteger $ valueOf hi)
+    let msg = "Clock Div Period : " + (realToString val) + "\n"
+
+    hPutStr fileHandle msg
+    hPutStr fileHandle genModuleName
+
+    addRules $
+      rules
+        {-# ASSERT fire when enabled #-}
+        {-# ASSERT no implicit conditions #-}
+        "tick" : when True ==> action
+          $display (counter)
+          counter := if (counter == hi_value)
+                    then 0
+                    else counter + 1
+    
+    return $
+      interface ClkDivider
+        reset :: Action
+        reset = do
+          counter := 0
+
+        isAdvancing :: Bool
+        isAdvancing = (counter == hi_value)
+        isHalfCycle = (counter == half_hi_value)

bs/Core.bs

@@ -0,0 +1,40 @@
+package Core(Core(..), mkCore) where
+
+import ClkDivider
+import Prelude
+
+interface (Core :: # -> *) clkFreq = {
+  getChar :: Bit 8
+ ;getLed  :: Bit 8
+ ;putChar :: Bit 8 -> Action
+ }
+
+mkCore :: Module (Core clkFreq)
+mkCore = do
+  counter    :: Reg (UInt (TLog clkFreq)) <- mkReg 0
+  tickSecond :: Wire Bool    <- mkDWire False
+  uartOut    :: Wire (Bit 8) <- mkWire;
+  ledOut     :: Reg (Bit 8)  <- mkReg 0
+
+  let clkFreqInt :: Integer = valueOf clkFreq
+  let clkFreqUInt :: UInt (TLog clkFreq) = fromInteger clkFreqInt
+  let val :: Real = fromInteger clkFreqInt
+
+  messageM $ "mkCore clkFreq" + realToString val
+
+  let pulseEverySecond :: Bool = (counter == clkFreqUInt)
+
+  addRules $
+    rules
+      "count" : when True ==>
+        counter := if (counter == clkFreqUInt) then 0 else (counter + 1)
+      "countingLed" : when pulseEverySecond ==>
+        ledOut := ledOut + 1
+
+  return $
+    interface Core
+     getChar = uartOut
+     getLed  = ledOut
+     putChar byteIn =
+       do
+         uartOut := byteIn

bs/Deserializer.bs

@@ -0,0 +1,53 @@
+package Deserializer(
+  mkDeserialize,
+  IDeserializer(..),
+  State(..)) 
+  where
+
+import ClkDivider
+import State
+
+
+interface (IDeserializer :: # -> # -> *) clkFreq baudRate = 
+  get         ::  Bit 8            
+  putBitIn    :: (Bit 1) -> Action {-# always_enabled, always_ready #-}
+
+mkDeserialize :: Handle -> Module (IDeserializer clkFreq baudRate)
+mkDeserialize fileHandle = do
+  ftdiRxIn :: Wire(Bit 1) <- mkBypassWire
+  shiftReg :: Reg(Bit 8) <- mkReg(0)
+  ftdiState <- mkReg(IDLE)
+
+  clkDivider :: (ClkDivider (TDiv clkFreq baudRate)) <- mkClkDivider fileHandle
+
+  addRules $
+    rules
+
+      {-# ASSERT fire when enabled #-}
+      "IDLE" : when (ftdiState == IDLE), (ftdiRxIn == 0) ==>
+        do
+          clkDivider.reset
+          ftdiState := ftdiState' ftdiState
+
+      {-# ASSERT fire when enabled #-}
+      "NOT IDLE" : when (ftdiState /= IDLE), (clkDivider.isAdvancing) ==>
+        do
+          ftdiState := ftdiState' ftdiState
+
+      {-# ASSERT fire when enabled #-}
+        "SAMPLING" : when 
+          DATA(n) <- ftdiState,
+          n >= 0,
+          n <= 7, 
+          let sampleTrigger = clkDivider.isHalfCycle
+            in sampleTrigger
+          ==>
+            do
+              shiftReg := ftdiRxIn ++ shiftReg[7:1]
+
+  return $
+    interface IDeserializer
+    {get      = shiftReg when (ftdiState == STOP), (clkDivider.isAdvancing)
+    ;putBitIn bit = 
+      ftdiRxIn := bit
+    }

bs/Serializer.bs

@@ -0,0 +1,52 @@
+package Serializer(
+  mkSerialize,
+  ISerializer(..),
+  State(..)) 
+  where
+
+import ClkDivider
+import State
+
+serialize :: State -> Bit 8 -> Bit 1
+serialize ftdiState dataReg =
+    case ftdiState of
+        START    -> 1'b0
+        (DATA n) -> dataReg[n:n]
+        _        -> 1'b1
+
+interface (ISerializer :: # -> # -> *) clkFreq baudRate = 
+  putBit8    :: (Bit 8) -> Action {-# always_enabled, always_ready #-}
+  bitLineOut ::  Bit 1            {-# always_ready #-}
+
+mkSerialize :: Handle -> Module (ISerializer clkFreq baudRate)
+mkSerialize fileHandle = do
+
+  ftdiTxOut :: Wire(Bit 1) <- mkBypassWire
+  dataReg  :: Reg(Bit 8) <- mkReg(0)
+  ftdiState <- mkReg(IDLE)
+  clkDivider :: (ClkDivider (TDiv clkFreq baudRate)) <- mkClkDivider fileHandle
+
+  addRules $
+    rules
+      {-# ASSERT fire when enabled #-}
+      "ADVANCE UART STATE WHEN NOT IDLE" : when 
+        (ftdiState /= IDLE), 
+        (clkDivider.isAdvancing) ==>
+        do
+          ftdiState := ftdiState' ftdiState
+
+      {-# ASSERT fire when enabled #-}
+      "BIT LINE" : when True ==>
+        do
+          ftdiTxOut := serialize ftdiState dataReg
+
+  return $
+    interface ISerializer
+      putBit8  bit8Val = 
+        do
+          clkDivider.reset
+          dataReg := bit8Val 
+          ftdiState := ftdiState' ftdiState
+        when (ftdiState == IDLE)
+      bitLineOut = ftdiTxOut
+    

bs/State.bs

@@ -0,0 +1,20 @@
+package State(
+  State(..),
+  ftdiState') where
+
+data State = IDLE 
+           | START 
+           | DATA (UInt (TLog 8)) 
+           | PARITY 
+           | STOP
+           deriving (Bits, Eq, FShow)
+
+ftdiState' :: State -> State
+ftdiState' state = 
+  case state of
+    IDLE    -> START
+    START   -> DATA(0)
+    DATA(7) -> PARITY
+    DATA(n) -> DATA(n+1)
+    PARITY  -> STOP
+    STOP    -> IDLE

bs/Top.bs

@@ -0,0 +1,76 @@
+package Top(mkTop, ITop(..)) where
+
+import Deserializer
+import Core
+import Serializer
+import BRAM
+import CBindings
+
+type FCLK = 25000000
+type BAUD = 9600
+
+interface ITop = {
+  ftdi_rxd :: Bit 1           {-# always_ready  #-}
+ ;led      :: Bit 8           {-# always_ready  #-}
+ ;ftdi_txd :: Bit 1 -> Action {-# always_ready , always_enabled  #-}
+};
+
+mkTop :: Module ITop
+mkTop = do
+  fileHandle   :: Handle <- openFile "compile.log" WriteMode
+  deserializer :: IDeserializer FCLK BAUD <- mkDeserialize fileHandle
+  serializer   :: ISerializer FCLK BAUD <- mkSerialize fileHandle
+  core         :: Core FCLK <- mkCore
+  persistLed  :: Reg (Bit 8) <- mkReg 0
+  messageM $ "Hallo!!" + (realToString 5)
+
+  -- refactor such that the following rules are let-bound to 
+  -- `attachIO` identifier
+  addRules $
+    rules
+      "coreLedO" : when True ==>
+        persistLed := core.getLed
+
+      "coreCharDeviceO" : when True ==>
+        serializer.putBit8 core.getChar
+
+      "coreCharDeviceO" : when True ==>
+        serializer.putBit8 core.getChar
+
+      "coreCharDeviceI" : when True ==>
+        core.putChar deserializer.get
+
+  return $
+    interface ITop
+      ftdi_rxd =  serializer.bitLineOut
+      ftdi_txd bitIn =  
+           do
+             deserializer.putBitIn bitIn
+      led =  persistLed
+
+mkSim :: Module Empty
+mkSim = do
+  let cfg          :: BRAM_Configure = defaultValue
+
+  count            :: Reg (UInt 3) <- mkReg 0;
+  initCFunctions :: Reg Bool <- mkReg False;
+  core             :: Core FCLK <- mkCore;
+
+  addRules $
+    rules
+      "initCFunctionsOnce":  when not initCFunctions ==>
+        do
+          initTerminal
+          setupSigintHandler
+          initCFunctions := True
+      "coreCharDeviceO":  when True ==>
+        do
+          writeCharToTerminal core.getChar
+      "coreCharDeviceI":  when (isCharAvailable == 1) ==>
+        do
+          core.putChar getCharFromTerminal
+      "endSim":  when wasCtrlCReceived ==>
+        do
+          restoreTerminal
+          $display "GOT CTRL+C"
+          $finish