first commit

hs/Decode/Opcodes.hs

@@ -0,0 +1,52 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE NumericUnderscores #-}
+
+module Decode.Opcodes(Opcode(..)) where
+import Clash.Prelude
+import Data.Functor.Contravariant (Op)
+
+type FUNCT7 = Unsigned 7
+type RS2    = Unsigned 5
+type RS1    = Unsigned 5
+type FUNCT3 = Unsigned 3
+type RD     = Unsigned 5
+type OPCODE = Unsigned 7
+
+type IMM12  = Unsigned 12
+type IMM13  = Unsigned 13
+type IMM20  = Unsigned 20
+type IMM21  = Unsigned 21
+
+data RTypeFields = RTypeFields OPCODE RD FUNCT3 RS1 RS2 FUNCT7
+data ITypeFields = ITypeFields OPCODE RD FUNCT3 RS1 IMM12
+data STypeFields = STypeFields OPCODE FUNCT3 RS1 RS2 IMM12
+data BTypeFields = BTypeFields OPCODE FUNCT3 RS1 RS2 IMM13
+data UTypeFields = UTypeFields OPCODE RD IMM20
+data JTypeFields = JTypeFields OPCODE RD IMM21
+
+data Opcode
+  = ADD  RTypeFields
+  | SUB  RTypeFields
+  | XOR  RTypeFields
+  | OR   RTypeFields
+  | AND  RTypeFields
+  | SLL  RTypeFields
+  | SRL  RTypeFields
+  | SRA  RTypeFields
+  | SLT  RTypeFields
+  | SLTU RTypeFields
+  | ADDRI  ITypeFields
+  | XORI   ITypeFields
+  | ORI    ITypeFields
+  | ANDI   ITypeFields
+  | SLLI   ITypeFields
+  | SRLI   ITypeFields
+  | SRAI   ITypeFields
+  | SLTI   ITypeFields
+  | SLTIU  ITypeFields
+  | LB     ITypeFields
+  | LH     ITypeFields
+  | LW     ITypeFields
+  | LBU    ITypeFields
+  | LHU    ITypeFields
+

hs/Fetch.hs

@@ -0,0 +1,24 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE NumericUnderscores #-}
+
+module Fetch(fetchInstruction) where
+
+import Clash.Prelude
+import Types(Mem, Addr, FullWord)
+import Util(endianSwapWord)
+
+data Insn = Instruction FullWord
+          | Misaligned Addr
+
+fetchInstruction :: KnownNat n => Mem n -> Addr -> Insn
+fetchInstruction mem addr =
+  let
+    isWordAligned = addr .&. 3 == 0
+    addrWordAligned = addr `shiftR` 2
+    insn = mem !! addrWordAligned
+    -- TODO : check if instruction is word aligned and create type
+    -- to capture if its not.
+  in
+    case isWordAligned of
+      True -> Instruction insn
+      False -> Misaligned addr

hs/Machine.hs

@@ -0,0 +1,67 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE NumericUnderscores #-}
+
+module Machine(
+  Machine(..),
+  RISCVCPU(..),
+  Endian(..),
+  machineInit) where
+
+import Clash.Prelude
+import Types(Pc, Mem)
+import RegFiles(GPR, FPR, CSR, gprInit, fprInit, csrInit)
+
+data Endian = Big | Little
+  deriving (Generic, Show, Eq, NFDataX)
+
+data PrivilegeLevel
+  = MachineMode
+  | SuperVisorMode
+  | UserMode
+  deriving (Generic, Show, Eq, NFDataX)
+
+data RISCVCPU = RISCVCPU
+  { pc  :: Pc,
+    gpr :: GPR,
+    fpr :: FPR,
+    privilegeLevel :: PrivilegeLevel
+  }
+  deriving (Generic, Show, Eq, NFDataX)
+
+data Machine = Machine
+  { cpu :: RISCVCPU,
+    mem :: Mem 14
+  }
+  deriving (Generic, Show, Eq, NFDataX)
+
+riscvCPUInit :: RISCVCPU
+riscvCPUInit =
+  RISCVCPU
+    0
+    gprInit
+    fprInit
+    MachineMode
+
+machineInit :: Machine
+machineInit =
+  Machine
+    riscvCPUInit
+    memInit
+
+memInit :: Vec 14 (Unsigned 32)
+memInit =
+     0x0000A03C
+  :> 0x3000A5E8
+  :> 0x1A002038
+  :> 0x18002598
+  :> 0x10002588
+  :> 0x01002170
+  :> 0xF8FF8141
+  :> 0x08002588
+  :> 0x01002138
+  :> 0x00002598
+  :> 0xE8FFFF4B
+  :> 0x00000060
+  :> 0x002000C0
+  :> 0x00000000
+  :> Nil

