{-# 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