Skip to content

Instantly share code, notes, and snippets.

@SplittyDev

SplittyDev/fchippy.fs

Last active September 30, 2015 12:10
Show Gist options
  • Save SplittyDev/e6a0c0865df5f6aa259b to your computer and use it in GitHub Desktop.
Save SplittyDev/e6a0c0865df5f6aa259b to your computer and use it in GitHub Desktop.
Download ZIP
WIP F# CHIP8 emulator
Raw
fchippy.fs
// The virtual screen width
let SCREEN_WIDTH = 64
// The virtual screen height
let SCREEN_HEIGHT = 32
// The CHIP8 font map
let font : byte array =
[| 0xF0uy; 0x90uy; 0x90uy; 0x90uy; 0xF0uy;
0x20uy; 0x60uy; 0x20uy; 0x20uy; 0x70uy;
0xF0uy; 0x10uy; 0xF0uy; 0x80uy; 0xF0uy;
0xF0uy; 0x10uy; 0xF0uy; 0x10uy; 0xF0uy;
0x90uy; 0x90uy; 0xF0uy; 0x10uy; 0x10uy;
0xF0uy; 0x80uy; 0xF0uy; 0x10uy; 0xF0uy;
0xF0uy; 0x80uy; 0xF0uy; 0x90uy; 0xF0uy;
0xF0uy; 0x10uy; 0x20uy; 0x40uy; 0x40uy;
0xF0uy; 0x90uy; 0xF0uy; 0x90uy; 0xF0uy;
0xF0uy; 0x90uy; 0xF0uy; 0x10uy; 0xF0uy;
0xF0uy; 0x90uy; 0xF0uy; 0x90uy; 0x90uy;
0xE0uy; 0x90uy; 0xE0uy; 0x90uy; 0xE0uy;
0xF0uy; 0x80uy; 0x80uy; 0x80uy; 0xF0uy;
0xE0uy; 0x90uy; 0x90uy; 0x90uy; 0xE0uy;
0xF0uy; 0x80uy; 0xF0uy; 0x80uy; 0xF0uy;
0xF0uy; 0x80uy; 0xF0uy; 0x80uy; 0x80uy; |]
// The CHIP8 keypad map
let keymap : char array =
[| 'x'; '1'; '2'; '3';
'q'; 'w'; 'e'; 'a';
's'; 'd'; 'z'; 'c';
'4'; 'r'; 'f'; 'v'; |]
// Debugging bit flags
[<System.FlagsAttribute>]
type debug_option = None=0 | Pause=2 | Halt=4 | Restart=8 | Step=16 | Verbose=32 | Slow=64
// The CHIP8 keypad state
let keystate : byte array = Array.zeroCreate 16
// The CHIP8 video memory
let vmem : byte array = SCREEN_WIDTH * SCREEN_HEIGHT |> Array.zeroCreate
// Random number generator for your daily portion of side effects
let rng = new System.Random ()
// Initialize memory
let mem_init size : byte array =
Array.append font <| Array.zeroCreate (size - font.Length)
// Clear memory
let mem_clear (mem : byte array) =
mem_init mem.Length
// Load a CHIP8 ROM into the memory
let mem_load_rom (mem : byte array) (rom : byte array) = Array.blit rom 0 mem 0x200 <| if rom.Length > 3584 then 3584 else rom.Length
// Read 8-bit integer from memory
let mem_read8 (mem : byte array) addr = mem.[addr]
// Read 16-bit integer from memory
let mem_read16 (mem : byte array) addr : int16 = int16 mem.[addr] <<< 8 ||| int16 mem.[addr + 1]
// Write 8-bit integer to memory
let mem_write8 (mem : byte array) addr (value : byte) =
Array.mapi (fun i x ->
if i = addr then value
else mem.[addr]) mem
// Write 16-bit integer to memory
let mem_write16 (mem : byte array) addr (value : int16) =
mem |> Array.mapi (fun i x ->
if i = addr then byte ((value >>> 8) &&& 0xFFs)
elif i = (addr + 1) then byte (value &&& 0xFFs)
else mem.[addr])
// Mark a key as pressed in the keystate
let keypad_set_key (key : char) = keystate.[Array.findIndex (fun x -> x = key) keymap] <- 1uy
// Mark a key as not pressed in the keystate
let keypad_unset_key (key : char) = keystate.[Array.findIndex (fun x -> x = key) keymap] <- 0uy
// Check if a key is pressed
let keypad_is_pressed keypos = keystate.[keypos] = 1uy
// Check if a key is not pressed
let keypad_is_released keypos = keystate.[keypos] = 0uy
// Read a key from stdin
let keypad_read_key () = System.Console.Read ()
// Clear the video memory
let vmem_clear =
let rec recfun i =
if i < vmem.Length then vmem.[i] <- 0uy
recfun 0
// Check if a pixel is set in the video memory
let vmem_is_set pos = vmem.[pos] = 1uy
// Set a pixel in the video memory
let vmem_set_pixel pos attr = vmem.[pos] <- attr
// Clear a pixel in the video memory
let vmem_unset_pixel pos = vmem.[pos] <- 0uy
// Dump the ROM without the font map
let rom_dump (mem) = Seq.skip 0x200 mem |> Seq.toArray
// Initialize the V register
let cpu_reg_init_V () : int array = Array.zeroCreate 16
// Set a 32-bit value in the V register
let cpu_reg_set_V (V : int array) i value =
V.[i] <- value
V
let rec cpu_cycle cycle (flags : debug_option) mem PC (SB : int16) SP DT ST I (V : int array) =
if PC + 0x200s >= 4096s || PC < 0x200s then
printfn "Error: Invalid memory region!"
if flags.HasFlag debug_option.Slow then Thread.Sleep 100
let instr : uint16 = uint16 (mem_read16 mem (int PC))
let nnn : int16 = int16 instr &&& 0x0FFFs
let nn : byte = byte (instr &&& 0x00FFus)
let op : byte = byte ((instr &&& 0xF000us) >>> 12)
let x : byte = byte ((instr &&& 0x0F00us) >>> 8)
let y : byte = byte ((instr &&& 0x00F0us) >>> 4)
let n : byte = byte (instr &&& 0x000Fus)
if flags.HasFlag debug_option.Verbose then
printfn "Iter: %d" cycle
(* Program counter, Stack base, Stack pointer *)
printfn "PC : 0x%04X SB : 0x%04X SP : 0x%04X" PC SB SP
(* Delay timer, Sound timer, Index register *)
printfn "DT : 0x%04X ST : 0x%04X I : 0x%04X" DT ST I
(* Full instruction and instruction parts *)
printfn "ins : 0x%04x" instr
(*
printfn "ins : 0x%04X nnn : 0x%04X" instr nnn
printfn "nn : 0x%02X op : 0x%02X" nn op
printfn "x : 0x%02X y : 0x%02X n : 0x%02X" x y n
*)
(* V registers *)
let rec dump_v i =
if i <> 0 && i % 3 = 0 then printf "\n"
printf "V%01X : 0x%04X " i V.[i]
if i < 15 then dump_v (i + 1)
dump_v 0
(* Newline *)
printf "\n\n"
(* This should be done at 60hz *)
let dt = if DT > 0uy then DT - 1uy else DT
let st = if ST > 0uy then Task.Factory.StartNew (fun () -> System.Console.Beep (300, 100)) |> ignore; ST - 1uy; else ST
match op with
| 0x0uy ->
match nn with
| 0xEEuy -> cpu_cycle (cycle + 1UL) flags mem (mem_read16 mem (int SB + int SP)) SB SP dt st I V
| _ -> printfn "Error: Invalid opcode 0x%04x" op
| 0x1uy -> cpu_cycle (cycle + 1UL) flags mem nnn SB SP dt st I V
| 0x2uy -> cpu_cycle (cycle + 1UL) flags (mem_write16 mem (int SB + int (SP + 2uy)) PC) PC SB (SP + 2uy) dt st I V
| 0x3uy -> cpu_cycle (cycle + 1UL) flags mem (PC + 2s + if V.[int x] = int nn then 2s else 0s) SB SP dt st I V
| 0x4uy -> cpu_cycle (cycle + 1UL) flags mem (PC + 2s + if V.[int x] <> int nn then 2s else 0s) SB SP dt st I V
| 0x5uy -> cpu_cycle (cycle + 1UL) flags mem (PC + 2s + if V.[int x] = V.[int y] then 2s else 0s) SB SP dt st I V
| 0x6uy -> cpu_cycle (cycle + 1UL) flags mem (PC + 2s) SB SP dt st I (cpu_reg_set_V V (int x) (int nn))
| 0x7uy -> cpu_cycle (cycle + 1UL) flags mem (PC + 2s) SB SP dt st I (cpu_reg_set_V V (int x) (V.[int x] + (int nn)))
| 0x8uy ->
match n with
| 0x0uy -> cpu_cycle (cycle + 1UL) flags mem (PC + 2s) SB SP dt st I (cpu_reg_set_V V (int x) V.[int y])
| 0x1uy -> cpu_cycle (cycle + 1UL) flags mem (PC + 2s) SB SP dt st I (cpu_reg_set_V V (int x) (V.[int x] ||| V.[int y]))
| 0x2uy -> cpu_cycle (cycle + 1UL) flags mem (PC + 2s) SB SP dt st I (cpu_reg_set_V V (int x) (V.[int x] &&& V.[int y]))
| 0x3uy -> cpu_cycle (cycle + 1UL) flags mem (PC + 2s) SB SP dt st I (cpu_reg_set_V V (int x) (V.[int x] ^^^ V.[int y]))
| 0x4uy -> let v = cpu_reg_set_V V 0xF <| if (V.[int x] + V.[int y]) > 0xFF then 1 else 0
cpu_cycle (cycle + 1UL) flags mem (PC + 2s) SB SP dt st I (cpu_reg_set_V v (int x) ((V.[int x] + V.[int y]) &&& 0xFF))
| 0x5uy -> let v = cpu_reg_set_V V 0xF <| if V.[int x] > V.[int y] then 1 else 0
cpu_cycle (cycle + 1UL) flags mem (PC + 2s) SB SP dt st I (cpu_reg_set_V v (int x) ((V.[int x] - V.[int y]) &&& 0xFF))
| 0x6uy -> cpu_cycle (cycle + 1UL) flags mem (PC + 2s) SB SP dt st I (cpu_reg_set_V (cpu_reg_set_V V 0xF (V.[int x] &&& 1)) (int x) (V.[int x] >>> 1))
| 0x7uy -> let v = cpu_reg_set_V V 0xF <| if V.[int y] > V.[int x] then 1 else 0
cpu_cycle (cycle + 1UL) flags mem (PC + 2s) SB SP dt st I (cpu_reg_set_V v (int x) ((V.[int y] - V.[int x]) &&& 0xFF))
| 0xEuy -> let v = cpu_reg_set_V V 0xF ((V.[int x] &&& 128) >>> 7)
cpu_cycle (cycle + 1UL) flags mem (PC + 2s) SB SP dt st I (cpu_reg_set_V v (int x) (V.[int x] <<< 1))
| _ -> printfn "Error: Invalid opcode 0x%04x" op
| 0x9uy -> cpu_cycle (cycle + 1UL) flags mem (PC + 2s + if V.[int x] <> V.[int y] then 2s else 0s) SB SP dt st I V
| 0xAuy -> cpu_cycle (cycle + 1UL) flags mem (PC + 2s) SB SP dt st nnn V
| 0xBuy -> cpu_cycle (cycle + 1UL) flags mem (nnn + int16 V.[0x0]) SB SP dt st I V
| 0xCuy -> cpu_cycle (cycle + 1UL) flags mem (PC + 2s) SB SP dt st I (cpu_reg_set_V V (int x) (int (rng.NextDouble () * 255.0) &&& int nn))
| 0xDuy ->
let v = cpu_reg_set_V V 0xF 0
let rec screen_iter_y px py yy =
if yy >= int n then ()
else
let _py = (V.[int y] + yy) % SCREEN_HEIGHT
if _py < 0 || _py > SCREEN_HEIGHT then screen_iter_y px _py (yy + 1)
let rec screen_iter_x px py yy xx =
if xx >= 8 then ()
else
let _px = (V.[int x] + xx) % SCREEN_WIDTH
if _px < 0 || _px > SCREEN_WIDTH then screen_iter_x _px _py yy (xx + 1)
let _attr = (mem.[int I + yy] >>> (7 - xx)) &&& 1uy
let col = vmem.[_px + _py * 64]
if _attr > 0uy && col > 0uy then V.[0xF] <- 1
let attr = _attr ^^^ col
vmem_set_pixel <| _px + _py * 64 <| attr
screen_iter_x _px _py yy (xx + 1)
screen_iter_x px _py yy 0
screen_iter_y px _py (yy + 1)
screen_iter_y 0 0 0
cpu_cycle (cycle + 1UL) flags mem (PC + 2s) SB SP dt st I V
| 0xEuy ->
match nn with
| 0x9Euy -> cpu_cycle (cycle + 1UL) flags mem (PC + 2s + if keypad_is_pressed V.[int x] then 2s else 0s) SB SP dt st I V
| 0xA1uy -> cpu_cycle (cycle + 1UL) flags mem (PC + 2s + if keypad_is_released V.[int x] then 2s else 0s) SB SP dt st I V
| _ -> printfn "Error: Invalid opcode 0x%04x" op
| 0xFuy ->
match nn with
| 0x07uy -> cpu_cycle (cycle + 1UL) flags mem (PC + 2s) SB SP dt st I (cpu_reg_set_V V <| int x <| int dt)
| 0x0Auy -> cpu_cycle (cycle + 1UL) flags mem (PC + 2s) SB SP dt st I (cpu_reg_set_V V (int x) <| keypad_read_key ())
| 0x15uy -> cpu_cycle (cycle + 1UL) flags mem (PC + 2s) SB SP (byte V.[int x]) st I V
| 0x18uy -> cpu_cycle (cycle + 1UL) flags mem (PC + 2s) SB SP dt (byte V.[int x]) I V
| 0x1Euy -> cpu_cycle (cycle + 1UL) flags mem (PC + 2s) SB SP dt st (I + int16 V.[int x]) V
| 0x29uy -> cpu_cycle (cycle + 1UL) flags mem (PC + 2s) SB SP dt st (int16 V.[int x] * 5s) V
| 0x33uy -> let mem_s1 = mem_write8 mem <| int I <| byte V.[int x] / 100uy
let mem_s2 = mem_write8 mem_s1 <| int (I + 1s) <| (byte V.[int x] / 10uy) % 10uy
let mem_s3 = mem_write8 mem_s2 <| int (I + 2s) <| (byte V.[int x] / 100uy) % 10uy
cpu_cycle (cycle + 1UL) flags mem_s3 (PC + 2s) SB SP dt st I V
| 0x55uy ->
let rec iterfun (i : int) _mem =
if i < int x then iterfun (i + 1) (mem_write8 _mem <| int I + i <| byte V.[i])
else _mem
cpu_cycle (cycle + 1UL) flags (iterfun 0 mem) (PC + 2s) SB SP dt st I V
| 0x65uy ->
let rec iterfun (i : int) (v : int array) =
if i < int x then iterfun (i + 1) (cpu_reg_set_V v i <| int mem.[int I + i])
else v
cpu_cycle (cycle + 1UL) flags mem (PC + 2s) SB SP dt st I (iterfun 0 V)
| _ -> printfn "Error: Invalid opcode 0x%04x" op
| _ -> printfn "Error: Invalid opcode 0x%04x" op
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment