6502 Addressing Mode.rkt

(define (addressing-mode registers memory)
  (let ((k (registers 'PC-ref)))
    (let ((opcode (memory-ref memory k)))
      (letrec ((self
                (lambda (message)
                  (case message
                    ;; Immediate
                    ((#b00000 #b00010 #b01001) 
                     (values opcode
                             (memory-ref memory (+ k 1))
                             ((registers 'PC-inc) 2)
                             memory))
                    ;; (Zero Page Index X)
                    ((#b00001) (let-values (((opcode 
                                              k
                                              registers 
                                              memory) (self #b10101)))
                                 (values opcode
                                         (memory-ref memory k)
                                         registers
                                         memory)))
                    ;; Zero Page
                    ((#b00100 #b00101 #b00110) 
                     (let-values (((opcode
                                    k
                                    registers
                                    memory) (self #b01001)))
                       (values opcode
                               (memory-ref memory k)
                               registers
                               memory)))
                    ;; Accumulator
                    ((#b01010) (values opcode
                                       (registers 'A-ref)
                                       ((registers 'PC-inc) 1)
                                       memory))
                    ;; Absolute
                    ((#b01100 #b01101 #b01110) 
                     (let-values (((opcode
                                    obj
                                    registers
                                    memory) (self #b01001)))
                       (values opcode
                               (memory-ref memory
                                           (+ obj
                                              (* #x100 
                                                 (memory-ref 
                                                  memory
                                                  (+ k 2)))))
                               ((registers 'PC-inc) 1)
                               memory)))
                    ;; (Zero Page) Index Y
                    ((#b10001) (let-values (((opcode
                                              obj
                                              registers
                                              memory) (self #b00101)))
                                 (values opcode
                                         (memory-ref
                                          memory
                                          (logand #xFF
                                                  (+ obj
                                                     (registers 'Y-ref))))
                                         registers
                                         memory)))
                    ;; Zero Page Index X
                    ((#b10100 #b10101 #b10110) 
                     (let-values (((opcode
                                    obj
                                    registers
                                    memory) (self #b01001)))
                       (values opcode
                               (memory-ref 
                                memory
                                (logand #xFF
                                        (+ obj
                                           (registers 
                                            (if (or (= opcode #x96)
                                                    (= opcode #xB6))
                                                'Y-ref
                                                'X-ref)))))
                               registers
                               memory)))
                    ;; Absolute Index Y
                    ((#b11001) (let-values (((opcode
                                              obj
                                              registers
                                              memory) (self #b01001)))
                                 (values opcode
                                         (memory-ref 
                                          memory
                                          (logand #xFFFF
                                                  (+ obj
                                                     (* #x100 
                                                        (memory-ref 
                                                         memory
                                                         (+ k 2)))
                                                     (registers 'Y-ref))))
                                         ((registers 'PC-inc) 1)
                                         memory)))
                    ;; Absolute Index X
                    ((#b11100 #b11101 #b11110) 
                     (let-values (((opcode
                                    obj
                                    registers
                                    memory) (self #b01001)))
                       (values opcode
                               (memory-ref 
                                memory
                                (logand #xFFFF
                                        (+ obj
                                           (* #x100 
                                              (memory-ref 
                                               memory
                                               (+ k 2)))
                                           (registers 
                                            (if (= opcode #xBE)
                                                'Y-ref
                                                'X-ref)))))
                               ((registers 'PC-inc) 1)
                               memory)))
                    ))))
        (self (bit-field opcode 0 5))))))