|
- #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))
|