summaryrefslogtreecommitdiff
path: root/binary.lisp
blob: 75ca5e9348f411d560717e0a00e3ca7791a46391 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
;; -*- mode: common-lisp -*-
#|
clasm-6502: An assembler for the 6502 written in Common Lisp.
Copyright (C) 2024  Aleksei Eaves

This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.

This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
|#

;; Rules for converting an addressing mode argument.
(defparameter
	*convert-addressing-modes*
  '(
	(immediate
	 (lambda (s)
	   (let ((return-value 0) ; Final return value.
			 (operand nil))   ; Stores +/- found.
		 (dotimes (i (length s))
		   (cond
			 ;; Starting hash
			 ((eq (char s i) #\#)
			  nil)
			 ;; Hexadecimal value
			 ((eq (char s i) #\$)
			  (progn (incf i)
					 (setf return-value
						   (if (not (equal operand nil))
							   (funcall operand
										return-value
										(hex2dec (subseq s i (+ i 2))))
							   (hex2dec (subseq s i (+ i 2)))))
					 (incf i)))
			 ;; Plus or Minus
			 ((or (eq (char s i) #\+)
				  (eq (char s i) #\-))
			  (setf operand
					(read-from-string (subseq s i (+ i 1)))))
			 ;; Interpret character
			 ((and (eq (char s i) #\')
				   (eq (char s (+ i 2)) #\'))
			  (progn (incf i)
					 (setf return-value
						   (if (not (equal operand nil))
							   (funcall operand
										return-value
										(char-code (char s i)))
							   (char-code (char s i))))
					 (incf i)))
			 (t (error "Badly formed immediate instruction."))
			 ))
		 (mod return-value 256)))
	 (absolute
	  (lambda (s)
		(list (hex2dec (subseq s 1 3))
			  (hex2dec (subseq s 3 5)))))
	 (zero-page
	  (lambda (s)
		(list (hex2dec (subseq s 1 3)))))
	 (implied
	  (lambda (s)
		nil))
	 (indirect-absolute
	  (lambda (s)
		(list (hex2dec (subseq s 2 4))
			  (hex2dec (subseq s 4 6)))))
	 (absolute-indexed-x
	  (lambda (s)
		(list (hex2dec (subseq s 1 3))
			  (hex2dec (subseq s 3 5)))))
	 (absolute-indexed-y
	  (lambda (s)
		(list (hex2dec (subseq s 1 3))
			  (hex2dec (subseq s 3 5)))))
	 (zero-page-indexed-x
	  (lambda (s) 
		(list (hex2dec (subseq s 1 3)))))
	 (zero-page-indexed-y
	  (lambda (s)
		(list (hex2dec (subseq s 1 3)))))
	 (indexed-indirect
	  (lambda (s)
		(list (hex2dec (subseq s 2 4)))))
	 (indirect-indexed
	  (lambda (s)
		(list (hex2dec (subseq s 2 4)))))
	 (relative
	  (lambda (s)
		(list (hex2dec (subseq s 1 3))
			  (hex2dec (subseq s 3 5)))))
	 (accumulator
	  (lambda (s)
		nil)))))