135 lines
3.5 KiB
Racket
135 lines
3.5 KiB
Racket
|
#lang racket
|
||
|
|
(require "memory.rkt")
|
||
|
|
|
||
|
|
;---------------------
|
||
|
|
; Decode dot ry ky ty
|
||
|
|
;---------------------
|
||
|
|
; Functions to decode
|
||
|
|
; a byte to an assembly
|
||
|
|
; instruction.
|
||
|
|
;---------------------
|
||
|
|
|
||
|
|
(define (inc16b x)
|
||
|
|
(mod-16bit (add1 x)))
|
||
|
|
|
||
|
|
(define (alu-op y)
|
||
|
|
(case y
|
||
|
|
[(0) 'RLC]
|
||
|
|
[(1) 'RRC]
|
||
|
|
[(2) 'RL]
|
||
|
|
[(3) 'RR]
|
||
|
|
[(4) 'SLA]
|
||
|
|
[(5) 'SRA]
|
||
|
|
[(6) 'SWAP]
|
||
|
|
[(7) 'SRL]))
|
||
|
|
|
||
|
|
(define (reg-op z)
|
||
|
|
(case z
|
||
|
|
[(0) 'reg-B]
|
||
|
|
[(1) 'reg-C]
|
||
|
|
[(2) 'reg-D]
|
||
|
|
[(3) 'reg-E]
|
||
|
|
[(4) 'reg-H]
|
||
|
|
[(5) 'reg-L]
|
||
|
|
[(6) 'reg-ind-HL]
|
||
|
|
[(7) 'reg-A]))
|
||
|
|
|
||
|
|
(define (cc-tab z)
|
||
|
|
(case z
|
||
|
|
[(0) 'NZ]
|
||
|
|
[(1) 'Z]
|
||
|
|
[(2) 'NC]
|
||
|
|
[(3) 'C]))
|
||
|
|
|
||
|
|
(define (rp-tab z)
|
||
|
|
(case z
|
||
|
|
[(0) 'reg-BC]
|
||
|
|
[(1) 'reg-DE]
|
||
|
|
[(2) 'reg-HL]
|
||
|
|
[(3) 'reg-SP]))
|
||
|
|
|
||
|
|
(define (read-word-mem memory)
|
||
|
|
(let ([lsb (read-byte-mem memory)]
|
||
|
|
[msb (read-byte-mem memory)])
|
||
|
|
(bitwise-ior lsb
|
||
|
|
(arithmetic-shift msb 8))))
|
||
|
|
|
||
|
|
(define (read-byte-mem memory)
|
||
|
|
(let ([pc (get-state 'state-PC memory)])
|
||
|
|
(let ([b (get-byte pc 0 memory)])
|
||
|
|
(begin
|
||
|
|
(set-state! 'state-PC memory (inc16b pc))
|
||
|
|
b))))
|
||
|
|
|
||
|
|
(define (read-instruction memory)
|
||
|
|
(let ([b1 (read-byte-mem memory)])
|
||
|
|
(if (= #xCB b1)
|
||
|
|
; $CB prefix ops
|
||
|
|
(letrec ([b2 (read-byte-mem memory)]
|
||
|
|
[x (arithmetic-shift (bitwise-and #b11000000 b2) -6)]
|
||
|
|
[y (arithmetic-shift (bitwise-and #b00111000 b2) -3)]
|
||
|
|
[z (bitwise-and #b00000111 b2)]
|
||
|
|
[p (arithmetic-shift y -1)]
|
||
|
|
[q (modulo y 2)])
|
||
|
|
(case x
|
||
|
|
[(0) `(,(alu-op y) ,(reg-op z))]
|
||
|
|
[(1) `(BIT ,y ,(reg-op z))]
|
||
|
|
[(2) `(RES ,y ,(reg-op z))]
|
||
|
|
[(3) `(SET ,y ,(reg-op z))]
|
||
|
|
[else (error "bad instruction")]))
|
||
|
|
; No prefix ops
|
||
|
|
(letrec ([x (arithmetic-shift (bitwise-and #b11000000 b1) -6)]
|
||
|
|
[y (arithmetic-shift (bitwise-and #b00111000 b1) -3)]
|
||
|
|
[z (bitwise-and #b00000111 b1)]
|
||
|
|
[p (arithmetic-shift y -1)]
|
||
|
|
[q (modulo y 2)])
|
||
|
|
(case x
|
||
|
|
[(0)
|
||
|
|
(case z
|
||
|
|
[(0)
|
||
|
|
(case y
|
||
|
|
[(0) '(NOP)]
|
||
|
|
[(1) `(LD-ind ,(read-word-mem memory) reg-SP)]
|
||
|
|
[(2) '(STOP)]
|
||
|
|
[(3) `(JR expl ,(read-byte-mem memory))]
|
||
|
|
[(4 5 6 7) `(JR ,(cc-tab (- y 4)) ,(read-byte-mem memory))]
|
||
|
|
[else (error "bad instruction")])]
|
||
|
|
[(1)
|
||
|
|
(case q
|
||
|
|
[(0) `(LD-16b ,(rp-tab p) ,(read-word-memory))]
|
||
|
|
[(1) `(ADD-16b reg-HL ,(rp-tab p))]
|
||
|
|
[else (error "bad instruction")])
|
||
|
|
]
|
||
|
|
[(2) (void)]
|
||
|
|
[(3) (void)]
|
||
|
|
[(4) (void)]
|
||
|
|
[(5) (void)]
|
||
|
|
[(6) (void)]
|
||
|
|
[(7) (void)])]
|
||
|
|
[(1) (void)]
|
||
|
|
[(2) (void)]
|
||
|
|
[(3) (void)]
|
||
|
|
[(4 5 6 7) (void)]
|
||
|
|
[else (error "bad instruction")]
|
||
|
|
)
|
||
|
|
)
|
||
|
|
)))
|
||
|
|
|
||
|
|
(define (test1)
|
||
|
|
(begin
|
||
|
|
(define m (make-memory))
|
||
|
|
(set-state! 'state-PC m #x150)
|
||
|
|
(set-byte! #x150 'nil m #x00)
|
||
|
|
(read-instruction m)))
|
||
|
|
|
||
|
|
(define (test2)
|
||
|
|
(begin
|
||
|
|
(define m (make-memory))
|
||
|
|
(set-state! 'state-PC m #x150)
|
||
|
|
(set-byte! #x150 'nil m #x08)
|
||
|
|
(set-byte! #x151 'nil m #x69)
|
||
|
|
(set-byte! #x152 'nil m #xFF)
|
||
|
|
(read-instruction m)))
|
||
|
|
|
||
|
|
(provide (all-defined-out))
|