96 lines
3 KiB
Haskell
96 lines
3 KiB
Haskell
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
|
|
module Bus(
|
|
Peripherals(..),
|
|
ReadResponse,
|
|
WriteResponse,
|
|
Bus.read,
|
|
Bus.write,
|
|
) where
|
|
|
|
import Clash.Prelude
|
|
|
|
import Peripherals.Ram(Ram, RamLine, read, RamAddr)
|
|
import Peripherals.Uart(UartAddr, read, write)
|
|
|
|
import BusTypes(
|
|
BusError(..),
|
|
TransactionSize(..),
|
|
WriteRequest(..),
|
|
ReadRequest(..),
|
|
BusVal(..),
|
|
)
|
|
import Types(Addr)
|
|
import Peripherals.Ram(write, bytesInRam)
|
|
import Util((|>))
|
|
|
|
|
|
data Peripherals = Peripherals
|
|
{
|
|
ram :: Ram
|
|
}
|
|
deriving (Generic, Show, Eq, NFDataX)
|
|
|
|
type ReadResponse = Either BusError BusVal
|
|
type WriteResponse = Either BusError Peripherals
|
|
|
|
busValToTransactionSize :: BusVal -> TransactionSize
|
|
busValToTransactionSize (BusByte _) = SizeByte
|
|
busValToTransactionSize (BusHalfWord _) = SizeHalfWord
|
|
busValToTransactionSize (BusFullWord _) = SizeFullWord
|
|
busValToTransactionSize (BusDoubleWord _) = SizeDoubleWord
|
|
busValToTransactionSize (BusQuadWord _) = SizeQuadWord
|
|
|
|
alignCheck :: Addr -> TransactionSize -> Bool
|
|
alignCheck _ SizeByte = True
|
|
alignCheck addr SizeHalfWord = addr `mod` 2 == 0
|
|
alignCheck addr SizeFullWord = addr `mod` 4 == 0
|
|
alignCheck addr SizeDoubleWord = addr `mod` 8 == 0
|
|
alignCheck addr SizeQuadWord = addr `mod` 16 == 0
|
|
|
|
-- address space follows QEMU behavior for now
|
|
(ramStart, ramEnd) = (0x80000000 :: Addr, ramStart + (bytesInRam - 1))
|
|
(uartStart, uartEnd) = (0x10000000 :: Addr, uartStart + 7)
|
|
|
|
-- reading/writing from/to UART is implemented as reading/writing
|
|
-- from/to stdin/stdout, so we need IO.
|
|
read :: ReadRequest -> Peripherals -> IO ReadResponse
|
|
read (ReadRequest addr size) peripherals
|
|
| not (alignCheck addr size) = return |> Left UnAligned
|
|
| (addr >= ramStart) && (addr <= ramEnd) =
|
|
return |> Right |> Peripherals.Ram.read size ramWordAddr (ram peripherals)
|
|
| (addr >= uartStart) && (addr <= uartEnd) =
|
|
fmap Right (Peripherals.Uart.read size uartAddr)
|
|
| otherwise = return |> Left UnMapped
|
|
where
|
|
ramAddrNoOffset = addr - ramStart
|
|
ramAddr :: RamAddr
|
|
ramAddr = resize ramAddrNoOffset
|
|
ramWordAddr :: RamAddr
|
|
ramWordAddr = resize |> ramAddrNoOffset `shiftR` 2
|
|
|
|
uartAddrNoOffset = addr - uartStart
|
|
uartAddr :: UartAddr
|
|
uartAddr = resize uartAddrNoOffset
|
|
|
|
write :: WriteRequest -> Peripherals -> IO WriteResponse
|
|
write (WriteRequest addr val) peripherals
|
|
| not (alignCheck addr |> busValToTransactionSize val) = return |> Left UnAligned
|
|
| (addr >= uartStart) && (addr <= uartEnd) =
|
|
do
|
|
Peripherals.Uart.write val uartAddr
|
|
return |> Right peripherals
|
|
| (addr >= ramStart) && (addr <= ramEnd) =
|
|
return |> Right |>
|
|
peripherals {
|
|
ram = Peripherals.Ram.write val ramAddr (ram peripherals)
|
|
}
|
|
| otherwise = return |> Left UnMapped
|
|
where
|
|
ramAddrNoOffset = addr - ramStart
|
|
ramAddr :: RamAddr
|
|
ramAddr = resize ramAddrNoOffset
|
|
|
|
uartAddrNoOffset = addr - uartStart
|
|
uartAddr :: UartAddr
|
|
uartAddr = resize uartAddrNoOffset
|