hs/Peripherals/Ram.hs

@@ -0,0 +1,93 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Peripherals.Ram() where
+
+import Clash.Prelude
+import qualified Prelude as P
+import qualified Data.ByteString.Lazy as BL
+import Data.Binary.Get
+import Data.Int (Int32)
+import qualified Clash.Sized.Vector as Vec
+
+-- vector depth has to be known statically at compile time
+#ifndef _RAM_DEPTH
+#define _RAM_DEPTH 1024
+#endif
+
+-- TODO : replace Unsigned 32 with BusVal types later...
+type Ram = Vec _RAM_DEPTH (Unsigned 32)
+
+initRamFromFile :: FilePath -> IO (Maybe Ram)
+initRamFromFile filePath = 
+    let
+      initRam = Vec.replicate (SNat :: SNat _RAM_DEPTH) 0
+    in
+      do
+      bs <- readFileIntoByteString filePath
+      let ints = getInts bs
+      pure $ populateVectorFromInt32 ints initRam
+
+readFileIntoByteString :: FilePath -> IO BL.ByteString
+readFileIntoByteString filePath = BL.readFile filePath
+
+-- Define a function to read a ByteString and convert to [Int32]
+getInts :: BL.ByteString -> [Int32]
+getInts bs = runGet listOfInts bs
+  where
+    listOfInts = do
+      empty <- isEmpty
+      if empty
+        then pure []
+      else do
+        i <- getInt32le    -- Parse a single Int32 from the stream
+        rest <- listOfInts -- Recursively parse the rest
+        pure (i : rest)
+
+-- Adjusts the length of a list of integers by either truncating or padding with zeros
+populateVectorFromInt32 :: 
+    KnownNat n =>
+    [Int32] -> 
+    Vec n (Unsigned 32) -> 
+    Maybe (Vec n (Unsigned 32))
+populateVectorFromInt32 ls v = Vec.fromList adjustedLs
+  where
+    vecLen = length v
+    adjustedLs = fromIntegral <$> adjustLength vecLen ls
+    adjustLength :: Int -> [Int32] -> [Int32]
+    adjustLength n xs = P.take n (xs P.++ P.repeat 0)
+
+
+
+-- 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

@@ -0,0 +1,8 @@
+module Peripherals.Setup (setupPeripherals) where
+
+import Prelude
+import Peripherals.UartCFFI(initTerminal)
+
+setupPeripherals :: IO ()
+setupPeripherals = do
+    initTerminal

hs/Peripherals/Teardown.hs

@@ -0,0 +1,8 @@
+module Peripherals.Teardown(teardownPeripherals) where
+
+import Prelude
+import Peripherals.UartCFFI(restoreTerminal)
+
+teardownPeripherals :: IO ()
+teardownPeripherals = do
+    restoreTerminal

hs/Peripherals/UartCFFI.hs

