summaryrefslogtreecommitdiff
path: root/pit/test/6502.pit
diff options
context:
space:
mode:
Diffstat (limited to 'pit/test/6502.pit')
-rw-r--r--pit/test/6502.pit174
1 files changed, 0 insertions, 174 deletions
diff --git a/pit/test/6502.pit b/pit/test/6502.pit
deleted file mode 100644
index eb5a4e8..0000000
--- a/pit/test/6502.pit
+++ /dev/null
@@ -1,174 +0,0 @@
-;; (implicit )
-;; (accumulator )
-;; (immediate )
-;; (zeropage )
-;; (zeropage-x )
-;; (zeropage-y )
-;; (relative )
-;; (absolute )
-;; (absolute-x )
-;; (absolute-y )
-;; (indirect )
-;; (indexed-indirect )
-;; (indirect-indexed )
-
-(defun! 6502/ensure-u8 (x)
- (if (and (>= x 0) (<= x 0xff))
- (list x)
- (error! "operand out of range")))
-
-(defun! 6502/ensure-i8 (x)
- (cond
- ((and (>= x 0) (<= x 127)) (list x))
- ((and (>= x -128) (< x 0)) (list (+ 0xff x)))
- (error! "operand out of range")))
-
-(defun! 6502/ensure-u16 (x)
- (if (and (>= (car x) 0) (<= (car x) 0xffff))
- (list (bitwise/and 0xff x) (bitwise/and 0xff (bitwise/rshift x 8)))
- (error! "operand out of range")))
-
-(defun! 6502/identify-operand (x)
- (cond
- ((equal? x nil) (cons 'implicit nil)) ;; (<op> )
- ((equal? x '(a)) (cons 'accumulator nil)) ;; (<op> a)
- ((integer? (car x)) (cons 'immediate (6502/ensure-u8 (car x)))) ;; (<op> 0x0f)
- ((equal? (caar x) 'zeropage) ;; (<op> (zeropage 0x0f x))
- (let ((zp (car x)))
- (let ((a (6502/ensure-u8 (cadr zp))))
- (case (caddr zp)
- (x (cons 'zeropage-x a))
- (y (cons 'zeropage-y a))
- (nil (cons 'zeropage a))
- (t (error! "unknown zeropage offset register"))))))
- ((equal? (caar x) 'relative) ;; (<op> (relative 0x0f))
- (cons 'relative (6502/ensure-i8 (cadar x))))
- ((equal? (caar x) 'absolute) ;; (<op> (absolute 0x0f x))
- (let ((ab (car x)))
- (let ((a (6502/ensure-u16 (cadr ab))))
- (case (caddr ab)
- (x (cons 'absolute-x a))
- (y (cons 'absolute-y a))
- (nil (cons 'absolute a))
- (t (error! "unknown absolute offset register"))))))
- ((equal? (caar x) 'indirect)
- (cons 'indirect (6502/ensure-u16 (cadar x))))
- ((and (equal? (caar x) 'indexed-indirect) (equal? (caddar x) 'x))
- (cons 'indexed-indirect (6502/ensure-u16 (cadar x))))
- ((and (equal? (caar x) 'indirect-indexed) (equal? (caddar x) 'y))
- (cons 'indexed-indirect (6502/ensure-u16 (cadar y))))
- (t (error! "unknown operand"))))
-
-(defun! 6502/single (op)
- (case op
- ;; conditional branches
- (bpl 0x10)
- (bmi 0x30)
- (bvc 0x50)
- (bvs 0x70)
- (bcc 0x90)
- (bcs 0xb0)
- (bne 0xd0)
- (beq 0xf0)
- ;; other instructions
- (brk 0x00)
- (jsr 0x20)
- (rti 0x40)
- (rts 0x60)
- ;; other single-byte instructions
- (php 0x08)
- (clc 0x18)
- (plp 0x28)
- (sec 0x38)
- (pha 0x48)
- (cli 0x58)
- (pla 0x68)
- (sei 0x78)
- (dey 0x88)
- (tya 0x98)
- (tay 0xa8)
- (clv 0xb8)
- (iny 0xc8)
- (cld 0xd8)
- (inx 0xe8)
- (sed 0xf8)
- (txa 0x8a)
- (txs 0x9a)
- (tax 0xaa)
- (tsx 0xba)
- (dex 0xca)
- (nop 0xea)
- (t (error! "invalid single-byte instruction"))))
-
-(defun! 6502/grouped (group opbits amodebits)
- (bitwise/or
- (bitwise/lshift (bitwise/and 0b111 opbits) 5)
- (bitwise/lshift (bitwise/and 0b111 amodebits) 2)
- group))
-
-(defun! 6502/group1 (op amode)
- (6502/grouped 0b01
- (case op
- (ora 0b000)
- (and 0b001)
- (eor 0b010)
- (adc 0b011)
- (sta 0b100)
- (lda 0b101)
- (cmp 0b110)
- (sbc 0b111)
- (t (error! "invalid group 1 opcode")))
- (case amode
- (indexed-indirect 0b000)
- (zeropage 0b001)
- (immediate 0b010)
- (absolute 0b011)
- (indirect-indexed 0b100)
- (zeropage-x 0b101)
- (absolute-y 0b110)
- (absolute-x 0b111)
- (t (error! "invalid addressing mode for group 1")))))
-
-(defun! 6502/group2 (op amode)
- (6502/grouped 0b10
- (case op
- (asl 0b000)
- (rol 0b001)
- (lsr 0b010)
- (ror 0b011)
- (stx 0b100)
- (ldx 0b101)
- (dec 0b110)
- (inc 0b111)
- (t (error! "invalid group 2 opcode")))
- (cond
- ((and (or (equal? op 'stx) (equal? op 'ldx)) (equal? amode 'zeropage-y)) 0b101)
- ((and (equal? op 'ldx) (equal? amode 'absolute-y)) 0b111)
- (t
- (case amode
- (immediate 0b000)
- (zeropage 0b001)
- (accumulator 0b010)
- (absolute 0b011)
- (zeropage-x 0b101)
- (absolute-x 0b111)
- (t (error! "invalid addressing mode for group 2")))))))
-
-(defun! 6502/group3 (op amode)
- (6502/grouped 0b00
- (case op
- (bit 0b001)
- (jmp 0b010)
- (jmp-abs 0b011)
- (sty 0b100)
- (ldy 0b101)
- (cpy 0b110)
- (cpx 0b111)
- (t (error! "invalid group 3 opcode")))
- (case amode
- (immediate 0b000)
- (zeropage 0b001)
- (absolute 0b011)
- (zeropage-x 0b101)
- (absolute-x 0b111)
- (t (error! "invalid addressing mode for group 3")))))