------------------------------------------------------------------------------- -- -- MIPS Core -- ------------------------------------------------------------------------------- package NewMips (sysNewMips) where import RegFile import FIFO import FoldFIFO import NewMipsInstr import NewMipsDefs import NewMipsROM ------ -- To test code generation sysNewMips :: Module Empty sysNewMips = module ram :: MRAM ram <- mkRAM rom :: MROM rom <- sysNewMipsROM mkMipsCPU rom ram -- {-# verilog mkRAM #-} mkRAM :: Module MRAM mkRAM = module -- 64 kbyte memory arr :: RegFile Address Value arr <- mkRegFile 0 0x3fff interface write a d = arr.upd a d read a = arr.sub a ------ ----------- -- TYPES -- ----------- type RegisterFile = RegFile CPUReg Value type MROM = ROM IAddress IValue type MRAM = RAM Address Value struct UInstr = pc :: IAddress instr :: IValue deriving (Bits) data MinorOp = Madd | Mand | Msub | Mnor | Mor | Mxor | Mslt | MsltU | Msll | Msra | Msrl | Mload | Mstore | Mwback deriving (Bits,Eq) struct DTemplate = pc :: IAddress mop :: MinorOp wback :: Bool ready :: Bool rd :: CPUReg v1 :: Value -- address on load/store/wb v2 :: Value -- offset on load/store/wb v3 :: Value -- value on store/wb deriving (Bits) --------------- -- FUNCTIONS -- --------------- isDest :: TBuffer -> CPUReg -> Bool isDest b r = let f :: DTemplate -> Bool -> Bool f x = (||) (x.wback && x.rd == r) in b.foldr f False canForward :: TBuffer -> CPUReg -> Bool canForward b r = let f :: DTemplate -> Bool -> Bool f x y = ((not x.wback) || x.ready || (x.rd /= r)) && y in b.foldr f True forward :: TBuffer -> CPUReg -> Value forward b r = let f :: DTemplate -> Value -> Value f x y = if (x.wback && x.ready && x.rd == r) then x.v1 else y in b.foldr f _ isJumpFunct :: Funct -> Bool isJumpFunct JR = True isJumpFunct JALR = True isJumpFunct _ = False -- in places where we check the op, perhaps -- it would be better to check the minor op? isStoreOp :: Op -> Bool isStoreOp SW = True isStoreOp _ = False isShiftOp :: Funct -> Bool isShiftOp SLL = True isShiftOp SRL = True isShiftOp SRA = True isShiftOp _ = False class Operation a where toMop :: a -> MinorOp instance Operation Op where -- arithmetic toMop ADDI = Madd toMop ADDIU = Madd toMop SLTI = Mslt toMop SLTIU = MsltU toMop ANDI = Mand toMop ORI = Mor toMop XORI = Mxor -- load store toMop LW = Mload toMop SW = Mstore instance Operation Funct where toMop ADD = Madd toMop ADDU = Madd toMop SUB = Msub toMop SUBU = Msub toMop AND = Mand toMop OR = Mor toMop XOR = Mxor toMop NOR = Mnor toMop SLT = Mslt toMop SLTU = MsltU toMop SRAV = Msra toMop SRLV = Msrl toMop SLLV = Msll -- shift toMop SRA = Msra toMop SRL = Msrl toMop SLL = Msll isArithmeticOp :: MinorOp -> Bool isArithmeticOp Mload = False isArithmeticOp Mstore = False isArithmeticOp Mwback = False isArithmeticOp _ = True isMemoryOp :: MinorOp -> Bool isMemoryOp Mload = True isMemoryOp Mstore = True isMemoryOp _ = False computeOp :: MinorOp -> Value -> Value -> Value -- only defined for arithmetic ops computeOp Madd v1 v2 = v1 + v2 computeOp Mand v1 v2 = v1 & v2 computeOp Msub v1 v2 = v1 - v2 computeOp Mnor v1 v2 = invert (v1 | v2) computeOp Mor v1 v2 = v1 | v2 computeOp Mxor v1 v2 = v1 ^ v2 computeOp Mslt v1 v2 = if v1 `vLT` v2 then 1 else 0 computeOp MsltU v1 v2 = if v1 < v2 then 1 else 0 computeOp Msll v1 v2 = v1 << vToNat v2 computeOp Msrl v1 v2 = v1 >> vToNat v2 computeOp Msra v1 v2 = v1 `vSRA` v2 computeOp _ _ _ = _ compareROp :: Op -> Value -> Value -> Bool compareROp BEQ v1 v2 = v1 == v2 compareROp BNE v1 v2 = v1 /= v2 compareZImmOp :: Op -> Value -> Bool compareZImmOp BLEZ v = v `vLE` 0 compareZImmOp BGTZ v = v `vGT` 0 compareZRegImmOp :: REGIMM -> Value -> Bool compareZRegImmOp BLTZ v = v `vLT` 0 compareZRegImmOp BGEZ v = v `vGE` 0 compareZALOp :: REGIMM -> Value -> Bool compareZALOp BLTZAL v = v `vLT` 0 compareZALOp BGEZAL v = v `vGE` 0 isCmpRegsOp :: Op -> Bool isCmpRegsOp BEQ = True isCmpRegsOp BNE = True isCmpRegsOp _ = False isCmpZeroImmOp :: Op -> Bool isCmpZeroImmOp BLEZ = True isCmpZeroImmOp BGTZ = True isCmpZeroImmOp _ = False isCmpZeroRegImmOp :: REGIMM -> Bool isCmpZeroRegImmOp BLTZ = True isCmpZeroRegImmOp BGEZ = True isCmpZeroRegImmOp _ = False isCmpZALOp :: REGIMM -> Bool isCmpZALOp BLTZAL = True isCmpZALOp BGEZAL = True isCmpZALOp _ = False ---------------- -- INTERFACES -- ---------------- type IBuffer = FIFO UInstr type TBuffer = FoldFIFO DTemplate mkMipsCPU :: MROM -> MRAM -> Module Empty mkMipsCPU imem dmem = module pc :: Reg IAddress pc <- mkReg 0 rf :: RegisterFile rf <- mkRegFile Reg1 Reg31 bd :: IBuffer bd <- mkFIFO be :: TBuffer be <- mkFoldFIFO bm :: TBuffer bm <- mkFoldFIFO bw :: TBuffer bw <- mkFoldFIFO addRules $ mkMipsRules pc rf bd be bm bw imem dmem ------------ -- RULES --- ------------ mkMipsRules :: Reg IAddress -> RegisterFile -> IBuffer -> TBuffer -> TBuffer -> TBuffer -> MROM -> MRAM -> Rules mkMipsRules pc rf bd be bm bw imem dmem = mkFetchRules pc bd imem <+> mkDecodeRules pc rf bd be bm bw <+> mkExecuteRules be bm <+> mkMemoryRules bm bw dmem <+> mkWritebackRules rf bw -- INSTRUCTION FETCH STAGE -- mkFetchRules :: Reg IAddress -> IBuffer -> MROM -> Rules mkFetchRules pc bd imem = rules "Fetch": when True ==> action pc := pc + 1 bd.enq (UInstr { pc = pc; instr = imem.read pc }) -- INSTRUCTION DECODE STAGE -- mkDecodeRules :: Reg IAddress -> RegisterFile -> IBuffer -> TBuffer -> TBuffer -> TBuffer -> Rules mkDecodeRules pc rf bd be bm bw = let stallFree :: CPUReg -> Bool stallFree r = not (isDest be r && not (canForward be r) || isDest bm r && not (canForward bm r)) registerValue :: CPUReg -> Value registerValue Reg0 = 0 registerValue r = if isDest be r && canForward be r then forward be r else if isDest bm r && canForward bm r then forward bm r else if isDest bw r then forward bw r else rf.sub r pc' :: IAddress pc' = bd.first.pc instr :: Instruction instr = unpack bd.first.instr in rules -- this rule performs the (constant) shifting rather than leaving the -- work for the ALU. In this way, the value can be forwarded -- earlier. "D-LUI": when (Immediate { op = LUI; rt; imm }) <- instr ==> (action { be.enq dt; bd.deq; }) where dt = DTemplate { pc = pc'; mop = Mwback; wback = True; ready = True; rd = rt; v1 = vZeroExt imm << 16; } "D-Immediate": when (Immediate { op; rs; rt; imm }) <- instr, op /= LUI, not (isCmpRegsOp op || isCmpZeroImmOp op || isStoreOp op), stallFree rs ==> (action { be.enq dt; bd.deq; }) where dt = DTemplate { pc = pc'; mop = toMop op; wback = True; ready = False; rd = rt; v1 = registerValue rs; v2 = vSignExt imm; } "D-Store": when (Immediate { op; rs; rt; imm }) <- instr, isStoreOp op, stallFree rs, stallFree rt ==> (action { be.enq dt; bd.deq; }) where dt = DTemplate { pc = pc'; mop = toMop op; wback = False; ready = False; v1 = registerValue rs; v2 = vSignExt imm; v3 = registerValue rt } "D-Register": when (Register { rs; rt; rd; sa; funct }) <- instr, not (isJumpFunct funct), stallFree rs, isShiftOp funct || stallFree rt ==> (action { be.enq dt; bd.deq; }) where dt = DTemplate { pc = pc'; mop = toMop funct; wback = True; ready = False; rd = rd; v1 = registerValue rs; v2 = if isShiftOp funct then vZeroExt sa else registerValue rt; } "D-JumpRegister": when (Register { rs; funct = JR }) <- instr, stallFree rs ==> action { pc := vToI (registerValue rs); bd.clear } "D-JumpAndLinkRegister": when (Register { rs; rd; funct = JALR }) <- instr, stallFree rs ==> (action { pc := vToI (registerValue rs); be.enq dt; bd.clear; }) where dt = DTemplate { pc = pc'; mop = Mwback; wback = True; ready = True; rd = rd; v1 = iToV (pc' + 2); } "D-Jump": when (Jump { op = J; target }) <- instr ==> action { pc := jumpExtend pc' target; bd.clear } "D-JumpAndLink": when (Jump { op = JAL; target }) <- instr ==> (action { pc := jumpExtend pc' target; bd.clear; be.enq dt; }) where dt = DTemplate { pc = pc'; mop = Mwback; wback = True; ready = True; rd = Reg31; v1 = iToV (pc' + 2); } "D-BranchCmpRegs": when (Immediate { op; rs; rt; imm }) <- instr, isCmpRegsOp op, stallFree rs, stallFree rt ==> (if compareROp op v1 v2 then action { pc := pc' + 1 + iaSignExt imm; bd.clear; } else bd.deq ) where { v1 = registerValue rs; v2 = registerValue rt; } "D-BranchCmpZeroImm": when (Immediate { op; rs; imm }) <- instr, isCmpZeroImmOp op, stallFree rs ==> (if compareZImmOp op v1 then action { pc := pc' + 1 + iaSignExt imm; bd.clear; } else bd.deq ) where { v1 = registerValue rs; } "D-BranchCmpZeroRegImm": when (RegImm { op; rs; imm }) <- instr, isCmpZeroRegImmOp op, stallFree rs ==> (if compareZRegImmOp op v1 then action { pc := pc' + 1 + iaSignExt imm; bd.clear; } else bd.deq ) where { v1 = registerValue rs; } "D-BranchCmpZeroAndLink": when (RegImm { op; rs; imm }) <- instr, isCmpZALOp op, stallFree rs ==> (if compareZALOp op v1 then action { pc := pc' + 1 + iaSignExt imm; be.enq dt; bd.clear; } else bd.deq ) where { v1 = registerValue rs; dt = DTemplate { pc = pc'; mop = Mwback; wback = True; ready = True; rd = Reg31; v1 = iToV (pc' + 2); } } -- ALU STAGE -- mkExecuteRules :: TBuffer -> TBuffer -> Rules mkExecuteRules be bm = rules "E-Wback": when dt@(DTemplate { mop = Mwback }) <- be.first ==> action { bm.enq dt; be.deq; } "E-Arith": when dt@(DTemplate { mop; v1; v2 }) <- be.first, isArithmeticOp mop ==> (action { bm.enq dt'; be.deq; }) where { dt' = dt { mop = Mwback; ready = True; v1 = result; }; result = computeOp mop v1 v2; } "E-Mem": when dt@(DTemplate { mop; v1; v2 }) <- be.first, isMemoryOp mop ==> (action { bm.enq dt'; be.deq; }) where dt' = dt { ready = False; v1 = v1 + v2; } -- MEMORY STAGE -- mkMemoryRules :: TBuffer -> TBuffer -> MRAM -> Rules mkMemoryRules bm bw dmem = rules "M-NoMem": when dt@(DTemplate { mop }) <- bm.first, not (isMemoryOp mop) ==> action { bw.enq dt; bm.deq; } "M-Store": when DTemplate { mop = Mstore; v1 = addr; v3 = datum } <- bm.first ==> action { dmem.write (vToA addr) datum; bm.deq; } "M-Load": when dt@(DTemplate { mop = Mload; v1 = addr; }) <- bm.first ==> (action { bw.enq dt'; bm.deq; }) where { dt' = dt { mop = Mwback; ready = True; v1 = datum; }; datum = dmem.read (vToA addr); } -- WRITEBACK STAGE -- mkWritebackRules :: RegisterFile -> TBuffer -> Rules mkWritebackRules rf bw = rules "Wback": when DTemplate { mop = Mwback; v1 = datum; rd } <- bw.first ==> action { if rd == Reg0 then action { } else rf.upd rd datum; bw.deq; }