rlm@105: (ns com.aurellem.assembly
rlm@105:   (:use (com.aurellem gb-driver vbm title items))
rlm@105:   (:import [com.aurellem.gb_driver SaveState]))
rlm@105: 
rlm@106: (defn mid-game []
rlm@106:   (read-state "mid-game"))
rlm@105: 
rlm@105: (defn inject-assembly
rlm@107:   ([^SaveState state
rlm@105:    program-counter registers
rlm@105:    assembly-code]
rlm@105:   (let [scratch-memory (memory state)]
rlm@105:     ;; inject assembly code
rlm@105:     (dorun (map (fn [index val]
rlm@105:                   (aset scratch-memory index val))
rlm@105:                 (range program-counter
rlm@105:                        (+ program-counter (count assembly-code)))
rlm@105:                 assembly-code))
rlm@106:     (-> state
rlm@106:         (write-memory! scratch-memory)
rlm@106:         (write-registers! registers)
rlm@106:         (PC! program-counter))))
rlm@107:   ;;([program-counter]
rlm@107:   ;;   (fn [^SaveState state registers assembly-code]
rlm@107:   ;;     (inject-assembly state program-counter registers assembly-code)))
rlm@107:   )
rlm@107: 
rlm@107: 
rlm@107: ;;(def inject-assembly-item
rlm@107: ;;  (inject-assembly (inc item-list-start)))
rlm@105: 
rlm@105: (defn inject-item-assembly
rlm@105:   ([^SaveState state assembly-code]
rlm@105:      (inject-assembly state (inc item-list-start)
rlm@105:                       (registers state)
rlm@105:                       assembly-code))
rlm@105:   ([assembly-code]
rlm@105:      (inject-item-assembly @current-state assembly-code)))
rlm@105: 
rlm@105: (defn info
rlm@105:   ([^SaveState state]
rlm@107:      (println (format "PC: 0x%04X" (PC state)))
rlm@106:      (println "Instruction:"
rlm@106:               (format "0x%02X" (aget (memory state) (PC state))))
rlm@105:      state))    
rlm@105: 
rlm@107: (defn print-interrupt
rlm@107:   [^SaveState state]
rlm@107:   (println (format "IE: %d" (IE state)))
rlm@107:   state)
rlm@107: 
rlm@105: (defn run-assembly
rlm@105:   ([info-fn assembly n]
rlm@105:      (let [final-state
rlm@105:            (reduce (fn [state _]
rlm@105:                      (tick (info-fn state)))
rlm@107:                    (inject-item-assembly
rlm@107:                      (mid-game) assembly)
rlm@105:                    (range n))]
rlm@105:        final-state))
rlm@105:   ([assembly n]
rlm@105:      (run-assembly info assembly n)))
rlm@107: 
rlm@107: 
rlm@107: (def buttons-port 0xFF00)
rlm@107: 
rlm@107: (defn view-register [state name reg-fn]
rlm@107:   (println (format "%s : 0x%02X" name (reg-fn state)))
rlm@107:   state)
rlm@107: 
rlm@107: (defn A [state]
rlm@107:   (bit-shift-right (bit-and 0x0000FF00 (AF state)) 8))
rlm@107: 
rlm@107: (defn view-memory [state mem]
rlm@107:   (println (format "mem 0x%04X = 0x%02X" mem (aget (memory state) mem)))
rlm@107:   state)
rlm@107: 
rlm@107: (defn read-buttons []
rlm@107:   (let [button-pressed (tick (step (mid-game) [:d]))]
rlm@107:     (-> button-pressed
rlm@109:         (IE! 0) ; disable interrupts
rlm@107:         (inject-item-assembly
rlm@107:          (concat
rlm@107:           ;; write 00010000 to 0xFF00 to select joypad
rlm@107:           [0x18   ;D31D                 ; jump over          
rlm@107:            0x01   ;D31E                 ; the next 8 bits
rlm@107:            (Integer/parseInt "00010000" 2) ;D31F data section 
rlm@107:            0x00   ;D320                 ; take a break
rlm@107:            0xFA   ;D321                 ; put DC15 into A
rlm@107:            0x1F   ;D322      --]       
rlm@107:            0xD3   ;D323      --]  DC1F  ; data section
rlm@107:            0x01   ;D324                 ; load 0xFF00 into BC
rlm@107:            0x00   ;D325
rlm@107:            0xFF   ;D326
rlm@109:            0x02   ;D327    (BC)->A      ; load (00010000) into FF00
rlm@107:                                         ; to select directional
rlm@107:                                         ; buttons
rlm@107: 
rlm@107:            ]
rlm@107: 
rlm@107:           []))
rlm@107:         (info)
rlm@107:         (tick)  ;; skip over data section
rlm@107:         (info)  
rlm@107:         (tick)  ;; no-op
rlm@107:         (info)
rlm@107:         (view-register "Register A" A)
rlm@107:         (tick)  ;; load-data into A
rlm@107:         (view-register "Register A" A)
rlm@107:         (info)
rlm@107:         (view-register "Register BC" BC)
rlm@108:         (tick) ;;  store 0xFFOO into BC
rlm@108:         (view-register "Register BC" BC)
rlm@108:         (info)
rlm@108:         (view-memory 0xFF00)
rlm@107:         (tick) ;; load A into 0xFF00
rlm@108:         (view-memory 0xFF00)
rlm@107:         )))
rlm@107:           
rlm@107:          
rlm@107: (defn trace [state]
rlm@107:   (loop [program-counters []
rlm@107:          opcodes []]
rlm@107:     (let [frame-boundary?
rlm@107:           (com.aurellem.gb.Gb/tick)]
rlm@107:       (println (count opcodes))
rlm@107:       (if frame-boundary?
rlm@107:         [program-counters opcodes]
rlm@107:         (recur
rlm@107:          (conj program-counters
rlm@107:                (first (registers @current-state)))
rlm@107:          (conj opcodes
rlm@107:                (aget (memory @current-state)
rlm@107:                      (PC @current-state))))))))
rlm@107:         
rlm@107:   
rlm@107: (defn good-trace []
rlm@107:   (-> (mid-game) (tick) (IE! 0)
rlm@107:       (set-inv-mem [0x00 0x00 0X00 0x00])
rlm@107:       (PC! item-list-start)(print-interrupt)
rlm@107:       (info) (tick) (info) (tick) (info)))