@@ -0,0 +1,52 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+
+module Peripherals.UartCFFI (
+    initTerminal,
+    restoreTerminal,
+    getCharFromTerminal,
+    writeCharToTerminal,
+    isCharAvailable,
+    setupSigintHandler,
+    wasCtrlCReceived
+) where
+
+import Prelude
+import Foreign.C.Types
+import Foreign.C.String
+import Foreign.Ptr
+import Data.Char (chr, ord)
+
+-- Foreign imports directly corresponding to the C functions
+foreign import ccall "init_terminal"            c_initTerminal :: IO ()
+foreign import ccall "restore_terminal"         c_restoreTerminal :: IO ()
+foreign import ccall "get_char_from_terminal"   c_getCharFromTerminal :: IO CChar
+foreign import ccall "write_char_to_terminal"   c_writeCharToTerminal :: CChar -> IO ()
+foreign import ccall "is_char_available"        c_isCharAvailable :: IO CInt
+foreign import ccall "setup_sigint_handler"     c_setupSigintHandler :: IO ()
+foreign import ccall "was_ctrl_c_received"      c_wasCtrlCReceived :: IO CInt
+
+-- Haskell friendly wrappers
+initTerminal :: IO ()
+initTerminal = c_initTerminal
+
+restoreTerminal :: IO ()
+restoreTerminal = c_restoreTerminal
+
+getCharFromTerminal :: IO Char
+getCharFromTerminal = fmap (chr . fromEnum) c_getCharFromTerminal
+
+writeCharToTerminal :: Char -> IO ()
+writeCharToTerminal char = c_writeCharToTerminal (toEnum $ ord char)
+
+isCharAvailable :: IO Int
+isCharAvailable = fmap fromEnum c_isCharAvailable
+
+setupSigintHandler :: IO ()
+setupSigintHandler = c_setupSigintHandler
+
+wasCtrlCReceived :: IO Int
+wasCtrlCReceived = fmap fromEnum c_wasCtrlCReceived
+
+-- Improved version of the ctrlCReceived to use the new wasCtrlCReceived signature
+ctrlCReceived :: IO Bool
+ctrlCReceived = fmap (/= 0) wasCtrlCReceived

hs/RegFiles.hs

@@ -0,0 +1,56 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE NumericUnderscores #-}
+
+module RegFiles(
+    GPR,
+    FPR,
+    CSR,
+    gprInit,
+    fprInit,
+    csrInit
+    ) where
+
+import Clash.Prelude
+
+-- In RISC-V, besides the GPR, FPR, and CSR, we may also encounter
+-- the following which are not modeled in this codebase.
+--  * VRF(Vector Registers File) for vector processing.
+--  * Debug Registers (DBR) for hardware debugging.
+--  * Shadow Registers for fast context switching (optional).
+--  * MPU Registers for memory protection.
+--  * Counter/Timer Registers for time/cycle counting.
+--  * Hypervisor Registers (HPR) for guest virtualization.
+
+type GPR = Vec 32 (Unsigned 64)
+type FPR = Vec 32 (Unsigned 64)
+type CSR = Vec 4096 (Unsigned 64)
+
+gprInit :: GPR
+gprInit = repeat 0
+
+fprInit :: FPR
+fprInit = repeat 0
+
+-- TODO: CSR can't actually be all 0 during initialization.
+-- We need to revisit the following and properly initialize
+-- various registers later.
+csrInit :: CSR
+csrInit =
+    replace (0x301 :: Integer) misa_init
+  $ replace (0x300 :: Integer) mstatus_init
+  $ replace (0x305 :: Integer) mtvec_init
+  $ replace (0xF11 :: Integer) mvendorid_init
+  $ replace (0xF12 :: Integer) marchid_init
+  $ replace (0xF13 :: Integer) mimpid_init
+  $ replace (0x701 :: Integer) mtime_init
+  $ replace (0x321 :: Integer) mtimecmp_init
+  $ repeat 0
+  where
+    misa_init     = 0x8000000000001104  -- `RV64IMAFD`
+    mstatus_init  = 0x0000000000001800  -- Default `mstatus`
+    mtvec_init    = 0x0000000000001000  -- Trap vector base
+    mvendorid_init = 0x00000000
+    marchid_init   = 0x00000000
+    mimpid_init    = 0x00000000
+    mtime_init     = 0x0000000000000000
+    mtimecmp_init  = 0xFFFFFFFFFFFFFFFF

hs/Simulation.hs

