gistfile1.txt

module CPUD where

import CLaSH.Prelude
import qualified Data.List as L

type InstrAddr = Unsigned 8
type MemAddr   = Unsigned 5
type Value     = Signed 8


data Instruction
  = Compute Operator Reg Reg Reg
  | Branch Reg Value
  | Jump Value
  | Load MemAddr Reg
  | Store Reg MemAddr
  | Nop
  deriving (Eq,Show)


data Operator = Add | Sub | Incr | Imm | CmpGt
  deriving (Eq,Show)

data MachCode
  = MachCode
  { inputX  :: Reg
  , inputY  :: Reg
  , result  :: Reg
  , aluCode :: Operator
  , ldReg   :: Reg
  , rdAddr  :: MemAddr
  , wrAddr  :: MemAddr
  , wrEn    :: Bool
  , jmpM    :: Maybe Value
  }

nullCode = MachCode { inputX = Zero, inputY = Zero, result = Zero, aluCode = Imm
                    , ldReg = Zero, wrAddr = 0, rdAddr = 0, wrEn = False
                    , jmpM = Nothing
                    }

data Reg
  = Zero
  | PC
  | RegA
  | RegB
  | RegC
  | RegD
  | RegE
  deriving (Eq,Show,Enum)

regBank wr1 wr2 wr3 rd1 rd2 rd3 = ((\(x,_,_) -> x) <$> out
                                  ,(\(_,x,_) -> x) <$> out
                                  ,(\(_,_,x) -> x) <$> out)
  where
    out = feedback regBankT
    regBankT mem = ((,,) <$> ((!!) <$> mem <*> rd1)
                         <*> ((!!) <$> mem <*> rd2)
                         <*> ((!!) <$> mem <*> rd3)
                   ,delay (singleton $ replicate d7 0) mem')
      where
        mem' = replace Zero 0  <$> (
               uncurry replace <$> wr1 <*> (
               uncurry replace <$> wr2 <*> (
               uncurry replace <$> wr3 <*> mem)))

decoder instr = case instr of
  Compute op rx ry res -> nullCode {inputX=rx,inputY=ry,result=res,aluCode=op}
  Branch cr a          -> nullCode {inputX=cr,jmpM=Just a}
  Jump a               -> nullCode {aluCode=Incr,jmpM=Just a}
  Load a r             -> nullCode {ldReg=r,rdAddr=a}
  Store r a            -> nullCode {inputX=r,wrAddr=a,wrEn=True}
  Nop                  -> nullCode

alu Add   x y = x + y
alu Sub   x y = x - y
alu Incr  x _ = x + 1
alu Imm   x _ = x
alu CmpGt x y = if x > y then 1 else 0

nextPCT jmpM aluOut ipntr = case jmpM of
  Just a | aluOut /= 0 -> ipntr + a
  _                    -> ipntr + 1

cpu memOut instr = (rdAddr,wrAddr,wrEn,aluOut,ipntr)
  where
    -- decoder
    machOp = decoder <$> instr

    -- regbank
    (ipntr,regX,regY) = regBank ((,) <$> pure PC             <*> nextPC)
                                ((,) <$> (result <$> machOp) <*> aluOut)
                                ((,) <$> (ldReg <$> machOp)  <*> memOut)
                                (pure PC)
                                (inputX <$> machOp)
                                (inputY <$> machOp)

    rdAddr = undefined
    wrAddr = undefined
    wrEn   = undefined
    aluOut = undefined
    nextPC = nextPCT <$> (jmpM <$> machOp) <*> aluOut <*> ipntr