hopefully progressing to a more scalable bus architecture

hs/Bus.hs

@@ -0,0 +1,45 @@
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+module Bus() where
+
+import Clash.Prelude
+
+import Peripherals.Ram(Ram, RamLine)
+import Machine(Peripherals(..))
+import BusTypes(
+    BusError(..),
+    TransactionSize(..),
+    Request(..),
+    BusResponse(..),
+    BusVal(..),
+    ReadResponse(..),
+    WriteResponse(..)
+  )
+import Types(Addr,
+             Byte, HalfWord, FullWord, DoubleWord, QuadWord)
+
+alignCheck :: Addr -> TransactionSize -> Bool
+alignCheck addr SizeByte       = True
+alignCheck addr SizeHalfWord   = addr `mod` 2 == 0
+alignCheck addr SizeWord       = addr `mod` 4 == 0
+alignCheck addr SizeDoubleWord = addr `mod` 8 == 0
+alignCheck addr SizeQuadWord   = addr `mod` 16 == 0
+
+-- ram shoudl start at 0x80000000
+
+-- concatWords :: [Ram -> Addr -> RamLine] -> Ram -> Addr -> RamLine
+-- concatWords readers ram baseAddr = foldl (\acc f -> (acc `shiftL` 32) .|. f ram baseAddr) 0 readers
+
+-- read :: Request -> Peripherals -> ReadResponse
+-- read (Request addr size) peripherals
+--   | not (alignCheck addr size) = ReadError UnAligned
+--   | addr >= numBytesInRam      = ReadError UnMapped
+--   | otherwise                  =
+--     case size of
+--       SizeByte       -> BusByte $ fromIntegral $ extractByte (ramRead 0)
+--       SizeHalfWord   -> BusHalfWord $ fromIntegral $ (ramRead 0 `shiftL` 8) .|. ramRead 1
+--       SizeWord       -> BusWord $ fromIntegral $ concatReads [0..3]
+--       SizeDoubleWord -> BusDoubleWord $ fromIntegral $ concatReads [0..7]
+--       SizeQuadWord   -> BusQuadWord $ fromIntegral $ concatReads [0..15]
+--   where
+--     ramRead offset = Peripherals.Ram.read (ram peripherals) (fromIntegral (addr + offset))
+--     concatReads offsets = foldl (\acc o -> (acc `shiftL` 8) .|. ramRead o) 0 offsets

hs/BusTypes.hs

@@ -0,0 +1,52 @@
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+module BusTypes(
+    BusError(..),
+    TransactionSize(..),
+    Request(..),
+    BusResponse(..),
+    BusVal(..),
+    ReadResponse(..),
+    WriteResponse(..)
+    ) where
+
+import Clash.Prelude
+
+import Peripherals.Ram(Ram, RamLine)
+import Machine(Peripherals(..))
+import Types(Addr,
+             Byte, HalfWord, FullWord, DoubleWord, QuadWord)
+
+data BusError
+    = UnMapped
+    | UnAligned
+    deriving (Generic, Show, Eq, NFDataX)
+
+data TransactionSize
+    = SizeByte
+    | SizeHalfWord
+    | SizeWord
+    | SizeDoubleWord
+    | SizeQuadWord
+    deriving (Generic, Show, Eq, NFDataX)
+
+data Request = Request Addr TransactionSize
+    deriving (Generic, Show, Eq, NFDataX)
+
+data BusResponse a
+    = Result a
+    | Error BusError
+    deriving (Generic, Show, Eq, NFDataX)
+
+data BusVal
+    = BusByte Byte
+    | BusHalfWord HalfWord
+    | BusWord FullWord
+    | BusDoubleWord DoubleWord
+    | BusQuadWord QuadWord
+    deriving (Generic, Show, Eq, NFDataX)
+
+newtype ReadResponse = ReadResponse (BusResponse BusVal)
+    deriving (Generic, Show, Eq, NFDataX)
+
+newtype WriteResponse = WriteResponse (BusResponse ())
+    deriving (Generic, Show, Eq, NFDataX)

hs/Peripherals/Ram.hs

@@ -3,7 +3,12 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell #-}
 
-module Peripherals.Ram(initRamFromFile, Ram) where
+module Peripherals.Ram(
+  initRamFromFile,
+  Ram,
+  RamLine,
+  -- Peripherals.Ram.read,
+  write) where
 
 import Clash.Prelude
 import qualified Prelude as P
@@ -11,6 +16,8 @@ import qualified Data.ByteString.Lazy as BL
 import Data.Binary.Get
 import Data.Int (Int32)
 import qualified Clash.Sized.Vector as Vec
+import Types(Addr,
+             Byte, HalfWord, FullWord, DoubleWord, QuadWord)
 
 -- vector depth has to be known statically at compile time
 #ifndef _RAM_DEPTH
@@ -19,6 +26,51 @@ import qualified Clash.Sized.Vector as Vec
 
 -- TODO : replace Unsigned 32 with BusVal types later...
 type Ram = Vec _RAM_DEPTH (Unsigned 32)
