171 lines
4.4 KiB
Haskell
171 lines
4.4 KiB
Haskell
package Top(mkTop, ITop(..)) where
|
|
|
|
import Deserializer
|
|
import Core
|
|
import Serializer
|
|
import BRAM
|
|
import CBindings
|
|
import Bus
|
|
import TagEngine
|
|
import List
|
|
import ActionSeq
|
|
|
|
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 #-}
|
|
};
|
|
|
|
interface BusClient =
|
|
request :: Bit 1
|
|
response :: Bit 1 -> Action
|
|
|
|
mkBusClient :: Module BusClient
|
|
mkBusClient = module
|
|
reqReg :: Reg (Bit 1) <- mkReg 0
|
|
return $
|
|
interface BusClient
|
|
request = reqReg
|
|
response resp = do
|
|
reqReg := 0 -- Reset request after receiving response
|
|
|
|
interface Bus =
|
|
request :: Bit 1 -> Action
|
|
response :: Bit 1
|
|
|
|
mkBus :: Module Bus
|
|
mkBus = module
|
|
respReg :: Reg (Bit 1) <- mkReg 0
|
|
return $
|
|
interface Bus
|
|
request req = do
|
|
respReg := req -- Simple pass-through for this example
|
|
response = respReg
|
|
|
|
-- -- Function to connect Bus to BusClient
|
|
connectBusToClient :: Bus -> BusClient -> Rules
|
|
connectBusToClient bus client =
|
|
rules
|
|
"busConnection": when True ==> do
|
|
bus.request client.request
|
|
client.response bus.response
|
|
|
|
-- need to implement mkBus
|
|
|
|
-- need function that can connect Bus to BusClient
|
|
|
|
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
|
|
|
|
bus :: Bus <- mkBus
|
|
busClient :: BusClient <- mkBusClient
|
|
let a :: List Integer = 1 :> 2 :> Nil
|
|
b = length a
|
|
|
|
persistLed :: Reg (Bit 8) <- mkReg 0
|
|
messageM $ "Hallo!!" + (realToString 5)
|
|
|
|
-- need to instantiate a Bus and BusClient
|
|
addRules $ connectBusToClient bus busClient
|
|
|
|
addRules $
|
|
rules
|
|
-- need new rule that always connects Bus to BusClient
|
|
"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
|
|
|
|
tagEngine :: TagEngine 5 <- mkTagEngine
|
|
count :: Reg (UInt 4) <- mkReg 0;
|
|
initCFunctions :: Reg Bool <- mkReg False;
|
|
core :: Core FCLK <- mkCore;
|
|
|
|
s :: ActionSeq
|
|
s <- actionSeq
|
|
$ do
|
|
$display "got tag : " tagEngine.requestTag
|
|
|> do
|
|
$display "got tag : " tagEngine.requestTag
|
|
|> do
|
|
$display "got tag : " tagEngine.requestTag
|
|
|> do
|
|
res <- tagEngine.retireTag 3
|
|
$display "retiring tag : 3 " (fshow res)
|
|
action {}
|
|
|> do
|
|
$display "got tag : " tagEngine.requestTag
|
|
|> do
|
|
$display "got tag : " tagEngine.requestTag
|
|
|> do
|
|
res <- tagEngine.retireTag 4
|
|
$display "retiring tag : 4 " (fshow res)
|
|
action {}
|
|
|> do
|
|
res <- tagEngine.retireTag 4
|
|
$display "retiring tag : 4 " (fshow res)
|
|
action {}
|
|
|> do
|
|
res <- tagEngine.retireTag 0
|
|
$display "retiring tag : 0 " (fshow res)
|
|
action {}
|
|
|> do
|
|
$display "got tag : " tagEngine.requestTag
|
|
|> do
|
|
$display "got tag : " tagEngine.requestTag
|
|
|> do
|
|
res <- tagEngine.retireTag 1
|
|
$display "retiring tag : 1 " (fshow res)
|
|
action {}
|
|
|> do
|
|
$display "got tag : " tagEngine.requestTag
|
|
|
|
addRules $
|
|
rules
|
|
"testIncrement": when (count < 10) ==>
|
|
do
|
|
count := count + 1
|
|
s.start
|
|
"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
|