;;;; 6502.scm


;; addressing modes

;; (defaddrmode ADDRMODE ADDRESS)

(defaddrmode imp 0)		; implied
(defaddrmode imm (begin0 PC (incw! PC))) ; immediate

(defaddrmode abs			; ABS
  (begin0 (peekw M PC) (incw! PC 2)))

(defaddrmode rel			; relative
  (let ((x (peek M PC)))
    (incw! PC)
    (when (nflag? x) (set! x (fx- x #x100)))
    (unless (fx= (hi x) (hi PC)) (incb! T))
    x))

(defaddrmode ind			; (ABS)
  (let ((x (peekw M PC)))
    (begin0 (peekw M x) (incw! PC 2))))

(defaddrmode absx			; ABS,X
  (let ((x (peekw M PC)))
    (incw! PC 2)
    (when (and (fx= T 4) 
	       (not (fx= (hi x) (hi (fx+ x X)))))
      (incb! T))
    (fx+ x X)))

(defaddrmode absy			; ABS,Y
  (let ((x (peekw M PC)))
    (incw! PC 2)
    (when (and (fx= T 4) 
	       (not (fx= (hi x) (hi (fx+ x Y)))))
      (incb! T))
    (fx+ x Y)))

(defaddrmode zp				; ZP
  (begin0 (peek M PC) (incw! PC)))

(defaddrmode zpx			; ZP,X
  (begin0 (lo (fx+ (peek M PC) X)) (incw! PC)))

(defaddrmode zpy			; ZP,Y
  (begin0 (lo (fx+ (peek M PC) Y)) (incw! PC)))

(defaddrmode indx 			; (ZP,X)
  (let ((v (fx+ (peek M PC) X)))
    (incw! PC)
    (peekw M v)))

(defaddrmode indy 			; (ZP),Y
  (let ((v (peek M PC)))
    (incw! PC)
    (let ((v (peekw M v)))
      (when (and (fx= T 5)
		 (not (fx= (hi v) (hi (fx+ v Y)))))
	(incb! T))
      (word (fx+ v Y)))))

(defaddrmode indabsx			; (ABS,X)
  (let ((x (fx+ (peekw M PC) X)))
    (peekw M x)))

(defaddrmode indzp			; (ZP)
  (peekw M (peek M (fx+ PC 1))))


;; (defop MNEMONIC ((OPCODE CLOCKTICKS ADDRMODE) ...) CODE)

(defop brk ((#x00 7 imp))
  (poke! M (fx+ #x100 S) (hi PC))
  (decb! S)
  (poke! M (fx+ #x100 S) (lo PC))
  (decb! S)
  (poke! M (fx+ #x100 S) P)
  (decb! S)
  (or! P #x14)
  (set! PC (lohi (peek M #xfffe) (peek M #xffff))))

(defop ora ((#x01 6 indx) (#x05 3 zp) (#x09 3 imm)
	    (#x0d 4 abs) (#x11 5 indy) (#x12 3 indzp)
	    (#x15 4 zpx) (#x19 4 absy) (#x1d 4 absx))
  (or! A (peek M V))
  (zflag! P A)
  (nflag! P A))

(defop nop ((#x02 2 imp) (#x03 2 imp) (#x07 2 imp)
	    (#x0b 2 imp) (#x0f 2 imp) (#x13 2 imp)
	    (#x17 2 imp) (#x1b 2 imp) (#x1f 2 imp)
	    (#x22 2 imp) (#x23 2 imp) (#x27 2 imp)
	    (#x2b 2 imp) (#x2f 2 imp) (#x33 2 imp)
	    (#x37 2 imp) (#x3b 2 imp) (#x3f 2 imp)
	    (#x42 2 imp) (#x43 2 imp) (#x44 2 imp)
	    (#x47 2 imp) (#x4b 2 imp) (#x4f 2 imp)
	    (#x53 2 imp) (#x54 2 imp) (#x57 2 imp)
	    (#x5b 2 imp) (#x5c 2 imp) (#x5f 2 imp)
	    (#x62 2 imp) (#x63 2 imp) (#x67 2 imp)
	    (#x6b 2 imp) (#x6f 2 imp) (#x73 2 imp)
	    (#x77 2 imp) (#x7b 2 imp) (#x7f 2 imp)
	    (#x82 2 imp) (#x83 2 imp) (#x87 2 imp)
	    (#x8b 2 imp) (#x8f 2 imp) (#x93 2 imp)
	    (#x97 2 imp) (#x9b 2 imp) (#x9f 2 imp)
	    (#xa3 2 imp) (#xa7 2 imp) (#xab 2 imp)
	    (#xaf 2 imp) (#xb3 2 imp) (#xb7 2 imp)
	    (#xbb 2 imp) (#xbf 2 imp) (#xc2 2 imp)
	    (#xc3 2 imp) (#xc7 2 imp) (#xcb 2 imp)
	    (#xcf 2 imp) (#xd3 2 imp) 
	    (#xd4 2 imp) (#xdb 2 imp) (#xdc 2 imp)
	    (#xdf 2 imp) (#xe3 2 imp) 
	    (#xe7 2 imp) (#xea 2 imp) (#xeb 2 imp)
	    (#xef 2 imp) (#xf3 2 imp) (#xf4 2 imp)
	    (#xf7 2 imp) (#xfb 2 imp) (#xfc 2 imp)
	    (#xff 2 imp))
  (void))

(defop tsb ((#x04 3 zp) (#x0c 4 abs))
  (or! V A)
  (zflag! P (peek M V)))

(defop asl ((#x06 5 zp) (#x0e 6 abs) (#x16 6 zpx) (#x1e 7 absx))
  (let ((v2 (peek M V)))
    (set! P (fxior (fxand P #xfe) (fxand (fxshr v2 7) #x01)))
    (set! v2 (fxand #xff (fxshl v2 1)))
    (poke! M V v2)
    (zflag! P v2)
    (nflag! P v2)))

(defop asla ((#x0a 2 imp))
  (set! P (fxior (fxand P #xfe) (fxand (fxshr A 7) #x01)))
  (set! A (fxand #xff (fxshl A 1)))
  (zflag! P A)
  (nflag! P A))

(defop php ((#x08 3 imp))
  (poke! M (+ #x100 S) P)
  (decb! S))

(defop bpl ((#x10 2 rel))
  (unless (nflag? P)
    (incw! PC V)
    (incb! T)))

(defop trb ((#x14 3 zp) (#x1c 4 abs))
  (let ((x (fxand (peek M V) (fxxor A #xff))))
    (poke! M V x)
    (zflag! P x)))

(defop clc ((#x18 2 imp))
  (set! P (fxand P #xfe)))

(defop ina ((#x1a 2 imp))
  (incb! A)
  (zflag! P A)
  (nflag! P A))

(defop jsr ((#x20 6 abs))
  (let ((x (fx- PC 1)))
    (poke! M (fx+ #x100 S) (hi x))
    (decb! S)
    (poke! M (fx+ #x100 S) (lo x))
    (decb! S)
    (set! PC V)))

(defop and ((#x21 6 indx) (#x25 3 zp) (#x29 3 imm) (#x2d 4 abs)
	    (#x31 5 indy) (#x32 3 indzp) (#x35 4 zpx) (#x39 4 absy)
	    (#x3d 4 absx))
  (and! A (peek M V))
  (zflag! P A)
  (nflag! P A))

(defop bit ((#x24 3 zp) (#x2c 4 abs) (#x34 4 zpx) (#x3c 4 absx)
	    (#x89 2 imm))
  (let ((x (peek M V)))
    (zflag! P (fxand x A))
    (set! P (fxior (fxand P #x3f) (fxand x #xc0)))))

(defop rol ((#x26 5 zp) (#x2e 6 abs) (#x36 6 zpx) (#x3e 7 absx))
  (let ((flags (fxand P #x01))
	(x (peek M V)))
    (set! P (fxior (fxand P #xfe) (fxand (fxshr x 7) #x01)))
    (let ((x (fxior (fxshl x 1) flags)))
      (poke! M V x)
      (zflag! P x)
      (nflag! P x))))

(defop rola ((#x2a 2 imp))
  (let ((flags (fxand P #x01)))
    (set! P (fxior (fxand P #xfe) (fxand (fxshr A 7) #x01)))
    (set! A (fxior flags (fxshl A 1)))
    (zflag! P A)
    (nflag! P A)))

(defop plp ((#x28 4 imp))
  (incb! S)
  (set! P (fxior (peek M (fx+ S #x100)) #x20)))

(defop bmi ((#x30 2 rel))
  (when (nflag? P)
    (incw! PC V)
    (incb! T)))

(defop bvs ((#x70 2 rel))
  (unless (zero? (fxand P #x40))
    (incw! PC V)
    (incb! T)))

(defop sec ((#x38 2 imp))
  (or! P 1))

(defop dea ((#x3a 2 imp))
  (decb! A)
  (zflag! P A)
  (nflag! P A))

(defop rti ((#x40 6 imp))
  (incb! S)
  (set! P (fxior (peek M (fx+ S #x100)) #x20))
  (set! PC 
    (lohi (peek M (fx+ (byte (fx+ S 1)) #x100))
	  (peek M (fx+ (byte (fx+ S 2)) #x100))))
  (incw! PC)
  (incb! S 2))

(defop eor ((#x41 6 indx) (#x45 3 zp) (#x49 3 imm) (#x4d 4 abs)
	    (#x51 5 indy) (#x52 3 indzp) (#x55 4 zpx) (#x59 4 absy)
	    (#x5d 4 absx))
  (set! A (fxxor A (peek M V)))
  (zflag! P A)
  (nflag! P A))

(defop lsr ((#x46 5 zp) (#x4e 6 abs) (#x56 6 zpx) (#x5e 7 absx))
  (let ((x (peek M V)))
    (set! P (fxior (fxand P #xfe) (fxand x #x01)))
    (set! x (fxshr x 1))
    (poke! M V x)
    (set! P
      (if (zero? x)
	  (fxior P #x02)
	  (fxand P #xfd)))
    (set! P
      (if (fx= #x80 (fxand x #x80))
	  (fxior P #x80)
	  (fxand P #x7f)))))

(defop pha ((#x48 3 imp))
  (poke! M (fx+ #x100 S) A)
  (decb! S))

(defop lsra ((#x4a 2 imp))
  (set! P (fxior (fxand P #xfe) (fxand A #x01)))
  (set! A (fxshr A 1))
  (zflag! P A)
  (nflag! P A))

(defop jmp ((#x4c 3 abs) (#x6c 5 ind) (#x7c 6 indabsx))
  (set! PC V))

(defop bvc ((#x50 2 rel))
  (when (zero? (fxand P #x40))
    (incw! PC V)
    (incb! T)))

(defop cli ((#x58 2 imp))
  (and! P #xfb))

(defop phy ((#x5a 3 imp))
  (poke! M (fx+ #x100 S) Y)
  (decb! S))

(defop rts ((#x60 6 imp))
  (incb! S)
  (set! PC
    (lohi (peek M (fx+ #x100 S))
	  (peek M (fx+ #x100 (byte (fx+ S 1))))))
  (incw! PC)
  (incb! S))

(defop adc ((#x61 6 indx) (#x65 3 zp) (#x69 3 imm) (#x6d 4 abs)
	    (#x71 5 indy) (#x72 3 indzp) (#x75 4 zpx) (#x79 4 absy)
	    (#x7d 4 absx))
  (let* ((x (peek M V))
	 (sf (fxand P #x01))		; C
	 (sum (fx+ (sextend A) (fx+ (sextend x) (fxshl sf 4)))))
    (set! P				; set or clear V
      (if (or (fx> sum #x7f) (fx< sum (fxneg #x80)))
	  (fxior P #x40)
	  (fxand P #xbf)))
    (let ((sum (fx+ (fxand A #xff) (fx+ (fxand #xff x) sf)))) ; unsigned
      (set! P				; set or clear carry
	(if (fx> sum #xff)
	    (fxior P #x01)
	    (fxand P #xfe)))
      (set! A (byte sum))
      (cond ((zero? (fxand P #x08))	; D
	     (incb! T))
	    (else
	     (and! P #xfe)
	     (when (fx> (fxand A #x0f) #x09)
	       (incb! A #x06))
	     (when (fx> (fxand A #xf0) #x90)
	       (incb! A #x60)
	       (or! P #x01))))
      (zflag! P A)
      (nflag! P A))))

(defop stz ((#x64 3 zp) (#x74 4 zpx) (#x9c 4 abs) (#x9e 5 absx))
  (poke! M V 0))

(defop ror ((#x66 5 zp) (#x6e 6 abs) (#x76 6 zpx) (#x7e 7 absx))
  (let ((sf (fxior P #x01))
	(x (peek M V)))
    (set! P (fxior (fxand P #xfe) (fxand x #x01)))
    (let ((x (fxshr x 1)))
      (unless (zero? sf) (or! x #x80))
      (poke! M V x)
      (zflag! P x)
      (nflag! P x))))

(defop pla ((#x68 4 imp))
  (incb! S)
  (set! A (peek M (fx+ S #x100)))
  (zflag! P A)
  (nflag! P A))

(defop rora ((#x6a 2 imp))
  (let ((sf (fxand P #x01)))
    (set! P (fxior (fxand P #xfe) (fxand A #x01)))
    (set! A (fxshr A 1))
    (unless (zero? sf) (or! A #x80))
    (zflag! P A)
    (nflag! P A)))

(defop sei ((#x78 2 imp))
  (or! P #x04))

(defop ply ((#x7a 4 imp))
  (incb! S)
  (set! Y (peek M (fx+ S #x100)))
  (zflag! P Y)
  (nflag! P Y))

(defop bra ((#x80 2 rel))
  (incw! PC V)
  (incb! T))

(defop sta ((#x81 6 indx) (#x85 2 zp) (#x8d 3 abs) (#x91 6 indy)
	    (#x92 3 indzp) (#x95 4 zpx) (#x99 5 absy) (#x9d 5 absx))
  (poke! M V A))

(defop sty ((#x84 2 zp) (#x8c 4 abs) (#x94 4 zpx))
  (poke! M V Y))

(defop stx ((#x86 2 zp) (#x8e 4 abs) (#x96 4 zpy))
  (poke! M V X))

(defop dey ((#x88 2 imp))
  (decb! Y)
  (zflag! P Y)
  (nflag! P Y))

(defop txa ((#x8a 2 imp))
  (set! A X)
  (zflag! P A)
  (nflag! P A))

(defop bcc ((#x90 2 rel))
  (when (zero? (fxand P #x01))
    (incw! PC V)
    (incb! T)))

(defop tya ((#x98 2 imp))
  (set! A Y)
  (zflag! P A)
  (nflag! P A))

(defop txs ((#x9a 2 imp))
  (set! S X))

(defop ldy ((#xa0 3 imm) (#xa4 3 zp) (#xac 4 abs) (#xb4 4 zpx)
	    (#xbc 4 absx))
  (set! Y (peek M V))
  (zflag! P Y)
  (nflag! P Y))

(defop lda ((#xa1 6 indx) (#xa5 3 zp) (#xa9 3 imm) (#xad 4 abs)
	    (#xb1 5 indy) (#xb2 3 indzp) (#xb5 4 zpx) (#xb9 4 absy)
	    (#xbd 4 absx))
  (set! A (peek M V))
  (zflag! P A)
  (nflag! P A))

(defop ldx ((#xa2 3 imm) (#xa6 3 zp) (#xae 4 abs) (#xb6 4 zpy)
	    (#xbe 4 absy))
  (set! X (peek M V))
  (zflag! P X)
  (nflag! P X))

(defop tay ((#xa8 2 imp))
  (set! Y A)
  (zflag! P Y)
  (nflag! P Y))

(defop tax ((#xaa 2 imp))
  (set! X A)
  (zflag! P X)
  (nflag! P X))

(defop bcs ((#xb0 2 rel))
  (unless (zero? (fxand P #x01))
    (incw! PC V)
    (incb! T)))

(defop clv ((#xb8 2 imp))
  (and! P #xbf))
  
(defop tsx ((#xba 2 imp))
  (set! X S)
  (zflag! P X)
  (nflag! P X))

(defop cpy ((#xc0 3 imm) (#xc4 3 zp) (#xcc 4 abs))
  (let ((x (fx- (fx+ Y #x100) (peek M V))))
    (set! P
      (if (fx> x #xff)
	  (fxior P #x01)
	  (fxand P #xfe)))
    (zflag! P x)
    (nflag! P x)))

(defop cmp ((#xc1 6 indx) (#xc5 3 zp) (#xc9 3 imm) (#xcd 4 abs)
	    (#xd1 5 indy) (#xd2 3 indzp) (#xd5 4 zpx) (#xd9 4 absy)
	    (#xdd 4 absx))
  (let ((x (fx- (fx+ A #x100) (peek M V))))
    (set! P
      (if (fx> x #xff)
	  (fxior P #x01)
	  (fxand P #xfe)))
    (zflag! P x)
    (nflag! P x)))

(defop dec ((#xc6 5 zp) (#xce 6 abs) (#xd6 6 zpx) (#xde 7 absx))
  (let ((x (fx- (peek M V) 1)))
    (poke! M V x)
    (zflag! P x)
    (nflag! P x)))

(defop iny ((#xc8 2 imp))
  (incb! Y)
  (zflag! P Y)
  (nflag! P Y))

(defop dex ((#xca 2 imp))
  (decb! X)
  (zflag! P X)
  (nflag! P X))

(defop bne ((#xd0 2 rel))
  (when (zero? (fxand P #x02))
    (incw! PC V)
    (incb! T)))

(defop cld ((#xd8 2 imp))
  (and! P #xf7))

(defop phx ((#xda 3 imp))
  (poke! M (fx+ S #x100) X)
  (decb! S))

(defop cpx ((#xe0 3 imm) (#xe4 3 zp) (#xec 4 abs))
  (let ((x (fx- (fx+ X #x100) (peek M V))))
    (set! P
      (if (fx> x #xff)
	  (fxior P #x01)
	  (fxand P #xfe)))
    (zflag! P x)
    (nflag! P x)))

(defop sbc ((#xe1 6 indx) (#xe5 3 zp) (#xe9 3 imm) (#xed 4 abs)
	    (#xf1 5 indy) (#xf2 3 indzp) (#xf5 4 zpx) (#xf9 4 absy)
	    (#xfd 4 absx))
  (let* ((x (fxxor (peek M V) #xff))
	 (sf (fxand P #x01))		; C
	 (sum (fx+ (sextend A) (fx+ (sextend x) sf))))
    (set! P 
      (if (or (fx> sum #x7f) (fx< sum (fxneg #x80)))
	  (fxior P #x40)		; V
	  (fxand P #xbf)))
    (let ((sum (fx+ A (fx+ x sf))))
      (set! P
	(if (fx> sum #xff)
	    (fxior P #x01)
	    (fxand P #xfe)))
      (set! A (byte sum))
      (cond ((zero? (fxand P #x08))	; D
	     (incb! T))
	    (else
	     (decb! A #x66)
	     (and! P #xfe)
	     (when (fx> (fxand A #x0f) #x09)
	       (incb! A #x06))
	     (when (fx> (fxand A #xf0) #x90)
	       (incb! A #x60)
	       (or! P #x01))))
      (zflag! P A)
      (nflag! P A))))

(defop inc ((#xe6 5 zp) (#xee 6 abs) (#xf6 6 zpx) (#xfe 7 absx))
  (let ((x (fx+ (peek M V) 1)))
    (poke! M V x)
    (zflag! P x)
    (nflag! P x)))

(defop inx ((#xe8 2 imp))
  (incb! X)
  (zflag! P X)
  (nflag! P X))

(defop beq ((#xf0 2 rel))
  (unless (zero? (fxand P #x02))
    (incw! PC V)
    (incb! T)))

(defop sed ((#xf8 2 imp))
  (or! P #x08))

(defop plx ((#xfa 4 imp))
  (incb! S)
  (set! X (peek M (fx+ S #x100)))
  (zflag! P X)
  (nflag! P X))