+type RamAddr = Unsigned (CLog 2 _RAM_DEPTH)
+type RamLine = Unsigned 32
+bytesInRam = 1024 * 4
+
+readByte0 :: Ram -> RamAddr -> Byte
+readByte0 ram addr = unpack $ slice d31 d24 word
+  where word = ram !! addr
+
+readByte1 :: Ram -> RamAddr -> Byte
+readByte1 ram addr = unpack $ slice d23 d16 word
+  where word = ram !! addr
+
+readByte2 :: Ram -> RamAddr -> Byte
+readByte2 ram addr = unpack $ slice d15 d8 word
+  where word = ram !! addr
+
+readByte3 :: Ram -> RamAddr -> Byte
+readByte3 ram addr = unpack $ slice d7 d0 word
+  where word = ram !! addr
+
+readHalfWord0 :: Ram -> RamAddr -> HalfWord
+readHalfWord0 ram addr = unpack $ slice d31 d16 word
+  where word = ram !! addr
+
+readHalfWord1 :: Ram -> RamAddr -> HalfWord
+readHalfWord1 ram addr = unpack $ slice d15 d0 word
+  where word = ram !! addr
+
+readFullWord :: Ram -> RamAddr -> FullWord
+readFullWord ram addr = ram !! addr
+
+readDoubleWord :: Ram -> RamAddr -> DoubleWord
+readDoubleWord ram addr = bitCoerce $ bitCoerce word0 ++# bitCoerce word1
+  where
+    word0 = readFullWord ram addr
+    word1 = readFullWord ram (addr + 1)
+
+readQuadWord :: Ram -> RamAddr -> QuadWord
+readQuadWord ram addr = bitCoerce $ bitCoerce dword0 ++# bitCoerce dword1
+  where
+    dword0 = readDoubleWord ram addr
+    dword1 = readDoubleWord ram (addr + 2)
+
+write :: Ram -> RamAddr -> RamLine -> Ram
+write ram addr value = replace addr value ram
 
 initRamFromFile :: FilePath -> IO (Maybe Ram)
 initRamFromFile filePath =
@@ -61,33 +113,3 @@ populateVectorFromInt32 ls v = Vec.fromList adjustedLs
 
 
 
--- Function to increment each element of a Clash vector
--- prepareVector :: KnownNat n => [Int32] -> Vec n (Unsigned 32)
--- prepareVector xs = let
---   unsigneds = map (fromIntegral :: Int32 -> Unsigned 32) xs  -- Step 1: Convert Int32 to Unsigned 32
---   len = length unsigneds
---   in case compare len (snatToNum (SNat @n)) of  -- Step 2: Adjust the length of the list
---       LT -> takeI unsigneds ++ repeat 0  -- Pad with zeros if the list is shorter
---       GT -> takeI unsigneds  -- Truncate if the list is longer
---       EQ -> takeI unsigneds  -- No padding or truncation needed
-
--- Function to load firmware
--- loadFirmware :: KnownNat n => [Int32] -> Vec n (Unsigned 32)
--- loadFirmware (x:xs) = vecHead ++ vecTail
---     where
---         vecHead = singleton (fromIntegral x)
---         vecTail = loadFirmware xs
--- loadFirmware [] = takeI $ repeat 0
-
--- loadFirmware xs = v
---     where
---         mapped :: [Unsigned 32] = Clash.Prelude.fromIntegral <$> xs
---         c = takeI (mapped ++ repeat 0)
---         v = takeI $ (mapped ++ repeat 0)
-
--- -- Example usage
--- someList :: [Int32]
--- someList = [1, 2, 3, 4, 5]
-
--- mem :: Vec 16 (Unsigned 32)
--- mem = loadFirmware someList

hs/Peripherals/Setup.hs

@@ -3,7 +3,7 @@ module Peripherals.Setup (
   ) where
 
 import Prelude
-import Peripherals.UartCFFI(initTerminal)
+import Peripherals.UartCFFI(initTerminal, restoreTerminal)
 import Peripherals.Ram (initRamFromFile, Ram)
 import Control.Exception (try)
 import System.IO.Error (ioeGetErrorString)

hs/Simulation.hs

@@ -48,10 +48,6 @@ machine' machine =
     peripherals' = machinePeripherals { ram = mem' }
     cpu' = machineCPU { pc = machinePC + 4 }
 
-    instruction =
-      case (fetchInstruction machineMem machinePC) of
-        Instruction i -> i
-        _ -> undefined
   in
     case (fetchInstruction machineMem machinePC) of
       Instruction insn ->
@@ -68,6 +64,9 @@ simulationLoop :: Int -> Machine -> IO [Machine]
 simulationLoop 0 state = return [state]
 simulationLoop n state = do
   let newState = machine' state
+  -- later use this to display writes from machine to its
+  -- uart peripheral
+  -- writeCharToTerminal 'a'
   rest <- simulationLoop (n - 1) newState
   return (state : rest)
 

hs/Types.hs

@@ -1,7 +1,9 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE NumericUnderscores #-}
 
-module Types(Pc, BusVal(..), Mem, FullWord, Insn, Addr) where
+module Types(Pc, Mem, Insn, Addr,
+    Byte, HalfWord, FullWord, DoubleWord, QuadWord)
+    where
 
 import Clash.Prelude
 
@@ -12,14 +14,6 @@ type DoubleWord = Unsigned 64
 type QuadWord   = Unsigned 128
 type Insn = FullWord
 
-data BusVal
-    = BusByte Byte
-    | BusHalfWord HalfWord
-    | BusWord FullWord
-    | BusDoubleWord DoubleWord
-    | BusQuadWord QuadWord
-    deriving (Generic, Show, Eq, NFDataX)
-
 type Pc   = DoubleWord
 type Addr = DoubleWord
 type Mem n = Vec n FullWord