Reorganize src/ directory

src/core/bit.ml

@@ -0,0 +1,20 @@
+(**
+ * Copyright (c) 2015, Fabien Freling
+ * All rights reserved.
+ *
+ * This source code is licensed under the BSD 2-clause license found in the
+ * LICENSE file at the top level directory of this source tree.
+ *)
+
+let is_set num i =
+  if i < 0 then
+    failwith "Invalid bit index."
+  else
+    (num lsr i) land 0b00000001 <> 0
+
+let two_complement n =
+  (lnot n) + 1
+
+let signed_byte n =
+  if n land 0x80 <> 0 then -((two_complement n) land 0xFF)
+  else n

src/core/cartridge.ml

@@ -0,0 +1,115 @@
+(**
+ * Copyright (c) 2015, Fabien Freling
+ * All rights reserved.
+ *
+ * This source code is licensed under the BSD 2-clause license found in the
+ * LICENSE file at the top level directory of this source tree.
+ *)
+
+(** http://bgb.bircd.org/pandocs.htm#thecartridgeheader *)
+
+
+type memory_bank_controller =
+  | ROM_ONLY
+  | MBC1
+
+type t = {
+  full_rom : bytes;
+  nintendo_logo : bytes;
+  title : string;
+  mem_type : memory_bank_controller;
+  rom_size : int;
+  ram_size : int;
+(*  header_checksum : bytes;
+  global_checksum : bytes; *)
+}
+
+(** The Nintendo logo is a checksum in the header *)
+let check_nintendo_logo cartridge =
+  let reference = Bytes.of_string
+  "\xCE\xED\x66\x66\xCC\x0D\x00\x0B\x03\x73\x00\x83\x00\x0C\x00\x0D\
+  \x00\x08\x11\x1F\x88\x89\x00\x0E\xDC\xCC\x6E\xE6\xDD\xDD\xD9\x99\
+  \xBB\xBB\x67\x63\x6E\x0E\xEC\xCC\xDD\xDC\x99\x9F\xBB\xB9\x33\x3E" in
+  (Bytes.compare cartridge.nintendo_logo reference) == 0
+
+let get_cartridge_type = function
+  | 0x00 -> ROM_ONLY
+  | 0x01 -> MBC1
+  | x -> Printf.printf "%02X\n" x; failwith "Invalid cartridge type."
+
+let mem_type_name = function
+  | ROM_ONLY -> "ROM_ONLY"
+  | MBC1 -> "MBC1"
+
+
+(** ROM size is expressed in KB *)
+let get_ROM_size = function
+  | 0x00 -> 32 (* no ROM banking *)
+  | 0x01 -> 64 (* 4 banks *)
+  | 0x02 -> 128 (* 8 banks *)
+  | 0x03 -> 256 (* 16 banks *)
+  | 0x04 -> 512 (* 32 banks *)
+  | 0x05 -> 1000 (* 64 banks - only 63 banks used by MBC1 *)
+  | 0x06 -> 2000 (* 128 banks - only 125 banks used by MBC1 *)
+  | 0x07 -> 4000 (* 256 banks *)
+  | 0x52 -> 1100 (* 72 banks *)
+  | 0x53 -> 1200 (* 80 banks *)
+  | 0x54 -> 1500 (* 96 banks *)
+  | _ -> failwith "Invalid ROM size code."
+
+(** RAM size is expressed in KB *)
+let get_RAM_size = function
+  | 0x00 -> 0
+  | 0x01 -> 2
+  | 0x02 -> 8
+  | 0x03 -> 32 (* 4 x 8KB banks *)
+  | _ -> failwith "Invalid RAM size code."
+
+
+let read_cartridge file =
+  try
+    let ic = open_in_bin file in
+
+    let file_size = in_channel_length ic in
+
+    let full_rom = Bytes.create file_size in
+    really_input ic full_rom 0 file_size;
+    close_in ic;
+
+      (* Nintendo logo *)
+      let nin_logo_offset = 0x0104 in
+      let nin_logo_size = 48 in
+      let nintendo_logo = Bytes.sub full_rom nin_logo_offset nin_logo_size in
+
+      (* Title *)
+      let title_offset = 0x0134 in
+      let title_size = 16 in
+      let title_b = Bytes.sub full_rom title_offset title_size in
+      let title = Bytes.to_string title_b in
+
+      (* Cartridge type - memory bank *)
+      let mem_type_code = Bytes.get full_rom 0x0147 |> int_of_char in
+      let mem_type = get_cartridge_type mem_type_code in
+
+      (* ROM size *)
+      let rom_size_code = Bytes.get full_rom 0x0148 |> int_of_char in
+      let rom_size = get_ROM_size rom_size_code in
+
+      (* RAM size *)
+      let ram_size_code = Bytes.get full_rom 0x0149 |> int_of_char in
+      let ram_size = get_RAM_size ram_size_code in
+
+      Some { full_rom; nintendo_logo; title; mem_type; rom_size; ram_size }
+
+  with
+  | Sys_error msg
+  | Invalid_argument msg (* This is triggered by Bytes.sub *)
+  | Failure msg -> prerr_endline msg; None
+
+
+let print_info cartridge =
+  let open Printf in
+  printf "Title: %s\n" cartridge.title;
+  printf "Mem. type: %s\n" (cartridge.mem_type |> mem_type_name);
+  printf "ROM size: %iKB\n" cartridge.rom_size;
+  printf "RAM size: %iKB\n" cartridge.ram_size

src/core/cpu.ml

@@ -0,0 +1,364 @@
+(**
+ * Copyright (c) 2015, Fabien Freling
+ * All rights reserved.
+ *
+ * This source code is licensed under the BSD 2-clause license found in the
+ * LICENSE file at the top level directory of this source tree.
+ *)
+
+open Printf
+
+let frequence = 4194304
+
+(** http://bgb.bircd.org/pandocs.htm#cpuregistersandflags
+    http://gameboy.mongenel.com/dmg/lesson1.html *)
+
+type registers = {
+  mutable a : char; (* accumulator *)
+  mutable f : char; (* flags *)
+  mutable b : char;
+  mutable c : char;
+  mutable d : char;
+  mutable e : char;
+  mutable h : char;
+  mutable l : char;
+
+  mutable sp : int; (* stack pointer *)
+  mutable pc : int; (* program counter *)
+}
+
+ type flags = {
+  mutable z : bool; (* zero *)
+  mutable n : bool; (* substraction *)
+  mutable h : bool; (* half-carry *)
+  mutable c : bool; (* carry *)
+}
+
+type t = {
+  reg : registers;
+  flag : flags;
+  mutable cycles : int;
+}
+
+let print_cpu_state cpu =
+  printf "[Cpu state] Registers:\n";
+  printf "[Cpu state] \tA: 0x%02X  \tF: 0x%02X\n" (int_of_char cpu.reg.a) (int_of_char cpu.reg.f);
+  printf "[Cpu state] \tB: 0x%02X  \tC: 0x%02X\n" (int_of_char cpu.reg.b) (int_of_char cpu.reg.c);
+  printf "[Cpu state] \tD: 0x%02X  \tE: 0x%02X\n" (int_of_char cpu.reg.d) (int_of_char cpu.reg.e);
+  printf "[Cpu state] \tH: 0x%02X  \tL: 0x%02X\n" (int_of_char cpu.reg.h) (int_of_char cpu.reg.l);
+  printf "[Cpu state] \tPC: 0x%04X\n" cpu.reg.pc;
+  printf "[Cpu state] \tSP: 0x%04X\n" cpu.reg.sp;
+
+  printf "[Cpu state] Flags:\n";
+  printf "[Cpu state] \t ZNHC\n";
+  let z = if cpu.flag.z then 1 else 0 in
+  let n = if cpu.flag.n then 1 else 0 in
+  let h = if cpu.flag.h then 1 else 0 in
+  let c = if cpu.flag.c then 1 else 0 in
+  printf "[Cpu state] \t[%d%d%d%d]\n" z n h c
+
+(** http://bgb.bircd.org/pandocs.htm#powerupsequence *)
+let init_registers =
+  {
+    a = '\x00';
+    f = '\x00';
+    b = '\x00';
+    c = '\x00';
+    d = '\x00';
+    e = '\x00';
+    h = '\x00';
+    l = '\x00';
+    sp = 0xFFFE;
+    pc = 0x0100;
+  }
+
+let init_flags =
+  {
+    z = false; n = false; h = false; c = false
+  }
+
+let init_cpu =
+  { reg = init_registers; flag = init_flags; cycles = 0 }
+
+let update_flag_reg cpu =
+  let z = if cpu.flag.z then 0b10000000 else 0 in
+  let n = if cpu.flag.n then 0b01000000 else 0 in
+  let h = if cpu.flag.h then 0b00100000 else 0 in
+  let c = if cpu.flag.c then 0b00010000 else 0 in
+  cpu.reg.f <- char_of_int @@ z + n + h + c
+
+let inc_pc cpu count =
+  cpu.reg.pc <- (cpu.reg.pc + count) mod 0xFFFF
+
+let inc_cycles cpu count =
+  cpu.cycles <- cpu.cycles + count
+
+let merge_bytes low high =
+  (int_of_char high) * 256 + (int_of_char low)
+
+let split_2B x =
+  let low = x mod 256 |> char_of_int in
+  let high = x / 256 |> char_of_int in
+  (high, low)
+
+let read_2B m addr =
+  let low = Memory.get m addr in
+  let high = Memory.get m (addr + 1) in
+  merge_bytes low high
+
+let inc_BC cpu =
+  let v = merge_bytes cpu.reg.c cpu.reg.b in
+  let low, high = split_2B (v + 1) in
+  cpu.reg.c <- low;
+  cpu.reg.b <- high
+
+let cmp_A cpu n =
+  let diff = int_of_char (cpu.reg.a) - n in
+  cpu.flag.z <- diff = 0;
+  cpu.flag.n <- true;
+  cpu.flag.h <- diff > 0x0F || diff < 0;
+  cpu.flag.c <- diff > 0xFF || diff < 0;
+  update_flag_reg cpu
+
+let read_pc_byte cpu mem =
+  let b = Memory.get mem cpu.reg.pc in
+  inc_pc cpu 1;
+  int_of_char b
+
+let read_pc_2bytes cpu mem =
+  let word = read_2B mem cpu.reg.pc in
+  inc_pc cpu 2;
+  word
+
+(*************************************************
+ *
+ *  Stack manipulation
+ *
+ ************************************************)
+let pop_stack cpu mem =
+  let low = Memory.get mem cpu.reg.sp in
+  cpu.reg.sp <- (cpu.reg.sp + 1) mod 0xFFFF;
+  let high = Memory.get mem cpu.reg.sp in
+  cpu.reg.sp <- (cpu.reg.sp + 1) mod 0xFFFF;
+  merge_bytes low high
+
+let push_pc_stack cpu mem =
+  let (high, low) = split_2B cpu.reg.pc in
+  cpu.reg.sp <- pred cpu.reg.sp;
+  Memory.set mem cpu.reg.sp high;
+  cpu.reg.sp <- pred cpu.reg.sp;
+  Memory.set mem cpu.reg.sp low
+
+
+
+
+(*************************************************
+ *
+ *  CPU instructions
+ *
+ ************************************************)
+(** http://imrannazar.com/GameBoy-Z80-Opcode-Map
+    https://github.com/sinamas/gambatte/blob/master/libgambatte/src/cpu.cpp *)
+let run cpu (mem: Memory.map) =
+  print_cpu_state cpu;
+  let opcode = read_pc_byte cpu mem |> char_of_int in
+(*  Hexa.print_slice cartridge.full_rom cpu.reg.pc (cpu.reg.pc + 7); *)
+
+  let inst, cycles = match opcode with
+
+  (* 8-bit load *)
+  (* LD   r,(HL) *)
+  | '\x7E' -> let inst = sprintf "LD \tA, (HL)" in
+              let hl = merge_bytes cpu.reg.l cpu.reg.h in
+              cpu.reg.a <- Memory.get mem hl;
+              inst, 8
+
+  | '\x36' -> let n = read_pc_byte cpu mem in
+              let inst = sprintf "LD \t(HL) 0x%02X" n in
+              let hl = merge_bytes cpu.reg.l cpu.reg.h in
+              Memory.set mem hl (char_of_int n);
+              inst, 12
+
+
+  (* CPU control *)
+  | '\x00' -> let inst = sprintf "NOP" in
+              inst, 4
+
+
+  (* jump *)
+  | '\x20' -> let n = read_pc_byte cpu mem in
+              let s = Bit.signed_byte n in
+              let inst = sprintf "JR \tNZ, 0x%02X (%d)" n s in
+              if cpu.flag.z = false then begin
+                inc_pc cpu (s - 2); (* we read 2 bytes from PC, opcode and n *)
+                inst, 12
+              end else
+                inst, 8
+
+  | '\xC9' -> let inst = sprintf "RET" in
+              cpu.reg.pc <- pop_stack cpu mem;
+              inst, 16
+
+  | '\xC0' -> let inst = sprintf "RET \tNZ" in
+              if cpu.flag.z = false then begin
+                cpu.reg.pc <- pop_stack cpu mem;
+                inst, 20
+              end else
+                inst, 8
+
+
+
+  | '\x03' -> let inst = sprintf "INC \tBC" in
+              inc_BC cpu;
+              inst, 8
+
+  | '\x05' -> let inst = sprintf "DEC \tB" in
+              let dec = int_of_char(cpu.reg.b) - 1 in
+              cpu.flag.z <- dec = 0;
+              cpu.flag.n <- true;
+              cpu.flag.h <- dec < 0;
+              cpu.reg.b <- char_of_int @@ if dec >= 0 then dec else 0;
+              inst, 4
+
+  | '\x06' -> let n = read_pc_byte cpu mem in
+              let inst = sprintf "LD \tB, 0x%02X" n in
+              cpu.reg.b <- char_of_int n;
+              inst, 8
+
+  | '\x18' -> let n = read_pc_byte cpu mem in
+              let inst = sprintf "JP \t0x%02X" n in
+              inc_pc cpu (n - 1);
+              inst, 12
+
+  | '\x21' -> let nn = read_pc_2bytes cpu mem in
+              let inst = sprintf "LD \tHL, 0x%04X" nn in
+              let high, low = split_2B nn in
+              cpu.reg.h <- high;
+              cpu.reg.l <- low;
+              inst, 12
+
+  | '\x22' -> let inst = sprintf "LDI \t(HL), A" in
+              let hl = merge_bytes cpu.reg.l cpu.reg.h in
+              Memory.set mem hl cpu.reg.a;
+              let high, low = split_2B (hl + 1) in
+              cpu.reg.h <- high;
+              cpu.reg.l <- low;
+              inst, 8
+
+
+  | '\x28' -> let n = read_pc_byte cpu mem in
+              let inst = sprintf "JR \tZ, 0x%02X" n in
+              if cpu.flag.z = true then begin
+                inc_pc cpu (n - 1);
+                inst, 12
+              end else 
+                inst, 8
+
+  | '\x34' -> let inst = sprintf "INC \t(HL)" in
+              let hl = merge_bytes cpu.reg.l cpu.reg.h in
+              let v = Memory.get mem hl |> int_of_char in
+              cpu.flag.z <- v + 1 = 0;
+              cpu.flag.n <- false;
+              cpu.flag.h <- v = 0b00001111;
+              Memory.set mem hl (char_of_int (v + 1));
+              inst, 12
+
+
+  | '\x3E' -> let n = read_pc_byte cpu mem in
+              let inst = sprintf "LD \tA, 0x%02X" n in
+              cpu.reg.a <- char_of_int n;
+              inst, 8
+
+  | '\xAF' -> let inst = sprintf "XOR \tA, A" in
+              let int_A = int_of_char cpu.reg.a in
+              cpu.reg.a <- char_of_int @@ int_A lxor int_A;
+              inst, 4
+
+  | '\xC3' -> let addr = read_pc_2bytes cpu mem in
+              let inst = sprintf "JP \t0x%04X" addr in
+              cpu.reg.pc <- addr;
+              inst, 16
+
+  | '\xE0' -> let n = read_pc_byte cpu mem in
+              let inst = sprintf "LDH \t(0xFF%02X), A" n in
+              Memory.set mem (0xFF00 + n) cpu.reg.a;
+              inst, 12
+
+  | '\xEA' -> let addr = read_pc_2bytes cpu mem in
+              let inst = sprintf "LD \t(0X%04X), A" addr in
+              Memory.set mem addr cpu.reg.a;
+              inst, 16
+
+
+  | '\xF0' -> let n = read_pc_byte cpu mem in
+              let inst = sprintf "LDH \tA, (0xFF%02X)" n in
+              cpu.reg.a <- Memory.get mem (0xFF00 + n);
+              inst, 12
+
+  | '\xF3' -> let inst = sprintf "DI" in
+              (* fixme *)
+              inst, 4
+
+  | '\xFE' -> let n = read_pc_byte cpu mem in
+              let inst = sprintf "CP \t0x%02X" n in
+              cmp_A cpu n;
+              inst, 8
+
+  | '\xFB' -> let inst = sprintf "EI" in
+              (* enable interrupts *)
+              Interrupt.gIME := true;
+              inst, 4
+
+  |  x -> eprintf "opcode 0x%02X\n" (int_of_char x);
+          eprintf "#cycles: %d\n" cpu.cycles;
+          failwith "Unimplemented opcode."
+
+  in
+  inc_cycles cpu cycles;
+  inst, cycles
+
+
+(*************************************************
+ *
+ *  Interrupt handlers
+ *
+ ************************************************)
+let handle_interrupt cpu mmap flag =
+  let int_vector = match flag with
+  | Interrupt.V_Blank  -> 0x40
+  | Interrupt.LCD_Stat -> 0x48
+  | Interrupt.Timer    -> 0x50
+  | Interrupt.Serial   -> 0x58
+  | Interrupt.Joypad   -> 0x60 in
+
+  Interrupt.reset_IF_flag flag mmap;
+  Interrupt.gIME := false;
+
+  push_pc_stack cpu mmap;
+  cpu.reg.pc <- int_vector;
+
+  (* run cpu until RETI is called *)
+  let last_inst = ref "" in
+  while !last_inst <> "RETI" do
+    let inst, cycles = run cpu mmap in
+    last_inst := inst
+  done;
+
+  Interrupt.gIME := true
+
+
+
+let handle_interrupts cpu mmap =
+  if not !Interrupt.gIME then
+    () (* Interrupt Master Enable flag set to false, nothing to do *)
+  else begin
+    (* N.B.: flags are precomputed once but an interrupt could be requested
+       during that time *)
+    let ie = Interrupt.get_IE mmap in 
+    let if_ = Interrupt.get_IF mmap in 
+    let interrupts = ie land if_ in
+    let flags = Interrupt.get_flags interrupts in
+    match flags with
+    | [] -> () (* No interrupt *)
+    | _ -> List.iter (fun x -> handle_interrupt cpu mmap x) flags
+  end

src/core/dune

@@ -0,0 +1,3 @@
+(library
+	(name oboy)
+	(libraries threads))

src/core/hexa.ml

@@ -0,0 +1,22 @@
+(**
+ * Copyright (c) 2015, Fabien Freling
+ * All rights reserved.
+ *
+ * This source code is licensed under the BSD 2-clause license found in the
+ * LICENSE file at the top level directory of this source tree.
+ *)
+
+open Printf
+
+let rec print_slice ?(width=8) b start last =
+  if start < last then
+    let max = min (start + width - 1) last in
+    for i = start to max do
+      printf "%02X " (Bytes.get b i |> int_of_char)
+    done;
+    print_newline ();
+    print_slice ~width b (start + width) last
+
+let print_bytes ?(width=8) b width =
+  let l = Bytes.length b in
+  print_slice ~width b 0 l

src/core/interrupt.ml

@@ -0,0 +1,66 @@
+(**
+ * Copyright (c) 2016, Fabien Freling
+ * All rights reserved.
+ *
+ * This source code is licensed under the BSD 2-clause license found in the
+ * LICENSE file at the top level directory of this source tree.
+ *)
+
+(** Interrupt Master Enable flag *)
+let gIME = ref false
+
+let ie_addr = 0xFFFF
+let if_addr = 0xFFF0
+
+type t =
+  | V_Blank
+  | LCD_Stat
+  | Timer
+  | Serial
+  | Joypad
+
+
+let get_flag_mask = function
+  | V_Blank  -> 0b00000001
+  | LCD_Stat -> 0b00000010
+  | Timer    -> 0b00000100
+  | Serial   -> 0b00001000
+  | Joypad   -> 0b00010000
+
+(** Return the list of interrupt flags sorted by priority. *)
+let get_flags byte =
+
+  let nth_interrupt i =
+    match i with
+    | 0 -> V_Blank
+    | 1 -> LCD_Stat
+    | 2 -> Timer
+    | 3 -> Serial
+    | 4 -> Joypad
+    | _ -> failwith "Invalid interrupt index." in
+
+  let rec get_flag byte i accu =
+    match i with
+    | 0 | 1 | 2 | 3 | 4 ->
+      if Bit.is_set byte i then
+        let interrupt = nth_interrupt i in
+        get_flag byte (i + 1) (interrupt :: accu)
+      else
+        get_flag byte (i + 1) accu
+    | _ -> List.rev accu in
+
+  get_flag byte 0 []
+
+
+(** Interrupt Enable *)
+let get_IE mem = Memory.get mem ie_addr |> int_of_char
+
+(** Interrupt Flag *)
+let get_IF mem = Memory.get mem if_addr |> int_of_char
+
+let reset_IF_flag flag mem =
+  let if_reg = get_IF mem in
+  let flag_mask = get_flag_mask flag in
+  let new_if_reg = if_reg land (lnot flag_mask) |> char_of_int in
+  Memory.set mem if_addr new_if_reg
+

src/core/memory.ml

@@ -0,0 +1,109 @@
+(**
+ * Copyright (c) 2015, Fabien Freling
+ * All rights reserved.
+ *
+ * This source code is licensed under the BSD 2-clause license found in the
+ * LICENSE file at the top level directory of this source tree.
+ *)
+
+open Bytes
+open Printf
+
+(** @see http://bgb.bircd.org/pandocs.htm#memorymap
+    @see http://imrannazar.com/GameBoy-Emulation-in-JavaScript:-Memory *)
+
+(** Common addresses *)
+let gDIV  = 0xFF04 (* divider register *)
+let gTIMA = 0xFF05 (* timer counter *)
+let gTMA  = 0xFF06 (* timer modulo *)
+let gTAC  = 0xFF07 (* timer control *)
+
+type map = {
+  rom_bank_00 : bytes; (* cartridge, 16KB *)
+  rom_bank_01 : bytes; (* additional bank, 16KB *)
+  vram        : bytes; (* Video RAM, 8KB *)
+  wram_bank_0 : bytes; (* work RAM, 4KB *)
+  wram_bank_1 : bytes; (* work RAM, 4KB *)
+  io          : bytes; (* I/O ports *)
+  hram        : bytes; (* High RAM, 8KB *)
+  interrupt   : bytes; (* Interrupt Enable Register *)
+}
+
+type t = {
+  map       : map;
+  timer_div : Timer.t;
+  tima      : Timer.t;
+}
+
+let init (cartridge: Cartridge.t) =
+  let map = {
+    rom_bank_00 = sub cartridge.full_rom 0 0x4000;
+    rom_bank_01 = create 0x4000;
+    vram = create 0x2000;
+    wram_bank_0 = create 0x1000;
+    wram_bank_1 = create 0x1000;
+    io = create 0x0080;
+    hram = create 0x2000;
+    interrupt = create 1
+  } in
+
+  (** Init register values
+      @see http://bgb.bircd.org/pandocs.htm#powerupsequence *)
+  let zero = char_of_int 0 in
+  set map.io 0x05 zero; (* TIMA, 0xFF05 *)
+  set map.io 0x06 zero; (* TMA,  0xFF06 *)
+  set map.io 0x07 zero; (* TAC,  0xFF07 *)
+
+  let timer_div = Timer.create 16384 true in
+  let tima = Timer.create_tima 0 in
+
+  { map; timer_div; tima; }
+
+let get_mem_bank mem addr =
+  match addr with
+  | x when x < 0x4000 -> mem.rom_bank_00, x
+  | x when x < 0x8000 -> mem.rom_bank_01, (x - 0x4000)
+  | x when x < 0xA000 -> mem.vram,  (x - 0x8000)
+  | x when x < 0xC000 -> failwith "Unimplemented memory range."
+  | x when x < 0xD000 -> mem.wram_bank_0,  (x - 0xC000)
+  | x when x < 0xE000 -> mem.wram_bank_1,  (x - 0xD000)
+  | x when x < 0xFF00 -> failwith "Unimplemented memory range."
+  | x when x < 0xFF80 -> mem.io, x - 0xFF00
+  | x when x < 0xFFFF -> mem.hram, x - 0xFF80
+  | 0xFFFF -> mem.interrupt, 0
+  | x -> eprintf "Memory access 0x%06X\n" x;
+         failwith "Invalid memory range."
+
+
+let get mem addr =
+  let m, x = get_mem_bank mem addr in
+  get m x
+
+let set mem addr c =
+  let m, x = get_mem_bank mem addr in
+  set m x c
+
+(** Increment byte in memory, wrap value in case of overflow *)
+let inc mem addr = 
+  let m, x = get_mem_bank mem addr in
+  let value = Bytes.get m x |> int_of_char in
+  let inc_value = value + 1 in
+  let overflow = inc_value > 0xFF in
+  let c = inc_value mod 0x01FF |> char_of_int in
+  Bytes.set m x c;
+  overflow
+
+
+let update_timers mem cycles =
+  let should_inc_div = Timer.update mem.timer_div cycles in
+  if should_inc_div then ignore (inc mem.map gDIV);
+
+  let should_inc_tima = Timer.update mem.tima cycles in
+  if should_inc_tima then begin
+    let overflow = inc mem.map gTIMA in
+    if overflow then begin
+      let tma = get mem.map gTMA in
+      set mem.map gTIMA tma
+      (* TODO: INT 50 - Timer interupt *)
+    end
+  end

src/core/oboy.ml

@@ -0,0 +1,73 @@
+(**
+ * Copyright (c) 2015, Fabien Freling
+ * All rights reserved.
+ *
+ * This source code is licensed under the BSD 2-clause license found in the
+ * LICENSE file at the top level directory of this source tree.
+ *)
+
+open Printf
+
+let fps = 60
+let cycles_per_frame = Cpu.frequence / fps
+
+let rec run (cpu: Cpu.t) (mem: Memory.t) (screen: Screen.t) =
+  let start = Unix.gettimeofday () in
+  printf "start %f\n" start;
+
+  let rec run_for cpu (mem: Memory.t) cycles_remaining =
+    if cycles_remaining > 0 then begin
+      printf "\n";
+      let inst, cycles = Cpu.run cpu mem.map in
+      printf "[Instruction] %s\n" inst;
+
+      Cpu.handle_interrupts cpu mem.map;
+
+      Memory.update_timers mem cycles;
+
+      run_for cpu mem (cycles_remaining - cycles)
+    end
+  in
+  run_for cpu mem cycles_per_frame;
+
+  let stop = Unix.gettimeofday () in
+  let delay = (1. -. (stop -. start)) /. (float_of_int fps) in
+  printf "stop %f\n" stop;
+  printf "delta %f\n" (stop -. start);
+  printf "delay %f\n" delay;
+  flush_all ();
+
+  if delay > 0. then Thread.delay delay;
+  run cpu mem screen
+
+(** Power up sequence
+    http://bgb.bircd.org/pandocs.htm#powerupsequence *)
+let power_up cartridge =
+  (* Nintendo logo scrolling *)
+  if not (Cartridge.check_nintendo_logo cartridge)
+  then print_endline "Invalid ROM."
+  else
+    print_endline "Valid ROM.";
+    Cartridge.print_info cartridge;
+
+    let cpu = Cpu.init_cpu in
+    let mem = Memory.init cartridge in
+    let screen = Screen.init in
+
+    (*Graphics.open_graph "";
+    Graphics.resize_window Screen.width Screen.height;
+    *)
+    run cpu mem screen
+
+
+let () =
+  if Array.length Sys.argv < 2 then begin
+    prerr_endline "Please specify a ROM.";
+    eprintf "Usage: %s path/to/rom\n" Sys.argv.(0);
+    exit 1;
+  end;
+
+  let cartridge = Cartridge.read_cartridge Sys.argv.(1) in
+  match cartridge with
+  | None -> print_endline "Invalid ROM file."
+  | Some c -> power_up c

src/core/screen.ml

@@ -0,0 +1,97 @@
+(**
+ * Copyright (c) 2015, Fabien Freling
+ * All rights reserved.
+ *
+ * This source code is licensed under the BSD 2-clause license found in the
+ * LICENSE file at the top level directory of this source tree.
+ *)
+
+let width = 160
+let height = 144
+
+type pixel = {
+  r : int;
+  g : int;
+  b : int;
+  a : int;
+}
+
+type t = {
+  data   : pixel array array;
+}
+
+type control = {
+  lcd_display_enable    : bool;
+  tile_map_select       : int;
+  window_display_enable : bool;
+  tile_data_select      : int;
+  bg_tile_map_select    : int;
+  sprite_size           : int;
+  sprite_enable         : bool;
+  bg_display            : bool;
+}
+
+let get_lcd_control mem =
+  let b = Memory.get mem 0xFF40 |> int_of_char in
+
+  let lcd_display_enable = Bit.is_set b 7 in
+  let tile_map_select = if not (Bit.is_set b 6) then 0x9800 else 0x9c00 in
+  let window_display_enable = Bit.is_set b 5 in
+  let tile_data_select = if not (Bit.is_set b 4) then 0x8800 else 0x8000 in
+  let bg_tile_map_select = if not (Bit.is_set b 3) then 0x9800 else 0x9c00 in
+  let sprite_size = if not (Bit.is_set b 2) then 8 else 16 in
+  let sprite_enable = Bit.is_set b 1 in
+  let bg_display = Bit.is_set b 0 in
+
+  {
+    lcd_display_enable;
+    tile_map_select;
+    window_display_enable;
+    tile_data_select;
+    bg_tile_map_select;
+    sprite_size;
+    sprite_enable;
+    bg_display;
+  }
+
+let init =
+  {
+    data = Array.make_matrix width height { r = 255; g = 255; b = 255; a = 255 }
+  }
+
+
+let render_map mem map_addr =
+  let tile_size = 16 in
+  let map = Bytes.create (32 * 32 * tile_size) in
+  for y = 0 to (32 - 1) do
+    for x = 0 to (32 - 1) do
+      let tile_number = Memory.get mem (map_addr + (y * 32 + x)) |> int_of_char in
+      let src_offset = map_addr + tile_number * tile_size in
+      let tile_line_size = 2 in
+      let tile_height = 8 in
+
+      for line_index = 0 to (tile_height - 1) do
+        let line_offset = src_offset + (line_index * tile_line_size) in
+        let dst_y = y * tile_height + line_index in
+        let dst_offset = (dst_y * 32 + x) * tile_line_size in
+        Bytes.blit mem.vram line_offset map dst_offset tile_line_size
+      done
+    done
+  done
+
+
+let render mem =
+  let
+  {
+    lcd_display_enable;
+    tile_map_select;
+    window_display_enable;
+    tile_data_select;
+    bg_tile_map_select;
+    sprite_size;
+    sprite_enable;
+    bg_display;
+  } = get_lcd_control mem in
+  let scy = Memory.get mem 0xFF42 |> int_of_char in
+  let scx = Memory.get mem 0xFF43 |> int_of_char in
+  scx + scy

src/core/timer.ml

@@ -0,0 +1,45 @@
+(**
+ * Copyright (c) 2016, Fabien Freling
+ * All rights reserved.
+ *
+ * This source code is licensed under the BSD 2-clause license found in the
+ * LICENSE file at the top level directory of this source tree.
+ *)
+
+let frequence = 4194304
+
+type t = {
+  clock_rate          : int;
+  period              : int;
+  mutable enabled     : bool;
+  mutable cycles_left : int;
+}
+
+let create clock_rate enabled =
+  let period = frequence / clock_rate in
+  {
+    clock_rate;
+    period;
+    enabled;
+    cycles_left = period;
+  }
+
+(** TIMA - Timer counter *)
+let create_tima tac =
+  let enabled = Bit.is_set tac 2 in 
+  let clock_select = tac land 0b00000011 in
+  let clock_rate = match clock_select with
+    | 0 -> 4096
+    | 1 -> 262144
+    | 2 -> 65536
+    | 3 -> 16384
+    | _ -> failwith "Unreachable clock rate code."
+  in
+  create clock_rate enabled
+
+let update timer cycles =
+  let remain = timer.cycles_left - cycles in
+  let should_inc = remain <= 0 in
+  if should_inc then
+    timer.cycles_left <- remain + timer.period;
+  should_inc