MOS 6502 emulator.fs

// This program executes 6502_functional_test.bin from https://github.com/Klaus2m5/6502_65C02_functional_tests
// It successes almost all the tests and fails the tests for decimal mode.
open System.IO
open System
open System.Collections.Generic

let hasBit i v = v &&& (1uy <<< i) <> 0uy

type Addr = Accumulator | Implied | Immediate of uint8 | Bus of int
type Addressing = Acc | Impl | Sharp | Rel | Zpg | ZpgX | ZpgY | Abs | AbsX | AbsY | Ind | XInd | IndY 
type Instruction =
  | LDA | LDX | LDY 
  | STA | STX | STY
  | TAX | TAY | TXA | TYA | TSX | TXS
  | ADC | SBC 
  | AND | ORA
  | ASL | LSR
  | BIT 
  | CMP | CPX | CPY
  | EOR 
  | DEC | DEX | DEY | INC | INX | INY 
  | ROL | ROR 
  | PHA | PHP | PLA | PLP 
  | JMP | JSR | RTS | RTI 
  | BCS | BCC | BEQ | BNE | BMI | BPL | BVS | BVC
  | CLC | CLI | CLV | CLD | SEC | SED | SEI
  | NOP | BRK 

let ops = Map.ofList [
  yield 0xea, (NOP, Impl)
  yield!
    [ BRK, Impl; JSR, Abs; RTI, Impl; RTS, Impl; ]
    |> List.mapi(fun i (op, addr) -> i * 32, (op, addr))
  for ops, ofs, inc, addr in 
   [[ PHP; CLC; PLP; SEC; PHA; CLI; PLA; SEI; DEY; TYA; TAY; CLV; INY; CLD; INX; SED ], 8, 16, Impl
    [ BPL; BMI; BVC; BVS; BCC; BCS; BNE; BEQ ], 0x10, 32, Rel
    [ TXA; TXS; TAX; TSX; DEX ], 0x8a, 16, Impl
  ] do yield! ops |> List.mapi(fun i op -> ofs + i * inc, (op, addr))
  for op, ofs, incAddrs in
   [BIT, 0x24, [0, Zpg; 8, Abs ]
    JMP, 0x4c, [0, Abs; 32, Ind ]
    STY, 0x84, [ 0, Zpg; 8, Abs; 16, ZpgX ]
    STX, 0x86, [ 0, Zpg; 8, Abs; 16, ZpgY ]
    LDY, 0xa0, [ 0, Sharp; 4, Zpg; 12, Abs; 20, ZpgX; 28, AbsX ]
    LDX, 0xa2, [ 0, Sharp; 4, Zpg; 12, Abs; 20, ZpgY; 28, AbsY ]
  ] do for inc, addr in incAddrs -> ofs + inc, (op, addr)
  for ops, ofs, incOp, incAddr in
   [[ ORA; AND; EOR; ADC; STA; LDA; CMP; SBC ], 1, 32, [ 0, XInd; 4, Zpg; 8, Sharp; 12, Abs; 16, IndY; 20, ZpgX; 24, AbsY; 28, AbsX ]
    [ ASL; ROL; LSR; ROR ], 6, 32, [0, Zpg; 4, Acc; 8, Abs; 16, ZpgX; 24, AbsX ]
    [ DEC; INC ], 0xc6, 32, [ 0, Zpg; 8, Abs; 16, ZpgX; 24, AbsX ]
    [ CPY; CPX ], 0xc0, 32, [ 0, Sharp; 4, Zpg; 12, Abs ]
  ] do for inc, addr in incAddr do yield! ops |> List.mapi(fun i op -> ofs + i * incOp + inc, (op, addr))
  ]
