Uart now has correct write implementation presumably

hs/Bus.hs

@@ -4,6 +4,7 @@ module Bus() where
 import Clash.Prelude
 
 import Peripherals.Ram(Ram, RamLine, read, RamAddr)
+import Peripherals.Uart(UartAddr, read)
 import Machine(Peripherals(..))
 import BusTypes(
     BusError(..),
@@ -35,10 +36,19 @@ alignCheck addr SizeQuadWord   = addr `mod` 16 == 0
 read :: Request -> Peripherals -> IO ReadResponse
 read (Request addr size) peripherals
   | not (alignCheck addr size) = return $ ReadResponse $ Error UnAligned
-  | (addr > ramStart) && (addr < ramEnd) =
-    return $ ReadResponse $ Result $ Peripherals.Ram.read size ramAddr (ram peripherals)
+  | (addr >= ramStart) && (addr <= ramEnd) =
+    return        $
+    ReadResponse  $
+    Result        $ Peripherals.Ram.read size ramAddr (ram peripherals)
+  | (addr >= uartStart) && (addr <= uartEnd) =
+     ReadResponse . Result <$>
+     Peripherals.Uart.read size uartAddr
   | otherwise = return $ ReadResponse $ Error UnMapped
     where
       ramAddrNoOffset = addr - ramStart
       ramAddr :: RamAddr
       ramAddr = resize ramAddrNoOffset
+
+      uartAddrNoOffset = addr - uartStart
+      uartAddr :: UartAddr
+      uartAddr = resize uartAddrNoOffset

hs/Peripherals/Uart.hs

@@ -1,8 +1,8 @@
-module Peripherals.Uart (read) where
+module Peripherals.Uart (read, write, UartAddr) where
 
 import Clash.Prelude hiding (read)
 import Types (Byte)
-import Data.Char (ord)
+import Data.Char (ord, chr)
 
 import Peripherals.UartCFFI (
     initTerminal,
@@ -20,6 +20,7 @@ import BusTypes (
     ReadResponse(..),
     WriteResponse(..)
   )
+import GHC.Generics (URec(UAddr), Generic (from))
 
 -- based on a 16550 UART which has an address space of 8 bytes
 type UartAddr = Unsigned 3
@@ -28,6 +29,9 @@ type UartAddr = Unsigned 3
 rbrAddr :: UartAddr
 rbrAddr = 0x0
 
+thrAddr :: UartAddr
+thrAddr = 0x0
+
 -- Line Status Register address
 lsrAddr :: UartAddr
 lsrAddr = 0x5
@@ -50,8 +54,11 @@ buildRBR = do
 -- Reads the Line Status Register (LSR) to check character availability
 buildLSR :: IO Byte
 buildLSR = do
-  char_available <- isCharAvailable
-  return $ fromIntegral char_available
+  (char_available :: Byte) <- fromIntegral <$> isCharAvailable
+  -- highly unlikely that we overflow stdout buffer, so we set
+  -- transmit to always ready
+  let (transmit_ready :: Byte) = 0b0010_0000
+  return (char_available .|. transmit_ready)
 
 -- Updated 'read' function to handle RBR and LSR reads
 read :: TransactionSize -> UartAddr -> IO BusVal
@@ -59,3 +66,18 @@ read size addr
   | addr == rbrAddr = busValFromByte size <$> buildRBR
   | addr == lsrAddr = busValFromByte size <$> buildLSR
   | otherwise       = return $ busValFromByte size 0x00
+
+extractLowestByte :: BusVal -> Byte
+extractLowestByte (BusByte b)       = b
+extractLowestByte (BusHalfWord hw)  = resize hw
+extractLowestByte (BusFullWord fw)  = resize fw
+extractLowestByte (BusDoubleWord dw) = resize dw
+extractLowestByte (BusQuadWord qw)   = resize qw
+
+byteToChar :: Byte -> Char
+byteToChar = chr . fromIntegral
+
+write :: BusVal -> UartAddr -> IO ()
+write val addr
+  | addr == thrAddr = writeCharToTerminal $ byteToChar $ extractLowestByte val
+  | otherwise = return ()