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