Skip to content

Instantly share code, notes, and snippets.

@martijnbastiaan
Created July 10, 2019 20:32
Show Gist options
  • Save martijnbastiaan/3fdb7b9b19ffafa12fd661489d8b09f2 to your computer and use it in GitHub Desktop.
Save martijnbastiaan/3fdb7b9b19ffafa12fd661489d8b09f2 to your computer and use it in GitHub Desktop.
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
module CPU where
import Clash.Prelude
import Data.Maybe (isJust)
import Control.DeepSeq (NFData)
import GHC.Generics (Generic)
data Ready
= Busy
| Ready
deriving (Generic, NFData, Show)
data CPUState
= Idle
| Waiting Int
deriving (Generic, NFData, Show)
data Instruction
= Add Int Int
| Multiply Int Int
deriving (Generic, NFData, Show)
doInstr :: Instruction -> Int
doInstr (Add a b) = a + b
doInstr (Multiply a b) = a * b
cpu
:: (CPUState, Int)
-- ^ State
-> Maybe Instruction
-- ^ Input
-> ((CPUState, Int), (Maybe Int, Ready))
-- (New state, output)
-- state input new state output
cpu (Idle, _) Nothing = ((Idle, 0), (Nothing, Ready))
cpu (Idle, _) (Just instr) = ((Waiting 0, doInstr instr), (Nothing, Busy))
cpu (Waiting 1, r) _ = ((Idle, 0), (Just r, Ready))
cpu (Waiting n, r) _ = ((Waiting (n + 1), r), (Nothing, Busy))
-- Example 1: Simple feed some instructions with nothings in between:
instrs1 :: [Maybe Instruction]
instrs1 =
[ Just (Add 1 2)
, Nothing
, Nothing
, Just (Add 3 5)
, Nothing
, Nothing
, Nothing
]
sim1 :: IO ()
sim1 = do
let s = mealy cpu (Idle, 0) (fromList instrs1)
putStrLn $ show $ sampleN 7 $ s
-- Example 2: Do the same as example 1, but manipulate the output signal:
sim2 :: IO ()
sim2 = do
let s = mealy cpu (Idle, 0) (fromList instrs1)
-- Only print first half of tuple:
putStrLn $ show $ sampleN 7 $ fmap fst s
-- Only print whether cpu outputted a result:
putStrLn $ show $ sampleN 7 $ fmap (isJust . fst) s
-- Example 3: Have another circuit drive the cpu
driver
:: Vec 3 Instruction
-> Ready
-> (Vec 3 Instruction, Maybe Instruction)
driver instrs Busy = (instrs, Nothing)
driver instrs Ready = (rotateLeftS instrs d1, Just (head instrs))
composed :: SystemClockReset => Signal System (Maybe Int)
composed = cpuResult
where
instr = mealy driver (Add 3 5 :> Multiply 10 2 :> Add 7 3 :> Nil) ready
-- If the cpu would directly depend on the driver, and vice-versa we would
-- create a combinatorial loop which is not computable. In order to prevent
-- such a loop, we insert a delay with its first value being "Nothing" or
-- "No instruction".
instrDelayed = register Nothing instr
cpuOutput = mealy cpu (Idle, 0) instrDelayed
(cpuResult, ready) = unbundle cpuOutput
sim3 :: IO ()
sim3 = putStrLn $ show $ sampleN 7 $ composed
-- Example 4: 'composed' should be fully synthesizable by running :vhdl. When
-- I test it on 0.99.3 I get compile errors though..
topEntity
:: Clock System Source
-> Reset System Asynchronous
-> Signal System (Maybe Int)
topEntity clk rst = withClockReset clk rst composed
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment