├── .github └── workflows │ └── build.yml ├── .gitignore ├── .ocamlformat ├── 6502-ml.opam ├── README.md ├── dune ├── dune-project ├── lib ├── addressing.ml ├── c6502.ml ├── c6502.mli ├── cpu0.ml ├── dune ├── index.mld ├── instruction.ml ├── register.ml ├── utils.ml └── utils.mli └── tests ├── dune ├── test_roms ├── 65C02_extended_opcodes_test.bin ├── instr_misc │ ├── 01-abs_x_wrap.nes │ ├── 01-abs_x_wrap.nes.bin │ ├── 02-branch_wrap.nes │ └── 02-branch_wrap.nes.bin ├── instr_test │ ├── 01-basics.nes.bin │ ├── 02-implied.nes.bin │ ├── 03-immediate.nes.bin │ ├── 04-zero_page.nes.bin │ ├── 05-zp_xy.nes.bin │ ├── 06-absolute.nes.bin │ ├── 07-abs_xy.nes.bin │ ├── 08-ind_x.nes.bin │ ├── 09-ind_y.nes.bin │ ├── 10-branches.nes.bin │ ├── 11-stack.nes.bin │ ├── 12-jmp_jsr.nes.bin │ ├── 13-rts.nes.bin │ ├── 14-rti.nes.bin │ ├── 15-brk.nes.bin │ └── 16-special.nes.bin ├── instr_timing │ ├── 1-instr_timing.nes │ ├── 1-instr_timing.nes.bin │ ├── 2-branch_timing.nes │ └── 2-branch_timing.nes.bin ├── klaus.bin ├── nestest.log └── nestest.nes.bin └── unit_test.ml /.github/workflows/build.yml: -------------------------------------------------------------------------------- 1 | # This is a basic workflow to help you get started with Actions 2 | 3 | name: build 4 | 5 | # Controls when the workflow will run 6 | on: 7 | # Triggers the workflow on push or pull request events but only for the main branch 8 | push: 9 | branches: [ main ] 10 | pull_request: 11 | branches: [ main ] 12 | 13 | # Allows you to run this workflow manually from the Actions tab 14 | workflow_dispatch: 15 | 16 | # A workflow run is made up of one or more jobs that can run sequentially or in parallel 17 | jobs: 18 | # This workflow contains a single job called "build" 19 | build: 20 | # The type of runner that the job will run on 21 | runs-on: ubuntu-latest 22 | 23 | # Steps represent a sequence of tasks that will be executed as part of the job 24 | steps: 25 | # Checks-out your repository under $GITHUB_WORKSPACE, so your job can access it 26 | - uses: actions/checkout@v3 27 | 28 | # Runs a single command using the runners shell 29 | - name: Setup OCaml switch 30 | uses: avsm/setup-ocaml@v1 31 | with: 32 | ocaml-version: 4.14.0 33 | 34 | # Runs a set of commands using the runners shell 35 | - name: Pin and build package 36 | run: opam install --with-test -y . 37 | 38 | # Run tests 39 | - name: Run tests 40 | run: | 41 | eval $(opam env) 42 | dune runtest 43 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | _opam -------------------------------------------------------------------------------- /.ocamlformat: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/6502-ml/08d2babe3d838eaae8ed90daca7d5fff4c5bf5ae/.ocamlformat -------------------------------------------------------------------------------- /6502-ml.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | synopsis: "Library for the simulation 6502 chip family" 4 | description: "Library for the simulation 6502 chip family" 5 | maintainer: ["virgile.robles@pm.me"] 6 | authors: ["Virgile Robles"] 7 | license: "MIT" 8 | homepage: "https://github.com/Firobe/6502-ml" 9 | bug-reports: "https://github.com/Firobe/6502-ml/issues" 10 | depends: [ 11 | "stdint" 12 | "stdint-literals" 13 | "dune" {>= "2.8" & build} 14 | "alcotest" {with-test} 15 | "re" {with-test} 16 | "str" {wth-test} 17 | "odoc" {with-doc} 18 | ] 19 | build: [ 20 | ["dune" "subst"] {dev} 21 | [ 22 | "dune" 23 | "build" 24 | "-p" 25 | name 26 | "-j" 27 | jobs 28 | "@install" 29 | "@runtest" {with-test} 30 | "@doc" {with-doc} 31 | ] 32 | ] 33 | dev-repo: "git+https://github.com/Firobe/6502-ml.git" 34 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # 6502-ml 2 | 3 | 6502 chip family simulator in OCaml. Created for use in a [NES emulator in OCaml](https://github.com/Firobe/nes-ml). 4 | 5 | ![CI](https://github.com/Firobe/6502-ml/actions/workflows/build.yml/badge.svg) 6 | 7 | **Documentation** containing simple examples and reference is available [online](https://firobe.fr/6502-ml/6502-ml/). 8 | 9 | ## Usage 10 | 11 | Assuming you have `opam` installed with an existing switch, either: 12 | - add a pin to this repo: 13 | > `opam pin add nes-ml https://github.com/Firobe/6502-ml.git` 14 | 15 | - or clone and run 16 | > `opam install .` 17 | 18 | Furthermore, you can run the tests with `dune runtest`. To use the library in other programs, see the [online documentation](https://firobe.fr/6502-ml/6502-ml/). 19 | 20 | Its zero page starts at address `0x0000`. 21 | 22 | ## Development status 23 | 24 | The CPU passes all functional tests of [Klaus Dormann's test suite](https://github.com/Klaus2m5/6502_65C02_functional_tests) (`klaus.bin` is an assembly of `6502_functional_test.a65`) and the [Nestest ROM](http://www.qmtpro.com/~nes/misc/nestest.txt) as compared to Nintendulator. 25 | 26 | Cycles count is accurate even for supported unofficial instructions, and tested. 27 | 28 | ## References 29 | 30 | Great ressources used: 31 | - http://www.6502.org/tutorials/ 32 | - http://www.obelisk.me.uk/6502/ 33 | - https://wiki.nesdev.com/ 34 | - http://www.masswerk.at/6502/6502_instruction_set.html 35 | - http://nesdev.com/6502_cpu.txt 36 | -------------------------------------------------------------------------------- /dune: -------------------------------------------------------------------------------- 1 | (env 2 | (_ 3 | (ocamlopt_flags 4 | (:standard -O3)))) 5 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 2.8) 2 | (name 6502-ml) 3 | 4 | ; (version 1.0.0) 5 | 6 | (generate_opam_files true) 7 | 8 | (source (github Firobe/6502-ml)) 9 | (license MIT) 10 | (authors "Virgile Robles") 11 | (maintainers "virgile.robles@pm.me") 12 | 13 | (package 14 | (name 6502-ml) 15 | (synopsis "Library for the simulation 6502 chip family") 16 | (description "Library for the simulation 6502 chip family") 17 | (depends 18 | stdint 19 | stdint-literals 20 | (dune :build) 21 | (alcotest :with-test) 22 | (re :with-test) 23 | (str :wth-test))) 24 | -------------------------------------------------------------------------------- /lib/addressing.ml: -------------------------------------------------------------------------------- 1 | type t = 2 | | Implicit 3 | | Accumulator 4 | | Immediate 5 | | Zero_Page 6 | | Zero_Page_X 7 | | Zero_Page_Y 8 | | Relative 9 | | Absolute 10 | | Absolute_X 11 | | Absolute_Y 12 | | Indirect 13 | | Indexed_Indirect 14 | | Indirect_Indexed 15 | 16 | let size = function 17 | | Implicit | Accumulator -> 1 18 | | Immediate | Zero_Page | Zero_Page_X | Zero_Page_Y | Indexed_Indirect 19 | | Indirect_Indexed | Relative -> 20 | 2 21 | | Absolute | Absolute_X | Absolute_Y | Indirect -> 3 22 | 23 | (* Addressed by b, c, a *) 24 | let layout = 25 | let impl = Implicit in 26 | let zpg_ = Zero_Page in 27 | let abs_ = Absolute in 28 | let rel_ = Relative in 29 | let zpgx = Zero_Page_X in 30 | let zpgy = Zero_Page_Y in 31 | let absx = Absolute_X in 32 | let absy = Absolute_Y in 33 | let imm_ = Immediate in 34 | let xind = Indexed_Indirect in 35 | let ind_ = Indirect in 36 | let indy = Indirect_Indexed in 37 | let jam_ = Implicit in 38 | let acc_ = Accumulator in 39 | [| 40 | [| 41 | [|impl; abs_; impl; impl; imm_; imm_; imm_; imm_|]; 42 | [|xind; xind; xind; xind; xind; xind; xind; xind|]; 43 | [|jam_; jam_; jam_; jam_; imm_; imm_; imm_; imm_|]; 44 | [|xind; xind; xind; xind; xind; xind; xind; xind|] 45 | |]; 46 | [| 47 | [|zpg_; zpg_; zpg_; zpg_; zpg_; zpg_; zpg_; zpg_|]; 48 | [|zpg_; zpg_; zpg_; zpg_; zpg_; zpg_; zpg_; zpg_|]; 49 | [|zpg_; zpg_; zpg_; zpg_; zpg_; zpg_; zpg_; zpg_|]; 50 | [|zpg_; zpg_; zpg_; zpg_; zpg_; zpg_; zpg_; zpg_|] 51 | |]; 52 | [| 53 | [|impl; impl; impl; impl; impl; impl; impl; impl|]; 54 | [|imm_; imm_; imm_; imm_; imm_; imm_; imm_; imm_|]; 55 | [|acc_; acc_; acc_; acc_; impl; impl; impl; impl|]; 56 | [|imm_; imm_; imm_; imm_; imm_; imm_; imm_; imm_|] 57 | |]; 58 | [| 59 | [|abs_; abs_; abs_; ind_; abs_; abs_; abs_; abs_|]; 60 | [|abs_; abs_; abs_; abs_; abs_; abs_; abs_; abs_|]; 61 | [|abs_; abs_; abs_; abs_; abs_; abs_; abs_; abs_|]; 62 | [|abs_; abs_; abs_; abs_; abs_; abs_; abs_; abs_|] 63 | |]; 64 | [| 65 | [|rel_; rel_; rel_; rel_; rel_; rel_; rel_; rel_|]; 66 | [|indy; indy; indy; indy; indy; indy; indy; indy|]; 67 | [|jam_; jam_; jam_; jam_; jam_; jam_; jam_; jam_|]; 68 | [|indy; indy; indy; indy; indy; indy; indy; indy|] 69 | |]; 70 | [| 71 | [|zpgx; zpgx; zpgx; zpgx; zpgx; zpgx; zpgx; zpgx|]; 72 | [|zpgx; zpgx; zpgx; zpgx; zpgx; zpgx; zpgx; zpgx|]; 73 | [|zpgx; zpgx; zpgx; zpgx; zpgy; zpgy; zpgx; zpgx|]; 74 | [|zpgx; zpgx; zpgx; zpgx; zpgy; zpgy; zpgx; zpgx|] 75 | |]; 76 | [| 77 | [|impl; impl; impl; impl; impl; impl; impl; impl|]; 78 | [|absy; absy; absy; absy; absy; absy; absy; absy|]; 79 | [|impl; impl; impl; impl; impl; impl; impl; impl|]; 80 | [|absy; absy; absy; absy; absy; absy; absy; absy|] 81 | |]; 82 | [| 83 | [|absx; absx; absx; absx; absx; absx; absx; absx|]; 84 | [|absx; absx; absx; absx; absx; absx; absx; absx|]; 85 | [|absx; absx; absx; absx; absy; absy; absx; absx|]; 86 | [|absx; absx; absx; absx; absy; absy; absx; absx|] 87 | |] 88 | |][@ocamlformat "disable"] 89 | 90 | (* Addressing and instruction dispatch *) 91 | let of_opcode_triple (a, b, c) = layout.(b).(c).(a) 92 | 93 | (* Precompute number of cycles taken, official *) 94 | let cycle_functions = 95 | let c0 pc = function 96 | | Immediate -> 2 97 | | Zero_Page -> 3 98 | | Zero_Page_X | Zero_Page_Y | Absolute -> 4 99 | | Absolute_X | Absolute_Y -> if pc then 5 else 4 100 | | Indirect_Indexed -> if pc then 6 else 5 101 | | _ -> 6 102 | in 103 | let c1 _ = function 104 | | Absolute_X | Absolute_Y -> 5 105 | | Indirect_Indexed -> 6 106 | | o -> c0 false o 107 | in 108 | let c2 _ _ = 2 in 109 | let c3 _ _ = 3 in 110 | let c4 _ _ = 4 in 111 | let c5 _ _ = 6 in 112 | let c6 _ _ = 7 in 113 | let c7 _ = function 114 | | Accumulator -> 2 115 | | Zero_Page -> 5 116 | | Zero_Page_X | Absolute -> 6 117 | | _ -> 7 118 | in 119 | let c8 _ = function Absolute -> 3 | _ -> 5 in 120 | let c9 _ _ = 2 in 121 | [| c0; c1; c2; c3; c4; c5; c6; c7; c8; c9 |] 122 | -------------------------------------------------------------------------------- /lib/c6502.ml: -------------------------------------------------------------------------------- 1 | open Stdint 2 | 3 | exception Invalid_instruction of uint16 * uint8 4 | 5 | include Cpu0 6 | 7 | module type CPU = sig 8 | type mem 9 | type input 10 | 11 | module Register : sig 12 | type register = [ `S | `A | `X | `Y | `P ] 13 | type t 14 | 15 | val get : t -> register -> uint8 16 | val set : t -> register -> uint8 -> unit 17 | end 18 | 19 | module PC : sig 20 | type t 21 | 22 | val get : t -> uint16 23 | val set : t -> uint16 -> unit 24 | val init : t -> mem -> unit 25 | end 26 | 27 | type t 28 | 29 | val create : ?collector:IRQ_collector.t -> ?nmi:NMI.t -> input -> t 30 | val pc : t -> PC.t 31 | val registers : t -> Register.t 32 | val memory : t -> mem 33 | val enable_decimal : t -> bool -> unit 34 | val cycle_count : t -> int 35 | val next_instruction : t -> int 36 | val next_cycle : t -> unit 37 | val reset : t -> unit 38 | val nmi : t -> unit 39 | val print_state : t -> unit 40 | val pp : Format.formatter -> t -> unit 41 | end 42 | 43 | module Utils = Utils 44 | 45 | module Make (M : MemoryMap) = struct 46 | type input = M.input 47 | type mem = M.t 48 | 49 | module Register = Register 50 | module Flag = Register.Flag 51 | module R = Register 52 | open Utils 53 | include Make (M) 54 | 55 | let create ?(collector = IRQ_collector.create ()) ?(nmi = NMI.create ()) rom = 56 | { 57 | mem = M.create rom; 58 | reg = Register.create (); 59 | pc = PC.create (); 60 | irq_collector = collector; 61 | nmi; 62 | enable_decimal = true; 63 | cycle_count = 0; 64 | sub_cycle = 0; 65 | } 66 | 67 | let pc st = st.pc 68 | let registers st = st.reg 69 | let memory st = st.mem 70 | let enable_decimal st b = st.enable_decimal <- b 71 | let cycle_count st = st.cycle_count 72 | 73 | let reset t = 74 | let open Uint8 in 75 | for i = 0 to 0xFFFF do 76 | M.write t.mem (u16 i) zero 77 | done; 78 | t.enable_decimal <- true; 79 | t.cycle_count <- 0; 80 | PC.reset t.pc; 81 | R.set t.reg `A zero; 82 | R.set t.reg `X zero; 83 | R.set t.reg `Y zero; 84 | R.set t.reg `P 0x24u 85 | 86 | module Decoding = struct 87 | module Instruction = Instruction.Make (M) 88 | 89 | (* Return (a, b, c) from the opcode aaabbbcc *) 90 | let triple (opcode : uint8) = 91 | let open Uint8 in 92 | let ib = shift_right_logical opcode 2 in 93 | let ia = shift_right_logical opcode 5 in 94 | ( to_int @@ logand ia 7u, 95 | to_int @@ logand ib 7u, 96 | to_int @@ logand opcode 3u ) 97 | 98 | open Stdlib 99 | 100 | (* Simulate cycles from unofficial opcodes *) 101 | let unofCycles (a, b, c) pc am = 102 | if (c = 3 && a >= 6) || a <= 3 then 103 | match am with 104 | | Addressing.Immediate -> 2 105 | | Zero_Page -> 5 106 | | Zero_Page_X | Absolute -> 6 107 | | Absolute_X | Absolute_Y -> 7 108 | | _ -> 8 109 | else 110 | let _, cfi = 111 | Instruction.of_opcode_triple (5, b, if c >= 2 then c - 2 else 0) 112 | in 113 | Addressing.cycle_functions.(cfi) pc am 114 | 115 | (* Return instruction operation, cycle function and addressing mode of 116 | * opcode *) 117 | let decode (opcode : uint8) = 118 | let triple = triple opcode in 119 | let f, cfi = Instruction.of_opcode_triple triple in 120 | let cf = 121 | if cfi = -1 then unofCycles triple else Addressing.cycle_functions.(cfi) 122 | in 123 | let am = Addressing.of_opcode_triple triple in 124 | (f, cf, am) 125 | 126 | module Location = Instruction.Location 127 | 128 | (* List of instructions *) 129 | (* Returns packaged location and if page was crossed *) 130 | let package_arg st am = 131 | let get_page = get_hi in 132 | let pc = PC.get st.pc in 133 | let b1 = Uint16.(pc + 1U) in 134 | let b2 = Uint16.(pc + 2U) in 135 | let v1 = M.read st.mem b1 in 136 | let v2 = M.read st.mem b2 in 137 | let v12 = mk_addr ~hi:v2 ~lo:v1 in 138 | let absolute r = 139 | let v = R.get st.reg r in 140 | let total = Uint16.(of_uint8 v + v12) in 141 | (Location.Address total, get_page v12 <> get_page total) 142 | in 143 | match am with 144 | | Addressing.Implicit -> (Location.None, false) 145 | | Accumulator -> (Location.Register `A, false) 146 | | Immediate -> (Location.Immediate v1, false) 147 | | Zero_Page -> (Location.Address (u16of8 v1), false) 148 | | Zero_Page_X -> 149 | (Location.Address (u16of8 Uint8.(v1 + R.get st.reg `X)), false) 150 | | Zero_Page_Y -> 151 | (Location.Address (u16of8 Uint8.(v1 + R.get st.reg `Y)), false) 152 | | Relative -> (Location.Immediate v1, false) 153 | | Absolute -> (Location.Address v12, false) 154 | | Absolute_X -> absolute `X 155 | | Absolute_Y -> absolute `Y 156 | | Indirect -> 157 | (* Second byte of target wrap around in page *) 158 | let sto_addr_hi = 159 | mk_addr ~hi:(get_hi v12) ~lo:Uint8.(succ @@ get_lo v12) 160 | in 161 | ( Location.Address 162 | (mk_addr ~hi:(M.read st.mem sto_addr_hi) ~lo:(M.read st.mem v12)), 163 | false ) 164 | | Indexed_Indirect (*X*) -> 165 | let sto_addr = Uint8.(v1 + R.get st.reg `X) in 166 | (* Second byte of target wrap around in zero page *) 167 | let sto_addr_hi = u16of8 @@ Uint8.(succ sto_addr) in 168 | ( Location.Address 169 | (mk_addr 170 | ~hi:(M.read st.mem sto_addr_hi) 171 | ~lo:(M.read st.mem @@ u16of8 sto_addr)), 172 | false ) 173 | | Indirect_Indexed (*Y*) -> 174 | (* Second byte of target wrap around in zero page *) 175 | let sto_addr_hi = u16of8 @@ Uint8.(succ v1) in 176 | let sto = 177 | mk_addr 178 | ~hi:(M.read st.mem sto_addr_hi) 179 | ~lo:(M.read st.mem @@ u16of8 v1) 180 | in 181 | let addr = Uint16.(sto + of_uint8 (R.get st.reg `Y)) in 182 | (Location.Address addr, get_page sto <> get_page addr) 183 | end 184 | 185 | let nmi st = 186 | Stack.push_addr st (PC.get st.pc); 187 | Stack.push st (R.get st.reg `P); 188 | Flag.set st.reg Flag.interrupt true; 189 | PC.set st.pc 190 | @@ mk_addr ~lo:(M.read st.mem 0xFFFAU) ~hi:(M.read st.mem 0xFFFBU) 191 | 192 | let next_instruction st = 193 | (* Check for interrupts *) 194 | (* NMI *) 195 | if NMI.check st.nmi then ( 196 | nmi st; 197 | NMI.clear st.nmi (* IRQ *)) 198 | else if 199 | (not @@ Flag.get st.reg Flag.interrupt) 200 | && IRQ_collector.is_pulled st.irq_collector 201 | then ( 202 | Stack.push_addr st (PC.get st.pc); 203 | Stack.push st (R.get st.reg `P); 204 | Flag.set st.reg Flag.interrupt true; 205 | PC.set st.pc 206 | @@ mk_addr 207 | ~lo:(M.read st.mem (u16 0xFFFE)) 208 | ~hi:(M.read st.mem (u16 0xFFFF))); 209 | (* Continue as normal *) 210 | let opcode = M.read st.mem @@ PC.get st.pc in 211 | let f, cf, am = Decoding.decode opcode in 212 | let arg, page_crossed = Decoding.package_arg st am in 213 | let mode_size = Addressing.size am in 214 | PC.set st.pc Uint16.(PC.get st.pc + u16 mode_size); 215 | let cycles_elapsed = cf page_crossed am in 216 | st.cycle_count <- st.cycle_count + cycles_elapsed; 217 | (* Reserved bit always on *) 218 | Flag.set st.reg Flag.reserved true; 219 | f st arg; 220 | cycles_elapsed 221 | 222 | let next_cycle st = 223 | if st.sub_cycle = 0 then st.sub_cycle <- next_instruction st - 1 224 | else st.sub_cycle <- st.sub_cycle - 1 225 | 226 | let nmi st = NMI.pull st.nmi 227 | 228 | let pp fmt st = 229 | let pc = PC.get st.pc in 230 | let opcode = M.read st.mem pc in 231 | let _, _, am = Decoding.decode opcode in 232 | let size = Addressing.size am in 233 | Format.fprintf fmt "%a " pp_u16 pc; 234 | for i = 0 to size - 1 do 235 | Format.fprintf fmt "%a " pp_u8 (M.read st.mem Uint16.(pc + u16 i)) 236 | done; 237 | Format.fprintf fmt "\t\t A:%a X:%a Y:%a P:%a SP:%a CYC:%3d\n%!" pp_u8 238 | (R.get st.reg `A) pp_u8 (R.get st.reg `X) pp_u8 (R.get st.reg `Y) pp_u8 239 | (R.get st.reg `P) pp_u8 (R.get st.reg `S) 240 | Stdlib.(st.cycle_count * 3 mod 341) 241 | 242 | let print_state = pp Format.std_formatter 243 | end 244 | -------------------------------------------------------------------------------- /lib/c6502.mli: -------------------------------------------------------------------------------- 1 | (** 6502 chip family simulation 2 | 3 | 6502-ml is a library handling the simulation of a 6502 processor with 4 | arbitrary memory mappings. 5 | 6 | To build a {!module-type:CPU}, one must provide a {!module-type:MemoryMap} 7 | (stateful module mapping CPU addresses to concrete memory cells and/or 8 | various peripherals) to the {!module:MakeCPU} functor. 9 | 10 | Afterwards, the obtained {!module-type:CPU} can be run instruction by 11 | instruction using the {!CPU.fetch_instr} function and inspected with the 12 | various other functions. 13 | 14 | All of the input and output is done with fixed-size integers from 15 | {!module:Stdint}. We provide a small helper module {!module:Int_utils} to 16 | handle these values. 17 | 18 | See the {!example} section for a gentle introduction. 19 | *) 20 | 21 | open Stdint 22 | 23 | (** {1 Modules} *) 24 | 25 | exception Invalid_instruction of uint16 * uint8 26 | (** [Invalid_instruction (address, instruction)] is raised when the program 27 | counter is pointing to an invalid instruction (which is different from 28 | unofficial) and {!CPU.fetch_instr} is run. *) 29 | 30 | (** Mapping from the CPU memory space to the real world. 31 | 32 | A memory map defines how the CPU interact with the world by translating 33 | reads and writes within the CPU memory space to concrete read and writes to 34 | OCaml objects. 35 | 36 | It can be used to map memory arrays to the CPU space or interact with 37 | various simulated peripherals. 38 | 39 | Addresses can use the full range of an {!type:uint16}: from [0x0000] to 40 | [0xFFFF]. *) 41 | module type MemoryMap = sig 42 | type t 43 | (** Type representing a mutable address space *) 44 | 45 | type input 46 | (** Type representing the information needed to initialize memory *) 47 | 48 | val create : input -> t 49 | (** Create the initial power-up memory *) 50 | 51 | val read : t -> uint16 -> uint8 52 | (** [read a] defines the behavior when trying to read from address [a]. *) 53 | 54 | val write : t -> uint16 -> uint8 -> unit 55 | (** [write a v] defines the behavior when trying to write value [v] to address 56 | [a]. *) 57 | end 58 | 59 | (** Mutable data structure, serving as a collector for device IRQs. Devices are 60 | meant to use this interface to change their IRQ output, and it is read by the 61 | CPU. 62 | Different devices must have different identifiers, and their outputs are 63 | OR'ed. 64 | *) 65 | module IRQ_collector : sig 66 | type key = string 67 | type t 68 | 69 | val is_pulled : t -> bool 70 | val set_pulled : t -> key -> bool -> unit 71 | val create : unit -> t 72 | end 73 | 74 | module NMI : sig 75 | type t 76 | 77 | val create : unit -> t 78 | val pull : t -> unit 79 | val check : t -> bool 80 | val clear : t -> unit 81 | end 82 | 83 | module type CPU = sig 84 | type mem 85 | 86 | type input 87 | (** The memory map of the CPU. You can use {!M.read} and {!M.write} to access 88 | the CPU memory space. *) 89 | 90 | (** {2 State of the CPU} *) 91 | 92 | (** Access and modify the content of the 8-bit registers of the CPU. *) 93 | module Register : sig 94 | type register = 95 | [ `S (** Stack pointer *) 96 | | `A (** Accumulator *) 97 | | `X (** X index *) 98 | | `Y (** Y index *) 99 | | `P (** Processor status *) ] 100 | (** The different 8-bit registers, represented by polymorphic variants. 101 | Every register defaults to zero at startup, except the processor status 102 | which defaults to [0x24]. *) 103 | 104 | type t 105 | (** Representation of the state of all registers *) 106 | 107 | val get : t -> register -> uint8 108 | (** Get the current value of a register. *) 109 | 110 | val set : t -> register -> uint8 -> unit 111 | (** Change the value of a register. *) 112 | end 113 | 114 | (** Access and modify the program counter of the CPU. 115 | 116 | The PC defaults to [0x400] at startup and upon reset. *) 117 | module PC : sig 118 | type t 119 | (** Representation of the PC *) 120 | 121 | val get : t -> uint16 122 | (** Get the current address of the PC. *) 123 | 124 | val set : t -> uint16 -> unit 125 | (** Set the current address of the PC. *) 126 | 127 | val init : t -> mem -> unit 128 | (** Set the PC by reading a full 16-bit address stored at [0xFFF[C-D]] 129 | (little-endian). *) 130 | end 131 | 132 | type t 133 | (** Representation of the whole CPU state, including its linked devices. Every 134 | function modifies this representation in place. *) 135 | 136 | val create : ?collector:IRQ_collector.t -> ?nmi:NMI.t -> input -> t 137 | (** Return the power-up state of the whole system *) 138 | 139 | val pc : t -> PC.t 140 | val registers : t -> Register.t 141 | val memory : t -> mem 142 | 143 | val enable_decimal : t -> bool -> unit 144 | (** Determines if the decimal flag of the processor has any effect in 145 | instructions [ADC] and [SBC]. Indeed, some machines (such as the NES) 146 | completely disable decimal mode at the hardware level. 147 | 148 | Default to [true]. *) 149 | 150 | val cycle_count : t -> int 151 | (** How many cycles have elapsed during the last reset. *) 152 | 153 | (** {2 Simulation} *) 154 | 155 | val next_instruction : t -> int 156 | (** Fetches, decodes and executes the whole next instruction, modifying the 157 | current state according to the simulation. Returns the number of cycles 158 | elapsed. 159 | 160 | This is the {e main entry point} of the simulation. *) 161 | 162 | val next_cycle : t -> unit 163 | (** Execute a single cycle of the CPU, 164 | more granular then [next_instruction] *) 165 | 166 | val reset : t -> unit 167 | (** Completely restore the default state of the CPU, wiping the CPU memory 168 | space with zeroes. *) 169 | 170 | val nmi : t -> unit 171 | (** Simulate a non-maskable interrupt of the processor, effectively suspending the 172 | current context to call the interrupt handler (whose address is stored at 173 | [0xFFF[A-B]]). *) 174 | 175 | val print_state : t -> unit 176 | (** Print the content of the registers, PC, the cycle count and the current 177 | byte pointed by PC. *) 178 | 179 | val pp : Format.formatter -> t -> unit 180 | (** Fine-grained pretty-printer *) 181 | end 182 | 183 | module Utils = Utils 184 | (** Some helper functions to make life easier with fixed-size integers. 185 | 186 | Mostly aliases for some {!module:Stdint} functions. *) 187 | 188 | (** A full CPU as obtained with {!module:MakeCPU}. 189 | 190 | This module contains the mutable state of the CPU. The state can be 191 | inspected and altered with the various setters and getters of 192 | {!module:Register} and {!module:PC}. 193 | 194 | Make a {!module-type:CPU} with a {!module-type:MemoryMap}. 195 | 196 | The two important functions relevant to simulation are {!fetch_instr} and 197 | {!interrupt}. *) 198 | module Make : functor (M : MemoryMap) -> 199 | CPU with type mem = M.t and type input = M.input 200 | 201 | (** {1:example Basic example} *) 202 | 203 | (** The code below builds a simple CPU from a {!module-type:MemoryMap} simply 204 | mapping all the memory space to a big array. 205 | 206 | {[ 207 | module SimpleCPU = C6502.MakeCPU (struct 208 | (* Big mutable array, internal to the CPU *) 209 | let mem = Array.make 0x10000 Uint8.zero 210 | 211 | (* Map addresses to cells of that array *) 212 | let read a = mem.(Uint16.to_int a) 213 | let write a v = mem.(Uint16.to_int a) <- v 214 | end) 215 | ]} 216 | 217 | We can then for example load a ROM into the memory, using {!CPU.M.write}: 218 | 219 | {[ 220 | let open Int_utils in (* for u8 and u16 *) 221 | let rom : Bytes.t = (* read ROM from file... *) in 222 | (** Load each byte to the CPU, converting to fixed-size integers *) 223 | Bytes.iteri (fun addr v -> 224 | SimpleCPU.M.write (u16 addr) (u8 (int_of_char v)) 225 | ) rom 226 | ]} 227 | 228 | And run the CPU until it encounters a trap (jump to the current address): 229 | 230 | {[ 231 | let rec run_until_trap () = 232 | let old_PC = SimpleCPU.PC.get () in 233 | SCpu.fetch_instr () ; 234 | if old_PC <> get_pc () then run_until_trap () 235 | ]} 236 | 237 | And then for example inspect the status of the processor: 238 | 239 | {[ Format.printf "Processor status: %a\n" pp_u8 (SimpleCPU.Register.get `P) ]} 240 | *) 241 | -------------------------------------------------------------------------------- /lib/cpu0.ml: -------------------------------------------------------------------------------- 1 | open Stdint 2 | 3 | module type MemoryMap = sig 4 | type t 5 | type input 6 | 7 | val create : input -> t 8 | val read : t -> uint16 -> uint8 9 | val write : t -> uint16 -> uint8 -> unit 10 | end 11 | 12 | module IRQ_collector = struct 13 | type key = string 14 | type t = (key, bool) Hashtbl.t 15 | 16 | let is_pulled t = Hashtbl.fold (fun _ x a -> x || a) t false 17 | let set_pulled t id b = Hashtbl.replace t id b 18 | let create () = Hashtbl.create 3 19 | end 20 | 21 | module NMI = struct 22 | type t = { mutable flip_flop : bool } 23 | 24 | let create () = { flip_flop = false } 25 | let pull t = t.flip_flop <- true 26 | let check t = t.flip_flop 27 | let clear t = t.flip_flop <- false 28 | end 29 | 30 | module Make (M : MemoryMap) = struct 31 | module PC = struct 32 | type t = { mutable value : uint16 } 33 | 34 | let create () = { value = 0x0400U } 35 | let get t = t.value 36 | let set t v = t.value <- v 37 | 38 | let init t mem = 39 | t.value <- Utils.mk_addr ~hi:(M.read mem 0xFFFDU) ~lo:(M.read mem 0xFFFCU) 40 | 41 | let reset t = t.value <- 0x0400U 42 | end 43 | 44 | type t = { 45 | mem : M.t; 46 | reg : Register.t; 47 | pc : PC.t; 48 | irq_collector : IRQ_collector.t; 49 | nmi : NMI.t; 50 | mutable enable_decimal : bool; 51 | mutable cycle_count : int; 52 | mutable sub_cycle : int; 53 | } 54 | 55 | module Stack = struct 56 | open Utils 57 | 58 | let total_addr t = mk_addr ~hi:0x01u ~lo:(Register.get t.reg `S) 59 | 60 | let push t v = 61 | (* Addr = 0x01XX *) 62 | M.write t.mem (total_addr t) v; 63 | Register.decr t.reg `S 64 | 65 | let push_addr t v = 66 | push t (get_hi v); 67 | push t (get_lo v) 68 | 69 | let pull t = 70 | Register.incr t.reg `S; 71 | M.read t.mem (total_addr t) 72 | 73 | let pull_addr t = 74 | let lo = pull t in 75 | let hi = pull t in 76 | mk_addr ~lo ~hi 77 | end 78 | end 79 | -------------------------------------------------------------------------------- /lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name c6502) 3 | (public_name 6502-ml) 4 | (libraries stdint) 5 | (preprocess 6 | (pps stdint-literals))) 7 | 8 | (documentation 9 | (mld_files :standard)) 10 | -------------------------------------------------------------------------------- /lib/index.mld: -------------------------------------------------------------------------------- 1 | {1 The 6502-ml library} 2 | 3 | 6502-ml is a library handling the simulation of a MOS 6502 processor with 4 | arbitrary memory mappings. 5 | 6 | See the documentation of the only module {!module:C6502} for a detailed 7 | reference and simple examples. 8 | 9 | This library is used as a basis for {{: https://github.com/Firobe/NES-ml} 10 | NES-ml}, a Nintendo Entertainment System emulator written in OCaml. 11 | -------------------------------------------------------------------------------- /lib/instruction.ml: -------------------------------------------------------------------------------- 1 | open Stdint 2 | 3 | module Make (M : Cpu0.MemoryMap) = struct 4 | module CPU = Cpu0.Make (M) 5 | 6 | module Location = struct 7 | type t = 8 | | None 9 | | Immediate of uint8 10 | | Register of Register.register 11 | | Address of uint16 12 | 13 | let get (st : CPU.t) = function 14 | | Register r -> Register.get st.reg r 15 | | Immediate n -> n 16 | | Address a -> M.read st.mem a 17 | | None -> assert false 18 | 19 | let set (st : CPU.t) l v = 20 | match l with 21 | | Register r -> Register.set st.reg r v 22 | | Address a -> M.write st.mem a v 23 | | _ -> () 24 | 25 | let ref = function Address a -> a | _ -> assert false 26 | end 27 | 28 | let ( !! ) (st, a) = Location.get st a 29 | let ( <<- ) (st, a) = Location.set st a 30 | 31 | module Implementations = struct 32 | open Uint8 33 | open Utils 34 | module Flag = Register.Flag 35 | module R = Register 36 | include CPU 37 | 38 | (* Load/Store *) 39 | let gen_LD st r (m : Location.t) = 40 | let v = !!(st, m) in 41 | R.set st.reg r v; 42 | Flag.update_nz st.reg v 43 | 44 | let _LDA st = gen_LD st `A 45 | let _LDX st = gen_LD st `X 46 | let _LDY st = gen_LD st `Y 47 | let _STA st m = (st, m) <<- R.get st.reg `A 48 | let _STX st m = (st, m) <<- R.get st.reg `X 49 | let _STY st m = (st, m) <<- R.get st.reg `Y 50 | let _SAX st m = (st, m) <<- logand (R.get st.reg `A) (R.get st.reg `X) 51 | 52 | (* Register transfers *) 53 | let gen_T st f t = 54 | let fv = R.get st.reg f in 55 | R.set st.reg t fv; 56 | Flag.update_nz st.reg fv 57 | 58 | let _TAX st _ = gen_T st `A `X 59 | let _TAY st _ = gen_T st `A `Y 60 | let _TXA st _ = gen_T st `X `A 61 | let _TYA st _ = gen_T st `Y `A 62 | 63 | (* Stack operations *) 64 | let _TSX st _ = gen_T st `S `X 65 | let _TXS st _ = R.set st.reg `S (R.get st.reg `X) 66 | let _PHA st _ = Stack.push st (R.get st.reg `A) 67 | 68 | let _PHP st _ = 69 | Stack.push st (logor (R.get st.reg `P) (Flag.mask Flag.break)) 70 | 71 | let _PLA st _ = 72 | R.set st.reg `A @@ Stack.pull st; 73 | Flag.update_nz st.reg (R.get st.reg `A) 74 | 75 | let _PLP st _ = 76 | R.set st.reg `P @@ Stack.pull st; 77 | Flag.set st.reg Flag.break false; 78 | Flag.set st.reg Flag.reserved true 79 | 80 | (* Logical *) 81 | let gen_OP st f m = 82 | let v = f !!(st, m) (R.get st.reg `A) in 83 | R.set st.reg `A v; 84 | Flag.update_nz st.reg v 85 | 86 | let _AND st = gen_OP st logand 87 | let _EOR st = gen_OP st logxor 88 | let _ORA st = gen_OP st logor 89 | 90 | let _BIT st m = 91 | let v = !!(st, m) in 92 | let masked = logand (R.get st.reg `A) v in 93 | Flag.update_zero st.reg masked; 94 | Flag.update_neg st.reg v; 95 | Flag.set st.reg Flag.overflow (get_bit v 6) 96 | 97 | (* Arithmetic *) 98 | let bcd_to_dec (b : uint8) = 99 | let lo = logand b 0x0Fu in 100 | let hi = shift_right_logical b 4 in 101 | lo + (hi * 10u) 102 | 103 | let dec_to_bcd (d : uint8) = 104 | let lo = rem d 10u in 105 | let hi = d / 10u in 106 | logor lo (shift_left hi 4) 107 | 108 | (* Addition : binary or decimal *) 109 | let _ADC st m = 110 | let v = !!(st, m) in 111 | let decimal = Flag.get st.reg Flag.decimal && st.enable_decimal in 112 | let pre = if decimal then bcd_to_dec else fun x -> x in 113 | let post = if decimal then dec_to_bcd else fun x -> x in 114 | let max = if decimal then 99U else 0xFFU in 115 | (* Convert ops to u16 to detect overflow *) 116 | let op1 = u16of8 @@ pre @@ R.get st.reg `A in 117 | let op2 = u16of8 @@ pre v in 118 | let c = u16of8 @@ Flag.geti st.reg Flag.carry in 119 | let sum = Uint16.(op1 + op2 + c) in 120 | Flag.set st.reg Flag.carry (sum > max); 121 | let rsum = u8of16 @@ Uint16.(rem sum (succ max)) in 122 | let overflow = 123 | zero 124 | <> logand (logand 0x80u (logxor v rsum)) (logxor (R.get st.reg `A) rsum) 125 | in 126 | Flag.set st.reg Flag.overflow overflow; 127 | let v = post rsum in 128 | R.set st.reg `A v; 129 | Flag.update_nz st.reg v 130 | 131 | (* Subtraction : binary or decimal *) 132 | let _SBC st m = 133 | let c2 = 134 | if Flag.get st.reg Flag.decimal && st.enable_decimal then 135 | dec_to_bcd (100u - bcd_to_dec !!(st, m) - one) 136 | else lognot !!(st, m) 137 | in 138 | (* probably a +1 or -1 here ?*) 139 | _ADC st (Location.Immediate c2) 140 | 141 | let gen_CMP st r m = 142 | let c = R.get st.reg r - !!(st, m) in 143 | Flag.update_nz st.reg c; 144 | Flag.set st.reg Flag.carry (R.get st.reg r >= !!(st, m)) 145 | 146 | let _CMP st = gen_CMP st `A 147 | let _CPX st = gen_CMP st `X 148 | let _CPY st = gen_CMP st `Y 149 | 150 | (* Increments & Decrements *) 151 | let gen_CR st op m = 152 | let updated = op !!(st, m) one in 153 | (st, m) <<- updated; 154 | Flag.update_nz st.reg updated 155 | 156 | let _INC st = gen_CR st ( + ) 157 | let _INX st _ = _INC st (Location.Register `X) 158 | let _INY st _ = _INC st (Location.Register `Y) 159 | let _DEC st = gen_CR st ( - ) 160 | let _DEX st _ = _DEC st (Location.Register `X) 161 | let _DEY st _ = _DEC st (Location.Register `Y) 162 | 163 | (* Shifts *) 164 | let gen_SHIFT st r f m = 165 | let oldm = !!(st, m) in 166 | let nv = f oldm in 167 | (st, m) <<- nv; 168 | Flag.set st.reg Flag.carry (get_bit oldm r); 169 | Flag.update_nz st.reg nv 170 | 171 | let _ASL st m = gen_SHIFT st 7 (fun n -> shift_left n 1) m 172 | let _LSR st m = gen_SHIFT st 0 (fun n -> shift_right_logical n 1) m 173 | 174 | let _ROL st m = 175 | gen_SHIFT st 7 176 | (fun n -> logor (shift_left n 1) (Flag.geti st.reg Flag.carry)) 177 | m 178 | 179 | let _ROR st m = 180 | gen_SHIFT st 0 181 | (fun n -> 182 | logor (shift_right_logical n 1) 183 | (shift_left (Flag.geti st.reg Flag.carry) 7)) 184 | m 185 | 186 | (* Jump and calls *) 187 | let _JMP st m = PC.set st.pc @@ Location.ref m 188 | 189 | let _JSR st m = 190 | Stack.push_addr st Uint16.(pred @@ PC.get st.pc); 191 | _JMP st m 192 | 193 | let _RTS st _ = PC.set st.pc Uint16.(succ @@ Stack.pull_addr st) 194 | 195 | (* Branches *) 196 | let gen_BRANCH st f s m = 197 | if Flag.get st.reg f = s then ( 198 | (* Interpret as signed *) 199 | let v = Int16.of_int8 @@ Int8.of_uint8 @@ !!(st, m) in 200 | (* Add as signed operation *) 201 | let next = Int16.(of_uint16 (PC.get st.pc) + v) in 202 | (* Back to unsigned *) 203 | let unext = Uint16.of_int16 next in 204 | let cp = if get_hi unext <> get_hi (PC.get st.pc) then 1 else 0 in 205 | Stdlib.(st.cycle_count <- st.cycle_count + 1 + cp); 206 | PC.set st.pc unext) 207 | 208 | let _BCC st = gen_BRANCH st Flag.carry false 209 | let _BCS st = gen_BRANCH st Flag.carry true 210 | let _BEQ st = gen_BRANCH st Flag.zero true 211 | let _BMI st = gen_BRANCH st Flag.negative true 212 | let _BNE st = gen_BRANCH st Flag.zero false 213 | let _BPL st = gen_BRANCH st Flag.negative false 214 | let _BVC st = gen_BRANCH st Flag.overflow false 215 | let _BVS st = gen_BRANCH st Flag.overflow true 216 | 217 | (* Status Flag Changes *) 218 | let _CLC st _ = Flag.set st.reg Flag.carry false 219 | let _CLD st _ = Flag.set st.reg Flag.decimal false 220 | let _CLI st _ = Flag.set st.reg Flag.interrupt false 221 | let _CLV st _ = Flag.set st.reg Flag.overflow false 222 | let _SEC st _ = Flag.set st.reg Flag.carry true 223 | let _SED st _ = Flag.set st.reg Flag.decimal true 224 | let _SEI st _ = Flag.set st.reg Flag.interrupt true 225 | 226 | (* System functions *) 227 | let _BRK st _ = 228 | Stack.push_addr st (Uint16.succ @@ PC.get st.pc); 229 | Flag.set st.reg Flag.break true; 230 | Stack.push st (R.get st.reg `P); 231 | Flag.set st.reg Flag.interrupt true; 232 | PC.set st.pc 233 | @@ mk_addr 234 | ~lo:(M.read st.mem (u16 0xFFFE)) 235 | ~hi:(M.read st.mem (u16 0xFFFF)) 236 | 237 | let _RTI st _ = 238 | R.set st.reg `P @@ Stack.pull st; 239 | Flag.set st.reg Flag.break false; 240 | Flag.set st.reg Flag.reserved true; 241 | PC.set st.pc @@ Stack.pull_addr st 242 | 243 | let _NOP _ _ = () 244 | let _NYI name _ _ = Printf.printf "%s not yet implemented" name 245 | 246 | (* Unofficial instructions *) 247 | let compose f1 f2 a b = 248 | f1 a b; 249 | f2 a b 250 | 251 | (* instruction crashes the CPU *) 252 | let _JAM _ _ = failwith "Executed JAM instruction" 253 | let _SLO = compose _ASL _ORA 254 | let _RLA = compose _ROL _AND 255 | let _SRE = compose _LSR _EOR 256 | let _RRA = compose _ROR _ADC 257 | let _LAX = compose _LDX _LDA 258 | let _LAS = compose _TSX _LDA 259 | let _DCP = compose _DEC _CMP 260 | let _ISB = compose _INC _SBC 261 | 262 | (* aka SAY or SYA, unstable *) 263 | let _SHY st m = 264 | let addr = Location.ref m in 265 | let addr = get_hi addr + 1u in 266 | let result = logand addr (R.get st.reg `Y) in 267 | (st, m) <<- result 268 | 269 | (* aka XAS or SXA, unstable *) 270 | let _SHX st m = 271 | let addr = Location.ref m in 272 | let addr = get_hi addr + 1u in 273 | let result = logand addr (R.get st.reg `X) in 274 | (st, m) <<- result 275 | 276 | let _ANC st m = 277 | _AND st m; 278 | Flag.set st.reg Flag.carry (Flag.get st.reg Flag.negative) 279 | 280 | (* aka ALR *) 281 | let _ASR st m = 282 | _AND st m; 283 | _LSR st (Register `A) 284 | 285 | (* aka AXS, SAX, ASX *) 286 | let _SBX st m = 287 | let v = !!(st, m) in 288 | let x = logand (R.get st.reg `X) (R.get st.reg `A) in 289 | Flag.(set st.reg carry (x >= v)); 290 | let x = x - v in 291 | R.set st.reg `X x; 292 | Flag.update_nz st.reg x 293 | 294 | (* wrong? *) 295 | let _ARR st m = 296 | let result = logand !!(st, m) (R.get st.reg `A) in 297 | let result = shift_right_logical result 1 in 298 | let result = 299 | if Flag.get st.reg Flag.carry then logor result 0b10000000u else result 300 | in 301 | Flag.(set st.reg negative (get st.reg carry)); 302 | Flag.update_neg st.reg result; 303 | if Flag.(get st.reg decimal) then 304 | (* TODO special operations in decimal mode *) 305 | () 306 | else ( 307 | Flag.(set st.reg carry (get_bit result 6)); 308 | let v = 309 | logor (shift_right_logical result 6) (shift_right_logical result 5) 310 | in 311 | Flag.(set st.reg Flag.overflow (get_bit v 0))); 312 | R.set st.reg `A result 313 | 314 | (* unstable *) 315 | let _LXA st m = 316 | _AND st m; 317 | R.set st.reg `X (R.get st.reg `A) 318 | 319 | (* aka ATX, XAA, unstable, not implemented *) 320 | let _ANE = _NYI "ANE" 321 | 322 | (* aka SAH, AXA, unstable, not implemented *) 323 | let _SHA = _NYI "SHA" 324 | 325 | (* aka SSH, TAS, XAS, unstable, not implemented *) 326 | let _SHS = _NYI "SHS" 327 | end 328 | 329 | (* Organized like so: 330 | * https://www.masswerk.at/6502/6502_instruction_set.html#layout *) 331 | (* Addressed by c, a, b *) 332 | let layout = 333 | let open Implementations in 334 | [| 335 | [| 336 | [|_BRK,7; _NOP,0; _PHP,3; _NOP,0; _BPL,9; _NOP,0; _CLC,2; _NOP,0|]; 337 | [|_JSR,5; _BIT,0; _PLP,4; _BIT,0; _BMI,9; _NOP,0; _SEC,2; _NOP,0|]; 338 | [|_RTI,5; _NOP,0; _PHA,3; _JMP,8; _BVC,9; _NOP,0; _CLI,2; _NOP,0|]; 339 | [|_RTS,5; _NOP,0; _PLA,4; _JMP,8; _BVS,9; _NOP,0; _SEI,2; _NOP,0|]; 340 | [|_NOP,0; _STY,1; _DEY,2; _STY,1; _BCC,9; _STY,1; _TYA,2; _SHY,0|]; 341 | [|_LDY,0; _LDY,0; _TAY,2; _LDY,0; _BCS,9; _LDY,0; _CLV,2; _LDY,0|]; 342 | [|_CPY,0; _CPY,0; _INY,2; _CPY,0; _BNE,9; _NOP,0; _CLD,2; _NOP,0|]; 343 | [|_CPX,0; _CPX,0; _INX,2; _CPX,0; _BEQ,9; _NOP,0; _SED,2; _NOP,0|] 344 | |]; 345 | [| 346 | [|_ORA,0; _ORA,0; _ORA,0; _ORA,0; _ORA,0; _ORA,0; _ORA,0; _ORA,0|]; 347 | [|_AND,0; _AND,0; _AND,0; _AND,0; _AND,0; _AND,0; _AND,0; _AND,0|]; 348 | [|_EOR,0; _EOR,0; _EOR,0; _EOR,0; _EOR,0; _EOR,0; _EOR,0; _EOR,0|]; 349 | [|_ADC,0; _ADC,0; _ADC,0; _ADC,0; _ADC,0; _ADC,0; _ADC,0; _ADC,0|]; 350 | [|_STA,1; _STA,1; _NOP,2; _STA,1; _STA,1; _STA,1; _STA,1; _STA,1|]; 351 | [|_LDA,0; _LDA,0; _LDA,0; _LDA,0; _LDA,0; _LDA,0; _LDA,0; _LDA,0|]; 352 | [|_CMP,0; _CMP,0; _CMP,0; _CMP,0; _CMP,0; _CMP,0; _CMP,0; _CMP,0|]; 353 | [|_SBC,0; _SBC,0; _SBC,0; _SBC,0; _SBC,0; _SBC,0; _SBC,0; _SBC,0|]; 354 | |]; 355 | [| 356 | [|_JAM,2; _ASL,7; _ASL,7; _ASL,7; _JAM,2; _ASL,7; _NOP,2; _ASL,7|]; 357 | [|_JAM,2; _ROL,7; _ROL,7; _ROL,7; _JAM,2; _ROL,7; _NOP,2; _ROL,7|]; 358 | [|_JAM,2; _LSR,7; _LSR,7; _LSR,7; _JAM,2; _LSR,7; _NOP,2; _LSR,7|]; 359 | [|_JAM,2; _ROR,7; _ROR,7; _ROR,7; _JAM,2; _ROR,7; _NOP,2; _ROR,7|]; 360 | [|_NOP,2; _STX,1; _TXA,2; _STX,1; _JAM,2; _STX,1; _TXS,2; _SHX,0|]; 361 | [|_LDX,0; _LDX,0; _TAX,2; _LDX,0; _JAM,0; _LDX,0; _TSX,2; _LDX,0|]; 362 | [|_NOP,2; _DEC,7; _DEX,2; _DEC,7; _JAM,7; _DEC,7; _NOP,2; _DEC,7|]; 363 | [|_NOP,2; _INC,7; _NOP,2; _INC,7; _JAM,2; _INC,7; _NOP,2; _INC,7|] 364 | |]; 365 | [| 366 | [|_SLO,-1; _SLO,-1; _ANC,02; _SLO,-1; _SLO,-1; _SLO,-1; _SLO,-1; _SLO,-1|]; 367 | [|_RLA,-1; _RLA,-1; _ANC,02; _RLA,-1; _RLA,-1; _RLA,-1; _RLA,-1; _RLA,-1|]; 368 | [|_SRE,-1; _SRE,-1; _ASR,00; _SRE,-1; _SRE,-1; _SRE,-1; _SRE,-1; _SRE,-1|]; 369 | [|_RRA,-1; _RRA,-1; _ARR,00; _RRA,-1; _RRA,-1; _RRA,-1; _RRA,-1; _RRA,-1|]; 370 | [|_SAX,01; _SAX,01; _ANE,00; _SAX,01; _SHA,00; _SAX,01; _SHS,00; _SHA,00|]; 371 | [|_LAX,-1; _LAX,-1; _LXA,02; _LAX,-1; _LAX,-1; _LAX,-1; _LAS,-1; _LAX,-1|]; 372 | [|_DCP,-1; _DCP,-1; _SBX,02; _DCP,-1; _DCP,-1; _DCP,-1; _DCP,-1; _DCP,-1|]; 373 | [|_ISB,-1; _ISB,-1; _SBC,00; _ISB,-1; _ISB,-1; _ISB,-1; _ISB,-1; _ISB,-1|]; 374 | |] 375 | |][@ocamlformat "disable"] 376 | 377 | (* Get instruction and cycle offset from opcode *) 378 | let of_opcode_triple (a, b, c) = layout.(c).(a).(b) 379 | end 380 | -------------------------------------------------------------------------------- /lib/register.ml: -------------------------------------------------------------------------------- 1 | open Stdint 2 | 3 | type t = { 4 | mutable stack_pointer : uint8; 5 | mutable acc : uint8; 6 | mutable irx : uint8; 7 | mutable iry : uint8; 8 | mutable processor_status : uint8; 9 | } 10 | 11 | type register = [ `S | `A | `X | `Y | `P ] 12 | 13 | let create () = 14 | Uint8. 15 | { 16 | stack_pointer = 0xFFu; 17 | acc = zero; 18 | irx = zero; 19 | iry = zero; 20 | processor_status = 0x24u; 21 | } 22 | 23 | (* Registers *) 24 | open Uint8 25 | 26 | let get t = function 27 | | `S -> t.stack_pointer 28 | | `A -> t.acc 29 | | `X -> t.irx 30 | | `Y -> t.iry 31 | | `P -> t.processor_status 32 | 33 | let set t r v = 34 | match r with 35 | | `S -> t.stack_pointer <- v 36 | | `A -> t.acc <- v 37 | | `X -> t.irx <- v 38 | | `Y -> t.iry <- v 39 | | `P -> t.processor_status <- v 40 | 41 | let incr t r = set t r (succ (get t r)) 42 | let decr t r = set t r (pred (get t r)) 43 | 44 | module Flag = struct 45 | type t = Mask of uint8 46 | 47 | let mkflag n = Mask (shift_left one n) 48 | let carry = mkflag 0 49 | let zero = mkflag 1 50 | let interrupt = mkflag 2 (* DISABLES interrupts when off *) 51 | let decimal = mkflag 3 52 | let break = mkflag 4 53 | let reserved = mkflag 5 54 | let overflow = mkflag 6 55 | let negative = mkflag 7 56 | let mask (Mask m) = m 57 | 58 | let set reg (Mask m) v = 59 | let p = get reg `P in 60 | let f = if v then logor p m else logand p (lognot m) in 61 | set reg `P f 62 | 63 | let get reg (Mask m) = 64 | if logand m (get reg `P) <> Uint8.zero then true else false 65 | 66 | let geti reg m = if get reg m then one else Uint8.zero 67 | let update_zero t v = set t zero (v = Uint8.zero) 68 | let update_neg t v = set t negative (Utils.get_bit v 7) 69 | 70 | let update_nz t v = 71 | update_zero t v; 72 | update_neg t v 73 | end 74 | -------------------------------------------------------------------------------- /lib/utils.ml: -------------------------------------------------------------------------------- 1 | open Stdint 2 | 3 | let u8 = Uint8.of_int 4 | let u16 = Uint16.of_int 5 | let u8of16 = Uint8.of_uint16 6 | let u16of8 = Uint16.of_uint8 7 | let pp_u8 fmt u = Format.fprintf fmt "%.2X" (Uint8.to_int u) 8 | let pp_u16 fmt u = Format.fprintf fmt "%.4X" (Uint16.to_int u) 9 | 10 | let mk_addr ~hi ~lo = 11 | let lo = u16of8 lo in 12 | let hi = u16of8 hi in 13 | Uint16.(logor (shift_left hi 8) lo) 14 | 15 | let get_hi (addr : uint16) = u8of16 Uint16.(shift_right_logical addr 8) 16 | let get_lo (addr : uint16) = u8of16 addr 17 | let get_bit (x : uint8) n = Uint8.(one = logand (shift_right_logical x n) one) 18 | -------------------------------------------------------------------------------- /lib/utils.mli: -------------------------------------------------------------------------------- 1 | (** Some helper functions to make life easier with fixed-size integers. 2 | 3 | Mostly aliases for some {!module:Stdint} functions. *) 4 | 5 | open Stdint 6 | 7 | val u8 : int -> uint8 8 | (** {!type:uint8} from OCaml {!type:int} *) 9 | 10 | val u16 : int -> uint16 11 | (** {!type:uint16} from OCaml {!type:int} *) 12 | 13 | val u8of16 : uint16 -> uint8 14 | (** Cast a 16-bit integer to 8-bit one *) 15 | 16 | val u16of8 : uint8 -> uint16 17 | (** Cast a 8-bit integer to 16-bit one *) 18 | 19 | val pp_u8 : Format.formatter -> uint8 -> unit 20 | (** Print an {!type:uint8} as 0xYY *) 21 | 22 | val pp_u16 : Format.formatter -> uint16 -> unit 23 | (** Print an {!type:uint16} as 0xYYYY *) 24 | 25 | val mk_addr : hi:uint8 -> lo:uint8 -> uint16 26 | (** Make an {!type:uint16} from a [lo] and [hi] byte. *) 27 | 28 | val get_hi : uint16 -> uint8 29 | (** Get the high byte of an {!type:uint16}. *) 30 | 31 | val get_lo : uint16 -> uint8 32 | (** Get the low byte of an {!type:uint16}. *) 33 | 34 | val get_bit : uint8 -> int -> bool 35 | (** [get_bit v n] returns if the [n]th bit of [v] is [1] *) 36 | -------------------------------------------------------------------------------- /tests/dune: -------------------------------------------------------------------------------- 1 | (test 2 | (name unit_test) 3 | (deps 4 | (source_tree test_roms/)) 5 | (libraries re str 6502-ml alcotest)) 6 | -------------------------------------------------------------------------------- /tests/test_roms/65C02_extended_opcodes_test.bin: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/6502-ml/08d2babe3d838eaae8ed90daca7d5fff4c5bf5ae/tests/test_roms/65C02_extended_opcodes_test.bin -------------------------------------------------------------------------------- /tests/test_roms/instr_misc/01-abs_x_wrap.nes: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/6502-ml/08d2babe3d838eaae8ed90daca7d5fff4c5bf5ae/tests/test_roms/instr_misc/01-abs_x_wrap.nes -------------------------------------------------------------------------------- /tests/test_roms/instr_misc/01-abs_x_wrap.nes.bin: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/6502-ml/08d2babe3d838eaae8ed90daca7d5fff4c5bf5ae/tests/test_roms/instr_misc/01-abs_x_wrap.nes.bin -------------------------------------------------------------------------------- /tests/test_roms/instr_misc/02-branch_wrap.nes: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/6502-ml/08d2babe3d838eaae8ed90daca7d5fff4c5bf5ae/tests/test_roms/instr_misc/02-branch_wrap.nes -------------------------------------------------------------------------------- /tests/test_roms/instr_misc/02-branch_wrap.nes.bin: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/6502-ml/08d2babe3d838eaae8ed90daca7d5fff4c5bf5ae/tests/test_roms/instr_misc/02-branch_wrap.nes.bin -------------------------------------------------------------------------------- /tests/test_roms/instr_test/01-basics.nes.bin: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/6502-ml/08d2babe3d838eaae8ed90daca7d5fff4c5bf5ae/tests/test_roms/instr_test/01-basics.nes.bin -------------------------------------------------------------------------------- /tests/test_roms/instr_test/02-implied.nes.bin: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/6502-ml/08d2babe3d838eaae8ed90daca7d5fff4c5bf5ae/tests/test_roms/instr_test/02-implied.nes.bin -------------------------------------------------------------------------------- /tests/test_roms/instr_test/03-immediate.nes.bin: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/6502-ml/08d2babe3d838eaae8ed90daca7d5fff4c5bf5ae/tests/test_roms/instr_test/03-immediate.nes.bin -------------------------------------------------------------------------------- /tests/test_roms/instr_test/04-zero_page.nes.bin: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/6502-ml/08d2babe3d838eaae8ed90daca7d5fff4c5bf5ae/tests/test_roms/instr_test/04-zero_page.nes.bin -------------------------------------------------------------------------------- /tests/test_roms/instr_test/05-zp_xy.nes.bin: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/6502-ml/08d2babe3d838eaae8ed90daca7d5fff4c5bf5ae/tests/test_roms/instr_test/05-zp_xy.nes.bin -------------------------------------------------------------------------------- /tests/test_roms/instr_test/06-absolute.nes.bin: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/6502-ml/08d2babe3d838eaae8ed90daca7d5fff4c5bf5ae/tests/test_roms/instr_test/06-absolute.nes.bin -------------------------------------------------------------------------------- /tests/test_roms/instr_test/07-abs_xy.nes.bin: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/6502-ml/08d2babe3d838eaae8ed90daca7d5fff4c5bf5ae/tests/test_roms/instr_test/07-abs_xy.nes.bin -------------------------------------------------------------------------------- /tests/test_roms/instr_test/08-ind_x.nes.bin: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/6502-ml/08d2babe3d838eaae8ed90daca7d5fff4c5bf5ae/tests/test_roms/instr_test/08-ind_x.nes.bin -------------------------------------------------------------------------------- /tests/test_roms/instr_test/09-ind_y.nes.bin: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/6502-ml/08d2babe3d838eaae8ed90daca7d5fff4c5bf5ae/tests/test_roms/instr_test/09-ind_y.nes.bin -------------------------------------------------------------------------------- /tests/test_roms/instr_test/10-branches.nes.bin: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/6502-ml/08d2babe3d838eaae8ed90daca7d5fff4c5bf5ae/tests/test_roms/instr_test/10-branches.nes.bin -------------------------------------------------------------------------------- /tests/test_roms/instr_test/11-stack.nes.bin: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/6502-ml/08d2babe3d838eaae8ed90daca7d5fff4c5bf5ae/tests/test_roms/instr_test/11-stack.nes.bin -------------------------------------------------------------------------------- /tests/test_roms/instr_test/12-jmp_jsr.nes.bin: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/6502-ml/08d2babe3d838eaae8ed90daca7d5fff4c5bf5ae/tests/test_roms/instr_test/12-jmp_jsr.nes.bin -------------------------------------------------------------------------------- /tests/test_roms/instr_test/13-rts.nes.bin: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/6502-ml/08d2babe3d838eaae8ed90daca7d5fff4c5bf5ae/tests/test_roms/instr_test/13-rts.nes.bin -------------------------------------------------------------------------------- /tests/test_roms/instr_test/14-rti.nes.bin: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/6502-ml/08d2babe3d838eaae8ed90daca7d5fff4c5bf5ae/tests/test_roms/instr_test/14-rti.nes.bin -------------------------------------------------------------------------------- /tests/test_roms/instr_test/15-brk.nes.bin: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/6502-ml/08d2babe3d838eaae8ed90daca7d5fff4c5bf5ae/tests/test_roms/instr_test/15-brk.nes.bin -------------------------------------------------------------------------------- /tests/test_roms/instr_test/16-special.nes.bin: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/6502-ml/08d2babe3d838eaae8ed90daca7d5fff4c5bf5ae/tests/test_roms/instr_test/16-special.nes.bin -------------------------------------------------------------------------------- /tests/test_roms/instr_timing/1-instr_timing.nes: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/6502-ml/08d2babe3d838eaae8ed90daca7d5fff4c5bf5ae/tests/test_roms/instr_timing/1-instr_timing.nes -------------------------------------------------------------------------------- /tests/test_roms/instr_timing/1-instr_timing.nes.bin: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/6502-ml/08d2babe3d838eaae8ed90daca7d5fff4c5bf5ae/tests/test_roms/instr_timing/1-instr_timing.nes.bin -------------------------------------------------------------------------------- /tests/test_roms/instr_timing/2-branch_timing.nes: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/6502-ml/08d2babe3d838eaae8ed90daca7d5fff4c5bf5ae/tests/test_roms/instr_timing/2-branch_timing.nes -------------------------------------------------------------------------------- /tests/test_roms/instr_timing/2-branch_timing.nes.bin: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/6502-ml/08d2babe3d838eaae8ed90daca7d5fff4c5bf5ae/tests/test_roms/instr_timing/2-branch_timing.nes.bin -------------------------------------------------------------------------------- /tests/test_roms/klaus.bin: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/6502-ml/08d2babe3d838eaae8ed90daca7d5fff4c5bf5ae/tests/test_roms/klaus.bin -------------------------------------------------------------------------------- /tests/test_roms/nestest.nes.bin: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Firobe/6502-ml/08d2babe3d838eaae8ed90daca7d5fff4c5bf5ae/tests/test_roms/nestest.nes.bin -------------------------------------------------------------------------------- /tests/unit_test.ml: -------------------------------------------------------------------------------- 1 | open Stdint 2 | open C6502.Utils 3 | 4 | module SCpu = C6502.Make (struct 5 | type t = uint8 array 6 | type input = string (* rom path *) 7 | 8 | let create path = 9 | let mem = Array.make 0x10000 Uint8.zero in 10 | let file = open_in_bin path in 11 | let store = Bytes.create 0x10000 in 12 | let read = input file store 0 0x10000 in 13 | let store = Bytes.sub store 0 read in 14 | Bytes.iteri (fun i el -> mem.(i) <- u8 (int_of_char el)) store; 15 | mem 16 | 17 | (* 0x000 to 0xFFFF main memory *) 18 | let read m a = m.(Uint16.to_int a) 19 | let write m a v = m.(Uint16.to_int a) <- v 20 | end) 21 | 22 | let set_pc cpu = SCpu.PC.set (SCpu.pc cpu) 23 | let get_pc cpu = SCpu.PC.get (SCpu.pc cpu) 24 | let set_reg cpu = SCpu.Register.set (SCpu.registers cpu) 25 | let get_reg cpu = SCpu.Register.get (SCpu.registers cpu) 26 | let read_mem cpu a = (SCpu.memory cpu).(a) 27 | 28 | let klaus () = 29 | let cpu = SCpu.create "test_roms/klaus.bin" in 30 | let continue = ref true in 31 | set_pc cpu (u16 0x400); 32 | set_reg cpu `P (u8 0); 33 | let start = Sys.time () in 34 | while !continue do 35 | let back = get_pc cpu in 36 | ignore @@ SCpu.next_instruction cpu; 37 | if back = get_pc cpu then continue := false 38 | done; 39 | let time_taken = Sys.time () -. start in 40 | let instr_per_s = float_of_int (SCpu.cycle_count cpu) /. time_taken in 41 | let _to_mhz = instr_per_s /. 1000000. in 42 | Alcotest.(check int) "Trap address" 0x3469 (get_pc cpu |> Uint16.to_int) 43 | 44 | let nestest () = 45 | let file = open_in_bin "test_roms/nestest.log" in 46 | let cpu = SCpu.create "test_roms/nestest.nes.bin" in 47 | Printf.printf "Nestest .............. %!"; 48 | let regexp = 49 | Str.regexp 50 | "^\\([0-9A-F]+\\).* A:\\([0-9A-F]+\\).* P:\\([0-9A-F]+\\).*CYC: \ 51 | *\\([0-9]+\\)" 52 | in 53 | let continue = ref true in 54 | set_reg cpu `S (u8 0xFD); 55 | SCpu.enable_decimal cpu false; 56 | set_reg cpu `P (u8 0x24); 57 | set_pc cpu (u16 0xC000); 58 | let last_line = ref "" in 59 | while !continue do 60 | if get_pc cpu = u16 0xC66E then continue := false; 61 | let toParse = input_line file in 62 | assert (Str.string_match regexp toParse 0); 63 | let correctPC = int_of_string @@ "0x" ^ Str.matched_group 1 toParse in 64 | let correctA = int_of_string @@ "0x" ^ Str.matched_group 2 toParse in 65 | let correctP = int_of_string @@ "0x" ^ Str.matched_group 3 toParse in 66 | let cycleNb = int_of_string @@ Str.matched_group 4 toParse in 67 | Alcotest.(check int) "Same cycle" cycleNb (SCpu.cycle_count cpu * 3 mod 341); 68 | Alcotest.(check int) 69 | "Same accumulator" correctA 70 | (Uint8.to_int @@ get_reg cpu `A); 71 | Alcotest.(check int) "Same PC" correctPC (Uint16.to_int @@ get_pc cpu); 72 | Alcotest.(check int) 73 | "Same P register" correctP 74 | (Uint8.to_int @@ get_reg cpu `P); 75 | last_line := toParse; 76 | ignore @@ SCpu.next_instruction cpu 77 | done; 78 | Alcotest.(check int) "Final status 1" 0 (Uint8.to_int @@ read_mem cpu 2); 79 | Alcotest.(check int) "Final status 2" 0 (Uint8.to_int @@ read_mem cpu 3) 80 | 81 | let test_rom path ?(expected = "Passed") () = 82 | let cpu = SCpu.create path in 83 | let continue = ref true in 84 | set_reg cpu `S (u8 0xFD); 85 | SCpu.enable_decimal cpu false; 86 | set_reg cpu `P (u8 0x24); 87 | SCpu.PC.init (SCpu.pc cpu) (SCpu.memory cpu); 88 | while !continue do 89 | let back = get_pc cpu in 90 | ignore @@ SCpu.next_instruction cpu; 91 | if back = get_pc cpu then continue := false 92 | done; 93 | let cur_pos = ref 0x6004 in 94 | while read_mem cpu !cur_pos <> u8 0 do 95 | incr cur_pos 96 | done; 97 | let end_pos = !cur_pos - 2 in 98 | cur_pos := end_pos; 99 | while read_mem cpu !cur_pos <> u8 0x0A do 100 | decr cur_pos 101 | done; 102 | let begin_pos = !cur_pos + 1 in 103 | let outStr = 104 | String.init 105 | (end_pos - begin_pos + 1) 106 | (fun i -> char_of_int @@ Uint8.to_int @@ read_mem cpu (begin_pos + i)) 107 | in 108 | let outStr = 109 | if outStr = "Passed" then outStr 110 | else 111 | String.init 112 | (end_pos - 0x6004 + 1) 113 | (fun i -> 114 | let m = read_mem cpu (0x6004 + i) in 115 | char_of_int @@ Uint8.to_int @@ if m = u8 0x0A then u8 0x3B else m) 116 | in 117 | Alcotest.(check string) "Status check" expected outStr 118 | 119 | let extended_opcodes ?(expected = 0x3469) () = 120 | let cpu = SCpu.create "test_roms/65C02_extended_opcodes_test.bin" in 121 | let continue = ref true in 122 | set_pc cpu (u16 0x400); 123 | set_reg cpu `P (u8 0x00); 124 | while !continue do 125 | let back = get_pc cpu in 126 | ignore @@ SCpu.next_instruction cpu; 127 | if back = get_pc cpu then continue := false 128 | done; 129 | Alcotest.(check int) "Trap address" expected (get_pc cpu |> Uint16.to_int) 130 | 131 | let () = 132 | let open Alcotest in 133 | let test_rom ?expected name path = 134 | test_case name `Quick (test_rom ?expected path) 135 | in 136 | run "6502-ml" 137 | [ 138 | ("basic", [ test_rom "Basics" "test_roms/instr_test/01-basics.nes.bin" ]); 139 | ( "addressing", 140 | [ 141 | test_rom "Implied" "test_roms/instr_test/02-implied.nes.bin"; 142 | test_rom "Immediate" 143 | ~expected:"6B ARR #n;AB ATX #n;;03-immediate;;Failed" 144 | "test_roms/instr_test/03-immediate.nes.bin"; 145 | test_rom "Zero page" "test_roms/instr_test/04-zero_page.nes.bin"; 146 | test_rom "Zero page XY" "test_roms/instr_test/05-zp_xy.nes.bin"; 147 | test_rom "Absolute" "test_roms/instr_test/06-absolute.nes.bin"; 148 | test_rom ~expected:"9C SYA abs,X;9E SXA abs,Y;;07-abs_xy;;Failed" 149 | "Absolute XY" "test_roms/instr_test/07-abs_xy.nes.bin"; 150 | test_rom "Indirect X" "test_roms/instr_test/08-ind_x.nes.bin"; 151 | test_rom "Indirect Y" "test_roms/instr_test/09-ind_y.nes.bin"; 152 | ] ); 153 | ( "control flow", 154 | [ 155 | test_rom "Branches" "test_roms/instr_test/10-branches.nes.bin"; 156 | test_rom "Stack" "test_roms/instr_test/11-stack.nes.bin"; 157 | test_rom "JMP JSR" "test_roms/instr_test/12-jmp_jsr.nes.bin"; 158 | test_rom "RTS" "test_roms/instr_test/13-rts.nes.bin"; 159 | test_rom "RTI" "test_roms/instr_test/14-rti.nes.bin"; 160 | test_rom "BRK" "test_roms/instr_test/15-brk.nes.bin"; 161 | ] ); 162 | (* 163 | "timing", [ 164 | test_rom "Instructions" "test_roms/instr_timing/1-instr_timing.nes.bin" ; 165 | test_rom "Branches" "test_roms/instr_timing/2-branch-timing.nes.bin" 166 | ]; 167 | *) 168 | ( "end-to-end", 169 | [ 170 | test_case "Klaus functional tests" `Slow klaus; 171 | test_case "Nestest comparison" `Slow nestest; 172 | ] ); 173 | ( "misc", 174 | [ 175 | test_rom "Special instructions" 176 | "test_roms/instr_test/16-special.nes.bin"; 177 | test_rom "Absolute X wrap" 178 | "test_roms/instr_misc/01-abs_x_wrap.nes.bin"; 179 | test_rom "Branch wrap" "test_roms/instr_misc/02-branch_wrap.nes.bin"; 180 | ] ); 181 | ( "unofficial", 182 | [ 183 | test_case "Extended opcodes" `Quick (extended_opcodes ~expected:0x423); 184 | ] ); 185 | ] 186 | --------------------------------------------------------------------------------