{-# LANGUAGE DataKinds, RecordWildCards, TypeOperators #-}
module Sprockell where

import CLaSH.Prelude

{-------------------------------------------------------------
| SPROCKELL: Simple PROCessor in hasKELL :-)
|
| j.kuper@utwente.nl
| October 28, 2012
-------------------------------------------------------------}


-- Types
type Word       = Signed 16

type RegBankSize = 8
type ProgMemSize = 128
type DataMemSize = 128

type RegBank    = Vec RegBankSize Word
type ProgMem    = Vec ProgMemSize Assembly
type DataMem    = Vec DataMemSize Word

type RegBankAddr = Unsigned 3
type ProgMemAddr = Unsigned 7
type DataMemAddr = Unsigned 7


-- value to be put in Register Bank
data RegValue   = RAddr DataMemAddr
                | RImm Word
                deriving (Eq,Show)

-- value to be put in data memory
data MemValue   = MAddr RegBankAddr
                | MImm Word
                deriving (Eq,Show)

data LdCode     = NoLoad
                | LdImm
                | LdAddr
                | LdAlu
                deriving (Eq,Show)

data StCode     = NoStore
                | StImm
                | StReg
                deriving (Eq,Show)

data SPCode     = None
                | Up
                | Down
                deriving (Eq,Show)

data JmpCode    = NoJump            -- No jump
                | UA                -- UnConditional - Absolute
                | UR                -- UnConditional - Relative
                | CA                -- Conditional   - Absolute
                | CR                -- Conditional   - Relative
                | Back              -- Back from subroutine
                deriving (Eq,Show)

data MachCode   = MachCode { ldCode     :: LdCode       -- 0/1: load from dmem to rbank?
                , stCode     :: StCode        -- storeCode
                , spCode     :: SPCode
                , opCode     :: OpCode        -- opCode
                , immvalueR  :: Word          -- value from Immediate - to regbank
                , immvalueS  :: Word          -- value from Immediate - to store
                , fromreg0   :: RegBankAddr   -- ibid, first parameter of Compute
                , fromreg1   :: RegBankAddr   -- ibid, second parameter of Compute
                , fromaddr   :: DataMemAddr   -- address in dmem
                , toreg      :: RegBankAddr   -- ibid, third parameter of Compute
                , toaddr     :: DataMemAddr   -- address in dmem
                , wen        :: Bool          -- enable signal for store
                , jmpCode    :: JmpCode       -- 0/1: indicates a jump
                , jumpN      :: ProgMemAddr   -- which instruction to jump to
                }
                deriving (Eq,Show)


data OpCode     = NoOp | Id  | Incr | Decr                              -- no corresponding functions in prog.language
                | Neg  | Not                                            -- unary operations
                | Add  | Sub | Mul | Equal | NEq | Gt | Lt | And | Or   -- binary operations
                deriving (Eq,Show)

data Assembly   = Compute OpCode RegBankAddr RegBankAddr RegBankAddr    -- Compute opCode r0 r1 r2: go to "alu",
                                                --      do "opCode" on regs r0, r1, and put result in reg r2
                | Jump JmpCode ProgMemAddr      -- JumpAbs n: set program counter to n
                | Load  RegValue RegBankAddr    -- Load (Addr a) r : from "memory a" to "regbank r"
                                                -- Load (Imm  v) r : put "Int v" in "regbank r"
                | Store MemValue DataMemAddr    -- Store (Addr r) a: from "regbank r" to "memory a"
                                                -- Store (Imm  v) r: put "Int v" in "memory r"
                | Push RegBankAddr              -- push a value on the stack
                | Pop RegBankAddr                       -- pop a value from the stack
                | EndProg                       -- end of program, handled bij exec function
                | Debug Word
                deriving (Eq,Show)

--record type for internal state of processor
data  PState = PState { regbank    :: RegBank      -- register bank
                        , dmem     :: DataMem       -- main memory, data memory
                        , cnd      :: Bool          -- condition register (whether condition was true)
                        , pc       :: ProgMemAddr
                        , sp       :: DataMemAddr
                        }
                        deriving (Eq, Show)

-- move reg0 reg1  = Compute Id reg0 zeroreg reg1
-- wait            = Jump UR 0

nullcode    = MachCode { ldCode = NoLoad
                , stCode        = NoStore
                , spCode        = None
                , opCode        = NoOp
                , immvalueR     = 0
                , immvalueS     = 0
                , fromreg0      = 0
                , fromreg1      = 0
                , fromaddr      = 0
                , toreg         = 0
                , toaddr        = 0
                , wen           = False
                , jmpCode       = NoJump
                , jumpN         = 0
                }

-- {-------------------------------------------------------------
-- | some constants
-- -------------------------------------------------------------}
-- zeroreg =  0 :: RegBankAddr
-- regA    =  1 :: RegBankAddr
-- regB    =  2 :: RegBankAddr
-- endreg  =  3 :: RegBankAddr  -- for FOR-loop
-- stepreg =  4 :: RegBankAddr  -- ibid
jmpreg  =  5 :: RegBankAddr  -- for jump instructions
-- pcreg   =  7 :: RegBankAddr  -- pc is added at the end of the regbank => regbank0

-- sp0 = 20 :: DataMemAddr      -- TODO: get sp0 from compiler, add OS

tobit True  = 1
tobit False = 0

oddB = (== 1) . lsb
-- wmax :: Word -> Word -> Word
-- wmax w1 w2 = if w1 > w2 then w1 else w2

-- (<~) :: RegBank -> (RegBankAddr, Word) -> RegBank
-- xs <~ (0, x) = xs
-- xs <~ (7, x) = xs
-- xs <~ (i, x) = xs'
--     where
--         addr = i
--         xs' = vreplace xs (fromUnsigned addr) x