@@ -0,0 +1,71 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE ConstraintKinds #-}
+
+module Simulation(Args(..), simulation) where
+
+import Peripherals.Setup(setupPeripherals)
+import Peripherals.Teardown(teardownPeripherals)
+import Text.Printf (printf)
+import Clash.Prelude
+import Machine(
+  Machine(..),
+  RISCVCPU(..),
+  machineInit, RISCVCPU (RISCVCPU))
+import Fetch(fetchInstruction)
+import Peripherals.UartCFFI(writeCharToTerminal)
+import Control.Concurrent (threadDelay)
+
+import Debug.Trace
+
+data Args = Args {
+    firmware :: FilePath
+    } deriving (Show)
+
+machine :: Machine
+machine = machineInit
+
+machine' :: Machine -> Machine
+machine' machine =
+  let
+    -- instruction =
+    --   traceShow
+    --     (printf "0x%X" (toInteger v) :: String)
+    --     v
+    --   where v = fetchInstruction mem msr pc
+    -- instruction = traceShow (bitpatToOpcode v) v
+    --   where v = fetchInstruction machineMem machinePC
+    machineMem  = mem machine
+    machineCPU  = cpu machine
+    machinePC   = pc machineCPU
+    instruction = fetchInstruction machineMem machinePC
+    addr = 0 :: Integer
+    -- execute would go here, but right now, we simply
+    mem' = replace addr (3) machineMem
+    cpu' = machineCPU { pc = machinePC + 4 }
+  in
+    machine { cpu = cpu', mem = mem' }
+
+machineSignal :: HiddenClockResetEnable dom => Signal dom Machine
+machineSignal = register machine (machine' <$> machineSignal)
+
+simulationLoop :: Int -> Machine -> IO [Machine]
+simulationLoop 0 state = return [state]
+simulationLoop n state = do
+  let newState = machine' state
+  rest <- simulationLoop (n - 1) newState
+  return (state : rest)
+
+simulation :: Args -> IO [Machine]
+simulation args = do
+  setupPeripherals
+
+  -- quick smoketest that UART works - remove later
+  writeCharToTerminal 'a'
+  threadDelay 1000000  -- Delay for 1 second (1,000,000 microseconds)
+
+  let initState = machine
+  sim <- simulationLoop 5 initState
+  teardownPeripherals
+  return sim

hs/Types.hs

@@ -0,0 +1,24 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE NumericUnderscores #-}
+
+module Types(Pc, BusVal(..), Mem, FullWord, Addr) where
+
+import Clash.Prelude
+
+type Byte       = Unsigned 8
+type HalfWord   = Unsigned 16
+type FullWord   = Unsigned 32
+type DoubleWord = Unsigned 64
+type QuadWord   = Unsigned 128
+
+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

hs/Util.hs

@@ -0,0 +1,44 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE ConstraintKinds #-}
+
+module Util(
+  powerIndex32,
+  powerIndex64,
+  endianSwapWord) where
+
+import Clash.Prelude
+import Types(FullWord)
+
+data ValidIndex32 (n :: Nat) where
+  ValidIndex32 :: (0 <= n, n <= 31) => SNat n -> ValidIndex32 n
+
+mkValidIndex32 :: forall n. (KnownNat n, 0 <= n, n <= 31) => ValidIndex32 n
+mkValidIndex32 = ValidIndex32 $ SNat @n
+
+powerIndex32 :: forall n. (KnownNat n, 0 <= n, n <= 31) => SNat (31 - n)
+powerIndex32 = case mkValidIndex32 @n of
+  ValidIndex32 _ -> SNat @(31 - n)
+
+data ValidIndex63 (n :: Nat) where
+  ValidIndex63 :: (0 <= n, n <= 63) => SNat n -> ValidIndex63 n
+
+mkValidIndex64 :: forall n. (KnownNat n, 0 <= n, n <= 63) => ValidIndex63 n
+mkValidIndex64 = ValidIndex63 $ SNat @n
+
+powerIndex64 :: forall n. (KnownNat n, 0 <= n, n <= 63) => SNat (63 - n)
+powerIndex64 = case mkValidIndex64 @n of
+  ValidIndex63 _ -> SNat @(63 - n)
+
+endianSwapWord :: FullWord -> FullWord
+endianSwapWord x = 
+  (byte0 `shiftL` 24) .|.
+  (byte1 `shiftL` 16) .|.
+  (byte2 `shiftL` 8)  .|.
+  byte3
+  where
+    byte0 = (x .&. 0x000000FF)
+    byte1 = (x .&. 0x0000FF00) `shiftR` 8
+    byte2 = (x .&. 0x00FF0000) `shiftR` 16
+    byte3 = (x .&. 0xFF000000) `shiftR` 24