├── .gitignore ├── Alu.hs ├── Alu2.hs ├── Cpu2.hs ├── Decode.hs ├── Main.hs ├── README.md ├── SevenSeg.hs ├── Types.hs ├── makefile ├── utils ├── 6502_functional_test.bin ├── 6502_functional_test.raw ├── MakeMem.hs ├── MakeMem2 ├── MakeMem2.hs ├── test.asm ├── test.bin └── test.hex └── vhdl └── extra ├── constraints.ucf └── ipcores └── clkwiz50.vhd /.gitignore: -------------------------------------------------------------------------------- 1 | *.o 2 | *.hi 3 | 4 | vhdl/Main 5 | utils/MakeMem 6 | working -------------------------------------------------------------------------------- /Alu.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ScopedTypeVariables #-} 2 | {-# LANGUAGE DataKinds #-} 3 | {-# LANGUAGE TypeOperators #-} 4 | {-# LANGUAGE FlexibleContexts #-} 5 | {-# LANGUAGE RecordWildCards #-} 6 | {-# LANGUAGE TemplateHaskell #-} 7 | 8 | module Alu where 9 | 10 | import CLaSH.Prelude 11 | import CLaSH.Sized.Unsigned 12 | import Debug.Trace 13 | import Text.Printf 14 | 15 | import qualified Alu2 as A 16 | import Types 17 | 18 | resetVec :: Addr 19 | resetVec = 0xfffc 20 | brkVec :: Addr 21 | brkVec = 0xfffe 22 | 23 | data AddrMode = Zp 24 | | Abs 25 | | Imm 26 | | ZpInd 27 | | AbsInd 28 | | Implicit 29 | deriving (Show, Eq) 30 | 31 | data AddrOp = AONone 32 | | AOPreAddX 33 | | AOPreAddY 34 | | AOPostAddY 35 | deriving (Show, Eq) 36 | 37 | {-# NOINLINE addrMode #-} 38 | addrMode :: BitVector 2 -> BitVector 3 -> BitVector 3 -> (AddrMode, AddrOp) 39 | addrMode 0 0 0 = (Implicit, AONone) 40 | addrMode 0 0 1 = (Abs, AONone) -- JSR 41 | addrMode 0 0 2 = (Implicit, AONone) -- RTI 42 | addrMode 0 0 3 = (Implicit, AONone) -- RTS 43 | addrMode 0 0 _ = (Imm, AONone) 44 | addrMode 0 1 _ = (Zp, AONone) 45 | -- addrMode 0 2 _ = (Implicit, AONone) -- PHP etc. 46 | addrMode 0 3 3 = (AbsInd, AONone) -- JMP (ABS) 47 | addrMode 0 3 _ = (Abs, AONone) 48 | addrMode 0 4 _ = (Imm, AONone) -- Conditional Branch 49 | addrMode 0 5 _ = (Zp, AOPreAddX) 50 | -- addrMode 0 6 _ = (Implicit, AONone) -- CLC etc. 51 | addrMode 0 7 _ = (Abs, AOPreAddX) 52 | 53 | 54 | addrMode 1 0 _ = (ZpInd, AOPreAddX) 55 | addrMode 1 1 _ = (Zp, AONone) 56 | addrMode 1 2 _ = (Imm, AONone) 57 | addrMode 1 3 _ = (Abs, AONone) 58 | addrMode 1 4 _ = (ZpInd, AOPostAddY) 59 | addrMode 1 5 _ = (Zp, AOPreAddX) 60 | addrMode 1 6 _ = (Abs, AOPreAddY) 61 | addrMode 1 7 _ = (Abs, AOPreAddX) 62 | 63 | addrMode 2 0 5 = (Imm, AONone) 64 | addrMode 2 1 _ = (Zp, AONone) 65 | 66 | -- addrMode 2 2 _ = (Implicit, AONone) 67 | 68 | addrMode 2 3 _ = (Abs, AONone) 69 | -- addrMode 2 4 _ = (Zp, AONone) 70 | addrMode 2 5 4 = (Zp, AOPreAddY) -- STX uses preaddY 71 | addrMode 2 5 5 = (Zp, AOPreAddY) -- LDX uses preaddY 72 | addrMode 2 5 _ = (Zp, AOPreAddX) 73 | -- addrMode 2 6 _ = (Zp, AOPreAddX) 74 | addrMode 2 7 5 = (Abs, AOPreAddY) -- STX uses preaddY 75 | addrMode 2 7 _ = (Abs, AOPreAddX) 76 | 77 | addrMode _ _ _ = (Implicit, AONone) 78 | 79 | 80 | data AluOp = ORA 81 | | AND 82 | | EOR 83 | | ADC 84 | | STA 85 | | LDA 86 | | CMP 87 | | SBC 88 | | BIT 89 | | ASL 90 | | ROL 91 | | LSR 92 | | ROR 93 | | STX 94 | | LDX 95 | | DEC 96 | | INC 97 | | TXA 98 | | TAX 99 | | JMP 100 | | STY 101 | | LDY 102 | | CPY 103 | | CPX 104 | | BCC 105 | | BRK 106 | | RTI 107 | | JSR 108 | | RTS 109 | | PHP 110 | | PLP 111 | | PHA 112 | | PLA 113 | | DEY 114 | | TAY 115 | | INY 116 | | INX 117 | | CLC 118 | | SEC 119 | | CLI 120 | | SEI 121 | | TYA 122 | | CLV 123 | | CLD 124 | | SED 125 | | TSX 126 | | TXS 127 | | DEX 128 | | NOP 129 | | LDP -- Not a real instruction used as a part of PLP 130 | | ILLEGAL 131 | deriving (Show, Eq) 132 | 133 | {-# NOINLINE aluOp #-} 134 | aluOp :: BitVector 2 -> BitVector 3 -> BitVector 3 -> AluOp 135 | aluOp 0 addrBits opBits = case addrBits of 136 | 4 -> BCC -- Conditional Branch is determined by the addressing mode op bits determine type 137 | 2 -> case opBits of 138 | 0 -> PHP 139 | 1 -> PLP 140 | 2 -> PHA 141 | 3 -> PLA 142 | 4 -> DEY 143 | 5 -> TAY 144 | 6 -> INY 145 | 7 -> INX 146 | _ -> ILLEGAL 147 | 6 -> case opBits of 148 | 0 -> CLC 149 | 1 -> SEC 150 | 2 -> CLI 151 | 3 -> SEI 152 | 4 -> TYA 153 | 5 -> CLV 154 | 6 -> CLD 155 | 7 -> SED 156 | _ -> ILLEGAL 157 | _ -> case opBits of 158 | 1 -> case addrBits of 159 | 0 -> JSR 160 | _ -> BIT 161 | 2 -> case addrBits of 162 | 0 -> RTI 163 | _ -> JMP 164 | 3 -> case addrBits of 165 | 0 -> RTS 166 | _ -> JMP 167 | 4 -> STY 168 | 5 -> LDY 169 | 6 -> CPY 170 | 7 -> CPX 171 | 0 -> case addrBits of 172 | 0 -> BRK 173 | _ -> ILLEGAL 174 | _ -> ILLEGAL 175 | 176 | aluOp 1 addrBits opBits = case opBits of 177 | 0 -> ORA 178 | 1 -> AND 179 | 2 -> EOR 180 | 3 -> ADC 181 | 4 -> case addrBits of 182 | 2 -> BIT -- Store Immediate is mising -- it's BIT # on 65C02 183 | _ -> STA 184 | 5 -> LDA 185 | 6 -> CMP 186 | 7 -> SBC 187 | _ -> ILLEGAL 188 | aluOp 2 addrBits opBits = case addrBits of 189 | 0 -> case opBits of 190 | 5 -> LDX 191 | _ -> ILLEGAL 192 | _ -> case opBits of 193 | 0 -> ASL 194 | 1 -> ROL 195 | 2 -> LSR 196 | 3 -> ROR 197 | 4 -> case addrBits of 198 | 2 -> TXA 199 | 6 -> TXS 200 | 7 -> ILLEGAL 201 | _ -> STX 202 | 5 -> case addrBits of 203 | 2 -> TAX 204 | 6 -> TSX 205 | _ -> LDX 206 | 6 -> case addrBits of 207 | 2 -> DEX 208 | _ -> DEC 209 | 7 -> case addrBits of 210 | 2 -> NOP 211 | _ -> INC 212 | _ -> ILLEGAL 213 | aluOp _ _ _ = ILLEGAL 214 | 215 | 216 | 217 | 218 | decodeInstruction :: CpuState -> Byte -> CpuState 219 | decodeInstruction st x = st' where 220 | o = aluOp dm addrBits opBits 221 | (m, ao) = addrMode dm addrBits opBits 222 | st' = st{rAluOp = o, rAddrMode = m, rAddrOp = ao, rIBits = x} 223 | dm = resize x 224 | opBits = resize (x `shiftR` 5) 225 | addrBits = resize (x `shiftR` 2) 226 | 227 | 228 | 229 | data State = Halt 230 | | Init 231 | | WaitPCL 232 | | WaitPCH 233 | | FetchI 234 | | FetchL 235 | | FetchH 236 | | ReadAddr 237 | | WriteByte 238 | | PushHigh 239 | | PushFlags 240 | | Interrupt 241 | | WaitFlags 242 | deriving (Show) 243 | 244 | 245 | negFlag = 0x80 :: Byte 246 | ovFlag = 0x40 :: Byte 247 | unusedFlag = 0x20 :: Byte 248 | breakFlag = 0x10 :: Byte 249 | decFlag = 0x08 :: Byte 250 | intFlag = 0x04 :: Byte 251 | zeroFlag = 0x02 :: Byte 252 | carryFlag = 0x01 :: Byte 253 | 254 | data CpuState = CpuState 255 | { state :: State 256 | , rA :: Byte 257 | , rX :: Byte 258 | , rY :: Byte 259 | , rFlags :: Byte 260 | , rSp :: Byte 261 | , rPC :: Addr 262 | , rAddr :: Addr -- Used for Indirect addressing 263 | -- The "decoded" instruction, is modified by the state machine as the address modes are "unwound" 264 | , rAluOp :: AluOp 265 | , rAddrMode :: AddrMode 266 | , rAddrOp :: AddrOp 267 | , rIBits :: Byte 268 | } deriving (Show) 269 | 270 | initialState = CpuState Init 0xaa 0x00 0x00 unusedFlag 0xfc 0x0000 0x0000 ADC Imm AONone 00 271 | 272 | 273 | execNoData :: CpuState -> (CpuState, Addr) 274 | execNoData st@CpuState{..} = (st', addr) where 275 | (st', addr) = (st {state = Halt}, rPC) -- TODO 276 | 277 | stackAddr :: Byte -> Addr 278 | stackAddr sp = 0x100 .|. (resize sp) 279 | 280 | 281 | {-# NOINLINE execWithData #-} 282 | execWithData :: CpuState -> Byte -> Addr -> (CpuState, Addr, Byte, Bool) 283 | execWithData st@CpuState{..} v addrIn = (st', addr, oByte, wr) where 284 | pc' = rPC+1 285 | (st', addr, oByte, wr) = case rAluOp of 286 | STA -> (st {state = WriteByte, rPC = pc'}, addrIn, rA, True) 287 | STX -> (st {state = WriteByte, rPC = pc'}, addrIn, rX, True) 288 | STY -> (st {state = WriteByte, rPC = pc'}, addrIn, rY, True) 289 | 290 | LDA -> (st {state = FetchI, rA = v, rFlags = setZN rFlags v, rPC= pc'}, pc', 0, False) 291 | LDX -> (st {state = FetchI, rX = v, rFlags = setZN rFlags v, rPC= pc'}, pc', 0, False) 292 | LDY -> (st {state = FetchI, rY = v, rFlags = setZN rFlags v, rPC= pc'}, pc', 0, False) 293 | 294 | CMP -> (st {state = FetchI, rFlags = flags', rPC = pc'}, pc', 0, False) where 295 | flags' = cmp rFlags rA v 296 | CPX -> (st {state = FetchI, rFlags = flags', rPC = pc'}, pc', 0, False) where 297 | flags' = cmp rFlags rX v 298 | CPY -> (st {state = FetchI, rFlags = flags', rPC = pc'}, pc', 0, False) where 299 | flags' = cmp rFlags rY v 300 | 301 | EOR -> logicOp st v xor 302 | ORA -> logicOp st v (.|.) 303 | AND -> logicOp st v (.&.) 304 | ADC -> (st {state = FetchI, rA = v', rFlags = flags', rPC = pc'}, pc', 0, False) where 305 | (v', flags) = adc rFlags rA v 306 | flags' = setZN flags v' 307 | SBC -> (st {state = FetchI, rA = v', rFlags = flags', rPC = pc'}, pc', 0, False) where 308 | (v', flags) = sbc rFlags rA v 309 | flags' = setZN flags v' 310 | 311 | ASL -> shiftOp st addrIn v (\x -> shiftL x 1) True 312 | ROL -> shiftOp st addrIn v rolFn True where 313 | rolFn x = (x `shiftL` 1) .|. (rFlags .&. carryFlag) -- Shifts in from carry 314 | LSR -> shiftOp st addrIn v (\x -> shiftR x 1) False 315 | ROR -> shiftOp st addrIn v rolFn False where 316 | rolFn x = (x `shiftR` 1) .|. (rFlags `shiftL` 7) -- Shifts in from carry 317 | 318 | 319 | TAX -> (st {state = FetchI, rX = rA, rFlags = setZN rFlags rA, rPC= pc'}, pc', 0, False) 320 | TAY -> (st {state = FetchI, rY = rA, rFlags = setZN rFlags rA, rPC= pc'}, pc', 0, False) 321 | TXA -> (st {state = FetchI, rA = rX, rFlags = setZN rFlags rX, rPC= pc'}, pc', 0, False) 322 | TYA -> (st {state = FetchI, rA = rY, rFlags = setZN rFlags rY, rPC= pc'}, pc', 0, False) 323 | DEC -> memOp st addrIn v (\x -> x-1) 324 | INC -> memOp st addrIn v (\x -> x+1) 325 | BIT -> (st {state = FetchI, rFlags = bitFlags rFlags rA v, rPC = pc'}, pc', 0, False) 326 | 327 | JMP -> (st {state = FetchI, rPC = addrIn}, addrIn, 0, False) 328 | BCC -> (st {state = FetchI, rPC = pc''}, pc'', 0, False) where 329 | pc'' = pc' + (bccOffset st v) 330 | 331 | CLD -> (st {state = FetchI, rFlags = rFlags .&. (complement decFlag), rPC = pc'}, pc', 0 , False) 332 | SED -> (st {state = FetchI, rFlags = rFlags .|. decFlag, rPC = pc'}, pc', 0 , False) 333 | CLC -> (st {state = FetchI, rFlags = rFlags .&. (complement carryFlag), rPC = pc'}, pc', 0 , False) 334 | SEC -> (st {state = FetchI, rFlags = rFlags .|. carryFlag, rPC = pc'}, pc', 0 , False) 335 | CLI -> (st {state = FetchI, rFlags = rFlags .&. (complement intFlag), rPC = pc'}, pc', 0 , False) 336 | SEI -> (st {state = FetchI, rFlags = rFlags .|. intFlag, rPC = pc'}, pc', 0 , False) 337 | CLV -> (st {state = FetchI, rFlags = rFlags .&. (complement ovFlag), rPC = pc'}, pc', 0 , False) 338 | -- SEV -> (st {state = FetchI, rFlags = rFlags .|. ovFlag, rPC = pc'}, pc', 0 , False) 339 | 340 | TXS -> (st {state = FetchI, rSp = rX, rPC = pc'}, pc', 0 , False) 341 | TSX -> (st {state = FetchI, rX = rSp, rFlags = setZN rFlags rSp, rPC = pc'}, pc', 0 , False) 342 | 343 | DEY -> (st {state = FetchI, rY = rY', rFlags = setZN rFlags rY', rPC = pc'}, pc', 0, False) where 344 | rY' = rY - 1 345 | DEX -> (st {state = FetchI, rX = rX', rFlags = setZN rFlags rX', rPC = pc'}, pc', 0, False) where 346 | rX' = rX - 1 347 | INY -> (st {state = FetchI, rY = rY', rFlags = setZN rFlags rY', rPC = pc'}, pc', 0, False) where 348 | rY' = rY + 1 349 | INX -> (st {state = FetchI, rX = rX', rFlags = setZN rFlags rX', rPC = pc'}, pc', 0, False) where 350 | rX' = rX + 1 351 | 352 | PHA -> (st {state = WriteByte, rPC = pc', rSp = rSp - 1}, stackAddr rSp, rA, True) 353 | -- PLA treated like LDA when it reenters through FetchL - SP updated here, PC updated after exec 354 | PLA -> (st {state = FetchL, rSp = rSp', rAluOp = LDA, rAddrMode = Imm}, stackAddr rSp', 0, False) where 355 | rSp' = rSp+1 356 | -- LDP second phase of PLP 357 | LDP -> (st {state = FetchI, rFlags = v .|. unusedFlag, rPC = pc'}, pc', 0, False) 358 | PLP -> (st {state = FetchL, rSp = rSp', rAluOp = LDP, rAddrMode = Imm}, stackAddr rSp', 0, False) where 359 | rSp' = rSp+1 360 | PHP -> (st {state = WriteByte, rPC = pc', rSp = rSp - 1}, stackAddr rSp, rFlags .|. breakFlag, True) 361 | 362 | JSR -> (st {state = PushHigh, rPC = rAddr, rSp = rSp - 1, rAddr = rPC}, stackAddr rSp, resize(rPC `shiftR` 8), True) 363 | RTS -> (st {state = WaitPCL, rSp = rSp + 2, rAddr = sp'}, sp', 0, False) where 364 | rSp' = rSp + 1 365 | sp' = stackAddr rSp' 366 | RTI -> (st {state = WaitFlags, rSp = rSp'}, stackAddr rSp', 0, False) where 367 | rSp' = rSp + 1 368 | 369 | 370 | NOP -> (st {state = FetchI, rPC = pc'}, pc', 0, False) 371 | BRK -> (st {state = PushHigh, rAddr = pc'', rSp = rSp - 1, rFlags = rFlags .|. breakFlag}, stackAddr rSp, resize(pc'' `shiftR` 8), True) where 372 | pc'' = pc' + 1 373 | -- _ -> trace (printf "Unsupported AluOp %s" (show rAluOp)) (st {state = Halt}, rPC, 0, False) 374 | _ -> (st {state = Halt}, rPC, 0, False) 375 | 376 | 377 | bitFlags :: Byte -> Byte -> Byte -> Byte 378 | bitFlags f a v = f' where 379 | t = a .&. v 380 | vnF = v .&. (ovFlag .|. negFlag) 381 | zF = if t == 0 then zeroFlag else 0 382 | f' = (f .&. (complement (ovFlag .|. negFlag .|. zeroFlag))) .|. vnF .|. zF 383 | 384 | 385 | bccOffset :: CpuState -> Byte -> Addr 386 | bccOffset CpuState{..} v = offset where 387 | flagMask = case resize (rIBits `shiftR` 6) :: BitVector 2 of 388 | 0 -> negFlag 389 | 1 -> ovFlag 390 | 2 -> carryFlag 391 | 3 -> zeroFlag 392 | compareTo = if (rIBits .&. 0x20) /= 0 then 0xff else 0x00 :: Byte 393 | branchOffset = (resize v) .|. if (v .&. 0x80) /= 0 then 0xff00 else 0x00 :: Addr 394 | offset = if (rFlags .&. flagMask) == (compareTo .&. flagMask) then branchOffset else 0 :: Addr 395 | 396 | 397 | 398 | 399 | {-# NOINLINE memOp #-} 400 | memOp :: CpuState -> Addr -> Byte -> (Byte -> Byte) -> (CpuState, Addr, Byte, Bool) 401 | memOp st@CpuState{..} addrIn v fn = (st', addr, oByte, wr) where 402 | pc' = rPC+1 403 | (st', addr, oByte, wr) = case rAddrMode of 404 | Implicit -> (st {state = FetchI, rA = v', rFlags = setZN rFlags v', rPC = pc'}, pc', 0, False) where 405 | v' = fn rA 406 | _ -> (st {state = WriteByte, rFlags = setZN rFlags v', rPC = pc'}, addrIn, v', True) where 407 | v' = fn v 408 | 409 | 410 | 411 | {-# NOINLINE shiftOp #-} 412 | shiftOp :: CpuState -> Addr -> Byte -> (Byte -> Byte) -> Bool -> (CpuState, Addr, Byte, Bool) 413 | shiftOp st@CpuState{..} addrIn v fn leftShift = (st', addr, oByte, wr) where 414 | pc' = rPC+1 415 | (st', addr, oByte, wr) = case rAddrMode of 416 | Implicit -> (st {state = FetchI, rA = v', rFlags = flags', rPC = pc'}, pc', 0, False) where 417 | (v', flags') = doShiftOp rFlags rA fn leftShift 418 | _ -> (st {state = WriteByte, rFlags = flags', rPC = pc'}, addrIn, v', True) where 419 | (v', flags') = doShiftOp rFlags v fn leftShift 420 | 421 | {-# NOINLINE doShiftOp #-} 422 | doShiftOp :: Byte -> Byte -> (Byte -> Byte) -> Bool -> (Byte, Byte) 423 | doShiftOp f a fn leftShift = (v, flags) where 424 | v = fn a 425 | flags' = setZN f v 426 | carryBit = if leftShift then 0x80 else 0x01 :: Byte 427 | carry = if (a .&. carryBit) == 0 then 0 else carryFlag 428 | flags = (flags' .&. (complement carryFlag)) .|. carry 429 | 430 | 431 | {-# NOINLINE logicOp #-} 432 | logicOp :: CpuState -> Byte -> (Byte -> Byte -> Byte) -> (CpuState, Addr, Byte, Bool) 433 | logicOp st@CpuState{..} v fn = (st {state = FetchI, rA = v', rFlags = flags, rPC = pc'}, pc', 0, False) where 434 | pc' = rPC+1 435 | v' = fn rA v 436 | flags = setZN rFlags v' 437 | 438 | {-# NOINLINE setZN #-} 439 | setZN :: Byte -> Byte -> Byte 440 | setZN f v = (f .&. (complement (negFlag .|. zeroFlag))) .|. z .|. n where 441 | n = v .&. negFlag 442 | z = if v == 0 then zeroFlag else 0 443 | 444 | -- Do the add set the OV and C flags 445 | -- adc :: Byte -> Byte -> Byte -> (Byte, Byte) 446 | -- adc flags a b = (v, flags') where 447 | -- (v, flags') = if (flags .&. decFlag == 0) then 448 | -- adcNorm flags a b 449 | -- else 450 | -- adcBCD flags a b 451 | 452 | -- Overflow appears to be calculated incorrectly 453 | -- ovCalc :: Byte -> Byte -> Byte -> Byte 454 | -- ovCalc m n result = if ((complement (m `xor` n)) .&. (m `xor` result)) .&. 0x80 == 0 then 0 else ovFlag 455 | 456 | adc :: Byte -> Byte -> Byte -> (Byte, Byte) 457 | adc flags a b = adcSbc A.AluADD flags a b 458 | 459 | sbc :: Byte -> Byte -> Byte -> (Byte, Byte) 460 | sbc flags a b = adcSbc A.AluSUB flags a b 461 | 462 | 463 | {-# NOINLINE adcSbc #-} 464 | adcSbc :: A.AluOp -> Byte -> Byte -> Byte -> (Byte, Byte) 465 | adcSbc op flags a b = (res, flags') where 466 | cIn = flags ! 0 467 | bcd = flags ! 3 468 | (res, c, ov) = A.alu op a b cIn bcd 469 | cOut = if c /= 0 then carryFlag else 0 470 | overflow = if ov /= 0 then ovFlag else 0 471 | flags' = (flags .&. (complement (ovFlag .|. carryFlag))) .|. overflow .|. cOut 472 | 473 | -- -- TODO need to test BCD implementation 474 | -- {-# NOINLINE adcBCD #-} 475 | -- adcBCD :: Byte -> Byte -> Byte -> (Byte, Byte) 476 | -- adcBCD flags a b = (res, flags') where 477 | -- cIn = resize (flags .&. carryFlag) :: BitVector 5 478 | -- lowO = (resize (a .&. 0xf) :: BitVector 5) + (resize (b .&. 0xf) :: BitVector 5) + cIn 479 | -- (lowCout, lowO') = if lowO > 9 then (1, (lowO + 6) .&. 0xf) else (0, lowO) :: (BitVector 5, BitVector 5) 480 | 481 | -- highO = (resize (a `shiftR` 4) :: BitVector 5) + (resize (b `shiftR` 4) :: BitVector 5) + lowCout 482 | -- (highCout, highO') = if highO > 9 then (carryFlag, highO + 6) else (0, highO) 483 | -- res = ((resize highO' :: BitVector 8) `shiftL` 4) .|. (resize lowO' :: BitVector 8) 484 | -- -- Overflow not documented for the original 6502, but basically set as if for the last nibble calculation in standard ADC case 485 | -- highOO = (resize highO :: BitVector 8) `shiftL` 4 486 | -- overflow = ovCalc a b highOO 487 | -- flags' = (flags .&. (complement (ovFlag .|. carryFlag))) .|. overflow .|. highCout 488 | 489 | 490 | -- Do the sub set the OV and C flags 491 | -- sbc :: Byte -> Byte -> Byte -> (Byte, Byte) 492 | -- sbc flags a b = (v, flags') where 493 | -- (v, flags') = if (flags .&. decFlag == 0) then 494 | -- sbcNorm flags a b 495 | -- else 496 | -- sbcBCD flags a b 497 | 498 | -- sbcNorm :: Byte -> Byte -> Byte -> (Byte, Byte) 499 | -- sbcNorm flags a b = (res, flags') where 500 | -- cIn = (complement flags) .&. carryFlag -- SBC needs the inverted carry 501 | -- res9 = (resize a :: BitVector 9) - (resize b :: BitVector 9) - (resize cIn :: BitVector 9) 502 | -- res = resize res9 503 | -- cOut = resize ((complement res9) `shiftR` 8) :: BitVector 8 504 | -- overflow = ovCalc a (complement b) res 505 | -- flags' = (flags .&. (complement (ovFlag .|. carryFlag))) .|. overflow .|. cOut 506 | 507 | 508 | -- -- TODO need to test BCD implementation 509 | -- {-# NOINLINE sbcBCD #-} 510 | -- sbcBCD :: Byte -> Byte -> Byte -> (Byte, Byte) 511 | -- sbcBCD flags a b = (res, flags') where 512 | -- cIn = resize ((complement flags) .&. carryFlag) :: BitVector 5 513 | -- lowO = (resize (a .&. 0xf) :: BitVector 5) - (resize (b .&. 0xf) :: BitVector 5) - cIn 514 | -- (lowCout, lowO') = if lowO > 9 then (1, (lowO - 6) .&. 0xf) else (0, lowO) :: (BitVector 5, BitVector 5) -- borrow 515 | 516 | -- highO = (resize (a `shiftR` 4) :: BitVector 5) - (resize (b `shiftR` 4) :: BitVector 5) - lowCout 517 | -- (highCout, highO') = if highO > 9 then (0, highO - 6) else (carryFlag, highO) -- correct Carry 518 | -- res = ((resize highO' :: BitVector 8) `shiftL` 4) .|. (resize lowO' :: BitVector 8) 519 | -- -- Overflow not documented for the original 6502, but basically set as if for the last nibble calculation in standard SBC case 520 | -- highOO = (resize highO :: BitVector 8) `shiftL` 4 521 | -- overflow = ovCalc a (complement b) highOO 522 | -- flags' = (flags .&. (complement (ovFlag .|. carryFlag))) .|. overflow .|. highCout 523 | 524 | 525 | 526 | {-# NOINLINE cmp #-} 527 | cmp :: Byte -> Byte -> Byte -> Byte 528 | cmp flags a b = flags' where 529 | t = a - b 530 | neg = t .&. 0x80 531 | c = if a >= b then carryFlag else 0 532 | z = if t == 0 then zeroFlag else 0 533 | flags' = (flags .&. (complement (carryFlag .|. negFlag .|. zeroFlag))) .|. neg .|. c .|. z 534 | 535 | 536 | 537 | 538 | 539 | 540 | 541 | 542 | 543 | -------------------------------------------------------------------------------- /Alu2.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ScopedTypeVariables #-} 2 | {-# LANGUAGE DataKinds #-} 3 | {-# LANGUAGE TypeOperators #-} 4 | {-# LANGUAGE FlexibleContexts #-} 5 | {-# LANGUAGE RecordWildCards #-} 6 | 7 | module Alu2 where 8 | 9 | 10 | import CLaSH.Prelude 11 | import CLaSH.Sized.Unsigned 12 | 13 | import qualified Data.List as L 14 | import Text.Printf 15 | import Debug.Trace 16 | 17 | 18 | -- 19 | -- Note this is not the same as the ALU un a real 65XX 20 | -- It incorporates the input inverter and the bcd Adjust 21 | -- Both are separate entities on the real silicon 22 | -- As a result Sub is an OP 23 | -- Left Shift should still be performed as an add 24 | -- 25 | 26 | 27 | data AluOp = AluADD 28 | | AluSUB -- Real 6502 Doesn't have this explicitly - adding it here allows us to not model the separate inverter 29 | | AluOR 30 | | AluAND 31 | | AluXOR 32 | | AluRSHIFT 33 | 34 | 35 | type Byte = BitVector 8 36 | type Nibble = BitVector 4 37 | 38 | 39 | -- op aIn bIn cIn bcd (out, carry, overflow) 40 | alu :: AluOp -> Byte -> Byte -> Bit -> Bit -> (Byte, Bit, Bit) 41 | alu op aIn bIn cIn bcd = case op of 42 | AluOR -> (aIn .|. bIn, 0, 0) 43 | AluAND -> (aIn .&. bIn, 0, 0) 44 | AluXOR -> (aIn `xor` bIn, 0, 0) 45 | AluRSHIFT -> (pack (cIn +>> v), v !! 7, 0) where 46 | v = unpack aIn :: Vec 8 Bit 47 | AluSUB -> (res', cOut, vOut) where 48 | (res, hc, cOut, vOut) = add aIn (complement bIn) cIn 0 49 | res' = if bcd == 1 then bcdAdjustSub res hc cOut else res 50 | AluADD -> (res', cOut, vOut) where 51 | (res, hc, cOut, vOut) = add aIn bIn cIn bcd 52 | res' = if bcd == 1 then bcdAdjustAdd res hc cOut else res 53 | 54 | bcdAdjustAdd :: Byte -> Bit -> Bit -> Byte 55 | bcdAdjustAdd aIn hc c = high ++# low where 56 | (hIn, lIn) = split aIn :: (Nibble, Nibble) 57 | low = if hc == 1 then lIn + 6 else lIn 58 | high = if c == 1 then hIn + 6 else hIn 59 | 60 | bcdAdjustSub :: Byte -> Bit -> Bit -> Byte 61 | bcdAdjustSub aIn hc c = high ++# low where 62 | (hIn, lIn) = split aIn :: (Nibble, Nibble) 63 | low = if hc == 0 then lIn + 10 else lIn 64 | high = if c == 0 then hIn + 10 else hIn 65 | 66 | -- aIn bIn cIn bcd -> (res, hcOut, cOut, vOut) 67 | add :: Byte -> Byte -> Bit -> Bit -> (Byte, Bit, Bit, Bit) 68 | add aIn bIn cIn bcd = (res, hc, cOut, vOut) where 69 | -- Do Add in 2 halfs to get intermediate carries 70 | (aHi, aLo) = split aIn :: (Nibble, Nibble) 71 | (bHi, bLo) = split bIn :: (Nibble, Nibble) 72 | (rLo, c0, _) = adder cIn aLo bLo 73 | hc = c0 .|. if (rLo >= 10) then bcd else 0 74 | (rHi, c1, vOut) = adder hc aHi bHi 75 | cOut = c1 .|. if (rHi >= 10) then bcd else 0 76 | res = rHi ++# rLo 77 | 78 | adder :: Bit -> Nibble -> Nibble -> (Nibble, Bit, Bit) 79 | adder cIn xV yV = (pack (reverse sum), cOut, vOut) where 80 | x = reverse $ unpack xV 81 | y = reverse $ unpack yV 82 | res = zipWith3 fullAdder (cIn +>> carries) x y 83 | (sum, carries) = unzip res 84 | cOut = carries !! 3 85 | vOut = cOut `xor` (carries !! 2) 86 | 87 | fullAdder :: Bit -> Bit -> Bit -> (Bit, Bit) 88 | fullAdder cIn x y = (s, cOut) where 89 | p = x `xor` y 90 | s = p `xor`cIn 91 | cOut = if p == low then y else cIn 92 | 93 | 94 | testBCD :: Bool 95 | testBCD = res where 96 | inp = [(i, j, c) | i <- [0..99], j <- [0..99], c <- [0,1]] :: [(Integer, Integer, Bit)] 97 | res = and res' 98 | res' = L.map doAndCheck inp 99 | doAndCheck :: (Integer, Integer, Bit) -> Bool 100 | doAndCheck (a, b, c) = r where 101 | a' = fromInteger ((a `div` 10) * 16 + (a `mod` 10)) :: Byte 102 | b' = fromInteger ((b `div` 10) * 16 + (b `mod` 10)) :: Byte 103 | (r0, _, _) = alu AluSUB a' b' c 1 104 | (rHi, rLo) = split(r0) :: (Nibble, Nibble) 105 | r1 = (toInteger rHi) * 10 + (toInteger rLo) 106 | -- Compute actual result 107 | r2' = a - b - if c == 0 then 1 else 0 108 | r2 = if r2' < 0 then r2' + 100 else r2' 109 | r = trace (if r1 /= r2 then printf "%d %d %s = %d -- %d" a b (show c) r1 r2 else "OK") $ r1 == r2 110 | 111 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | -------------------------------------------------------------------------------- /Cpu2.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ScopedTypeVariables #-} 2 | {-# LANGUAGE DataKinds #-} 3 | {-# LANGUAGE TypeOperators #-} 4 | {-# LANGUAGE FlexibleContexts #-} 5 | {-# LANGUAGE RecordWildCards #-} 6 | 7 | 8 | module Cpu2 (cpuM, CpuOut(..), CpuIn(..), Probes(..))where 9 | 10 | import CLaSH.Prelude 11 | import CLaSH.Sized.Unsigned 12 | import qualified Data.List as L 13 | import Text.Printf 14 | 15 | import Alu 16 | import Types 17 | 18 | data Probes = Probes 19 | { prStateIn :: State 20 | , prState :: State 21 | , prPC :: Addr 22 | , prA :: Byte 23 | , prX :: Byte 24 | , prY :: Byte 25 | , prFlags :: Byte 26 | 27 | , prAddr :: Addr 28 | , prDIn :: Byte 29 | , prAddrOut :: Addr 30 | , prDOut :: Byte 31 | , prWrEn :: Bool 32 | } 33 | 34 | instance Show Probes where 35 | show a = str where 36 | -- str = "Hello" 37 | Probes{..} = a 38 | str = (printf "%-8s" (show prStateIn)) L.++ " " L.++ 39 | (printf "%-8s" (show prState)) L.++ " " L.++ 40 | (printf "%04x" (toInteger prPC)) L.++ " " L.++ 41 | (printf "%02x" (toInteger prA)) L.++ " " L.++ 42 | (printf "%02x" (toInteger prX)) L.++ " " L.++ 43 | (printf "%02x" (toInteger prY)) L.++ " " L.++ 44 | (pRegString prFlags) L.++ " " L.++ 45 | (printf "%04x" (toInteger prAddr)) L.++ " " L.++ 46 | (printf "%02x" (toInteger prDIn)) L.++ " " L.++ 47 | (printf "%04x" (toInteger prAddrOut)) L.++ " " L.++ 48 | (printf "%02x" (toInteger prDOut)) L.++ " " L.++ 49 | (show prWrEn) 50 | 51 | 52 | pRegString :: Byte -> String 53 | pRegString v = res where 54 | c = if (v .&. carryFlag) /= 0 then "C" else "c" 55 | z = if (v .&. zeroFlag) /= 0 then "Z" else "z" 56 | d = if (v .&. decFlag) /= 0 then "D" else "d" 57 | o = if (v .&. ovFlag) /= 0 then "O" else "o" 58 | n = if (v .&. negFlag) /= 0 then "N" else "n" 59 | i = if (v .&. intFlag) /= 0 then "I" else "i" 60 | un = if (v .&. unusedFlag) /= 0 then "U" else "u" 61 | b = if (v .&. breakFlag) /= 0 then "B" else "b" 62 | res = n L.++ o L.++ un L.++ b L.++ d L.++ i L.++ z L.++ c 63 | 64 | 65 | 66 | data CpuIn = CpuIn 67 | { dIn :: Byte 68 | } deriving (Show) 69 | 70 | data CpuOut = CpuOut 71 | { dOut :: Byte 72 | , addr :: Addr 73 | , writeEn :: Bool 74 | } deriving (Show) 75 | 76 | 77 | 78 | 79 | 80 | cpuM = cpu `mealy` initialState 81 | 82 | {-# NOINLINE cpu #-} 83 | cpu :: CpuState -> CpuIn -> (CpuState, (CpuOut, Probes)) 84 | cpu st@CpuState{..} CpuIn{..} = (st', (out, probes)) where 85 | state' = getState st' 86 | probes = Probes state state' rPC rA rX rY rFlags rAddr dIn (addr out) (dOut out) (writeEn out) 87 | 88 | (st', out) = case state of 89 | Halt -> (st, CpuOut 0 0 False) 90 | Init -> (st { state = WaitPCL, rAddr = resetVec }, CpuOut 0 resetVec False) 91 | WaitPCL -> (st { state = WaitPCH, rPC = resize dIn}, CpuOut 0 addr False) where 92 | addr = (rAddr .&. 0xff00) .|. ((rAddr + 1) .&. 0xff) 93 | WaitPCH -> (st { state = FetchI, rPC = pc' }, CpuOut 0 pc' False) where 94 | incPC = if rIBits == 0x60 then 1 else 0 95 | pc' = rPC + ((resize dIn :: Addr) `shiftL` 8) + incPC 96 | 97 | -- Read and decode the instruction - execute single byte instructions 98 | -- PC always advanced 99 | FetchI -> (st'', CpuOut oByte addr wr) where 100 | pc' = rPC+1 101 | stp = decodeInstruction st dIn 102 | (st'', addr, oByte, wr) = case getAddrMode stp of 103 | Implicit -> execWithData stp 0 0 104 | _ -> (stp {rPC = pc', state = FetchL }, pc', 0, False) 105 | 106 | -- Low data byte ready 107 | -- Can execute anything that doesn't require indirection through that byte 108 | FetchL -> (st'', CpuOut oByte addr wr) where 109 | pc' = rPC + 1 110 | cAddr = computeAddress st dIn 111 | (m, ao) = newAddrMode rAddrMode rAddrOp 112 | (st'', addr, oByte, wr) 113 | | canExecute rAluOp rAddrMode = execWithData st dIn cAddr 114 | -- Some indirection required -- pc not incremented, until instruction executed 115 | -- just read the byte from the supplied address and rerun this state as if it were Immediate 116 | | rAddrMode == Zp = (st {state = FetchL, rAddrMode = Imm, rAddr = cAddr}, cAddr, 0, False) 117 | -- Read the 16 bit address 118 | | rAddrMode == ZpInd = (st {state = ReadAddr, rAddr = cAddr, rAddrMode = m, rAddrOp = ao}, cAddr, 0, False) 119 | -- Have to fetch a 3rd instructionByte -- Store low byte of final 16 bit value in addr 120 | | otherwise = (st{state = FetchH, rAddr = resize dIn, rPC = pc'}, pc', 0, False) 121 | canExecute :: AluOp -> AddrMode -> Bool 122 | canExecute _ Imm = True 123 | canExecute _ Implicit = True 124 | canExecute a Zp = if writesToAddress a then True else False 125 | canExecute _ _ = False 126 | 127 | FetchH -> (st'', CpuOut oByte addr wr) where 128 | base = ((resize dIn) `shiftL` 8) .|. (rAddr) 129 | cAddr = computeAddress st{rAddr = base} dIn 130 | (m, ao) = newAddrMode rAddrMode rAddrOp 131 | (st'', addr, oByte, wr) 132 | | canExecute rAluOp rAddrMode = execWithData st dIn cAddr 133 | -- Need to indirect Addr mode must be ABS or ABSInd at this point 134 | | rAddrMode == Abs = (st {state = FetchL, rAddrMode = Imm, rAddr = cAddr}, cAddr, 0, False) 135 | -- AbsInd only happens for JSR 136 | | otherwise = (st {state = ReadAddr, rAddr = cAddr, rAddrMode = m, rAddrOp = ao}, cAddr, 0, False) 137 | 138 | canExecute :: AluOp -> AddrMode -> Bool 139 | canExecute _ Imm = True 140 | canExecute _ Implicit = True 141 | canExecute a Abs = if writesToAddress a then True else False 142 | canExecute _ _ = False 143 | 144 | ReadAddr -> (st'', CpuOut 0 addr' False) where 145 | addr' = rAddr + 1 146 | st'' = st{state = FetchH, rAddr = resize dIn} 147 | 148 | -- This is just a delay state for the write to occur on the bus before issuing an instruction read 149 | WriteByte -> (st{state = FetchI}, CpuOut 0 rPC False) 150 | PushHigh -> (st{state = state', rSp = rSp-1}, CpuOut (resize rAddr) (stackAddr rSp) True) where 151 | state' = if rIBits == 0x20 then WriteByte else PushFlags -- JSR doesn't push the flags 152 | PushFlags -> (st{state = Interrupt, rSp = rSp-1}, CpuOut rFlags (stackAddr rSp) True) 153 | Interrupt -> (st{state = WaitPCL, rFlags = rFlags .|. intFlag, rAddr = brkVec}, CpuOut 0 brkVec False) 154 | WaitFlags -> (st{state = WaitPCL, rFlags = dIn, rSp = rSp + 2, rAddr = addr'}, CpuOut 0 addr' False) where 155 | rSp' = rSp + 1 156 | addr' = stackAddr rSp' 157 | 158 | 159 | 160 | newAddrMode :: AddrMode -> AddrOp -> (AddrMode, AddrOp) 161 | newAddrMode ZpInd AOPostAddY = (Abs, AOPreAddY) 162 | newAddrMode _ _ = (Abs, AONone) 163 | 164 | 165 | 166 | computeAddress :: CpuState -> Byte -> Addr 167 | computeAddress st@CpuState{..} dIn = case rAddrMode of 168 | Zp -> resize $ addressCalc st dIn 169 | ZpInd -> resize $ addressCalc st dIn 170 | Abs -> addressCalc st rAddr 171 | AbsInd -> addressCalc st rAddr 172 | _ -> rAddr 173 | 174 | addressCalc :: forall n . (KnownNat n) => CpuState -> BitVector n -> BitVector n 175 | addressCalc CpuState{..} base = case rAddrOp of 176 | AOPreAddX -> base + (resize rX) 177 | AOPreAddY -> base + (resize rY) 178 | _ -> base 179 | 180 | 181 | 182 | writesToAddress :: AluOp -> Bool 183 | writesToAddress STA = True 184 | writesToAddress STX = True 185 | writesToAddress _ = False 186 | 187 | 188 | getAddr :: CpuState -> Addr 189 | getAddr st = rAddr st 190 | 191 | getAddrMode :: CpuState -> AddrMode 192 | getAddrMode st = rAddrMode st 193 | 194 | getState :: CpuState -> State 195 | getState st = state st 196 | 197 | 198 | -------------------------------------------------------------------------------- /Decode.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ScopedTypeVariables #-} 2 | {-# LANGUAGE DataKinds #-} 3 | {-# LANGUAGE TypeOperators #-} 4 | {-# LANGUAGE FlexibleContexts #-} 5 | {-# LANGUAGE RecordWildCards #-} 6 | 7 | module Decode where 8 | 9 | import CLaSH.Prelude 10 | import CLaSH.Sized.Unsigned 11 | import qualified Data.List as L 12 | import Text.Printf -------------------------------------------------------------------------------- /Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ScopedTypeVariables #-} 2 | {-# LANGUAGE DataKinds #-} 3 | {-# LANGUAGE TypeOperators #-} 4 | {-# LANGUAGE FlexibleContexts #-} 5 | {-# LANGUAGE TemplateHaskell #-} 6 | 7 | module Main where 8 | 9 | import CLaSH.Prelude 10 | import CLaSH.Sized.Unsigned 11 | import Language.Haskell.TH 12 | import CLaSH.Promoted.Nat 13 | 14 | import Types 15 | import SevenSeg 16 | -- import Cpu 17 | import Cpu2 18 | import qualified Data.List as L 19 | 20 | -- declare d65536 21 | $(decLiteralD 65536) 22 | $(decLiteralD 65012) 23 | 24 | 25 | 26 | {-# ANN topEntity 27 | (TopEntity 28 | { t_name = "main" 29 | , t_inputs = [] 30 | , t_outputs = ["SS_ANODES", "SS_SEGS"] 31 | , t_extraIn = [ ("CLOCK_32", 1) 32 | ] 33 | , t_extraOut = [] 34 | , t_clocks = [ (clockWizard "clkwiz50" 35 | "CLOCK_32(0)" 36 | "'0'") 37 | ] 38 | }) #-} 39 | 40 | 41 | 42 | topEntity :: Signal (BitVector 4, BitVector 8) 43 | topEntity = ss where 44 | ss = sevenSegA (resize . prPC <$> system) 45 | 46 | ram64K :: Signal Addr -> Signal Bool -> Signal Byte -> Signal Byte 47 | -- ram64K addr wrEn dataIn = blockRamPow2 testRAMContents addr addr wrEn dataIn 48 | ram64K addr wrEn dataIn = unpack <$> blockRamFilePow2 "utils/6502_functional_test.bin" (unpack <$> addr) (unpack <$> addr) wrEn (pack <$> dataIn) 49 | 50 | 51 | 52 | 53 | 54 | -- system :: Signal CpuProbes 55 | -- system = probes where 56 | -- (out, probes) = unbundle $ cpuA $ (CpuIn <$> din) 57 | -- adr = (resize . addr) <$> out :: Signal (Unsigned 16) 58 | -- din = ram64K adr (writeEn <$> out) (dataOut <$> out) 59 | 60 | system :: Signal Probes 61 | system = probes where 62 | (out, probes) = unbundle $ cpuM $ (CpuIn <$> din) 63 | adr = (resize . addr) <$> out :: Signal (Addr) 64 | din = ram64K adr (writeEn <$> out) (dOut <$> out) 65 | 66 | 67 | -- Note we have to drop 1 because the initial state of dIn is undefined 68 | runSystem = putStr $ unlines $ L.map (show) $L.drop 1 (sampleN 75000000 system) 69 | 70 | main = runSystem 71 | 72 | 73 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Clash6502 2 | 3 | A naive implementation of a MOS 6502 in Clash. It is not cycle accurate nor very efficient in terms of space usage. 4 | It's intened to be a simple none trivial project to better understand Clash. 5 | 6 | Currently it implements all documented 6502 instructions and passes a basic functional test. 7 | There is no current support for external interrupts. 8 | 9 | The Makefile is specific to my odd setup developing on a Mac with the Xilinx tools hosted in a Windows VM run via SSH from the Mac referencing source files via a network share. 10 | 11 | 12 | 13 | -------------------------------------------------------------------------------- /SevenSeg.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ScopedTypeVariables #-} 2 | {-# LANGUAGE DataKinds #-} 3 | {-# LANGUAGE TypeOperators #-} 4 | {-# LANGUAGE FlexibleContexts #-} 5 | 6 | 7 | module SevenSeg (sevenSegA) where 8 | 9 | import CLaSH.Prelude 10 | import qualified Data.List as L 11 | 12 | 13 | digitToSeg :: BitVector 4 -> BitVector 8 14 | digitToSeg 0x0 = 0xc0 15 | digitToSeg 0x1 = 0xf9 16 | digitToSeg 0x2 = 0xa4 17 | digitToSeg 0x3 = 0xb0 18 | digitToSeg 0x4 = 0x99 19 | digitToSeg 0x5 = 0x92 20 | digitToSeg 0x6 = 0x82 21 | digitToSeg 0x7 = 0xf8 22 | digitToSeg 0x8 = 0x80 23 | digitToSeg 0x9 = 0x90 24 | digitToSeg 0xa = 0x88 25 | digitToSeg 0xb = 0x83 26 | digitToSeg 0xc = 0xc6 27 | digitToSeg 0xd = 0xa1 28 | digitToSeg 0xe = 0x86 29 | digitToSeg 0xf = 0x8e 30 | 31 | 32 | anode :: BitVector 2 -> BitVector 4 33 | anode 0 = 0x7 34 | anode 1 = 0xb 35 | anode 2 = 0xd 36 | anode 3 = 0xe 37 | 38 | sh :: BitVector 2 -> Int 39 | sh 0 = 0 40 | sh 1 = 4 41 | sh 2 = 8 42 | sh 3 = 12 43 | 44 | multiplex :: (BitVector 2, BitVector 16) -> BitVector 16 -> ((BitVector 2, BitVector 16), (BitVector 4, BitVector 8)) 45 | multiplex (d, cnt) v = ((d', cnt+1), (an, leds)) where 46 | d' | (cnt == 0) = d+1 47 | | otherwise = d 48 | an = anode d 49 | leds = digitToSeg (resize (v `shiftR` (sh d))) 50 | 51 | sevenSegA = multiplex `mealy` (0, 0) 52 | 53 | -------------------------------------------------------------------------------- /Types.hs: -------------------------------------------------------------------------------- 1 | module Types where 2 | 3 | import CLaSH.Prelude 4 | import CLaSH.Sized.Unsigned 5 | 6 | type Byte = BitVector 8 7 | type Addr = BitVector 16 -------------------------------------------------------------------------------- /makefile: -------------------------------------------------------------------------------- 1 | CLASH = clash 2 | topLevel = Main 3 | part = XC6SLX9-TQG144-2 4 | 5 | ucfFiles = ..\\vhdl\\extra\\constraints.ucf 6 | 7 | srcDir = Z:\\git\\Clash\\examples\\MOS6502 8 | working = working 9 | 10 | # coregen_work_dir ?= ./coregen-tmp 11 | map_opts = -timing -ol high -detail -pr b -register_duplication -w 12 | par_opts = -ol high 13 | isedir = C:\\Xilinx\\14.7\\ISE_DS 14 | xil_env = $(isedir)\\settings64.bat 15 | 16 | 17 | # flashsize ?= 8192 18 | 19 | sshPreCmd = cmd /c Z: & cd $(srcDir)\\$(working) & $(xil_env) 20 | 21 | SHELL = /bin/zsh 22 | 23 | # test: 24 | # echo '$(addprefix -uc , $(ucfFiles))' 25 | 26 | all : $(working)/$(topLevel).bit 27 | 28 | junk += $(working) 29 | 30 | # Create a project file 31 | $(working)/$(topLevel).prj: vhdl/$(topLevel)/$(topLevel).vhdl Makefile 32 | test -d $(working) || mkdir $(working) 33 | for src in vhdl/$(topLevel)/*.vhdl; do echo "vhdl work ../$$src" >> $(working)/$(topLevel).tmpprj; done 34 | echo "vhdl work ../vhdl/extra/ipcores/clkwiz50.vhd" >> $(working)/$(topLevel).tmpprj 35 | sort -u $(working)/$(topLevel).tmpprj > $(working)/$(topLevel).prj 36 | rm -f $(working)/$(topLevel).tmpprj 37 | 38 | # and the xst script file 39 | $(working)/$(topLevel).scr: Makefile 40 | test -d $(working) || mkdir $(working) 41 | echo "run" > $@ 42 | echo "-opt_mode area" >> $@ 43 | echo "-opt_level 2" >> $@ 44 | echo "-p $(part)" >> $@ 45 | echo "-top $(topLevel)" >> $@ 46 | echo "-ifn $(topLevel).prj" >> $@ 47 | echo "-ofn $(topLevel).ngc" >> $@ 48 | 49 | # create the net list file 50 | $(working)/$(topLevel).ngc: vhdl/$(topLevel)/$(topLevel).vhdl $(working)/$(topLevel).scr $(working)/$(topLevel).prj 51 | echo $(isedir) 52 | ssh administrator@10.211.55.3 '$(sshPreCmd) & xst -ifn $(topLevel).scr' 53 | 54 | # Xilinx version of the netlist 55 | $(working)/$(topLevel).ngd: $(working)/$(topLevel).ngc 56 | ssh administrator@10.211.55.3 '$(sshPreCmd) & ngdbuild $(addprefix -uc , $(ucfFiles)) $(topLevel).ngc' 57 | 58 | # Map 59 | $(working)/$(topLevel).ncd: $(working)/$(topLevel).ngd 60 | ssh administrator@10.211.55.3 '$(sshPreCmd) & map $(map_opts) $(topLevel).ngd' 61 | 62 | #Par 63 | $(working)/$(topLevel)_par.ncd: $(working)/$(topLevel).ncd 64 | ssh administrator@10.211.55.3 '$(sshPreCmd) & par $(par_opts) -w $(topLevel).ncd $(topLevel)_par.ncd' 65 | 66 | 67 | #Bitgen 68 | $(working)/$(topLevel).bit: $(working)/$(topLevel)_par.ncd 69 | ssh administrator@10.211.55.3 '$(sshPreCmd) & bitgen -g DriveDone:yes -g StartupClk:Cclk -w $(topLevel)_par.ncd $(topLevel).bit' 70 | 71 | 72 | timing : $(topLevel).pcf 73 | 74 | $(topLevel).pcf: $(working)/$(topLevel)_par.ncd 75 | ssh administrator@10.211.55.3 '$(sshPreCmd) & trce -v 12 -fastpaths -o design_timing_report $(topLevel)_par.ncd $(topLevel).pcf' 76 | 77 | 78 | # Create the VHDL files 79 | vhdl/$(topLevel)/$(topLevel).vhdl : $(topLevel).hs Makefile 80 | rm -rf vhdl/$(topLevel) 81 | clash -odir obj -hidir obj --vhdl $(topLevel) 82 | junk += vhdl/$(topLevel) 83 | junk += obj 84 | 85 | 86 | interactive : 87 | clash -odir obj -hidir obj --interactive $(topLevel) 88 | 89 | clean : 90 | rm -rf $(junk) 91 | 92 | 93 | 94 | -------------------------------------------------------------------------------- /utils/6502_functional_test.raw: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/polygonhell/Clash6502/a684dd7bee153ebb43cfc26bd0f020bc08e9afd6/utils/6502_functional_test.raw -------------------------------------------------------------------------------- /utils/MakeMem.hs: -------------------------------------------------------------------------------- 1 | import System.Environment 2 | 3 | import Data.List 4 | import Data.List.Split 5 | import Text.Printf 6 | 7 | 8 | valuesFromString :: String -> [Int] 9 | valuesFromString contents = bytes where 10 | words = filter (\x -> x /= "") $ splitOneOf " \n\t" contents 11 | bytes = (map (\x -> read ("0x" ++ x) :: Int) words) 12 | 13 | 14 | vectors = [0x00, 0x02, 0x00, 0x00] 15 | baseAddr = 0x200 16 | romSize = 65536 17 | 18 | romImage :: Int -> [Int] -> [Int] 19 | romImage baseAddr imageBytes = preBytes ++ imageBytes ++ postBytes ++ vectors where 20 | preBytes = (replicate baseAddr 0x00) 21 | bytesToPad = romSize - (length imageBytes) - baseAddr - (length vectors) 22 | postBytes = (replicate bytesToPad 0x00) 23 | 24 | toBinStrings :: [Int] -> [String] 25 | toBinStrings bytes = map (\x -> printf "%08b" x) bytes 26 | 27 | 28 | 29 | main = do 30 | [f, fo] <- getArgs 31 | contents <- readFile f 32 | writeFile fo $ unlines $ toBinStrings $ romImage baseAddr (valuesFromString contents) 33 | -------------------------------------------------------------------------------- /utils/MakeMem2: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/polygonhell/Clash6502/a684dd7bee153ebb43cfc26bd0f020bc08e9afd6/utils/MakeMem2 -------------------------------------------------------------------------------- /utils/MakeMem2.hs: -------------------------------------------------------------------------------- 1 | import System.Environment 2 | 3 | import Data.List 4 | import Data.List.Split 5 | import Text.Printf 6 | import qualified Data.ByteString as B 7 | import Data.Word 8 | import System.IO 9 | 10 | 11 | 12 | 13 | toBinStrings :: B.ByteString -> [String] 14 | toBinStrings bytes = map (\x -> printf "%08b" x) (B.unpack bytes) 15 | 16 | 17 | 18 | main = do 19 | [f, fo] <- getArgs 20 | h <- openFile f ReadMode 21 | contents <- B.hGetContents h 22 | writeFile fo $ unlines $ toBinStrings contents 23 | -------------------------------------------------------------------------------- /utils/test.asm: -------------------------------------------------------------------------------- 1 | *= $200 2 | 3 | lda #$00 4 | bpl L2 5 | L2 lda #$02 6 | ldx #$80 7 | bpl L3 8 | brk 9 | 10 | L3 lda #$ff 11 | brk 12 | 13 | .end -------------------------------------------------------------------------------- /utils/test.hex: -------------------------------------------------------------------------------- 1 | A9 00 10 00 A9 02 A2 80 2 | 10 01 00 A9 FF 00 -------------------------------------------------------------------------------- /vhdl/extra/constraints.ucf: -------------------------------------------------------------------------------- 1 | ## Prohibit the automatic placement of pins that are connected to VCC or GND for configuration. 2 | CONFIG PROHIBIT=P60; 3 | CONFIG PROHIBIT=P69; 4 | CONFIG PROHIBIT=P144; 5 | CONFIG PART=XC6SLX9-TQG144-2; 6 | 7 | 8 | # Clock 9 | NET "CLOCK_32<0>" LOC = "P94" | IOSTANDARD = LVTTL | PERIOD=31.25ns; 10 | 11 | # 7-segment display 12 | 13 | NET "SS_ANODES<0>" LOC="P85"; 14 | NET "SS_ANODES<1>" LOC="P79"; 15 | NET "SS_ANODES<2>" LOC="P56"; 16 | NET "SS_ANODES<3>" LOC="P48"; 17 | 18 | NET "SS_SEGS<7>" LOC="P51"; # DP 19 | NET "SS_SEGS<6>" LOC="P81"; 20 | NET "SS_SEGS<5>" LOC="P61"; 21 | NET "SS_SEGS<4>" LOC="P58"; 22 | NET "SS_SEGS<3>" LOC="P67"; 23 | NET "SS_SEGS<2>" LOC="P66"; 24 | NET "SS_SEGS<1>" LOC="P83"; 25 | NET "SS_SEGS<0>" LOC="P75"; 26 | 27 | # Joystick 28 | # -- NET "BTN_UP" LOC="P50"; 29 | # -- NET "BTN_DOWN" LOC="P55"; 30 | # -- NET "BTN_LEFT" LOC="P57"; 31 | # -- NET "BTN_RIGHT" LOC="P59"; 32 | # -- NET "BTN_CENTER" LOC="P47"; 33 | 34 | # Input SW 35 | # -- NET "SWITCH<7>" LOC = "P114"; # IOSTANDARD=LVTTL; 36 | # -- NET "SWITCH<6>" LOC = "P115"; # | IOSTANDARD=LVTTL; 37 | # -- NET "SWITCH<5>" LOC = "P116"; # | IOSTANDARD=LVTTL; 38 | # -- NET "SWITCH<4>" LOC = "P117"; # | IOSTANDARD=LVTTL; 39 | # -- NET "SWITCH<3>" LOC = "P118"; # | IOSTANDARD=LVTTL; 40 | # -- NET "SWITCH<2>" LOC = "P119" ; # | IOSTANDARD=LVTTL; 41 | # -- NET "SWITCH<1>" LOC = "P120" ; # | IOSTANDARD=LVTTL; 42 | # -- NET "SWITCH<0>" LOC = "P121" ; # | IOSTANDARD=LVTTL; 43 | 44 | # LEDs 45 | # NET "LED<0>" LOC = "P134"; 46 | # NET "LED<1>" LOC = "P133"; 47 | # NET "LED<2>" LOC = "P132"; 48 | # NET "LED<3>" LOC = "P131"; 49 | # NET "LED<4>" LOC = "P127"; 50 | # NET "LED<5>" LOC = "P126"; 51 | # NET "LED<6>" LOC = "P124"; 52 | # NET "LED<7>" LOC = "P123"; 53 | 54 | # VGA 55 | # -- NET "VGA_R<0>" LOC = "P78" | IOSTANDARD=LVTTL; 56 | # -- NET "VGA_R<1>" LOC = "P74" | IOSTANDARD=LVTTL; 57 | # -- NET "VGA_R<2>" LOC = "P95" | IOSTANDARD=LVTTL; 58 | # -- NET "VGA_G<0>" LOC = "P84" | IOSTANDARD=LVTTL; 59 | # -- NET "VGA_G<1>" LOC = "P82" | IOSTANDARD=LVTTL; 60 | # -- NET "VGA_G<2>" LOC = "P80" | IOSTANDARD=LVTTL; 61 | # -- NET "VGA_B<0>" LOC = "P92" | IOSTANDARD=LVTTL; 62 | # -- NET "VGA_B<1>" LOC = "P87" | IOSTANDARD=LVTTL; 63 | # -- NET "VGA_VSYNC" LOC = "P99" | IOSTANDARD=LVTTL; 64 | # -- NET "VGA_HSYNC" LOC = "P97" | IOSTANDARD=LVTTL; 65 | -------------------------------------------------------------------------------- /vhdl/extra/ipcores/clkwiz50.vhd: -------------------------------------------------------------------------------- 1 | -- file: clkwiz50.vhd 2 | -- 3 | -- (c) Copyright 2008 - 2011 Xilinx, Inc. All rights reserved. 4 | -- 5 | -- This file contains confidential and proprietary information 6 | -- of Xilinx, Inc. and is protected under U.S. and 7 | -- international copyright and other intellectual property 8 | -- laws. 9 | -- 10 | -- DISCLAIMER 11 | -- This disclaimer is not a license and does not grant any 12 | -- rights to the materials distributed herewith. Except as 13 | -- otherwise provided in a valid license issued to you by 14 | -- Xilinx, and to the maximum extent permitted by applicable 15 | -- law: (1) THESE MATERIALS ARE MADE AVAILABLE "AS IS" AND 16 | -- WITH ALL FAULTS, AND XILINX HEREBY DISCLAIMS ALL WARRANTIES 17 | -- AND CONDITIONS, EXPRESS, IMPLIED, OR STATUTORY, INCLUDING 18 | -- BUT NOT LIMITED TO WARRANTIES OF MERCHANTABILITY, NON- 19 | -- INFRINGEMENT, OR FITNESS FOR ANY PARTICULAR PURPOSE; and 20 | -- (2) Xilinx shall not be liable (whether in contract or tort, 21 | -- including negligence, or under any other theory of 22 | -- liability) for any loss or damage of any kind or nature 23 | -- related to, arising under or in connection with these 24 | -- materials, including for any direct, or any indirect, 25 | -- special, incidental, or consequential loss or damage 26 | -- (including loss of data, profits, goodwill, or any type of 27 | -- loss or damage suffered as a result of any action brought 28 | -- by a third party) even if such damage or loss was 29 | -- reasonably foreseeable or Xilinx had been advised of the 30 | -- possibility of the same. 31 | -- 32 | -- CRITICAL APPLICATIONS 33 | -- Xilinx products are not designed or intended to be fail- 34 | -- safe, or for use in any application requiring fail-safe 35 | -- performance, such as life-support or safety devices or 36 | -- systems, Class III medical devices, nuclear facilities, 37 | -- applications related to the deployment of airbags, or any 38 | -- other applications that could lead to death, personal 39 | -- injury, or severe property or environmental damage 40 | -- (individually and collectively, "Critical 41 | -- Applications"). Customer assumes the sole risk and 42 | -- liability of any use of Xilinx products in Critical 43 | -- Applications, subject only to applicable laws and 44 | -- regulations governing limitations on product liability. 45 | -- 46 | -- THIS COPYRIGHT NOTICE AND DISCLAIMER MUST BE RETAINED AS 47 | -- PART OF THIS FILE AT ALL TIMES. 48 | -- 49 | ------------------------------------------------------------------------------ 50 | -- User entered comments 51 | ------------------------------------------------------------------------------ 52 | -- None 53 | -- 54 | ------------------------------------------------------------------------------ 55 | -- "Output Output Phase Duty Pk-to-Pk Phase" 56 | -- "Clock Freq (MHz) (degrees) Cycle (%) Jitter (ps) Error (ps)" 57 | ------------------------------------------------------------------------------ 58 | -- CLK_OUT1____50.000______0.000______50.0______600.000____150.000 59 | -- 60 | ------------------------------------------------------------------------------ 61 | -- "Input Clock Freq (MHz) Input Jitter (UI)" 62 | ------------------------------------------------------------------------------ 63 | -- __primary__________32.000____________0.010 64 | 65 | library ieee; 66 | use ieee.std_logic_1164.all; 67 | use ieee.std_logic_unsigned.all; 68 | use ieee.std_logic_arith.all; 69 | use ieee.numeric_std.all; 70 | 71 | library unisim; 72 | use unisim.vcomponents.all; 73 | 74 | entity clkwiz50 is 75 | port 76 | (-- Clock in ports 77 | CLK_IN1 : in std_logic; 78 | -- Clock out ports 79 | CLK_OUT1 : out std_logic; 80 | -- Status and control signals 81 | RESET : in std_logic; 82 | LOCKED : out std_logic 83 | ); 84 | end clkwiz50; 85 | 86 | architecture xilinx of clkwiz50 is 87 | attribute CORE_GENERATION_INFO : string; 88 | attribute CORE_GENERATION_INFO of xilinx : architecture is "clkwiz50,clk_wiz_v3_6,{component_name=clkwiz50,use_phase_alignment=true,use_min_o_jitter=false,use_max_i_jitter=false,use_dyn_phase_shift=false,use_inclk_switchover=false,use_dyn_reconfig=false,feedback_source=FDBK_AUTO,primtype_sel=DCM_SP,num_out_clk=1,clkin1_period=31.25,clkin2_period=31.25,use_power_down=false,use_reset=true,use_locked=true,use_inclk_stopped=false,use_status=false,use_freeze=false,use_clk_valid=false,feedback_type=SINGLE,clock_mgr_type=AUTO,manual_override=false}"; 89 | -- Input clock buffering / unused connectors 90 | signal clkin1 : std_logic; 91 | -- Output clock buffering 92 | signal clkfb : std_logic; 93 | signal clk0 : std_logic; 94 | signal clkfx : std_logic; 95 | signal clkfbout : std_logic; 96 | signal locked_internal : std_logic; 97 | signal status_internal : std_logic_vector(7 downto 0); 98 | begin 99 | 100 | 101 | -- Input buffering 102 | -------------------------------------- 103 | clkin1_buf : IBUFG 104 | port map 105 | (O => clkin1, 106 | I => CLK_IN1); 107 | 108 | 109 | -- Clocking primitive 110 | -------------------------------------- 111 | 112 | -- Instantiation of the DCM primitive 113 | -- * Unused inputs are tied off 114 | -- * Unused outputs are labeled unused 115 | dcm_sp_inst: DCM_SP 116 | generic map 117 | (CLKDV_DIVIDE => 2.000, 118 | CLKFX_DIVIDE => 16, 119 | CLKFX_MULTIPLY => 16, 120 | CLKIN_DIVIDE_BY_2 => FALSE, 121 | CLKIN_PERIOD => 31.25, 122 | CLKOUT_PHASE_SHIFT => "NONE", 123 | CLK_FEEDBACK => "1X", 124 | DESKEW_ADJUST => "SYSTEM_SYNCHRONOUS", 125 | PHASE_SHIFT => 0, 126 | STARTUP_WAIT => FALSE) 127 | port map 128 | -- Input clock 129 | (CLKIN => clkin1, 130 | CLKFB => clkfb, 131 | -- Output clocks 132 | CLK0 => clk0, 133 | CLK90 => open, 134 | CLK180 => open, 135 | CLK270 => open, 136 | CLK2X => open, 137 | CLK2X180 => open, 138 | CLKFX => clkfx, 139 | CLKFX180 => open, 140 | CLKDV => open, 141 | -- Ports for dynamic phase shift 142 | PSCLK => '0', 143 | PSEN => '0', 144 | PSINCDEC => '0', 145 | PSDONE => open, 146 | -- Other control and status signals 147 | LOCKED => locked_internal, 148 | STATUS => status_internal, 149 | RST => RESET, 150 | -- Unused pin, tie low 151 | DSSEN => '0'); 152 | 153 | LOCKED <= locked_internal; 154 | 155 | 156 | 157 | -- Output buffering 158 | ------------------------------------- 159 | clkf_buf : BUFG 160 | port map 161 | (O => clkfb, 162 | I => clk0); 163 | 164 | 165 | clkout1_buf : BUFG 166 | port map 167 | (O => CLK_OUT1, 168 | I => clkfx); 169 | 170 | 171 | 172 | end xilinx; 173 | --------------------------------------------------------------------------------