-- (<~~) :: DataMem -> (Bool, DataMemAddr, Word) -> DataMem
-- xs <~~ (False, i, x) = xs
-- xs <~~ (True, i , x) = vreplace xs i x


{-------------------------------------------------------------
| The actual Sprockell
-------------------------------------------------------------}

decode :: (ProgMemAddr, DataMemAddr) -> Assembly -> MachCode
decode (pc, sp) instr  = case instr of
    Compute c i0 i1 i2  ->  nullcode {ldCode  = LdAlu,  opCode    = c,        fromreg0 = i0, fromreg1=i1, toreg=i2}
    Jump jc n           ->  nullcode {jmpCode = jc,     fromreg0  = jmpreg,   jumpN    = n}
    Load  (RImm  n) j   ->  nullcode {ldCode  = LdImm,  immvalueR = n,        toreg    = j}
    Load  (RAddr i) j   ->  nullcode {ldCode  = LdAddr, fromaddr  = i,        toreg    = j}
    Store (MAddr i) j   ->  nullcode {stCode  = StReg,  fromreg0  = i,        toaddr   = j, wen = True}
    Store (MImm  n) j   ->  nullcode {stCode  = StImm,  immvalueS = n,        toaddr   = j, wen = True}
    Push r              ->  nullcode {stCode  = StReg,  fromreg0  = r,        toaddr   = sp + 1, spCode = Up, wen = True}
    Pop r               ->  nullcode {ldCode  = LdAddr, fromaddr  = sp,       toreg    = r, spCode = Down}
    EndProg             ->  nullcode
    Debug _             ->  nullcode

alu :: OpCode -> (Word, Word) -> (Word, Bool)
alu opCode (x, y) = (z, cnd)
    where
        (z, cnd)   = (app opCode x y, oddB z)
        app opCode = case opCode of
            Id      -> \x y -> x        -- identity function on first argument
            Incr    -> \x y -> x + 1    -- increment first argument with 1
            Decr    -> \x y -> x - 1    -- decrement first argument with 1
            Neg     -> \x y -> -x
            Add     -> (+)          -- goes without saying
            Sub     -> (-)
            Mul     -> (*)
            Equal   -> (tobit.).(==)    -- test for equality; result 0 or 1
            NEq     -> (tobit.).(/=)    -- test for inequality
            Gt      -> (tobit.).(>)
            Lt      -> (tobit.).(<)
            And     -> (*)
            Or      -> \x y -> 0
            Not     -> \x y -> 1-x
            NoOp    -> \x y -> 0        -- result will always be 0

-- load :: RegBank -> LdCode -> RegBankAddr -> (Word, Word, Word) -> RegBank
-- load regbank ldCode toreg (immvalueR, mval, z) = regbank'
--     where
--         v =  case ldCode of
--             NoLoad  -> 0
--             LdImm   -> immvalueR
--             LdAddr  -> mval
--             LdAlu   -> z
--         regbank'  =  regbank <~ (toreg, v)

-- store :: DataMem -> StCode -> (Bool, DataMemAddr) -> (Word, Word) -> DataMem
-- store dmem stCode (wen, toaddr) (immvalueS, x) = dmem'
--         where
--           v = case stCode of
--             NoStore -> 0
--             StImm   -> immvalueS
--             StReg   -> x
--           dmem' = dmem <~~ (wen, toaddr, v)

-- pcUpd :: (JmpCode, Bool) -> (ProgMemAddr, ProgMemAddr, Word) -> ProgMemAddr
-- pcUpd (jmpCode, cnd) (pc, jumpN, x) = pc'
--     where
--         pc' =  case jmpCode of
--             NoJump  -> inc pc
--             UA      -> jumpN
--             UR      -> pc + jumpN
--             CA      -> if cnd then jumpN      else inc pc
--             CR      -> if cnd then pc + jumpN else inc pc
--             Back    -> bv2u (vdrop d9 (s2bv x))
--         inc i = i + 1

-- spUpd :: SPCode -> DataMemAddr -> DataMemAddr
-- spUpd spCode sp = case spCode of
--                     Up      -> sp + 1
--                     Down    -> sp - 1
--                     None    -> sp

-- -- ======================================================================================
-- -- Putting it all together

-- sprockell :: ProgMem -> (State PState) -> Bit -> (State PState, Bit)
-- sprockell  prog  (State state)  inp    =   (State (PState {dmem = dmem',regbank = regbank',cnd = cnd',pc = pc',sp = sp'}), outp)
--   where
--     PState{..}   = state
--     MachCode{..} = decode (pc,sp) (prog ! (fromUnsigned pc))
--     regbank0     = vreplace regbank (fromUnsigned pcreg) (pc2wrd pc)
--     (x,y)        = (regbank0 ! (fromUnsigned fromreg0) , regbank0 ! (fromUnsigned fromreg1))
--     mval         = dmem ! fromaddr
--     (z,cnd')     = alu    opCode         (x,y)
--     regbank'     = load   regbank ldCode toreg  (immvalueR,mval,z)
--     dmem'        = store  dmem    stCode (wen,toaddr)   (immvalueS,x)
--     pc'          = pcUpd  (jmpCode,cnd)  (pc,jumpN,x)
--     sp'          = spUpd  spCode     sp
--     outp         = inp
--     pc2wrd pca   = bv2s (u2bv (resizeUnsigned pca :: Unsigned 16))


-- prog1 = vcopy EndProg

-- initstate = PState {
--                 regbank = vcopy 0,
--                 dmem    = vcopy 0,
--                 cnd     = False,
--                 pc      = 0,
--                 sp      = sp0
--                 }

-- sprockellL = sprockell prog1 ^^^ initstate

topEntity = alu
