ClojureScript & Electron

├── resources ├── renderer.cljs.edn ├── nestest.nes ├── main.cljs.edn ├── package.json └── index.html ├── boot.properties ├── src ├── cljsnes │ ├── interrupts.cljs │ ├── emulator.cljs │ ├── assembler.cljs │ ├── state.cljs │ ├── arith.cljs │ ├── display.cljs │ ├── spec.cljs │ ├── cartridge.cljs │ ├── memory.cljs │ ├── opcodes.cljs │ ├── ppu.cljs │ └── cpu.cljs ├── demos │ ├── notifications.cljs │ ├── shell.cljs │ ├── filesystem.cljs │ └── badge.cljs └── app │ ├── main.cljs │ └── renderer.cljs ├── .gitignore ├── result.txt ├── README.md └── test └── cljsnes └── all_test.cljs /resources/renderer.cljs.edn: -------------------------------------------------------------------------------- 1 | {:require [app.renderer] 2 | :init-fns [app.renderer/init]} 3 | -------------------------------------------------------------------------------- /resources/nestest.nes: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/angusiguess/cljs-nes/HEAD/resources/nestest.nes -------------------------------------------------------------------------------- /resources/main.cljs.edn: -------------------------------------------------------------------------------- 1 | {:require [app.main] 2 | :init-fns [app.main/init] 3 | :compiler-options {:target :nodejs}} 4 | -------------------------------------------------------------------------------- /resources/package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name" : "electron-cljs", 3 | "version" : "0.1.0", 4 | "main" : "main.js" 5 | } 6 | -------------------------------------------------------------------------------- /boot.properties: -------------------------------------------------------------------------------- 1 | #https://github.com/boot-clj/boot 2 | #Fri Jul 31 00:07:27 CEST 2015 3 | BOOT_CLOJURE_VERSION=1.9.0-alpha14 4 | BOOT_VERSION=2.7.1 5 | -------------------------------------------------------------------------------- /src/cljsnes/interrupts.cljs: -------------------------------------------------------------------------------- 1 | (ns cljsnes.interrupts 2 | (:require [cljsnes.spec :as spec])) 3 | 4 | (defn check-interrupt [state] 5 | (get state :interrupt nil)) 6 | -------------------------------------------------------------------------------- /src/demos/notifications.cljs: -------------------------------------------------------------------------------- 1 | (ns demos.notifications) 2 | 3 | (comment 4 | (js/Notification. "Hello ClojuTRE!" (clj->js {:body "It's great to be here."})) 5 | 6 | ) 7 | -------------------------------------------------------------------------------- /src/demos/shell.cljs: -------------------------------------------------------------------------------- 1 | (ns demos.shell) 2 | 3 | (comment 4 | (def cp (js/require "child_process")) 5 | 6 | (.spawn cp "screencapture" #js ["-i" "screenshot.png"]) 7 | 8 | ) 9 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | pom.xml 2 | pom.xml.asc 3 | *jar 4 | /lib/ 5 | /classes/ 6 | /target/ 7 | /checkouts/ 8 | .lein-deps-sum 9 | .lein-repl-history 10 | .lein-plugins/ 11 | .lein-failures 12 | .nrepl-port 13 | *.DS_Store 14 | /out/ 15 | -------------------------------------------------------------------------------- /resources/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | ClojureScript & Electron 6 | 7 | 8 | 9 |