type CPU(bus:byte[], pc:int) =
  let N, V, R, B, D, I, Z, C = 7, 6, 5, 4, 3, 2, 1, 0
  let mutable A, X, Y, S, P = 0uy, 0uy, 0uy, 0uy, 0uy
  let PC = ref pc
  let push v = bus.[0x100 + int S] <- v; S <- S - 1uy
  let pop () = S <- S + 1uy; bus.[0x100 + int S]
  let pushWord v = for n in [8; 0] do v >>> n |> byte |> push
  let popWord() = (pop() |> int) ||| ((pop() |> int) <<< 8) 
  let clearBit i = P <- P &&& ~~~(1uy <<< i)
  let setBit i = P <- P ||| (1uy <<< i) 
  let toBit i b = if b then setBit i else clearBit i
  let setNZ v = toBit N (hasBit 7 v); toBit Z (v = 0uy); v
  let setC v = v > 0xffu |> toBit C; (byte)v
  let setCLower v = v &&& 1uy = 1uy |> toBit C; v >>> 1
  let setNZC v = v |> setC |> setNZ
  let compare v0 v1 =
    toBit C (v0 >= v1) 
    setNZ (v0 - v1) |> ignore
  let readBus() = let pc = !PC in incr PC; bus.[pc]
  let peekWord i = (int bus.[i + 1] <<< 8) + int bus.[i]

  member __.Addr addr =
    match addr with
    | Acc -> Accumulator
    | Impl -> Implied
    | _ ->
    let bb0 = readBus()
    let b0 = int bb0
    match addr with
    | Sharp -> b0 |> byte |> Immediate
    | Rel -> !PC + (bb0 |> sbyte |> int) |> Bus
    | Zpg -> b0 |> Bus
    | ZpgX -> bb0 + X |> int |> Bus
    | ZpgY -> bb0 + Y |> int |> Bus
    | XInd -> bb0 + X |> int |> peekWord |> Bus
    | IndY -> (bb0 |> int |> peekWord) + int Y |> Bus
    | _ -> 
    let b1 = readBus() |> int
    let b = (b1 <<< 8) + b0
    match addr with
    | AbsX -> b + int X |> Bus
    | AbsY -> b + int Y |> Bus
    | Abs -> b |> Bus
    | _ -> b |> peekWord |> Bus
 
  member __.Run (op, addr) =
    let g = match addr with Accumulator -> A | Immediate v -> v | Bus i -> bus.[i] | _ -> 0uy
    let s v = match addr with Accumulator -> A <- v | Bus i -> bus.[i] <- v | _ -> ()
    match op with
    | LDA -> A <- setNZ g | STA -> s A 
    | LDX -> X <- setNZ g | STX -> s X 
    | LDY -> Y <- setNZ g | STY -> s Y
    | TAX -> X <- setNZ A | TXA -> A <- setNZ X
    | TAY -> Y <- setNZ A | TYA -> A <- setNZ Y
    | TSX -> X <- setNZ S | TXS -> S <- X
    | ADC -> 
      let t = uint32 A + uint32 g + uint32 (P &&& 1uy)
      (~~~(A ^^^ byte g) &&& (A ^^^ byte t)) >>> 7 = 1uy |> toBit V
      A <- t |> setNZC
    | SBC ->
      let t = uint32 A - uint32 g - uint32 (~~~P &&& 1uy)
      ((A ^^^ byte g) &&& (A ^^^ byte t)) >>> 7 = 1uy |> toBit V
      toBit C (t < 0x100u)
      A <- t |> byte |> setNZ
    | AND -> A <- A &&& g |> setNZ | ORA -> A <- A ||| g |> setNZ
    | CMP -> compare A g | CPX -> compare X g | CPY -> compare Y g
    | EOR -> A <- A ^^^ g |> setNZ
    | DEC -> g - 1uy |> setNZ |> s | INC -> g + 1uy |> setNZ |> s
    | DEX -> X <- X - 1uy |> setNZ | INX -> X <- X + 1uy |> setNZ
    | DEY -> Y <- Y - 1uy |> setNZ | INY -> Y <- Y + 1uy |> setNZ
    | ASL -> uint32 g <<< 1 |> setNZC |> s | LSR -> g |> setCLower |> setNZ |> s
    | ROL -> (uint32 P &&& 1u) ||| (uint32 g <<< 1) |> setNZC |> s | ROR -> (P <<< 7) ||| setCLower g |> setNZ |> s
    | BIT ->
      P <- (P &&& 0x3fuy) ||| (g &&& 0xc0uy)
      toBit Z (A &&& g = 0uy) 
    | PHA -> push A | PHP -> push (P ||| (1uy <<< B)) | PLA -> A <- pop() |> setNZ | PLP -> P <- pop() ||| 0x20uy
    | RTS -> PC := popWord() + 1
    | RTI -> 
      P <- pop()
      PC := popWord()
    | CLC -> clearBit C | CLV -> clearBit V | CLI -> clearBit I | CLD -> clearBit D 
    | SEC -> setBit C | SED -> setBit D | SEI -> setBit I 
    | BRK -> 
      !PC + 1 |> pushWord 
      setBit B
      push P
      setBit I
      PC := peekWord 0xfffe
    | _ -> 
      match addr with
      | Bus i ->
        match op with
        | JMP -> PC := i
        | JSR -> 
          !PC - 1 |> pushWord
          PC := i
        | _ ->
          let is inst0 inst1 n = op = if hasBit n P then inst0 else inst1
          if is BCS BCC C || is BEQ BNE Z || is BVS BVC V || is BMI BPL N then PC:= i
      | _ -> ()

  member __.Debug() =
    let queue = Queue()
    let mutable line = ""
    let count = ref 10000000
    while !PC < bus.Length && (decr count; !count > 0) do
      let pc = !PC
      let b = readBus() |> int
      match Map.tryFind b ops with
      | Some (op, am) -> 
        let addr = __.Addr am 
        match op with 
        | DEX | NOP -> () 
        | _ ->
          let p = "NVRBDIZC" |> String.mapi (fun i c -> if (P >>> (7 - i)) &&& 1uy = 1uy then c else '_')
          let sAddr = am.ToString().PadRight(5, ' ')
          let g = match addr with Immediate v -> sprintf "#$%02x" v | Bus i -> sprintf "$%04x -> #$%02x" i bus.[i] | _ -> ""
          let t = sprintf "%04x %A %s A%02x X%02x Y%02x S%02x P%s %s" pc op sAddr A X Y S p g
          if line = t then count := 0
          printfn "%s" t
          queue.Enqueue t
          if queue.Count > 200 then queue.Dequeue() |> ignore
          line <- t
        __.Run(op, addr)
      | _ -> printfn "%04x %2x" pc b 
    for t in queue do printfn "%s" t

[<EntryPoint>]
let main _ =
  let cpu = CPU(File.ReadAllBytes "6502_functional_test.bin", 1024)
  cpu.Debug()
  Console.ReadKey() |> ignore
  0