10 | 11 | 12 | 13 | -------------------------------------------------------------------------------- /src/cljsnes/emulator.cljs: -------------------------------------------------------------------------------- 1 | (ns cljsnes.emulator 2 | (:require [cljsnes.cartridge :as cart] 3 | [cljsnes.memory :as memory] 4 | [cljsnes.state :as state] 5 | [cljsnes.cpu :as cpu])) 6 | 7 | (defn init [path] 8 | (let [rom (cart/load-rom path) 9 | memory (memory/init-mem rom)] 10 | (state/init! memory))) 11 | -------------------------------------------------------------------------------- /result.txt: -------------------------------------------------------------------------------- 1 | 2 | ;; ====================================================================== 3 | ;; Testing with Node: 4 | 5 | 6 | Testing cljsnes.all-test 7 | Success! 8 | 9 | Ran 3 tests containing 3 assertions. 10 | 0 failures, 0 errors. 11 | 12 | Testing cljsnes.all-test 13 | Success! 14 | 15 | Ran 3 tests containing 3 assertions. 16 | 0 failures, 0 errors. 17 | -------------------------------------------------------------------------------- /src/demos/filesystem.cljs: -------------------------------------------------------------------------------- 1 | (ns demos.filesystem) 2 | 3 | (comment 4 | 5 | (def fs (js/require "fs")) 6 | 7 | (def path (js/require "path")) 8 | 9 | (def current-dir (.resolve path ".")) 10 | 11 | (.writeFile fs 12 | (str current-dir "/written-from-cljs.txt") 13 | "I didn't expect it to be so warm in Finland.") 14 | 15 | ) 16 | -------------------------------------------------------------------------------- /src/cljsnes/assembler.cljs: -------------------------------------------------------------------------------- 1 | (ns cljsnes.assembler 2 | (:require [clojure.string :as str] 3 | [clojure.spec :as s])) 4 | 5 | (s/def ::opcode #{"LDA"}) 6 | 7 | (defn drop-comments [s] 8 | (take-while (fn [x] (not= ";" x)) s)) 9 | 10 | (defn assemble [s] 11 | (let [lines (->> s 12 | str/split-lines 13 | (map (fn [s] (str/split s #"\s+"))))] 14 | (map drop-comments lines))) 15 | -------------------------------------------------------------------------------- /src/demos/badge.cljs: -------------------------------------------------------------------------------- 1 | (ns demos.dock) 2 | 3 | (comment 4 | ;; Code for main process 5 | (def app (js/require "app")) 6 | (def ipc (js/require "ipc")) 7 | 8 | (.on ipc "bounce-dock" (fn [event arg] 9 | (.. app -dock bounce))) 10 | (.on ipc "set-badge" (fn [event arg] 11 | (.. app -dock (setBadge arg)))) 12 | 13 | ) 14 | 15 | (comment 16 | (def ipc (js/require "ipc")) 17 | 18 | (.send ipc "bounce-dock") 19 | 20 | (.send ipc "set-badge" "122") 21 | 22 | ) 23 | -------------------------------------------------------------------------------- /src/app/main.cljs: -------------------------------------------------------------------------------- 1 | (ns app.main) 2 | 3 | (def electron (js/require "electron")) 4 | (def app (.-app electron)) 5 | (def BrowserWindow (.-BrowserWindow electron)) 6 | 7 | (goog-define dev? false) 8 | 9 | (defn load-page 10 | "When compiling with `:none` the compiled JS that calls .loadURL is 11 | in a different place than it would be when compiling with optimizations 12 | that produce a single artifact (`:whitespace, :simple, :advanced`). 13 | 14 | Because of this we need to dispatch the loading based on the used 15 | optimizations, for this we defined `dev?` above that we can override 16 | at compile time using the `:clojure-defines` compiler option." 17 | [window] 18 | (if dev? 19 | (.loadURL window (str "file://" js/__dirname "/../../index.html")) 20 | (.loadURL window (str "file://" js/__dirname "/index.html")))) 21 | 22 | (def main-window (atom nil)) 23 | 24 | (defn mk-window [w h frame? show?] 25 | (BrowserWindow. #js {:width w :height h :frame frame? :show show?})) 26 | 27 | (defn init-browser [] 28 | (reset! main-window (mk-window 800 600 true true)) 29 | (load-page @main-window) 30 | (if dev? (.openDevTools @main-window)) 31 | (.on @main-window "closed" #(reset! main-window nil))) 32 | 33 | (defn init [] 34 | (.on app "window-all-closed" #(when-not (= js/process.platform "darwin") (.quit app))) 35 | (.on app "ready" init-browser) 36 | (set! *main-cli-fn* (fn [] nil))) 37 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Electron & ClojureScript 2 | 3 | This repository contains an Electron app written in ClojureScript. In 4 | contrast to other examples out there this one uses ClojureScript for 5 | both parts of the Electron app: the main process and the renderer. 6 | 7 | #### Development 8 | 9 | For development you can start the compiler with `boot watch dev-build`. 10 | This will incrementally compile ClojureScript sources, push changes to your 11 | running Electron app and provide a REPL connection 12 | ([docs](https://github.com/adzerk-oss/boot-cljs-repl))into the app. 13 | 14 | You can start the electron process using 15 | [electron-prebuilt](https://github.com/mafintosh/electron-prebuilt) or 16 | using a downloaded `Electron.app` package: 17 | 18 | ``` 19 | electron target/ # Do not omit the trailing '/' 20 | ``` 21 | 22 | The `build.boot` file is annotated so you can exactly understand 23 | what's happening. When you make changes to the main process (the 24 | `app.main` namespace) you will need to restart the 25 | application. Probably automatic reloading could be added here too but 26 | changes are the main process are not as frequent so I didn't bother 27 | too much. 28 | 29 | #### Packaging the app 30 | 31 | The easiest way to package an electron app is by using 32 | [`electron-packager`](https://github.com/maxogden/electron-packager): 33 | 34 | ``` 35 | electron-packager target/ MyApp --platform=darwin --arch=x64 --version=0.31.2 36 | ``` 37 | -------------------------------------------------------------------------------- /src/cljsnes/state.cljs: -------------------------------------------------------------------------------- 1 | (ns cljsnes.state 2 | (:require [cljsnes.spec :as spec] 3 | [reagent.ratom :as r] 4 | [cljsnes.cpu :as cpu] 5 | [cljsnes.ppu :as ppu] 6 | [clojure.spec :as s])) 7 | 8 | (defonce state (r/atom nil)) 9 | 10 | (defonce save-state (r/atom nil)) 11 | 12 | (defn make-buffer 13 | ([] 14 | (make-buffer 0x00)) 15 | ([colour] 16 | (let [row (into [] (repeat 257 colour))] 17 | (into [] (repeat 225 row))))) 18 | 19 | (defn init-state [memory] 20 | {:order [:ppu :ppu :ppu :cpu] 21 | :cpu {:a 0 22 | :x 0 23 | :y 0 24 | :pc 0 25 | :s 0xFD 26 | :c 0 27 | :z 0 28 | :i 1 29 | :d 0 30 | :b 0 31 | :u 0 32 | :v 0 33 | :n 0 34 | :cycles 0 35 | :ticks 0 36 | :nmi 0 37 | :irq 0 38 | :reset 0} 39 | :memory memory 40 | :ppu {:cycle 0 41 | :line 0 42 | :write-address-low 0 43 | :write-address-high 0 44 | :write-started false 45 | :nmi-enable true} 46 | :display {:front (make-buffer 0x26) 47 | :back (make-buffer 0x27)}}) 48 | 49 | (defn get-order [state] 50 | (get state :order)) 51 | 52 | (defn step-order [state] 53 | (update state :order #(into [] 54 | (take 4 (drop 1 (cycle %)))))) 55 | 56 | (defn init-vectors [state] 57 | (let [cpu-mem (get state :memory)] 58 | (-> state 59 | (assoc-in [:cpu :nmi] (cpu/get-address cpu-mem 0xFFFA)) 60 | (assoc-in [:cpu :reset] (cpu/get-address cpu-mem 0xFFFC)) 61 | (assoc-in [:cpu :irq] (cpu/get-address cpu-mem 0xFFFE)) 62 | (assoc-in [:cpu :pc] (cpu/get-address cpu-mem 0xFFFC))))) 63 | 64 | (defn init! [memory] 65 | (reset! state (init-vectors 66 | (init-state memory)))) 67 | 68 | (defn step! [] 69 | (let [next (first (get-order @state))] 70 | (if (= :ppu next) (swap! state (comp step-order ppu/step)) 71 | (swap! state (comp step-order cpu/step))))) 72 | 73 | (defn save-state! [] 74 | (reset! save-state @state)) 75 | 76 | (defn load-state! [] 77 | (reset! state @save-state)) 78 | -------------------------------------------------------------------------------- /src/cljsnes/arith.cljs: -------------------------------------------------------------------------------- 1 | (ns cljsnes.arith 2 | (:require [cljs.spec :as s]) 3 | (:refer-clojure :exclude [inc dec])) 4 | 5 | (s/def ::byte (s/int-in 0 256)) 6 | 7 | (s/def ::address (s/int-in 0 65536)) 8 | 9 | (s/def ::carry-bit #{0 1}) 10 | 11 | ;; Some addition fns 12 | (defn add 13 | ([] [0 0]) 14 | ([x] [x 0]) 15 | ([x y] 16 | (let [sum (+ x y) 17 | masked-sum (bit-and 0xFF sum) 18 | carry (if (bit-test sum 8) 1 0)] 19 | [masked-sum carry])) 20 | ([x y z] 21 | (let [[sum carry] (add x y)] 22 | (add sum z)))) 23 | 24 | (defn inc [x] 25 | (add x 1)) 26 | 27 | (defn sub 28 | ([] [0 0]) 29 | ([x] [x]) 30 | ([x y] 31 | (let [negated-y (bit-and 0xFF (+ 1 (bit-not y)))] 32 | (add x negated-y))) 33 | ([x y z] 34 | (let [[diff carry] (sub x y)] 35 | (sub diff z)))) 36 | 37 | (defn dec [x] 38 | (sub x 1)) 39 | 40 | (defn make-address [lower upper] 41 | (+ lower (bit-shift-left upper 8))) 42 | 43 | (defn address->bytes [address] 44 | (let [mask-high 0xFF00 45 | mask-low 0xFF] 46 | [(bit-and mask-low address) 47 | (bit-shift-right (bit-and mask-high address) 8)])) 48 | 49 | (s/fdef make-address 50 | :args (s/cat :lower ::byte :upper ::byte) 51 | :ret ::address) 52 | 53 | (s/fdef add 54 | :args (s/cat :x (s/? ::byte) :y (s/? ::byte) :z (s/? ::byte)) 55 | :ret (s/cat :sum ::byte :carry ::carry-bit)) 56 | 57 | (s/fdef inc 58 | :args (s/cat :x ::byte) 59 | :ret (s/cat :sum ::byte :carry ::carry-bit)) 60 | 61 | ;; Negative? 62 | 63 | (defn neg-byte? [x] 64 | (bit-test x 7)) 65 | 66 | (s/fdef neg-byte? 67 | :args (s/cat :x nat-int?) 68 | :ret boolean?) 69 | 70 | 71 | 72 | ;; Logical Shifts 73 | 74 | (defn asl [x] 75 | (let [shifted (bit-shift-left x 1) 76 | masked (bit-and shifted 255) 77 | carry (if (bit-test shifted 8) 1 0)] 78 | [masked carry])) 79 | 80 | (s/fdef asl 81 | :args (s/cat :x ::byte) 82 | :fn #(or (>= (-> % :ret :shifted) (-> % :args :x)) 83 | (= (-> % :ret :carry) 1)) 84 | :ret (s/cat :shifted ::byte :carry ::carry-bit)) 85 | 86 | (defn lsr [x] 87 | (let [shifted (bit-shift-right x 1) 88 | carry (if (bit-test x 0) 1 0)] 89 | [shifted carry])) 90 | 91 | (s/fdef lsr 92 | :args (s/cat :x ::byte) 93 | :fn #(or (<= (-> % :ret :shifted) (-> % :args :x)) 94 | (= (-> % :ret :carry) 1)) 95 | :ret (s/cat :shifted ::byte :carry ::carry-bit)) 96 | 97 | (defn unsigned->signed [x] 98 | (let [mask 128] 99 | (+ (- (bit-and x mask)) 100 | (bit-and x (bit-not mask))))) 101 | 102 | ;; Logical ops 103 | 104 | (defn l-and [x y] 105 | (bit-and x y)) 106 | 107 | (s/fdef l-and 108 | :args (s/cat :x ::byte :y ::byte) 109 | :ret ::byte) 110 | 111 | (defn l-or [x y] 112 | (bit-or x y)) 113 | 114 | (s/fdef l-or 115 | :args (s/cat :x ::byte :y ::byte) 116 | :ret ::byte) 117 | 118 | (defn l-xor [x y] 119 | (bit-xor x y)) 120 | 121 | (s/fdef l-xor 122 | :args (s/cat :x ::byte :y ::byte) 123 | :ret ::byte) 124 | -------------------------------------------------------------------------------- /src/cljsnes/display.cljs: -------------------------------------------------------------------------------- 1 | (ns cljsnes.display 2 | (:require [clojure.pprint :as pprint])) 3 | 4 | (enable-console-print!) 5 | 6 | (def palette [#_0x00 [0x75 0x75 0x75] 7 | #_0x01 [0x27 0x1B 0x8F] 8 | #_0x02 [0x00 0x00 0xAB] 9 | #_0x03 [0x47 0x00 0x9F] 10 | #_0x04 [0x8F 0x00 0x77] 11 | #_0x05 [0xAB 0x00 0x13] 12 | #_0x06 [0xA7 0x00 0x00] 13 | #_0x07 [0x7F 0x0B 0x00] 14 | #_0x08 [0x43 0x2F 0x00] 15 | #_0x09 [0x00 0x47 0x00] 16 | #_0x0A [0x00 0x51 0x00] 17 | #_0x0B [0x00 0x3F 0x17] 18 | #_0x0C [0x1B 0x3F 0x5F] 19 | #_0x0D [0x00 0x00 0x00] 20 | #_0x0E [0x00 0x00 0x00] 21 | #_0x0F [0x00 0x00 0x00] 22 | #_0x10 [0xBC 0xBC 0xBC] 23 | #_0x11 [0x00 0x73 0xEF] 24 | #_0x12 [0x23 0x3B 0xEF] 25 | #_0x13 [0x83 0x00 0xF3] 26 | #_0x14 [0xBF 0x00 0xBF] 27 | #_0x15 [0xE7 0x00 0x5B] 28 | #_0x16 [0xDB 0x2B 0x00] 29 | #_0x17 [0xCB 0x4F 0x0F] 30 | #_0x18 [0x8B 0x73 0x00] 31 | #_0x19 [0x00 0x97 0x00] 32 | #_0x1A [0x00 0xAB 0x00] 33 | #_0x1B [0x00 0x93 0x3B] 34 | #_0x1C [0x00 0x83 0x8B] 35 | #_0x1D [0x00 0x00 0x00] 36 | #_0x1E [0x00 0x00 0x00] 37 | #_0x1F [0x00 0x00 0x00] 38 | #_0x20 [0xFF 0xFF 0xFF] 39 | #_0x21 [0x3F 0xBF 0xFF] 40 | #_0x22 [0x5F 0x97 0xFF] 41 | #_0x23 [0xA7 0x8B 0xFD] 42 | #_0x24 [0xF7 0x7B 0xFF] 43 | #_0x25 [0xFF 0x77 0xB7] 44 | #_0x26 [0xFF 0x77 0x63] 45 | #_0x27 [0xFF 0x9B 0x3B] 46 | #_0x28 [0xF3 0xBF 0x3F] 47 | #_0x29 [0x83 0xD3 0x13] 48 | #_0x2A [0x4F 0xDF 0x4B] 49 | #_0x2B [0x58 0xF8 0x98] 50 | #_0x2C [0x00 0xEB 0xDB] 51 | #_0x2D [0x00 0x00 0x00] 52 | #_0x2E [0x00 0x00 0x00] 53 | #_0x2F [0x00 0x00 0x00] 54 | #_0x30 [0xFF 0xFF 0xFF] 55 | #_0x31 [0xAB 0xE7 0xFF] 56 | #_0x32 [0xC7 0xD7 0xFF] 57 | #_0x33 [0xD7 0xCB 0xFF] 58 | #_0x34 [0xFF 0xC7 0xFF] 59 | #_0x35 [0xFF 0xC7 0xDB] 60 | #_0x36 [0xFF 0xBF 0xB3] 61 | #_0x37 [0xFF 0xDB 0xAB] 62 | #_0x38 [0xFF 0xE7 0xA3] 63 | #_0x39 [0xE3 0xFF 0xA3] 64 | #_0x3A [0xAB 0xF3 0xBF] 65 | #_0x3B [0xB3 0xFF 0xCF] 66 | #_0x3C [0x9F 0xFF 0xF3] 67 | #_0x3D [0x00 0x00 0x00] 68 | #_0x3E [0x00 0x00 0x00] 69 | #_0x3F [0x00 0x00 0x00]]) 70 | 71 | (def palette-a (apply array (map #(apply array %) palette))) 72 | 73 | (defn render-frame [buffer ctx] 74 | (when ctx 75 | (let [image-data (.createImageData ctx 256 224) 76 | data (.-data image-data)] 77 | (loop [x 0 78 | y 0] 79 | (let [rgb (aget palette-a (get-in buffer [y x])) 80 | r (aget rgb 0) 81 | g (aget rgb 1) 82 | b (aget rgb 2) 83 | idx (* 4 (+ x (* y 256)))] 84 | (aset data idx r) 85 | (aset data (+ idx 1) g) 86 | (aset data (+ idx 2) b) 87 | (aset data (+ idx 3) 0xFF)) 88 | (if (not (and (= x 256) (= y 224))) 89 | (recur (if (= x 256) 0 (inc x)) (if (do (= x 256)) (inc y) y)))) 90 | (.putImageData ctx image-data 0 0)))) 91 | -------------------------------------------------------------------------------- /src/cljsnes/spec.cljs: -------------------------------------------------------------------------------- 1 | (ns cljsnes.spec 2 | (:require [clojure.spec :as s] 3 | [cljsnes.memory :as memory] 4 | [clojure.test.check.generators :as gen])) 5 | 6 | (s/def ::bit #{0 1}) 7 | 8 | (s/def ::byte (s/int-in 0 256)) 9 | 10 | (s/def ::address (s/int-in 0 65536)) 11 | 12 | ;; CPU 13 | 14 | (s/def :cpu/a ::byte) 15 | 16 | (s/def :cpu/x ::byte) 17 | 18 | (s/def :cpu/y ::byte) 19 | 20 | (s/def :cpu/pc ::address) 21 | 22 | (s/def :cpu/s ::byte) 23 | 24 | (s/def :cpu/n ::bit) 25 | 26 | (s/def :cpu/c ::bit) 27 | 28 | (s/def :cpu/z ::bit) 29 | 30 | (s/def :cpu/i ::bit) 31 | 32 | (s/def :cpu/d ::bit) 33 | 34 | (s/def :cpu/u ::bit) 35 | 36 | (s/def :cpu/v ::bit) 37 | 38 | (s/def :cpu/n ::bit) 39 | 40 | (s/def :cpu/cycles (s/int-in 0 1000000000)) 41 | 42 | (s/def :cpu/ticks (s/int-in 0 8192)) 43 | 44 | (s/def :cpu/nmi ::byte) 45 | 46 | (s/def :cpu/irq ::byte) 47 | 48 | (s/def :cpu/reset ::byte) 49 | 50 | (s/def :cpu/status (s/keys :req-un [:cpu/n :cpu/v :cpu/d 51 | :cpu/i :cpu/z :cpu/c])) 52 | 53 | (s/def :state/cpu (s/keys :req-un [:cpu/a :cpu/x :cpu/pc :cpu/s :cpu/c 54 | :cpu/z :cpu/i :cpu/d :cpu/u 55 | :cpu/v :cpu/n :cpu/cycles :cpu/ticks 56 | :cpu/memory])) 57 | 58 | ;; PPU 59 | 60 | (s/def :ppu/frame-parity boolean?) 61 | 62 | (s/def :ppu/cycle (s/int-in 0 341)) 63 | 64 | (s/def :ppu/scan-line (s/int-in 0 262)) 65 | 66 | (s/def :ppu/frame nat-int?) 67 | 68 | ;; PPU CTRL $2000 69 | 70 | (s/def :ppu/nmi-enable boolean?) 71 | 72 | (s/def :ppu/ppu-master boolean?) 73 | 74 | (s/def :ppu/sprite-height boolean?) 75 | 76 | (s/def :ppu/background-tile-select boolean?) 77 | 78 | (s/def :ppu/increment-mode boolean?) 79 | 80 | (s/def :ppu/nametable-select #{0 1 2 3}) 81 | 82 | ;; PPU MASK $2001 83 | 84 | (s/def :ppu/colour-emphasis-red boolean?) 85 | 86 | (s/def :ppu/colour-emphasis-green boolean?) 87 | 88 | (s/def :ppu/colour-emphasis-blue boolean?) 89 | 90 | (s/def :ppu/sprite-enable boolean?) 91 | 92 | (s/def :ppu/background-enable boolean?) 93 | 94 | (s/def :ppu/sprite-column-left boolean?) 95 | 96 | (s/def :ppu/background-left-column-enable boolean?) 97 | 98 | (s/def :ppu/greyscale boolean?) 99 | 100 | ;; PPU STATUS $2002 101 | 102 | (s/def :ppu/vblank boolean?) 103 | 104 | (s/def :ppu/sprite-zero-hit boolean?) 105 | 106 | (s/def :ppu/sprite-overflow boolean?) 107 | 108 | (s/def :ppu/oam-addr ::byte) 109 | 110 | (s/def :ppu/oam-data ::byte) 111 | 112 | (s/def :ppu/ppu-scroll ::byte) 113 | 114 | (s/def :ppu/ppu-addr ::byte) 115 | 116 | (s/def :ppu/ppu-data ::byte) 117 | 118 | (s/def :ppu/oam-data ::byte) 119 | 120 | (s/def :ppu/rgb (s/int-in 0x000000 0x1000000)) 121 | 122 | (s/def :ppu/display (s/coll-of :ppu/rgb 123 | :count 61440 124 | :into [])) 125 | 126 | (s/def ::ppu (s/keys :req-un [:ppu/cycle :ppu/scan-line :ppu/frame 127 | :ppu/nmi-enable :ppu/master :ppu/sprite-height 128 | :ppu/background-tile-select :ppu/increment-mode 129 | :ppu/colour-emphasis-red :ppu/colour-emphasis-green 130 | :ppu/colour-emphasis-blue :ppu/sprite-column-left 131 | :ppu/background-left-column-enable :ppu/vblank 132 | :ppu/sprite-zero-hit :ppu/sprite-overflow 133 | :ppu/oam-addr :ppu/oam-data :ppu/ppu-scroll 134 | :ppu/ppu-addr :ppu/ppu-data :ppu/oam-data])) 135 | 136 | ;; Interrupts 137 | 138 | (s/def :interrupt/interrupt #{:nmi :reset :irq}) 139 | 140 | ;; State 141 | 142 | (s/def ::state (s/keys :req-un [:state/cpu :state/ppu])) 143 | -------------------------------------------------------------------------------- /src/app/renderer.cljs: -------------------------------------------------------------------------------- 1 | (ns app.renderer 2 | (:require [reagent.core :as r] 3 | [cljs.spec :as s] 4 | [cljs.core.async :as a] 5 | [cljsnes.state :as state] 6 | [cljsnes.spec :as spec] 7 | [clojure.pprint :as pprint] 8 | [cljsnes.cpu :as cpu] 9 | [cljsnes.display :as display] 10 | [cljsnes.emulator :as emulator] 11 | [cljsnes.assembler :as assembler] 12 | [cljsnes.cartridge :as cartridge] 13 | [cljsnes.memory :as memory] 14 | [cljsnes.opcodes :as opcodes]) 15 | (:require-macros [cljs.core.async.macros :refer [go go-loop]])) 16 | 17 | (enable-console-print!) 18 | 19 | (def front (r/cursor state/state [:display :front])) 20 | 21 | (def buffer (r/cursor state/state [:display])) 22 | 23 | (def ppu-cycles (r/cursor state/state [:ppu :cycle])) 24 | 25 | (def ppu-line (r/cursor state/state [:ppu :line])) 26 | 27 | (def cpu-cycles (r/cursor state/state [:cpu :cycles])) 28 | 29 | (def zero-flag (r/cursor state/state [:cpu :z])) 30 | 31 | (defonce stop-chan (a/chan)) 32 | 33 | (defn swap-buffers [] 34 | (swap! state/state update :display (fn [{:keys [front back] :as state}] 35 | (assoc state :front back 36 | :back front)))) 37 | 38 | (defn swap-button [] 39 | [:div [:input {:type "button" 40 | :value "Swap buffer!" 41 | :on-click #(swap-buffers)}]]) 42 | 43 | (defn init-button [] 44 | [:div [:input {:type "button" 45 | :value "Init State!" 46 | :on-click #(emulator/init "/Users/angusiguess/Downloads/Super Mario Bros. (Japan, USA).nes")}]]) 47 | 48 | (defn step-button [] 49 | [:div [:input {:type "button" 50 | :value "Step State!" 51 | :on-click #(state/step!)}]]) 52 | 53 | (defn stop-button [] 54 | [:div [:input {:type "button" 55 | :value "Stop state!" 56 | :on-click #(a/put! stop-chan :stop)}]]) 57 | 58 | (defn run-button [] 59 | [:div [:input {:type "button" 60 | :value "Run state!" 61 | :on-click #(go-loop [] 62 | (let [[v ch] (a/alts! [stop-chan (go 1)])] 63 | (when (not= ch stop-chan) 64 | (state/step!) 65 | (recur))))}]]) 66 | 67 | (defn save-state [] 68 | [:div [:input {:type "button" 69 | :value "Save state" 70 | :on-click #(state/save-state!)}]]) 71 | 72 | (defn load-state [] 73 | [:div [:input {:type "button" 74 | :value "Load state" 75 | :on-click #(state/load-state!)}]]) 76 | 77 | (defn cpu-cycle [] 78 | [:div [:p "CPU Cycles: " @cpu-cycles]]) 79 | 80 | (defn ppu-cycle [] 81 | [:div [:p "PPU Cycles: " @ppu-cycles] 82 | [:p "PPU Line: " @ppu-line]]) 83 | 84 | (defn cpu-pc [] 85 | (let [cursor (r/cursor state/state [:cpu :pc])] 86 | [:div [:p "Program Counter: " (pprint/cl-format nil "~x" @cursor)]])) 87 | 88 | (defn cpu-registers [] 89 | (let [a (r/cursor state/state [:cpu :a]) 90 | x (r/cursor state/state [:cpu :x]) 91 | y (r/cursor state/state [:cpu :y]) 92 | i (r/cursor state/state [:cpu :i]) 93 | s (r/cursor state/state [:cpu :s]) 94 | z (r/cursor state/state [:cpu :z])] 95 | [:div [:p "A: " @a " X: " @x " Y: " @y " I: " @i] 96 | [:p "Stack Pointer: " @s] 97 | [:z "Zero? " @z]])) 98 | 99 | (defn display-component [] 100 | @front 101 | (when-let [elem (.getElementById js/document "display")] 102 | (let [context (.getContext elem "2d")] 103 | (display/render-frame @front context))) 104 | [:div 105 | [:canvas {:width 256 :height 224 :id :display}]]) 106 | 107 | (defn container [] 108 | [:div 109 | (display-component) 110 | (swap-button) 111 | (init-button) 112 | (step-button) 113 | (save-state) 114 | (load-state) 115 | (run-button) 116 | (stop-button) 117 | (ppu-cycle) 118 | (cpu-cycle) 119 | (cpu-pc) 120 | (cpu-registers)]) 121 | 122 | (defn init [] 123 | (r/render-component [container] 124 | (.getElementById js/document "container")) 125 | (js/console.log "Starting Application")) 126 | -------------------------------------------------------------------------------- /src/cljsnes/cartridge.cljs: -------------------------------------------------------------------------------- 1 | (ns cljsnes.cartridge 2 | (:require [cljs.nodejs :as node] 3 | [clojure.string :as str] 4 | [cljs.reader :as reader] 5 | [clojure.spec :as s])) 6 | 7 | (def fs (node/require "fs")) 8 | 9 | (def buffer (node/require "buffer")) 10 | 11 | (def util (node/require "util")) 12 | 13 | (def Buffer (.-Buffer buffer)) 14 | 15 | (s/def :cart/rom-banks (s/int-in 2 9)) 16 | 17 | (s/def :cart/vrom-banks (s/int-in 1 11)) 18 | 19 | (s/def :cart/vrom-bank-bytes (s/coll-of (s/coll-of 20 | (s/int-in 0 256) :into []) 21 | :into [])) 22 | 23 | (s/def :cart/rom-bank-bytes (s/coll-of (s/coll-of (s/int-in 0 256) 24 | :into []) 25 | :into [])) 26 | 27 | (s/def :cart/vertical-mirroring boolean?) 28 | 29 | 30 | 31 | 32 | (defn stat-file [path] 33 | (.statSync fs path)) 34 | 35 | (defn get-size [stat] 36 | (aget stat "size")) 37 | 38 | (defn open-file [path] 39 | (.openSync fs path "r")) 40 | 41 | (defn read-file-sync [path] 42 | (let [] 43 | (.readFileSync fs path "utf-8"))) 44 | 45 | (defn read-file [path] 46 | (let [fd (open-file path) 47 | size (-> path 48 | stat-file 49 | get-size) 50 | buf (.alloc Buffer size)] 51 | (.readSync fs fd buf 0 size) 52 | (into [] (es6-iterator-seq (.values buf))))) 53 | 54 | (defn get-opts-one [byte] 55 | (let [bits (map #(if (bit-test byte %) 1 0) (range 8)) 56 | [vertical-mirroring battery-ram trainer four-screen 57 | & mapper-lower] bits] 58 | {:vertical-mirroring (pos? vertical-mirroring) 59 | :battery-ram (pos? battery-ram) 60 | :trainer (pos? trainer) 61 | :four-screen (pos? four-screen) 62 | :mapper-lower (into [] mapper-lower)})) 63 | 64 | (defn get-opts-two [byte] 65 | (let [bits (map #(if (bit-test byte %) 1 0) (range 8)) 66 | [vs-system _ _ _ & mapper-upper] bits] 67 | {:vs-system (pos? vs-system) 68 | :mapper-upper (into [] mapper-upper)})) 69 | 70 | (defn pal? [byte] 71 | (bit-test byte 0)) 72 | 73 | (defn get-mapper [cart] 74 | (let [lower (get cart :mapper-lower) 75 | upper (get cart :mapper-upper)] 76 | (assoc cart :mapper (reader/read-string (str 77 | "2r" 78 | (str/join upper) 79 | (str/join lower)))))) 80 | 81 | (defn parse-headers 82 | "This table was cribbed from http://fms.komkon.org/EMUL8/NES.html#LABM 83 | Byte Contents 84 | --------------------------------------------------------------------------- 85 | 0-3 String \"NES^Z\" used to recognize .NES files. 86 | 4 Number of 16kB ROM banks. 87 | 5 Number of 8kB VROM banks. 88 | 6 bit 0 1 for vertical mirroring, 0 for horizontal mirroring. 89 | bit 1 1 for battery-backed RAM at $6000-$7FFF. 90 | bit 2 1 for a 512-byte trainer at $7000-$71FF. 91 | bit 3 1 for a four-screen VRAM layout. 92 | bit 4-7 Four lower bits of ROM Mapper Type. 93 | 7 bit 0 1 for VS-System cartridges. 94 | bit 1-3 Reserved, must be zeroes! 95 | bit 4-7 Four higher bits of ROM Mapper Type. 96 | 8 Number of 8kB RAM banks. For compatibility with the previous 97 | versions of the .NES format, assume 1x8kB RAM page when this 98 | byte is zero. 99 | 9 bit 0 1 for PAL cartridges, otherwise assume NTSC. 100 | bit 1-7 Reserved, must be zeroes! 101 | 10-15 Reserved, must be zeroes! 102 | 16-... ROM banks, in ascending order. If a trainer is present, its 103 | 512 bytes precede the ROM bank contents. 104 | ...-EOF VROM banks, in ascending order." 105 | [rom] 106 | (let [header (subvec rom 0 4) 107 | rom-banks (get rom 4) 108 | chr-banks (get rom 5) 109 | opts-one (get rom 6) 110 | opts-two (get rom 7) 111 | ram-banks (get rom 8) 112 | pal (pal? (get rom 9)) 113 | rom-offset (+ 16 (* 16384 rom-banks)) 114 | chr-offset (+ rom-offset (* 8192 chr-banks))] 115 | (assert (= header [78 69 83 26])) 116 | (-> {:header header 117 | :rom-banks rom-banks 118 | :chr-banks chr-banks 119 | :ram-banks ram-banks 120 | :pal pal 121 | :rom-bank-bytes (mapv (partial into []) 122 | (partition 16384 123 | (subvec rom 16 rom-offset))) 124 | :chr-bank-bytes (mapv (partial into []) 125 | (partition 8192 126 | (subvec rom 127 | rom-offset 128 | chr-offset))) 129 | :count (count rom)} 130 | (merge (get-opts-one opts-one) 131 | (get-opts-two opts-two)) 132 | get-mapper))) 133 | 134 | (defn load-rom [path] 135 | (-> (read-file path) 136 | parse-headers)) 137 | -------------------------------------------------------------------------------- /test/cljsnes/all_test.cljs: -------------------------------------------------------------------------------- 1 | (ns cljsnes.all-test 2 | (:require [cljs.test :refer [deftest is testing run-tests]] 3 | [cljs.spec :as s] 4 | [cljs.pprint :as pprint] 5 | [cljs.spec.test :as stest] 6 | [cljsnes.state :as state] 7 | [cljsnes.cartridge :as cart] 8 | [cljsnes.memory :as memory] 9 | [cljsnes.arith :as arith] 10 | [cljsnes.opcodes :as opcodes] 11 | [cljsnes.ppu :as ppu] 12 | [cljsnes.cpu :as cpu])) 13 | 14 | (enable-console-print!) 15 | 16 | (defn summarize-results' [spec-check] 17 | (map (comp #(pprint/write % :stream nil) stest/abbrev-result) spec-check)) 18 | 19 | (defn check' [spec-check] 20 | (is (empty? (->> spec-check 21 | (filter :failure))) (summarize-results' spec-check))) 22 | 23 | 24 | (deftest byte-arithmetic 25 | (check' (stest/check [`arith/add 26 | `arith/inc 27 | `arith/neg-byte? 28 | `arith/asl 29 | `arith/lsr 30 | `arith/l-and 31 | `arith/l-or 32 | `arith/l-xor 33 | `arith/make-address]))) 34 | 35 | (deftest cpu-ops 36 | (check' (stest/check [#_`cpu/push-8 37 | #_`cpu/pop-8 38 | #_`cpu/push-16 39 | #_`cpu/status->byte 40 | `cpu/byte->status]))) 41 | 42 | (deftest opcodes-conform 43 | (is (nil? (s/explain :opcode/ops opcodes/ops)))) 44 | 45 | (deftest ppu-ticks-cycle 46 | (testing "cycle increment" 47 | (let [state (ppu/step {:ppu {:cycle 0 :line 0}})] 48 | (is (= 1 (get-in state [:ppu :cycle])))) 49 | (testing "cycle wrap" 50 | (let [state (ppu/step {:ppu {:cycle 340 :line 10}})] 51 | (is (= 0 (get-in state [:ppu :cycle]))) 52 | (is (= 11 (get-in state [:ppu :line]))))) 53 | (testing "cycle-and-line-wrap" 54 | (let [state (ppu/step {:ppu {:cycle 340 :line 261}})] 55 | (is (= 0 (get-in state [:ppu :cycle])) 56 | (= 0 (get-in state [:ppu :line]))))))) 57 | 58 | (deftest cpu-stack-test 59 | (let [memory (memory/make-nrom [[]] [[]] [[]] [[]] false) 60 | state {:cpu {:s 0xFF} 61 | :memory memory}] 62 | (testing "push-8 pop-8" 63 | (let [pushed-state (cpu/push-8 state 0xBB)] 64 | (is (= 0xFE (get-in pushed-state [:cpu :s]))) 65 | (is (= 0xBB (first (cpu/pop-8 pushed-state)))) 66 | (is (= 0xFF (-> (cpu/pop-8 pushed-state) 67 | last 68 | (get-in [:cpu :s])))))) 69 | (testing "push-16 pop-16" 70 | (let [pushed-state (cpu/push-16 state 0xBBCC)] 71 | (is (= 0xFD (get-in pushed-state [:cpu :s]))) 72 | (is (= 0xBBCC (first (cpu/pop-16 pushed-state)))) 73 | (is (= 0xFF (-> (cpu/pop-16 pushed-state) 74 | last 75 | (get-in [:cpu :s])))))))) 76 | 77 | (deftest ppu-registers-shared 78 | (let [memory (memory/make-nrom [[]] [[]] [[]] [[]] false)] 79 | (testing "Shared registers" 80 | (doseq [address (range 0x2000 0x2008)] 81 | (is (= 0xBB (-> memory 82 | (memory/cpu-write address 0xBB) 83 | (memory/ppu-read address)))) 84 | (is (= 0xBB (-> memory 85 | (memory/ppu-write address 0xBB) 86 | (memory/cpu-read address)))))))) 87 | 88 | (deftest status-read 89 | (is (cpu/ppu-status-read? {:resolved-address 0x2002})) 90 | (is (false? (cpu/ppu-status-read? {})))) 91 | 92 | (deftest control-write 93 | (let [state {:memory (memory/make-nrom [[]] [[]] [[]] [[]] false) 94 | :ppu {:t 0}}] 95 | (is (cpu/ppu-control-write? {:resolved-address 0x2000})) 96 | (is (= 3072 (get-in (ppu/write-control state 0xFF) [:ppu :t]))))) 97 | 98 | (deftest ppu-read-status 99 | (let [state {:memory (memory/make-nrom [[]] [[]] [[]] [[]] false) 100 | :ppu {:write-address-low 0xBB 101 | :write-address-high 0xCC 102 | :w true}} 103 | after-read (ppu/read-status state)] 104 | (is (= false (get-in after-read [:ppu :w]))))) 105 | 106 | (deftest ppu-write-scroll 107 | (let [state {:memory (memory/make-nrom [[]] [[]] [[]] [[]] false) 108 | :ppu {:t 0 109 | :x 0 110 | :w false}} 111 | first-write (ppu/write-register-scroll state 0xFF) 112 | second-write (ppu/write-register-scroll first-write 0xFF)] 113 | (is (get-in first-write [:ppu :w])) 114 | (is (= 0x07 (get-in first-write [:ppu :x]))) 115 | (is (= 31 (get-in first-write [:ppu :t]))) 116 | (is (not (get-in second-write [:ppu :w]))) 117 | (is (= 2r111001111111111 (get-in second-write [:ppu :t]))))) 118 | 119 | (deftest ppu-write-address 120 | (let [state {:memory (memory/make-nrom [[]] [[]] [[]] [[]] false) 121 | :ppu {:t 0 122 | :x 0 123 | :w false}} 124 | first-write (ppu/write-register-address state 0xFF) 125 | second-write (ppu/write-register-address first-write 0xFF)] 126 | (is (get-in first-write [:ppu :w])) 127 | (is (= 2r011111100000000 (get-in first-write [:ppu :t]))) 128 | (is (not (get-in second-write [:ppu :w]))) 129 | (is (= 2r011111111111111 (get-in second-write [:ppu :t]))) 130 | (is (= 2r011111111111111 (get-in second-write [:ppu :v]))))) 131 | 132 | (deftest ppu-write-data 133 | (let [state {:memory (memory/make-nrom [[]] [[]] [[]] [[]] false) 134 | :ppu {:t 0 135 | :v 0x2009 136 | :x 0 137 | :w false}} 138 | first-write (ppu/write-register-data state 0xFF) 139 | memory (get first-write :memory)] 140 | (is (= 0x200A (get-in first-write [:ppu :v]))) 141 | (is (= 0xFF (memory/ppu-read memory 0x2009))))) 142 | 143 | (deftest coarse-x 144 | (let [v 0] 145 | (testing "regular increment" 146 | (let [first-increment (ppu/coarse-x-increment v)] 147 | (is (= 1 first-increment)))) 148 | (testing "tile increment" 149 | (let [tile-increment (ppu/coarse-x-increment 31)] 150 | (is (= 1024 tile-increment)))))) 151 | 152 | (deftest nes-test-rom 153 | (let [rom (cart/load-rom "/Users/angusiguess/code/cljsnes/resources/nestest.nes") 154 | log (clojure.string/split-lines (cart/read-file-sync "/Users/angusiguess/code/cljsnes/resources/nestest.log")) 155 | memory (memory/init-mem rom) 156 | state (assoc-in (state/init-vectors (state/init-state memory)) [:cpu :pc] 0xC000)] 157 | (loop [log log 158 | state state 159 | line-no 1] 160 | (when log 161 | (let [log-line (-> log 162 | first 163 | (clojure.string/replace #"CYC:.*$" "") 164 | (clojure.string/split #"\s+")) 165 | my-line (clojure.string/split (cpu/log-step state) #"\s+")] 166 | (println line-no) 167 | (println log-line) 168 | (println my-line) 169 | (when (is (= log-line my-line)) 170 | (recur (rest log) (cpu/test-step state) (inc line-no)))))))) 171 | -------------------------------------------------------------------------------- /src/cljsnes/memory.cljs: -------------------------------------------------------------------------------- 1 | (ns cljsnes.memory 2 | (:require [clojure.pprint :as pprint])) 3 | 4 | (defprotocol CPUMemory 5 | (cpu-read [_ addr]) 6 | (cpu-write [_ addr byte])) 7 | 8 | (defprotocol PPUMemory 9 | (ppu-read [_ addr]) 10 | (ppu-write [_ addr byte])) 11 | 12 | ;; CPU ROM mappers 13 | 14 | (defrecord Nrom [ram ppu-registers apu-io test-mode 15 | lower-bank upper-bank prg-ram chr vram mirroring palette-ram] 16 | CPUMemory 17 | (cpu-read [_ addr] 18 | (cond (<= 0x0 addr 0x1FFF) (get ram (mod addr 0x800)) 19 | (<= 0x2000 addr 0x3FFF) (get ppu-registers (-> addr 20 | (- 0x2000) 21 | (mod 0x08))) 22 | (<= 0x4000 addr 0x4017) (get apu-io (- addr 0x4000)) 23 | (<= 0x4018 addr 0x401F) (get test-mode (- addr 0x4018)) 24 | (<= 0x6000 addr 0x7FFF) (get prg-ram (-> addr 25 | (- 0x6000) 26 | (mod 0x800))) 27 | (<= 0x8000 addr 0xBFFF) (get lower-bank (- addr 0x8000)) 28 | (<= 0xC000 addr 0xFFFF) (get upper-bank (- addr 0xC000)) 29 | :else (throw (js/Error (pprint/cl-format nil 30 | "Address ~x out of range" addr))))) 31 | (cpu-write [_ addr byte] 32 | (cond (<= 0x0 addr 0x1FFF) (Nrom. 33 | (assoc ram (mod addr 0x800) byte) 34 | ppu-registers 35 | apu-io 36 | test-mode 37 | lower-bank 38 | upper-bank 39 | prg-ram 40 | chr 41 | vram 42 | mirroring 43 | palette-ram) 44 | (<= 0x2000 addr 0x3FFF) (Nrom. ram 45 | (assoc ppu-registers 46 | (-> addr 47 | (- 0x2000) 48 | (mod 0x08)) 49 | byte) 50 | apu-io 51 | test-mode 52 | lower-bank 53 | upper-bank 54 | prg-ram 55 | chr 56 | vram 57 | mirroring 58 | palette-ram) 59 | (<= 0x4000 addr 0x4017) (Nrom. ram 60 | ppu-registers 61 | (assoc apu-io (- addr 0x4000) byte) 62 | test-mode 63 | lower-bank 64 | upper-bank 65 | prg-ram 66 | chr 67 | vram 68 | mirroring 69 | palette-ram) 70 | (<= 0x4018 addr 0x401F) (Nrom. ram 71 | ppu-registers 72 | apu-io 73 | (assoc test-mode (- addr 0x4018) byte) 74 | lower-bank 75 | upper-bank 76 | prg-ram 77 | chr 78 | vram 79 | mirroring 80 | palette-ram) 81 | (<= 0x6000 addr 0x7FFF) (Nrom. ram 82 | ppu-registers 83 | apu-io 84 | test-mode 85 | lower-bank 86 | upper-bank 87 | (assoc prg-ram 88 | (-> addr 89 | (- 0x6000) 90 | (mod 0x800)) 91 | byte) 92 | chr 93 | vram 94 | mirroring 95 | palette-ram) 96 | :else (throw (js/Error (pprint/cl-format nil 97 | "Address ~x out of range" addr))))) 98 | PPUMemory 99 | (ppu-read [_ addr] 100 | (let [vram-offset 0x2000 101 | palette-offset 0x3000] 102 | (cond (<= 0x0000 addr 0x1FFF) (get chr addr) 103 | (<= 0x2000 addr 0x2007) (get ppu-registers (- addr vram-offset)) 104 | (<= 0x2008 addr 0x2FFF) (get vram (- addr vram-offset)) 105 | (<= 0x3F00 addr 0x3FFF) (get palette-ram (mod (- addr palette-offset) 0x20)) 106 | :else (throw (js/Error (pprint/cl-format nil 107 | "Address ~x out of range" addr)))))) 108 | (ppu-write [_ addr byte] 109 | (let [vram-offset 0x2000 110 | palette-offset 0x3000] 111 | (cond 112 | (<= 0x2000 addr 0x2007) (Nrom. ram 113 | (assoc ppu-registers (- addr vram-offset) byte) 114 | apu-io 115 | test-mode 116 | lower-bank 117 | upper-bank 118 | prg-ram 119 | chr 120 | vram 121 | mirroring 122 | palette-ram) 123 | (<= 0x2008 addr 0x2FFF) (Nrom. ram 124 | ppu-registers 125 | apu-io 126 | test-mode 127 | lower-bank 128 | upper-bank 129 | prg-ram 130 | chr 131 | (assoc vram 132 | (- addr vram-offset) 133 | byte) 134 | mirroring 135 | palette-ram) 136 | (<= 0x3000 addr 0x3FFF) (Nrom. ram 137 | ppu-registers 138 | apu-io 139 | test-mode 140 | lower-bank 141 | upper-bank 142 | prg-ram 143 | chr 144 | vram 145 | mirroring 146 | (assoc palette-ram 147 | (mod (- addr palette-offset) 0x20) 148 | byte)) 149 | :else (throw (js/Error (pprint/cl-format nil 150 | "Address ~x out of range" addr))))))) 151 | 152 | (defn make-nrom [lower-bank upper-bank prg-ram chr mirroring] 153 | (map->Nrom {:ram (into [] (repeat 0x2000 0)) 154 | :ppu-registers (into [] (repeat 0x08 0)) 155 | :apu-io (into [] (repeat 0x18 0)) 156 | :test-mode (into [] (repeat 0x08 0)) 157 | :lower-bank lower-bank 158 | :upper-bank upper-bank 159 | :prg-ram prg-ram 160 | :chr chr 161 | :vram (into [] (repeat 0xFFF 0)) 162 | :mirroring mirroring 163 | :palette-ram (into [] (repeat 0x1F 0))})) 164 | 165 | (defn init-mem [rom] 166 | (case (:mapper rom) 167 | 0 (make-nrom (get-in rom [:rom-bank-bytes 0]) 168 | (or (get-in rom [:rom-bank-bytes 1]) 169 | (get-in rom [:rom-bank-bytes 0])) 170 | (get-in rom [:vrom-bank-bytes 0]) 171 | (get-in rom [:chr-bank-bytes 0]) 172 | (get rom :vertical-mirroring)))) 173 | -------------------------------------------------------------------------------- /src/cljsnes/opcodes.cljs: -------------------------------------------------------------------------------- 1 | (ns cljsnes.opcodes 2 | (:require [clojure.spec :as s])) 3 | 4 | (s/def :opcode/code (s/int-in 0x00 0xFF)) 5 | 6 | (s/def :opcode/fn #{:adc :and :asl :bcc :bcs :beq :bit :bmi :bne :bpl :brk 7 | :bvc :bvs :clc :cld :cli :clv :cmp :cpx :cpy :dec :dex 8 | :dey :eor :inc :inx :iny :jmp :jsr :lda :ldx :ldy :lsr 9 | :nop :ora :pha :php :pla :plp :rol :ror :rti :rts :sbc 10 | :sec :sed :sei :sta :stx :sty :tax :tay :tsx :txa :txs 11 | :tya}) 12 | 13 | (s/def :opcode/address-mode #{:immediate :zero :zero-x :zero-y 14 | :absolute :absolute-x :absolute-y 15 | :indirect :indirect-x :indirect-y 16 | :relative :implied :accumulator}) 17 | 18 | (s/def :opcode/bytes-read (s/int-in 1 4)) 19 | 20 | (s/def :opcode/cycles (s/int-in 1 8)) 21 | 22 | (s/def :opcode/op (s/keys :req-un [:opcode/fn 23 | :opcode/address-mode :opcode/bytes-read 24 | :opcode/cycles])) 25 | 26 | (s/def :opcode/ops (s/map-of :opcode/code :opcode/op)) 27 | 28 | (defn make-op 29 | [m code fn address-mode bytes-read cycles] 30 | (assert (nil? (get m code))) 31 | (assoc m code {:fn fn 32 | :address-mode address-mode 33 | :bytes-read bytes-read 34 | :cycles cycles})) 35 | 36 | (def ops (-> {} 37 | ;; ADC official 38 | (make-op 0x69 :adc :immediate 2 2) 39 | (make-op 0x65 :adc :zero 2 3) 40 | (make-op 0x75 :adc :zero-x 2 4) 41 | (make-op 0x6D :adc :absolute 3 4) 42 | (make-op 0x7D :adc :absolute-x 3 4) 43 | (make-op 0x79 :adc :absolute-y 3 4) 44 | (make-op 0x61 :adc :indirect-x 2 6) 45 | (make-op 0x71 :adc :indirect-y 2 5) 46 | ;; AND official 47 | (make-op 0x29 :and :immediate 2 2) 48 | (make-op 0x25 :and :zero 2 3) 49 | (make-op 0x35 :and :zero-x 2 4) 50 | (make-op 0x2D :and :absolute 3 4) 51 | (make-op 0x3D :and :absolute-x 3 4) 52 | (make-op 0x39 :and :absolute-y 3 4) 53 | (make-op 0x21 :and :indirect-x 2 6) 54 | (make-op 0x31 :and :indirect-y 2 5) 55 | ;; ASL official 56 | (make-op 0x0A :asl :accumulator 1 2) 57 | (make-op 0x06 :asl :zero 2 5) 58 | (make-op 0x16 :asl :zero-x 2 6) 59 | (make-op 0x0E :asl :absolute 3 6) 60 | (make-op 0x1E :asl :absolute-x 3 7) 61 | ;; BCC official 62 | (make-op 0x90 :bcc :relative 2 2) 63 | ;; BCS official 64 | (make-op 0xB0 :bcs :relative 2 2) 65 | ;; BEQ official 66 | (make-op 0xF0 :beq :relative 2 2) 67 | ;; BIT official 68 | (make-op 0x24 :bit :zero 2 3) 69 | (make-op 0x2C :bit :absolute 3 4) 70 | ;; BMI official 71 | (make-op 0x30 :bmi :relative 2 2) 72 | ;;BNE official 73 | (make-op 0xD0 :bne :relative 2 2) 74 | ;; BPL official 75 | (make-op 0x10 :bpl :relative 2 2) 76 | ;; BRK official 77 | (make-op 0x00 :brk :implied 1 7) 78 | ;; BVC official 79 | (make-op 0x50 :bvc :relative 2 2) 80 | ;; BVS official 81 | (make-op 0x70 :bvs :relative 2 2) 82 | ;; CLC official 83 | (make-op 0x18 :clc :implied 1 2) 84 | ;; CLD official 85 | (make-op 0xD8 :cld :implied 1 2) 86 | ;; CLI official 87 | (make-op 0x58 :cli :implied 1 2) 88 | ;; CLV official 89 | (make-op 0xB8 :clv :implied 1 2) 90 | ;; CMP official 91 | (make-op 0xC9 :cmp :immediate 2 2) 92 | (make-op 0xC5 :cmp :zero 2 3) 93 | (make-op 0xD5 :cmp :zero-x 2 4) 94 | (make-op 0xCD :cmp :absolute 3 4) 95 | (make-op 0xDD :cmp :absolute-x 3 4) 96 | (make-op 0xD9 :cmp :absolute-y 3 4) 97 | (make-op 0xC1 :cmp :indirect-x 2 6) 98 | (make-op 0xD1 :cmp :indirect-y 2 5) 99 | ;; CPX official 100 | (make-op 0xE0 :cpx :immediate 2 2) 101 | (make-op 0xE4 :cpx :zero 2 3) 102 | (make-op 0xEC :cpx :absolute 3 4) 103 | ;; CPY official 104 | (make-op 0xC0 :cpy :immediate 2 2) 105 | (make-op 0xC4 :cpy :zero 2 3) 106 | (make-op 0xCC :cpy :absolute 3 4) 107 | ;; DEC official 108 | (make-op 0xC6 :dec :zero 2 5) 109 | (make-op 0xD6 :dec :zero-x 2 6) 110 | (make-op 0xCE :dec :absolute 3 6) 111 | (make-op 0xDE :dec :absolute-x 3 7) 112 | ;; DEX official 113 | (make-op 0xCA :dex :implied 1 2) 114 | ;; DEY official 115 | (make-op 0x88 :dey :implied 1 2) 116 | ;; EOR official 117 | (make-op 0x49 :eor :immediate 2 2) 118 | (make-op 0x45 :eor :zero 2 3) 119 | (make-op 0x55 :eor :zero-x 2 4) 120 | (make-op 0x4D :eor :absolute 3 4) 121 | (make-op 0x5D :eor :absolute-x 3 4) 122 | (make-op 0x59 :eor :absolute-y 3 4) 123 | (make-op 0x41 :eor :indirect-x 2 6) 124 | (make-op 0x51 :eor :indirect-y 2 5) 125 | ;; INC official 126 | (make-op 0xE6 :inc :zero 2 5) 127 | (make-op 0xF6 :inc :zero-x 2 6) 128 | (make-op 0xEE :inc :absolute 3 6) 129 | (make-op 0xFE :inc :absolute-x 3 7) 130 | ;; INX official 131 | (make-op 0xE8 :inx :implied 1 2) 132 | ;; INY official 133 | (make-op 0xC8 :iny :implied 1 2) 134 | ;; JMP official 135 | (make-op 0x4C :jmp :absolute 3 3) 136 | (make-op 0x6C :jmp :indirect 3 5) 137 | ;; JSR official 138 | (make-op 0x20 :jsr :absolute 3 6) 139 | ;; LDA official 140 | (make-op 0xA9 :lda :immediate 2 2) 141 | (make-op 0xA5 :lda :zero 2 3) 142 | (make-op 0xB5 :lda :zero-x 2 4) 143 | (make-op 0xAD :lda :absolute 3 4) 144 | (make-op 0xBD :lda :absolute-x 3 4) 145 | (make-op 0xB9 :lda :absolute-y 3 4) 146 | (make-op 0xA1 :lda :indirect-x 2 6) 147 | (make-op 0xB1 :lda :indirect-y 2 5) 148 | ;; LDX official 149 | (make-op 0xA2 :ldx :immediate 2 2) 150 | (make-op 0xA6 :ldx :zero 2 3) 151 | (make-op 0xB6 :ldx :zero-y 2 4) 152 | (make-op 0xAE :ldx :absolute 3 4) 153 | (make-op 0xBE :ldx :absolute-y 3 4) 154 | ;; LDY official 155 | (make-op 0xA0 :ldy :immediate 2 2) 156 | (make-op 0xA4 :ldy :zero 2 3) 157 | (make-op 0xB4 :ldy :zero-x 2 4) 158 | (make-op 0xAC :ldy :absolute 3 4) 159 | (make-op 0xBC :ldy :absolute-x 3 4) 160 | ;; LSR official 161 | (make-op 0x4A :lsr :accumulator 1 2) 162 | (make-op 0x46 :lsr :zero 2 5) 163 | (make-op 0x56 :lsr :zero-x 3 6) 164 | (make-op 0x4E :lsr :absolute 3 6) 165 | (make-op 0x5E :lsr :absolute-x 3 7) 166 | ;; NOP official 167 | (make-op 0xEA :nop :implied 1 2) 168 | ;; ORA official 169 | (make-op 0x09 :ora :immediate 2 2) 170 | (make-op 0x05 :ora :zero 2 3) 171 | (make-op 0x15 :ora :zero-x 2 4) 172 | (make-op 0x0D :ora :absolute 3 4) 173 | (make-op 0x1D :ora :absolute-x 3 4) 174 | (make-op 0x19 :ora :absolute-y 3 4) 175 | (make-op 0x01 :ora :indirect-x 2 6) 176 | (make-op 0x11 :ora :indirect-y 2 5) 177 | ;; PHA official 178 | (make-op 0x48 :pha :implied 1 3) 179 | ;; PHP official 180 | (make-op 0x08 :php :implied 1 3) 181 | ;; PLA official 182 | (make-op 0x68 :pla :implied 1 4) 183 | ;; PLP official 184 | (make-op 0x28 :plp :implied 1 4) 185 | ;; ROL official 186 | (make-op 0x2A :rol :accumulator 1 2) 187 | (make-op 0x26 :rol :zero 2 5) 188 | (make-op 0x36 :rol :zero-x 2 6) 189 | (make-op 0x2E :rol :absolute 3 6) 190 | (make-op 0x3E :rol :absolute-x 3 7) 191 | ;; ROR official 192 | (make-op 0x6A :ror :accumulator 1 2) 193 | (make-op 0x66 :ror :zero 2 5) 194 | (make-op 0x76 :ror :zero-x 2 6) 195 | (make-op 0x6E :ror :absolute 3 6) 196 | (make-op 0x7E :ror :absolute-x 3 7) 197 | ;; RTI official 198 | (make-op 0x40 :rti :implied 1 6) 199 | ;; RTS official 200 | (make-op 0x60 :rts :implied 1 6) 201 | ;; SBC official 202 | (make-op 0xE9 :sbc :immediate 2 2) 203 | (make-op 0xE5 :sbc :zero 2 3) 204 | (make-op 0xF5 :sbc :zero-x 2 4) 205 | (make-op 0xED :sbc :absolute 3 4) 206 | (make-op 0xFD :sbc :absolute-x 3 4) 207 | (make-op 0xF9 :sbc :absolute-y 3 4) 208 | (make-op 0xE1 :sbc :indirect-x 2 6) 209 | (make-op 0xF1 :sbc :indirect-y 2 5) 210 | ;; SEC official 211 | (make-op 0x38 :sec :implied 1 2) 212 | ;; SED official 213 | (make-op 0xF8 :sed :implied 1 2) 214 | ;; SEI official 215 | (make-op 0x78 :sei :implied 1 2) 216 | ;; STA official 217 | (make-op 0x85 :sta :zero 2 3) 218 | (make-op 0x95 :sta :zero-x 2 4) 219 | (make-op 0x8D :sta :absolute 3 4) 220 | (make-op 0x9D :sta :absolute-x 3 5) 221 | (make-op 0x99 :sta :absolute-y 3 5) 222 | (make-op 0x81 :sta :indirect-x 2 6) 223 | (make-op 0x91 :sta :indirect-y 2 6) 224 | ;; STX official 225 | (make-op 0x86 :stx :zero 2 3) 226 | (make-op 0x96 :stx :zero-y 2 4) 227 | (make-op 0x8E :stx :absolute 3 4) 228 | ;; STY official 229 | (make-op 0x84 :sty :zero 2 3) 230 | (make-op 0x94 :sty :zero-x 2 4) 231 | (make-op 0x8C :sty :absolute 3 4) 232 | ;; TAX official 233 | (make-op 0xAA :tax :implied 1 2) 234 | ;; TAY official 235 | (make-op 0xA8 :tay :implied 1 2) 236 | ;; TSX official 237 | (make-op 0xBA :tsx :implied 1 2) 238 | ;; TXA official 239 | (make-op 0x8A :txa :implied 1 2) 240 | ;; TXS official 241 | (make-op 0x9A :txs :implied 1 2) 242 | ;; TYA official 243 | (make-op 0x98 :tya :implied 1 2))) 244 | -------------------------------------------------------------------------------- /src/cljsnes/ppu.cljs: -------------------------------------------------------------------------------- 1 | (ns cljsnes.ppu 2 | (:require [clojure.spec :as s] 3 | [cljsnes.arith :as arith] 4 | [cljsnes.memory :as memory])) 5 | 6 | ;;$0000-1FFF is normally mapped by the cartridge to a CHR-ROM or CHR-RAM, often with a bank switching mechanism. 7 | ;; $2000-2FFF is normally mapped to the 2kB NES internal VRAM, providing 2 nametables with a mirroring configuration controlled by the cartridge, but it can be partly or fully remapped to RAM on the cartridge, allowing up to 4 simultaneous nametables. 8 | ; $3000-3EFF is usually a mirror of the 2kB region from $2000-2EFF. The PPU does not render from this address range, so this space has negligible utility. 9 | ;; $3F00-3FFF is not configurable, always mapped to the internal palette control. 10 | 11 | ;; We need a couple of internal registers for everything to work. 12 | 13 | ;; v is a register containing current vram address info. 14 | ;; t is a register containing temporary vram address info. 15 | ;; x is the fine x scroll, which allows for partial scrolling 16 | ;; w is the write toggle, which we use since some of our registers require two writes. 17 | ;; we'll write values to register flags too. To start let's phrase them as getters. 18 | ;; cycle is the horizontal render cycle 19 | ;; line is the scan line we're rendering 20 | ;; frame is a frame counter I'll use 21 | ;; I don't think I need to remove anything, I'll just make things consistent 22 | ;; with scroll 23 | 24 | (enable-console-print!) 25 | 26 | ;; Getters for internal state 27 | 28 | (defn get-v [state] 29 | (get-in state [:ppu :v])) 30 | 31 | (defn get-t [state] 32 | (get-in state [:ppu :t])) 33 | 34 | (defn get-x [state] 35 | (get-in state [:ppu :x])) 36 | 37 | (defn get-w [state] 38 | (get-in state [:ppu :w])) 39 | 40 | (defn get-memory [state] 41 | (let [memory (get state :memory)] 42 | (get state :memory))) 43 | 44 | (defn get-line [state] 45 | (get-in state [:ppu :line])) 46 | 47 | (defn get-nametable-byte [state] 48 | (get-in state [:ppu :nametable-byte])) 49 | 50 | (defn get-low-tile-byte [state] 51 | (get-in state [:ppu :low-tile-byte])) 52 | 53 | (defn get-high-tile-byte [state] 54 | (get-in state [:ppu :high-tile-byte])) 55 | 56 | (defn get-attribute-table-byte [state] 57 | (get-in state [:ppu :attribute-table-byte])) 58 | 59 | (defn get-tile-data [state] 60 | (get-in state [:ppu :tile-data])) 61 | 62 | (defn copy-y! [state] 63 | (let [v (get-v state)] 64 | (assoc-in state [:ppu :v] (bit-or (bit-and 0x841F v) 65 | (bit-and 0x7BE0 v))))) 66 | 67 | (defn copy-x! [state] 68 | (let [v (get-v state)] 69 | (assoc-in state [:ppu :v] (bit-or (bit-and v 0xFBE0) 70 | (bit-and v 0x041F))))) 71 | 72 | (defn inc-line [state] 73 | (update-in state [:ppu :line] inc)) 74 | 75 | (defn zero-line [state] 76 | (assoc-in state [:ppu :line] 0)) 77 | 78 | (defn get-cycle [state] 79 | (get-in state [:ppu :cycle])) 80 | 81 | (defn inc-cycle [state] 82 | (update-in state [:ppu :cycle] inc)) 83 | 84 | (defn zero-cycle [state] 85 | (-> state 86 | (assoc-in [:ppu :cycle] 0) 87 | (update-in [:ppu :line] inc))) 88 | 89 | (defn get-flag-background-table [state] 90 | (let [memory (get-memory state) 91 | register (memory/ppu-read memory 0x2000)] 92 | (if (bit-test register 4) 1 0))) 93 | 94 | (defn get-flag-background-enabled [state] 95 | (let [memory (get-memory state) 96 | register (memory/ppu-read memory 0x2001)] 97 | (bit-test register 3))) 98 | 99 | (defn get-write-started [state] 100 | (get-in state [:ppu :write-started])) 101 | 102 | (defn set-vblank! [state] 103 | (let [memory (get-memory state) 104 | byte (memory/ppu-read memory 0x2002) 105 | back (get-in state [:display :back]) 106 | front (get-in state [:display :front])] 107 | (-> state 108 | (assoc :memory (memory/ppu-write memory 0x2002 (bit-or 0x70 byte))) 109 | (assoc-in [:ppu :vblank] true) 110 | (assoc-in [:display :back] front) 111 | (assoc-in [:display :front] back)))) 112 | 113 | (defn clear-vblank! [state] 114 | (let [memory (get-memory state) 115 | byte (memory/ppu-read memory 0x2002)] 116 | (-> state 117 | (assoc :memory (memory/ppu-write memory 118 | 0x2002 119 | (bit-or 0xE0 byte))) 120 | (assoc-in [:ppu :vblank] false)))) 121 | 122 | (defn get-frame [state] 123 | (get-in state [:ppu :frame])) 124 | 125 | (defn nmi-enabled? [state] 126 | (get-in state [:ppu :nmi-enable])) 127 | 128 | ;; Register $2000, write only 129 | ;; PPU Control Register 130 | ;; VPHB SINN 131 | ;; V = VBLANK NMI, generate an interrupt if this is set. 132 | ;; P = PPU M/S, read backdrop from ext or write to ext 133 | ;; H = Sprite size, 0 = 8x8, 1 = 8x16 134 | ;; B = Background pattern table, 0 = $0000 1 = $1000 135 | ;; S = Sprite pattern table, 0 = $0000 1 = $1000, 8x16 ignores 136 | ;; I = VRAM increment, 0 adds 1, 1 adds 32 on vram increment 137 | ;; NN = base nametable address, 0, 1, 2, 3 138 | 139 | 140 | ;; t: ...BA.. ........ = d: ......BA 141 | (defn write-control [state byte] 142 | (let [nametable-bits (bit-shift-left (bit-and 0x03 byte) 10) 143 | t (get-t state)] 144 | (update-in state [:ppu :t] bit-or nametable-bits))) 145 | 146 | ;; Register $2002, read only 147 | ;; PPU status register 148 | ;; VSO. .... 149 | 150 | ;; V = Vblank has started 151 | ;; S = Sprite zero hit. Set when a nonzero pixel of sprite 0 overlaps with nonzero background 152 | ;; O = Sprite overflow, Set during sprite evaluation 153 | 154 | (defn read-status [state] 155 | (let [memory (get-memory state) 156 | status (memory/ppu-read memory 0x2000) 157 | v-cleared (bit-and 0x7F status) 158 | updated-memory (memory/ppu-write memory 0x2000 v-cleared)] 159 | (-> state 160 | (assoc-in [:ppu :w] false) 161 | (assoc :memory updated-memory)))) 162 | 163 | ;; Register $2003, OAM address. TODO add this 164 | 165 | ;; Register $2004, OAM data. TODO add this. 166 | 167 | ;; Register $2005, PPUSCROLL 168 | ;; Write twice to set scroll x and then scroll y 169 | 170 | ;; If w is false 171 | 172 | ;;t: ....... ...HGFED = d: HGFED... 173 | ;;x: CBA = d: .....CBA 174 | ;;w: = 1 175 | 176 | ;; If w is true 177 | ;; t: CBA..HG FED..... = d: HGFEDCBA 178 | ;; w: = 0 179 | 180 | (defn- scroll-second-write [t byte] 181 | (let [t (bit-and 2r000110000011111 t) 182 | cba (bit-shift-left (bit-and 0x07 byte) 12) 183 | defgh (bit-shift-left (bit-and 0xF8 byte) 2)] 184 | (bit-or t cba defgh))) 185 | 186 | (defn write-register-scroll [state byte] 187 | (let [w (get-w state) 188 | for-t (bit-shift-right byte 3) 189 | for-x (bit-and byte 0x07)] 190 | (cond-> state 191 | (not w) (update-in [:ppu :t] #(-> % (bit-shift-right 5) 192 | (bit-shift-left 5) 193 | (bit-or for-t))) 194 | (not w) (assoc-in [:ppu :x] for-x) 195 | (not w) (assoc-in [:ppu :w] true) 196 | w (update-in [:ppu :t] scroll-second-write byte) 197 | w (assoc-in [:ppu :w] false)))) 198 | 199 | ;; $2005 Address register first write 200 | ;;t: .FEDCBA ........ = d: ..FEDCBA 201 | ;;t: X...... ........ = 0 202 | ;;w: = 1 203 | 204 | ;;second write 205 | ;;t: ....... HGFEDCBA = d: HGFEDCBA 206 | ;;v = t 207 | ;;w: = 0 208 | 209 | (defn- first-address-write [t byte] 210 | (let [abcdef (-> byte (bit-and 0x3F) (bit-shift-left 8))] 211 | (bit-or t abcdef (bit-and 0x80FF t)))) 212 | 213 | (defn- second-address-write [t byte] 214 | (bit-or t byte)) 215 | 216 | (defn- copy-t-to-v [state] 217 | (assoc-in state [:ppu :v] (get-in state [:ppu :t]))) 218 | 219 | (defn write-register-address [state byte] 220 | (let [w (get-w state)] 221 | (cond-> state 222 | (not w) (update-in [:ppu :t] first-address-write byte) 223 | (not w) (assoc-in [:ppu :w] true) 224 | w (update-in [:ppu :t] second-address-write byte) 225 | w copy-t-to-v 226 | w (assoc-in [:ppu :w] false)))) 227 | 228 | (defn write-register-data [state byte] 229 | (let [memory (get-memory state) 230 | address (get-v state) 231 | increment-y (-> memory (memory/ppu-read 0x2000) (bit-test 3))] 232 | (cond-> state 233 | true (assoc :memory (memory/ppu-write memory address byte)) 234 | increment-y (update-in [:ppu :v] + 32) 235 | (not increment-y) (update-in [:ppu :v] inc)))) 236 | 237 | (defn get-ppu-mask [state] 238 | (memory/ppu-read (get-memory state) 0x2001)) 239 | 240 | (defn- switch-vertical-nametable [v] 241 | (bit-and 0xFFFF (bit-xor v 0x0800))) 242 | 243 | (defn- apply-coarse-y [v y] 244 | (bit-or 245 | (bit-and v (bit-and 0xFFFF (bit-not 0x03E0))) 246 | (bit-shift-left y 5))) 247 | 248 | (defn increment-y-component [v] 249 | ;; If fine Y < 7, we'll increment it 250 | (let [coarse-y (bit-shift-right (bit-and v 0x03E0) 5)] 251 | (cond (not= (bit-and v 0x7000) 0x7000) (+ v 0x1000) 252 | (= 29 coarse-y) (-> v 253 | switch-vertical-nametable 254 | (apply-coarse-y 0)) 255 | (= 31 coarse-y) (apply-coarse-y v 0) 256 | :else (apply-coarse-y v (inc coarse-y))))) 257 | 258 | (defn- zero-coarse-x [v] 259 | (bit-and 0xFFFF (bit-and v (bit-not 0x001F)))) 260 | 261 | (defn- switch-horizontal-nametable [v] 262 | (bit-and 0xFFFF (bit-xor 0x0400 v))) 263 | 264 | (defn coarse-x-increment [v] 265 | (let [coarse-x (bit-and 0x001F v)] 266 | (if (= 31 coarse-x) (-> v zero-coarse-x switch-horizontal-nametable) 267 | (inc v)))) 268 | 269 | (defn fetch-nametable-byte [state] 270 | (let [v (get-v state) 271 | memory (get-memory state) 272 | address (bit-or 0x2000 (bit-and v 0x0FFF))] 273 | (assoc-in state [:memory :nametable-byte] (memory/ppu-read memory address)))) 274 | 275 | (defn fetch-attribute-table-byte [state] 276 | (let [v (get-v state) 277 | memory (get-memory state) 278 | address (bit-or 0x23C0 279 | (bit-and 0x0C00 v) 280 | (bit-and (bit-shift-right v 4) 0x38) 281 | (bit-and (bit-shift-right v 2) 0x07)) 282 | shift (bit-or (bit-and 0x04 (bit-shift-right v 4)) 283 | (bit-and 0x02 v)) 284 | table-byte (bit-shift-left (bit-and 285 | (bit-shift-right (memory/ppu-read memory address) shift) 286 | 3) 287 | 2)] 288 | (assoc-in state [:ppu :attribute-table-byte] table-byte))) 289 | 290 | (defn fetch-low-tile-byte [state] 291 | (let [v (get-v state) 292 | memory (get-memory state) 293 | fine-y (bit-and (bit-shift-right v 12) 7) 294 | tile (get-nametable-byte state) 295 | background-table (get-flag-background-table state) 296 | address (+ (* 0x1000 background-table) 297 | (* tile 16) 298 | fine-y)] 299 | (assoc-in state [:ppu :low-tile-byte] (memory/ppu-read memory address)))) 300 | 301 | (defn fetch-high-tile-byte [state] 302 | (let [v (get-v state) 303 | memory (get-memory state) 304 | fine-y (bit-and (bit-shift-right v 12) 7) 305 | tile (get-nametable-byte state) 306 | background-table (get-flag-background-table state) 307 | address (+ (* 0x1000 background-table) 308 | (* tile 16) 309 | fine-y)] 310 | (assoc-in state [:ppu :low-tile-byte] (memory/ppu-read memory (+ 8 address))))) 311 | 312 | (defn store-tile-data [state] 313 | (let [a (get-attribute-table-byte state) 314 | [data low high] (loop [i 0 315 | tile-data 0x0 316 | low-tile-byte (get-low-tile-byte state) 317 | high-tile-byte (get-high-tile-byte state)] 318 | (if (= 7 i) [tile-data low-tile-byte high-tile-byte] 319 | (let [p1 (bit-shift-right (bit-and low-tile-byte 0x80) 7) 320 | p2 (bit-shift-right (bit-and high-tile-byte 0x80) 6)] 321 | (recur (inc i) 322 | (-> tile-data 323 | (bit-shift-left 4) 324 | (bit-or a p1 p2)) 325 | (bit-shift-left low-tile-byte 1) 326 | (bit-shift-left high-tile-byte 1)))))] 327 | (-> state 328 | (assoc-in [:ppu :tile-data] data) 329 | (assoc-in [:ppu :low-tile-byte] low) 330 | (assoc-in [:ppu :high-tile-byte] high)))) 331 | 332 | (defn background-enabled? [state] 333 | (let [ppu-mask (get-ppu-mask state)] 334 | (bit-test ppu-mask 3))) 335 | 336 | (defn sprite-enabled? [state] 337 | (let [ppu-mask (get-ppu-mask state)] 338 | (bit-test ppu-mask 4))) 339 | 340 | (defn rendering-enabled? [state] 341 | (or (background-enabled? state) 342 | (sprite-enabled? state))) 343 | 344 | (defn nmi-interrupt? [state] 345 | (get-in state [:ppu :nmi-enable])) 346 | 347 | (defn even-frame? [state] 348 | (get-in state [:ppu :f])) 349 | 350 | 351 | (defn cycle-wrap? [state] 352 | (= 340 (get-cycle state))) 353 | 354 | (defn line-wrap? [state] 355 | (and (cycle-wrap? state) 356 | (= 261 (get-line state)))) 357 | 358 | (defn v-blank? [state] 359 | (let [line (get-line state) 360 | cycle (get-cycle state)] 361 | (and (= line 241) 362 | (= cycle 1) 363 | (nmi-interrupt? state)))) 364 | 365 | (defn clear-vblank? [state] 366 | (let [line (get-line state) 367 | cycle (get-cycle state)] 368 | (and (= 261 line) 369 | (= 1 cycle)))) 370 | 371 | (defn visible-cycle [cycle] 372 | (<= 1 cycle 256)) 373 | 374 | (defn pre-fetch-cycle [cycle] 375 | (<= 321 cycle 336)) 376 | 377 | (defn fetch-cycle [cycle] 378 | (or (visible-cycle cycle) 379 | (pre-fetch-cycle cycle))) 380 | 381 | (defn visible-line [line] 382 | (< line 240)) 383 | 384 | (defn render-line [line] 385 | (or (visible-line line) 386 | (= 261 line))) 387 | 388 | (def render-and-fetch? (comp fetch-cycle render-line)) 389 | 390 | (defn do-fetch [state cycle]) 391 | 392 | (defn tick! [state] 393 | (cond-> state 394 | (not (cycle-wrap? state)) inc-cycle 395 | (cycle-wrap? state) zero-cycle 396 | (line-wrap? state) zero-line)) 397 | 398 | (defn trigger-vblank! [state] 399 | (println "Triggering Vblank") 400 | (-> state 401 | set-vblank! 402 | (assoc :interrupt :nmi))) 403 | 404 | (defn apply-fetch [state cycle] 405 | (case (mod cycle 8) 406 | ;; gross 407 | 0 (-> state 408 | store-tile-data 409 | (update-in [:ppu :v] coarse-x-increment)) 410 | 1 (fetch-nametable-byte state) 411 | 3 (fetch-attribute-table-byte state) 412 | 5 (fetch-low-tile-byte state) 413 | 7 (fetch-high-tile-byte state) 414 | state)) 415 | 416 | (defn background-pixel [state] 417 | (if (get-flag-background-enabled state) 418 | (let [tile-data (get-tile-data state) 419 | x (get-x state) 420 | shift-val (* 4 (- 7 x))] 421 | (-> tile-data 422 | (bit-shift-right shift-val) 423 | (bit-and 0x0F))) 424 | 0)) 425 | 426 | (defn render-pixel [state] 427 | (let [x (dec (get-cycle state)) 428 | y (get-line state) 429 | memory (get-memory state) 430 | ;; Omit left background later 431 | bg (background-pixel state) 432 | colour (memory/ppu-read memory 433 | (mod (+ 0x3F00 bg) 64))] 434 | (assoc-in state [:display :back y x] colour))) 435 | 436 | (defn render-background [state] 437 | ;; currently just for bg 438 | (let [line (get-line state) 439 | cycle (get-cycle state)] 440 | (if (get-flag-background-enabled state) 441 | (cond-> state 442 | ;; TODO 443 | (and (visible-line line) 444 | (visible-cycle cycle)) render-pixel 445 | (and (render-line line) 446 | (fetch-cycle cycle)) (apply-fetch cycle) 447 | (and (= line 261) 448 | (<= 280 cycle 304)) copy-y! 449 | (= 256 cycle) (update-in [:ppu :v] increment-y-component) 450 | (= 257 cycle) copy-x!) 451 | state))) 452 | 453 | (defn step [state] 454 | (let [cycle (get-cycle state)] 455 | (cond-> state 456 | true tick! 457 | true render-background 458 | (v-blank? state) trigger-vblank! 459 | (clear-vblank? state) clear-vblank!))) 460 | -------------------------------------------------------------------------------- /src/cljsnes/cpu.cljs: -------------------------------------------------------------------------------- 1 | (ns cljsnes.cpu 2 | (:require [cljsnes.arith :as arith] 3 | [cljsnes.memory :as memory] 4 | [cljsnes.opcodes :as opcodes] 5 | [cljsnes.interrupts :as interrupts] 6 | [cljsnes.spec :as spec] 7 | [cljsnes.ppu :as ppu] 8 | [cljs.spec :as s] 9 | [cljs.core :as c] 10 | [cljs.pprint :as pprint] 11 | [cljs.reader :as reader]) 12 | (:refer-clojure :exclude [and])) 13 | 14 | (enable-console-print!) 15 | 16 | ;; Memory map for state 17 | ;; $0000-$07FF $0800 2KB internal RAM 18 | ;; $0800-$0FFF $0800 Mirrors of $0000-$07FF 19 | ;; $1000-$17FF $0800 20 | ;; $1800-$1FFF $0800 21 | ;; $2000-$2007 $0008 NES PPU registers 22 | ;; $2008-$3FFF $1FF8 Mirrors of $2000-2007 (repeats every 8 bytes) 23 | ;; $4000-$4017 $0018 NES APU and I/O registers 24 | ;; $4018-$401F $0008 APU and I/O functionality that is normally disabled. See CPU Test Mode. 25 | ;; $4020-$FFFF $BFE0 Cartridge space: PRG ROM, PRG RAM, and mapper registers (See Note) 26 | 27 | ;; Registers 28 | ;; A is one byte 29 | ;; X and Y are one byte, not accumulators, mostly used for addressing 30 | ;; PC, program counter, references 65536 memory locations 31 | ;; S is stack pointer, one byte 32 | ;; P is the status register, each bit being a status flag. 33 | ;; we can represent each of the status flags if we like 34 | ;; C is carry, if last or addition or shift resulted in a carry 35 | ;; Z is zero, if last operation resulted in a zero. 36 | ;; Interrupt, can inhibit interrupts (0 IRQ and NMI, 1 just NMI) 37 | ;; D decimal, ignored 38 | ;; s used by stack copy 39 | ;; O is overflow, if ADC or SBC resulted in overflow 40 | ;; N is negative, set to bit 7 of last operation (sign bit) 41 | 42 | ;; So our state is: memory, registers, and status flags, everything 43 | ;; can operate on them. 44 | 45 | 46 | ;; Manipulating state 47 | 48 | (defn get-address [memory address] 49 | (let [lower (memory/cpu-read memory address) 50 | upper (memory/cpu-read memory (inc address))] 51 | (arith/make-address lower upper))) 52 | 53 | (defn get-address-wrap-upper [memory address] 54 | (let [lower-byte address 55 | upper-byte (mod (inc address) 0x100) 56 | lower (memory/cpu-read memory lower-byte) 57 | upper (memory/cpu-read memory upper-byte)] 58 | (arith/make-address lower upper))) 59 | 60 | ;; Special Reads 61 | 62 | (defn ppu-control-write? [{:keys [resolved-address] :as op}] 63 | (= resolved-address 0x2000)) 64 | 65 | (defn ppu-status-read? [{:keys [resolved-address] :as op}] 66 | (= resolved-address 0x2002)) 67 | 68 | (defn ppu-address-write? [{:keys [resolved-address] :as op}] 69 | (= resolved-address 0x2006)) 70 | 71 | (defn ppu-data-write? [{:keys [resolved-address] :as op}] 72 | (= resolved-address 0x2007)) 73 | 74 | (defn ppu-scroll-write? [{:keys [resolved-address] :as op}] 75 | (= resolved-address 0x2005)) 76 | 77 | ;; Stack Manipulation 78 | 79 | 80 | 81 | (s/fdef push-8 :args (s/cat :state ::spec/state :byte ::spec/byte) 82 | :ret ::spec/state) 83 | 84 | (defn push-8 [{:keys [cpu memory] :as state} byte] 85 | (let [{:keys [s]} cpu] 86 | (-> state 87 | (assoc :memory (memory/cpu-write memory (+ 0x100 s) byte)) 88 | (update-in [:cpu :s] dec)))) 89 | 90 | (s/fdef pop-8 :args (s/cat :state ::spec/state) 91 | :ret ::spec/state) 92 | 93 | (defn pop-8 [{:keys [cpu memory] :as state}] 94 | (let [{:keys [s]} cpu 95 | to-pop (memory/cpu-read memory (+ 0x100 (inc s)))] 96 | [to-pop (update-in state [:cpu :s] inc)])) 97 | 98 | (s/fdef push-16 :args (s/cat :state ::spec/state :address ::spec/address) 99 | :ret ::spec/state) 100 | 101 | (defn push-16 [state address] 102 | (let [[low high] (arith/address->bytes address)] 103 | (-> state 104 | (push-8 high) 105 | (push-8 low)))) 106 | 107 | (s/fdef pop-16 :args (s/cat :state ::spec/state) 108 | :ret ::spec/state) 109 | 110 | (defn pop-16 [state] 111 | (let [[low low-state] (pop-8 state) 112 | [high high-state] (pop-8 low-state)] 113 | [(arith/make-address low high) high-state])) 114 | 115 | (s/fdef status->byte :args (s/cat :state ::spec/state) 116 | :ret ::spec/byte) 117 | 118 | (defn status->byte [{:keys [cpu] :as state}] 119 | (let [{:keys [n v b d i z c]} cpu] 120 | (reader/read-string (str "2r" n v "1" b d i z c)))) 121 | 122 | (s/fdef byte->status :args (s/cat :byte ::spec/byte) 123 | :ret :cpu/status) 124 | 125 | (defn bool->bit [bool] 126 | (if bool 1 0)) 127 | 128 | (defn byte->status [status] 129 | {:n (bool->bit (bit-test status 7)) 130 | :v (bool->bit (bit-test status 6)) 131 | :b (bool->bit (bit-test status 4)) 132 | :d (bool->bit (bit-test status 3)) 133 | :i (bool->bit (bit-test status 2)) 134 | :z (bool->bit (bit-test status 1)) 135 | :c (bool->bit (bit-test status 0))}) 136 | 137 | (defn get-memory [state] 138 | (get state :memory)) 139 | 140 | (defn get-cycles [state] 141 | (get-in state [:cpu :cycles])) 142 | 143 | (defn set-ticks! [state ticks] 144 | (assoc-in state [:cpu :ticks] ticks)) 145 | 146 | (defn inc-ticks! [state] 147 | (update-in state [:cpu :ticks] inc)) 148 | 149 | (defn dec-ticks! [state] 150 | (update-in state [:cpu :ticks] dec)) 151 | 152 | (defn inc-cycles! [state] 153 | (update-in state [:cpu :cycles] inc)) 154 | 155 | ;; Addressing 156 | 157 | (defn page-crossed? [address offset] 158 | (let [mask 0x0F00] 159 | (not= (bit-and address mask) 160 | (bit-and (+ address offset) mask)))) 161 | 162 | (defn read-next [memory pc] 163 | (memory/cpu-read memory (inc pc))) 164 | 165 | (defn get-sp [state] 166 | (get-in state [:cpu :s])) 167 | 168 | (defn set-sp-to [state v] 169 | (assoc-in state [:cpu :s] v)) 170 | 171 | (defn get-pc [state] 172 | (get-in state [:cpu :pc])) 173 | 174 | (defn set-pc-to [state v] 175 | (assoc-in state [:cpu :pc] v)) 176 | 177 | (defn get-a [state] 178 | (get-in state [:cpu :a])) 179 | 180 | (defn set-a-to [state v] 181 | (assoc-in state [:cpu :a] v)) 182 | 183 | (defn dec-x [state] 184 | (update-in state [:cpu :x] dec)) 185 | 186 | (defn inc-x [state] 187 | (update-in state [:cpu :x] dec)) 188 | 189 | (defn get-x [state] 190 | (get-in state [:cpu :x])) 191 | 192 | (defn set-x-to [state v] 193 | (assoc-in state [:cpu :x] v)) 194 | 195 | (defn get-y [state] 196 | (get-in state [:cpu :y])) 197 | 198 | (defn dec-y [state] 199 | (update-in state [:cpu :y] dec)) 200 | 201 | (defn set-y-to [state v] 202 | (assoc-in state [:cpu :y] v)) 203 | 204 | (defn inc-y [state] 205 | (update-in state [:cpu :y] inc)) 206 | 207 | (defn get-interrupt [state] 208 | (get-in state [:cpu :i])) 209 | 210 | (defn set-interrupt-to [state v] 211 | (assoc-in state [:cpu :i] v)) 212 | 213 | (defn set-interrupt [state] 214 | (set-interrupt-to state 1)) 215 | 216 | (defn clear-interrupt [state] 217 | (set-interrupt-to state 0)) 218 | 219 | (defn get-overflow [state] 220 | (get-in state [:cpu :v])) 221 | 222 | (defn set-overflow-to [state v] 223 | (assoc-in state [:cpu :v] v)) 224 | 225 | (defn set-overflow [state] 226 | (set-overflow-to state 1)) 227 | 228 | (defn clear-overflow [state] 229 | (set-overflow-to state 0)) 230 | 231 | (defn get-carry [state] 232 | (get-in state [:cpu :c])) 233 | 234 | (defn set-carry [state] 235 | (assoc-in state [:cpu :c] 1)) 236 | 237 | (defn set-carry-to [state v] 238 | (assoc-in state [:cpu :c] v)) 239 | 240 | (defn clear-carry [state] 241 | (assoc-in state [:cpu :c] 0)) 242 | 243 | (defn get-negative [state] 244 | (get-in state [:cpu :n])) 245 | 246 | (defn set-negative [state value] 247 | (let [to-set (if (arith/neg-byte? value) 1 0)] 248 | (assoc-in state [:cpu :n] to-set))) 249 | 250 | (defn set-negative-to [state v] 251 | (assoc-in state [:cpu :n] v)) 252 | 253 | (defn get-zero [state] 254 | (get-in state [:cpu :z])) 255 | 256 | (defn set-zero [state value] 257 | (let [to-set (if (zero? value) 1 0)] 258 | (assoc-in state [:cpu :z] to-set))) 259 | 260 | (defn advance-pc [state offset] 261 | (update-in state [:cpu :pc] + offset)) 262 | 263 | (defn set-decimal [state] 264 | (assoc-in state [:cpu :d] 1)) 265 | 266 | (defn clear-decimal [state] 267 | (assoc-in state [:cpu :d] 0)) 268 | 269 | (defn write-memory [state address byte] 270 | (update state :memory memory/cpu-write address byte)) 271 | 272 | ;; Address modes 273 | 274 | 275 | (defmulti address (fn [state op] 276 | (:address-mode op))) 277 | 278 | (defmethod address :immediate [state op] 279 | (let [pc (get-pc state) 280 | memory (get-memory state)] 281 | (assoc op :resolved-arg (memory/cpu-read memory (inc pc))))) 282 | 283 | (defmethod address :zero [state op] 284 | (let [pc (get-pc state) 285 | memory (get-memory state) 286 | reference (memory/cpu-read memory (inc pc)) 287 | value (memory/cpu-read memory reference)] 288 | (assoc op 289 | :resolved-arg value 290 | :resolved-address reference))) 291 | 292 | (defmethod address :zero-x [state op] 293 | (let [pc (get-pc state) 294 | x (get-x state) 295 | memory (get-memory state) 296 | address (memory/cpu-read memory (inc pc)) 297 | [sum _] (arith/add address x)] 298 | (assoc op :resolved-arg (memory/cpu-read memory sum) 299 | :resolved-address sum))) 300 | 301 | (defmethod address :zero-y [state op] 302 | (let [pc (get-pc state) 303 | y (get-y state) 304 | memory (get-memory state) 305 | address (memory/cpu-read memory (inc pc)) 306 | [sum _] (arith/add address y)] 307 | (assoc op :resolved-arg (memory/cpu-read memory sum) 308 | :resolved-address sum))) 309 | 310 | (defmethod address :absolute [state op] 311 | (let [pc (get-pc state) 312 | memory (get-memory state) 313 | address (get-address memory (inc pc))] 314 | (assoc op :resolved-arg (memory/cpu-read memory address) 315 | :resolved-address address))) 316 | 317 | (defmethod address :absolute-x [state op] 318 | (let [memory (get-memory state) 319 | pc (get-pc state) 320 | x (get-x state) 321 | address (get-address memory (inc pc))] 322 | (cond-> op 323 | (page-crossed? address x) (update :cycles inc) 324 | true (assoc :resolved-arg (memory/cpu-read memory (+ address x)) 325 | :resolved-address (+ address x))))) 326 | 327 | (defmethod address :absolute-y [state op] 328 | (let [memory (get-memory state) 329 | pc (get-pc state) 330 | y (get-y state) 331 | address (get-address memory (inc pc))] 332 | (cond-> op 333 | (page-crossed? address y) (update :cycles inc) 334 | true (assoc :resolved-arg (memory/cpu-read memory (+ address y)) 335 | :resolved-address (+ address y))))) 336 | 337 | (defmethod address :indirect [state op] 338 | (let [memory (get-memory state) 339 | pc (get-pc state) 340 | address (get-address memory (inc pc)) 341 | indirect-address (get-address memory address)] 342 | (assoc op :resolved-arg (memory/cpu-read memory indirect-address) 343 | :resolved-address indirect-address))) 344 | 345 | (defmethod address :indirect-x [state op] 346 | (let [memory (get-memory state) 347 | pc (get-pc state) 348 | x (get-x state) 349 | address (memory/cpu-read memory (inc pc)) 350 | offset-address (mod (+ x address) 0x100) 351 | indirect-address (get-address-wrap-upper memory offset-address)] 352 | (assoc op :resolved-arg (memory/cpu-read memory indirect-address) 353 | :resolved-address indirect-address))) 354 | 355 | (defmethod address :indirect-y [state op] 356 | (let [memory (get-memory state) 357 | pc (get-pc state) 358 | y (get-y state) 359 | address (get-address memory (inc pc)) 360 | offset-address (+ y address) 361 | indirect-address (memory/cpu-read memory offset-address)] 362 | (cond-> op 363 | (page-crossed? pc offset-address) (update :cycles inc) 364 | true (assoc :resolved-arg (memory/cpu-read memory indirect-address) 365 | :resolved-address indirect-address)))) 366 | 367 | (defmethod address :relative [state op] 368 | (let [memory (get-memory state) 369 | pc (get-pc state) 370 | offset (memory/cpu-read memory (inc pc))] 371 | (assoc op :resolved-arg offset 372 | :resolved-address (+ pc 2 offset)))) 373 | 374 | (defmethod address :implied [state op] 375 | (assoc op :resolved-arg nil)) 376 | 377 | (defmethod address :accumulator [state op] 378 | (let [a (get-a state)] 379 | (assoc op :resolved-arg a))) 380 | 381 | ;; Opcode implementations 382 | 383 | (defmulti exec-op (fn [state op] (:fn op))) 384 | 385 | (defmethod exec-op :adc [state {:keys [cycles bytes-read resolved-arg] :as op}] 386 | (let [a (get-a state) 387 | c (get-carry state) 388 | [sum carry] (arith/add a resolved-arg c) 389 | overflow (bool->bit (not= 0 (bit-and (bit-xor a sum) 390 | (bit-xor resolved-arg sum) 391 | 0x80)))] 392 | (cond-> state 393 | (ppu-status-read? op) ppu/read-status 394 | true (set-a-to sum) 395 | true (set-overflow-to overflow) 396 | true (set-carry-to carry) 397 | true (set-zero sum) 398 | true (set-negative sum) 399 | true (set-ticks! cycles) 400 | true (advance-pc bytes-read)))) 401 | 402 | (defmethod exec-op :and [state {:keys [cycles bytes-read resolved-arg] :as op}] 403 | (let [a (get-a state) 404 | and-a (bit-and a resolved-arg)] 405 | (cond-> state 406 | (ppu-status-read? op) ppu/read-status 407 | true (set-zero and-a) 408 | true (set-negative and-a) 409 | true (set-ticks! cycles) 410 | true (set-a-to and-a) 411 | true (advance-pc bytes-read)))) 412 | 413 | (defmethod exec-op :asl [state {:keys [cycles bytes-read 414 | resolved-arg resolved-address address-mode :as op]}] 415 | (let [memory (get-memory state) 416 | to-shift (if (= :accumulator address-mode) (get-a state) 417 | resolved-arg) 418 | [shifted carry] (arith/asl to-shift)] 419 | (cond-> state 420 | (ppu-status-read? op) ppu/read-status 421 | true (set-carry-to carry) 422 | true (set-zero shifted) 423 | true (set-negative shifted) 424 | true (set-ticks! cycles) 425 | (= :accumulator address-mode) (set-a-to shifted) 426 | (not= :accumulator address-mode) (update :memory memory/cpu-write resolved-address shifted) 427 | true (advance-pc bytes-read)))) 428 | 429 | (defmethod exec-op :bcc [state 430 | {:keys [cycles bytes-read resolved-arg] :as op}] 431 | (let [c (get-carry state) 432 | pc (get-pc state) 433 | signed-arg (arith/unsigned->signed resolved-arg)] 434 | (cond-> state 435 | true (set-ticks! cycles) 436 | (zero? c) inc-ticks! 437 | (zero? c) (advance-pc signed-arg) 438 | true (advance-pc bytes-read) 439 | (page-crossed? pc signed-arg) inc-ticks!))) 440 | 441 | (defmethod exec-op :bcs [state 442 | {:keys [cycles bytes-read resolved-arg] :as op}] 443 | (let [c (get-carry state) 444 | pc (get-pc state) 445 | signed-arg (arith/unsigned->signed resolved-arg)] 446 | (cond-> state 447 | true (set-ticks! cycles) 448 | (pos? c) inc-ticks! 449 | (pos? c) (advance-pc signed-arg) 450 | true (advance-pc bytes-read) 451 | (page-crossed? pc signed-arg) inc-ticks!))) 452 | 453 | (defmethod exec-op :beq [state 454 | {:keys [cycles bytes-read resolved-arg] :as op}] 455 | (let [z (get-zero state) 456 | pc (get-pc state) 457 | signed-arg (arith/unsigned->signed resolved-arg)] 458 | (cond-> state 459 | true (set-ticks! cycles) 460 | (pos? z) inc-ticks! 461 | (pos? z) (advance-pc signed-arg) 462 | true (advance-pc bytes-read) 463 | (page-crossed? pc signed-arg) inc-ticks!))) 464 | 465 | (defmethod exec-op :bit [state 466 | {:keys [cycles bytes-read resolved-arg] :as op}] 467 | (let [a (get-a state)] 468 | (cond-> state 469 | true (set-ticks! cycles) 470 | true (set-zero (bit-and a resolved-arg)) 471 | true (set-overflow-to (bool->bit (bit-test resolved-arg 6))) 472 | true (set-negative-to (bool->bit (bit-test resolved-arg 7))) 473 | true (advance-pc bytes-read)))) 474 | 475 | (defmethod exec-op :bmi [state 476 | {:keys [cycles bytes-read resolved-arg] :as op}] 477 | (let [pc (get-pc state) 478 | n (get-negative state) 479 | signed-arg (arith/unsigned->signed resolved-arg)] 480 | (cond-> state 481 | true (set-ticks! cycles) 482 | (pos? n) inc-ticks! 483 | (pos? n) (advance-pc signed-arg) 484 | (c/and (pos? n) (page-crossed? pc signed-arg)) inc-ticks! 485 | true (advance-pc bytes-read)))) 486 | 487 | (defmethod exec-op :bne [state 488 | {:keys [cycles bytes-read resolved-arg] :as op}] 489 | (let [z (get-zero state) 490 | pc (get-pc state) 491 | signed-arg (arith/unsigned->signed resolved-arg)] 492 | (cond-> state 493 | true (set-ticks! cycles) 494 | (zero? z) inc-ticks! 495 | (zero? z) (advance-pc signed-arg) 496 | true (advance-pc bytes-read) 497 | (c/and (zero? z) (page-crossed? pc signed-arg)) inc-ticks!))) 498 | 499 | (defmethod exec-op :bpl [state 500 | {:keys [cycles bytes-read resolved-arg] :as op}] 501 | (let [pc (get-pc state) 502 | n (get-negative state) 503 | signed-arg (arith/unsigned->signed resolved-arg)] 504 | (cond-> state 505 | true (set-ticks! cycles) 506 | (zero? n) inc-ticks! 507 | (zero? n) (advance-pc signed-arg) 508 | (c/and (zero? n) (page-crossed? pc signed-arg)) inc-ticks! 509 | true (advance-pc bytes-read)))) 510 | 511 | (defmethod exec-op :brk [state 512 | {:keys [cycles bytes-read] :as op}] 513 | (let [pc (get-pc state)] 514 | (-> state 515 | (push-16 pc) 516 | (push-8 (status->byte state)) 517 | (set-pc-to (get-in state [:cpu :irq])) 518 | (set-ticks! 7)))) 519 | 520 | (defmethod exec-op :bvc [state 521 | {:keys [cycles bytes-read resolved-arg] :as op}] 522 | (let [pc (get-pc state) 523 | v (get-overflow state) 524 | signed-arg (arith/unsigned->signed resolved-arg)] 525 | (cond-> state 526 | true (set-ticks! cycles) 527 | (zero? v) (advance-pc (+ bytes-read signed-arg)) 528 | (zero? v) inc-ticks! 529 | (c/and (zero? v) (page-crossed? pc signed-arg)) inc-ticks! 530 | (pos? v) (advance-pc bytes-read)))) 531 | 532 | (defmethod exec-op :bvs [state 533 | {:keys [cycles bytes-read resolved-arg] :as op}] 534 | (let [pc (get-pc state) 535 | v (get-overflow state) 536 | signed-arg (arith/unsigned->signed resolved-arg)] 537 | (cond-> state 538 | true (set-ticks! cycles) 539 | (pos? v) (advance-pc (+ bytes-read signed-arg)) 540 | (pos? v) inc-ticks! 541 | (c/and (pos? v) (page-crossed? pc signed-arg)) inc-ticks! 542 | (zero? v) (advance-pc bytes-read)))) 543 | 544 | (defmethod exec-op :clc [state {:keys [cycles bytes-read] :as op}] 545 | (-> state 546 | clear-carry 547 | (advance-pc bytes-read) 548 | (set-ticks! cycles))) 549 | 550 | (defmethod exec-op :cld [state {:keys [cycles bytes-read] :as op}] 551 | (-> state 552 | clear-decimal 553 | (advance-pc bytes-read) 554 | (set-ticks! cycles))) 555 | 556 | (defmethod exec-op :cli [state {:keys [cycles bytes-read] :as op}] 557 | (-> state 558 | clear-interrupt 559 | (advance-pc bytes-read) 560 | (set-ticks! cycles))) 561 | 562 | (defmethod exec-op :clv [state {:keys [cycles bytes-read] :as op}] 563 | (-> state 564 | clear-overflow 565 | (advance-pc bytes-read) 566 | (set-ticks! cycles))) 567 | 568 | (defmethod exec-op :cmp [state {:keys [cycles bytes-read resolved-arg] :as op}] 569 | (let [a (get-a state) 570 | [diff carry] (arith/sub a resolved-arg)] 571 | (cond-> state 572 | true (set-negative diff) 573 | true (set-zero diff) 574 | (<= resolved-arg a) set-carry 575 | (< a resolved-arg) clear-carry 576 | true (set-ticks! cycles) 577 | true (advance-pc bytes-read)))) 578 | 579 | (defmethod exec-op :cpx [state {:keys [cycles bytes-read resolved-arg] :as op}] 580 | (let [x (get-x state) 581 | [diff carry] (arith/sub x resolved-arg)] 582 | (cond-> state 583 | true (set-negative diff) 584 | true (set-zero diff) 585 | (<= resolved-arg x) set-carry 586 | (< x resolved-arg) clear-carry 587 | true (set-ticks! cycles) 588 | true (advance-pc bytes-read)))) 589 | 590 | (defmethod exec-op :cpy [state {:keys [cycles bytes-read resolved-arg] :as op}] 591 | (let [y (get-y state) 592 | [diff carry] (arith/sub y resolved-arg)] 593 | (cond-> state 594 | true (set-negative diff) 595 | true (set-zero diff) 596 | (<= resolved-arg y) set-carry 597 | (< y resolved-arg) clear-carry 598 | true (set-ticks! cycles) 599 | true (advance-pc bytes-read)))) 600 | 601 | (defmethod exec-op :dec [state 602 | {:keys [cycles bytes-read 603 | resolved-arg resolved-address] :as op}] 604 | (let [memory (get-memory state) 605 | [decced _] (arith/dec resolved-arg)] 606 | (cond-> state 607 | true (write-memory resolved-address decced) 608 | true (set-zero decced) 609 | true (set-negative decced) 610 | true (set-ticks! cycles) 611 | true (advance-pc bytes-read)))) 612 | 613 | (defmethod exec-op :dex [state 614 | {:keys [cycles bytes-read] :as op}] 615 | (let [x (get-x state) 616 | [decced _] (arith/dec x)] 617 | (cond-> state 618 | true (set-x-to decced) 619 | true (set-zero decced) 620 | true (set-negative decced) 621 | true (set-ticks! cycles) 622 | true (advance-pc bytes-read)))) 623 | 624 | (defmethod exec-op :dey [state 625 | {:keys [cycles bytes-read] :as op}] 626 | (let [y (get-y state) 627 | [decced _] (arith/dec y)] 628 | (cond-> state 629 | true (set-y-to decced) 630 | true (set-zero decced) 631 | true (set-negative decced) 632 | true (set-ticks! cycles) 633 | true (advance-pc bytes-read)))) 634 | 635 | (defmethod exec-op :eor [state 636 | {:keys [cycles bytes-read resolved-arg] :as op}] 637 | (let [a (get-a state) 638 | x-or (bit-xor a resolved-arg)] 639 | (cond-> state 640 | true (set-a-to x-or) 641 | true (set-zero x-or) 642 | true (set-negative x-or) 643 | true (set-ticks! cycles) 644 | true (advance-pc bytes-read)))) 645 | 646 | (defmethod exec-op :inc [state 647 | {:keys [cycles bytes-read 648 | resolved-arg resolved-address] :as op}] 649 | (let [memory (get-memory state) 650 | [inced _] (arith/inc resolved-arg)] 651 | (cond-> state 652 | true (write-memory resolved-address inced) 653 | true (set-zero inced) 654 | true (set-negative inced) 655 | true (set-ticks! cycles) 656 | true (advance-pc bytes-read)))) 657 | 658 | (defmethod exec-op :inx [state 659 | {:keys [cycles bytes-read] :as op}] 660 | (let [x (get-x state) 661 | [inced _] (arith/inc x)] 662 | (cond-> state 663 | true (set-x-to inced) 664 | true (set-zero inced) 665 | true (set-negative inced) 666 | true (set-ticks! cycles) 667 | true (advance-pc bytes-read)))) 668 | 669 | (defmethod exec-op :iny [state 670 | {:keys [cycles bytes-read] :as op}] 671 | (let [y (get-y state) 672 | [inced _] (arith/inc y)] 673 | (cond-> state 674 | true (set-y-to inced) 675 | true (set-zero inced) 676 | true (set-negative inced) 677 | true (set-ticks! cycles) 678 | true (advance-pc bytes-read)))) 679 | 680 | (defmethod exec-op :jmp [state 681 | {:keys [cycles bytes-read resolved-address] :as op}] 682 | ;; fix weird paging error 683 | (-> state 684 | (set-ticks! cycles) 685 | (assoc-in [:cpu :pc] resolved-address))) 686 | 687 | (defmethod exec-op :jsr [state 688 | {:keys [cycles bytes-read resolved-arg 689 | resolved-address] :as op}] 690 | (let [pc (get-pc state) 691 | return (+ pc bytes-read) 692 | memory (get-memory state)] 693 | (-> state 694 | (push-16 (dec return)) 695 | (set-pc-to resolved-address) 696 | (set-ticks! cycles)))) 697 | 698 | (defmethod exec-op :lda [state 699 | {:keys [cycles bytes-read resolved-arg] :as op}] 700 | (cond-> state 701 | (ppu-status-read? op) ppu/read-status 702 | true (set-a-to resolved-arg) 703 | true (set-zero resolved-arg) 704 | true (set-negative resolved-arg) 705 | true (set-ticks! cycles) 706 | true (advance-pc bytes-read))) 707 | 708 | (defmethod exec-op :ldx [state 709 | {:keys [cycles bytes-read resolved-arg] :as op}] 710 | (cond-> state 711 | (ppu-status-read? op) ppu/read-status 712 | true (set-x-to resolved-arg) 713 | true (set-zero resolved-arg) 714 | true (set-negative resolved-arg) 715 | true (set-ticks! cycles) 716 | true (advance-pc bytes-read))) 717 | 718 | (defmethod exec-op :ldy [state 719 | {:keys [cycles bytes-read resolved-arg] :as op}] 720 | (cond-> state 721 | (ppu-status-read? op) ppu/read-status 722 | true (set-y-to resolved-arg) 723 | true (set-zero resolved-arg) 724 | true (set-negative resolved-arg) 725 | true (set-ticks! cycles) 726 | true (advance-pc bytes-read))) 727 | 728 | (defmethod exec-op :lsr [state 729 | {:keys [cycles bytes-read resolved-arg 730 | resolved-address address-mode] :as op}] 731 | (let [memory (get-memory state) 732 | to-shift (if (= :accumulator address-mode) (get-a state) resolved-arg) 733 | [shifted carry] (arith/lsr to-shift)] 734 | (cond-> state 735 | true (set-carry-to carry) 736 | true (set-zero shifted) 737 | true (set-negative shifted) 738 | true (set-ticks! cycles) 739 | true (advance-pc bytes-read) 740 | (= :accumulator address-mode) (set-a-to shifted) 741 | (not= :accumulator address-mode) (write-memory resolved-address shifted)))) 742 | 743 | (defmethod exec-op :nop [state {:keys [cycles bytes-read]}] 744 | (-> state 745 | (set-ticks! cycles) 746 | (advance-pc bytes-read))) 747 | 748 | (defmethod exec-op :ora [state {:keys [cycles bytes-read resolved-arg]}] 749 | (let [a (get-a state) 750 | ored-a (bit-or a resolved-arg)] 751 | (cond-> state 752 | true (set-zero ored-a) 753 | true (set-negative ored-a) 754 | true (set-a-to ored-a) 755 | true (set-ticks! cycles) 756 | true (advance-pc bytes-read)))) 757 | 758 | (defmethod exec-op :pha [state {:keys [cycles bytes-read]}] 759 | (let [a (get-a state)] 760 | (-> state 761 | (push-8 a) 762 | (set-ticks! cycles) 763 | (advance-pc bytes-read)))) 764 | 765 | (defmethod exec-op :php [state {:keys [cycles bytes-read]}] 766 | (-> state 767 | (push-8 (bit-or 0x10 (status->byte state))) 768 | (set-ticks! cycles) 769 | (advance-pc bytes-read))) 770 | 771 | (defmethod exec-op :pla [state {:keys [cycles bytes-read]}] 772 | (let [[pop popped-state] (pop-8 state)] 773 | (-> popped-state 774 | (set-a-to pop) 775 | (set-zero pop) 776 | (set-negative pop) 777 | (set-ticks! cycles) 778 | (advance-pc bytes-read)))) 779 | 780 | (defmethod exec-op :plp [state {:keys [cycles bytes-read]}] 781 | (let [[pop popped-state] (pop-8 state) 782 | adjusted-pop (bit-or 0x20 (bit-and pop 0xEF)) ;; nestest needs this 783 | flags (byte->status adjusted-pop)] 784 | (-> popped-state 785 | (update :cpu merge flags) 786 | (set-ticks! cycles) 787 | (advance-pc bytes-read)))) 788 | 789 | (defmethod exec-op :rol [state 790 | {:keys [cycles bytes-read address-mode 791 | resolved-arg resolved-address] :as op}] 792 | (let [[shifted carry] (arith/asl resolved-arg) 793 | c (get-carry state) 794 | rotated (+ shifted c) 795 | memory (get-memory state)] 796 | (cond-> state 797 | (= :accumulator address-mode) (set-a-to rotated) 798 | (not= :accumulator address-mode) (write-memory resolved-address rotated) 799 | true (set-carry-to carry) 800 | true (set-zero rotated) 801 | true (set-negative rotated) 802 | true (set-ticks! cycles) 803 | true (advance-pc bytes-read)))) 804 | 805 | (defmethod exec-op :ror [state 806 | {:keys [cycles bytes-read address-mode 807 | resolved-arg resolved-address] :as op}] 808 | (let [[shifted carry] (arith/lsr resolved-arg) 809 | c (get-carry state) 810 | rotated (+ shifted (* 128 c)) 811 | memory (get-memory state)] 812 | (cond-> state 813 | (= :accumulator address-mode) (set-a-to rotated) 814 | (not= :accumulator address-mode) (write-memory resolved-address rotated) 815 | true (set-carry-to carry) 816 | true (set-zero rotated) 817 | true (set-negative-to c) 818 | true (set-ticks! cycles) 819 | true (advance-pc bytes-read)))) 820 | 821 | (defmethod exec-op :rti [state {:keys [cycles bytes-read]}] 822 | (let [[status state] (pop-8 state) 823 | status-map (byte->status status) 824 | [pc state] (pop-16 state)] 825 | (-> state 826 | (update :cpu merge status-map (merge status-map)) 827 | (set-pc-to pc) 828 | (set-ticks! cycles)))) 829 | 830 | (defmethod exec-op :rts [state {:keys [cycles]}] 831 | (let [[pc state] (pop-16 state)] 832 | (-> state 833 | (set-pc-to (inc pc)) 834 | (set-ticks! cycles)))) 835 | 836 | (defmethod exec-op :sbc [state {:keys [cycles resolved-arg bytes-read]}] 837 | (let [a (get-a state) 838 | c (get-carry state) 839 | [diff _] (arith/add a (bit-and 0xFF (bit-not resolved-arg)) c) 840 | carry (bool->bit (<= 0 (- a resolved-arg (- 1 c)))) 841 | overflow (bool->bit (not= 0 (bit-and (bit-xor a diff) 842 | (bit-xor (bit-and 0xFF (bit-not resolved-arg)) diff) 843 | 0x80)))] 844 | (cond-> state 845 | true (set-a-to diff) 846 | true (set-zero diff) 847 | true (set-negative diff) 848 | true (set-overflow-to overflow) 849 | true (set-carry-to carry) 850 | true (set-ticks! cycles) 851 | true (advance-pc bytes-read)))) 852 | 853 | (defmethod exec-op :sec [state {:keys [cycles bytes-read]}] 854 | (-> state 855 | (advance-pc bytes-read) 856 | (set-ticks! cycles) 857 | set-carry)) 858 | 859 | (defmethod exec-op :sed [state {:keys [cycles bytes-read]}] 860 | (-> state 861 | (advance-pc bytes-read) 862 | (set-ticks! cycles) 863 | set-decimal)) 864 | 865 | (defmethod exec-op :sei [state {:keys [cycles bytes-read] :as op}] 866 | (-> state 867 | set-interrupt 868 | (set-ticks! cycles) 869 | (advance-pc bytes-read))) 870 | 871 | (defmethod exec-op :sta [state 872 | {:keys [cycles resolved-address bytes-read] :as op}] 873 | (let [memory (get-memory state) 874 | a (get-a state)] 875 | (cond-> state 876 | (ppu-control-write? op) (ppu/write-control a) 877 | (ppu-scroll-write? op) (ppu/write-register-scroll a) 878 | (ppu-data-write? op) (ppu/write-register-data a) 879 | (ppu-address-write? op) (ppu/write-register-address a) 880 | true (set-ticks! cycles) 881 | true (advance-pc bytes-read) 882 | true (write-memory resolved-address a)))) 883 | 884 | (defmethod exec-op :stx [state 885 | {:keys [cycles resolved-address bytes-read] :as op}] 886 | (let [memory (get-memory state) 887 | x (get-x state)] 888 | (cond-> state 889 | (ppu-control-write? op) (ppu/write-control x) 890 | (ppu-scroll-write? op) (ppu/write-register-scroll x) 891 | (ppu-data-write? op) (ppu/write-register-data x) 892 | (ppu-address-write? op) (ppu/write-register-address x) 893 | true (set-ticks! cycles) 894 | true (advance-pc bytes-read) 895 | true (write-memory resolved-address x)))) 896 | 897 | (defmethod exec-op :sty [state 898 | {:keys [cycles resolved-address bytes-read] :as op}] 899 | (let [memory (get-memory state) 900 | y (get-y state)] 901 | (cond-> state 902 | (ppu-control-write? op) (ppu/write-control y) 903 | (ppu-scroll-write? op) (ppu/write-register-scroll y) 904 | (ppu-data-write? op) (ppu/write-register-data y) 905 | (ppu-address-write? op) (ppu/write-register-address y) 906 | true (set-ticks! cycles) 907 | true (advance-pc bytes-read) 908 | true (write-memory resolved-address y)))) 909 | 910 | (defmethod exec-op :tax [state 911 | {:keys [cycles resolved-address bytes-read] :as op}] 912 | (let [a (get-a state)] 913 | (cond-> state 914 | true (set-x-to a) 915 | true (set-zero a) 916 | true (set-negative a) 917 | true (set-ticks! cycles) 918 | true (advance-pc bytes-read)))) 919 | 920 | (defmethod exec-op :tay [state 921 | {:keys [cycles resolved-address bytes-read] :as op}] 922 | (let [a (get-a state)] 923 | (cond-> state 924 | true (set-y-to a) 925 | true (set-zero a) 926 | true (set-negative a) 927 | true (set-ticks! cycles) 928 | true (advance-pc bytes-read)))) 929 | 930 | (defmethod exec-op :tsx [state 931 | {:keys [cycles resolved-address bytes-read] :as op}] 932 | (let [sp (get-sp state)] 933 | (cond-> state 934 | true (set-x-to sp) 935 | true (set-zero sp) 936 | true (set-negative sp) 937 | true (set-ticks! cycles) 938 | true (advance-pc bytes-read)))) 939 | 940 | (defmethod exec-op :txa [state 941 | {:keys [cycles resolved-address bytes-read] :as op}] 942 | (let [x (get-x state)] 943 | (cond-> state 944 | true (set-a-to x) 945 | true (set-zero x) 946 | true (set-negative x) 947 | true (set-ticks! cycles) 948 | true (advance-pc bytes-read)))) 949 | 950 | (defmethod exec-op :txs [state 951 | {:keys [cycles resolved-address bytes-read] :as op}] 952 | (let [x (get-x state)] 953 | (cond-> state 954 | true (assoc-in [:cpu :s] x) 955 | true (set-ticks! cycles) 956 | true (advance-pc bytes-read)))) 957 | 958 | (defmethod exec-op :tya [state 959 | {:keys [cycles resolved-address bytes-read] :as op}] 960 | (let [y (get-y state)] 961 | (cond-> state 962 | true (set-a-to y) 963 | true (set-zero y) 964 | true (set-negative y) 965 | true (set-ticks! cycles) 966 | true (advance-pc bytes-read)))) 967 | 968 | ;; Interrupt handling 969 | 970 | (defn handle-interrupt [state interrupt] 971 | (println "Handling interrupt: " interrupt) 972 | (let [vector (get-in state [:cpu interrupt]) 973 | _ (println (pprint/cl-format nil "~x" vector)) 974 | pc (get-pc state) 975 | status (status->byte state) 976 | interrupt-cycles 7] 977 | (-> state 978 | (push-16 pc) 979 | (push-8 status) 980 | (set-pc-to vector) 981 | (set-ticks! interrupt-cycles) 982 | (assoc :interrupt nil)))) 983 | 984 | ;; Tick 985 | 986 | (defn tick! [{:keys [cpu] :as state} instruction] 987 | (let [{:keys [cycles ticks]} cpu 988 | interrupt (interrupts/check-interrupt state)] 989 | (cond (< 0 ticks) (-> state 990 | dec-ticks! 991 | inc-cycles!) 992 | interrupt (handle-interrupt state interrupt) 993 | :else (do 994 | (println instruction) 995 | (exec-op state instruction))))) 996 | 997 | (defn log-indirect-x [state {:keys [address-mode resolved-arg resolved-address] :as op}] 998 | (let [memory (get-memory state) 999 | pc (get-pc state) 1000 | x (get-x state) 1001 | initial-address (memory/cpu-read memory (inc pc))] 1002 | (pprint/cl-format nil "($~:@(~2,'0X~),X) @ ~:@(~2,'0X~) = ~:@(~4,'0X~) = ~:@(~2,'0X~)" 1003 | (memory/cpu-read memory (inc pc)) 1004 | (mod (+ x initial-address) 0x100) 1005 | resolved-address 1006 | resolved-arg))) 1007 | 1008 | (defn log-address [state {:keys [address-mode resolved-arg resolved-address fn] :as op}] 1009 | (let [memory (get-memory state) 1010 | pc (get-pc state)] 1011 | (case address-mode 1012 | :immediate (pprint/cl-format nil "#$~:@(~2,'0X~)" resolved-arg) 1013 | :absolute (cond (get #{:jmp :jsr} fn) (pprint/cl-format nil "$~:@(~4,'0X~)" resolved-address) 1014 | :else (pprint/cl-format nil "$~:@(~4,'0X~) = ~:@(~2,'0X~)" resolved-address resolved-arg)) 1015 | :implied "" 1016 | :indirect-x (log-indirect-x state op) 1017 | :accumulator "A" 1018 | :relative (pprint/cl-format nil "$~:@(~2,'0X~)" resolved-address) 1019 | :zero (pprint/cl-format nil "$~:@(~2,'0X~) = ~:@(~2,'0X~)" resolved-address resolved-arg)))) 1020 | 1021 | (defn cpu-state [state] 1022 | (let [a (get-a state) 1023 | x (get-x state) 1024 | y (get-y state) 1025 | p (status->byte state) 1026 | sp (get-sp state)] 1027 | (pprint/cl-format nil "A:~:@(~2,'0X~) X:~:@(~2,'0X~) Y:~:@(~2,'0X~) P:~:@(~2,'0X~) SP:~:@(~2,'0X~)" a x y p sp))) 1028 | 1029 | (defn log-step [state] 1030 | (let [pc (get-pc state) 1031 | memory (get-memory state) 1032 | op (memory/cpu-read memory pc) 1033 | instruction (->> (get opcodes/ops op) 1034 | (address state)) 1035 | {:keys [bytes-read]} instruction 1036 | byte-one (pprint/cl-format nil "~:@(~2,'0X~)" (memory/cpu-read memory pc)) 1037 | byte-two (if (<= 2 bytes-read) (pprint/cl-format nil "~:@(~2,'0X~)" (memory/cpu-read memory (inc pc))) " ") 1038 | byte-three (if (<= 3 bytes-read) (pprint/cl-format nil "~:@(~2,'0X~)" (memory/cpu-read memory (+ 2 pc))) " ") 1039 | opcode (pprint/cl-format nil "~:@(~A~)" (name (:fn instruction))) 1040 | address (log-address state instruction) 1041 | cpu-state (cpu-state state)] 1042 | (pprint/cl-format nil "~:@(~4,'0X~) ~A ~A ~A ~A ~A ~A" 1043 | pc 1044 | byte-one 1045 | byte-two 1046 | byte-three 1047 | opcode 1048 | address 1049 | cpu-state))) 1050 | 1051 | (defn test-step [state] 1052 | (let [pc (get-pc state) 1053 | memory (get-memory state) 1054 | op (memory/cpu-read memory pc) 1055 | instruction (->> (get opcodes/ops op) 1056 | (address state))] 1057 | (-> state 1058 | (tick! instruction) 1059 | (set-ticks! 0)))) 1060 | 1061 | (defn step [state] 1062 | (let [pc (get-pc state) 1063 | memory (get-memory state) 1064 | op (memory/cpu-read memory pc) 1065 | _ (println op) 1066 | instruction (->> (get opcodes/ops op) 1067 | (address state))] 1068 | (tick! state instruction))) 1069 | --------------------------------------------------------------------------------