Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Release: 0.8.9. Now with even more SEXP!

  • Loading branch information...
commit 75fffbd4aa3fb813835c4a476d43e907f8cb120b 1 parent 0807e7c
@kingcons authored
View
4 NEWS.md
@@ -1,3 +1,7 @@
+## Changes for 0.8.9 (2013-03-03):
+
+* Add symbolic assembly and disassembly, i.e. sexp-format support.
+
## Changes for 0.8.8 (2013-02-23):
* Massive package overhaul and docs update.
View
3  TODO
@@ -3,8 +3,7 @@ Improve the disassembler for browsing large ROMs. (i.e. Mega Man 2)
Find other example programs?
Ideas:
-Turn ASM into a generic function.
--- Current definition becomes (asm STRING). Write (asm LIST). :)
+Write a high-level macro-assembler! (using defmacro and sexps, of course)
Define restarts for step?
-- Define the instruction.
-- Hand over a lambda to funcall/form to eval.
View
2  cl-6502.asd
@@ -1,7 +1,7 @@
(defsystem #:cl-6502
:name "cl-6502"
:description "An emulator for the MOS 6502 CPU"
- :version "0.8.6"
+ :version "0.8.9"
:license "BSD"
:author "Brit Butler <redline6561@gmail.com>"
:pathname "src/"
View
11 docs/cl-6502.html
@@ -94,9 +94,9 @@
<div class="definition">
<a class="symbolname" name="asm_func" href="#asm_func">asm</a>
<span class="lambdalist">source</span>
-<span class="symboltype">function</span></div>
+<span class="symboltype">standard-generic-function</span></div>
<div class="documentation">
-<pre>Assemble SOURCE string into a bytevector and return it.</pre></div></div>
+<pre>Assemble SOURCE into a bytevector and return it.</pre></div></div>
<div class="symboldecl">
<div class="definition">
<a class="symbolname" name="disasm_func" href="#disasm_func">disasm</a>
@@ -106,6 +106,13 @@
<pre>Disassemble memory from START to END.</pre></div></div>
<div class="symboldecl">
<div class="definition">
+<a class="symbolname" name="disasm-to-list_func" href="#disasm-to-list_func">disasm-to-list</a>
+<span class="lambdalist">start end</span>
+<span class="symboltype">function</span></div>
+<div class="documentation">
+<pre>Disassemble a given region of memory into a SEXP-based format.</pre></div></div>
+<div class="symboldecl">
+<div class="definition">
<a class="symbolname" name="disasm-to-str_func" href="#disasm-to-str_func">disasm-to-str</a>
<span class="lambdalist">start end</span>
<span class="symboltype">function</span></div>
View
18 src/assemble.lisp
@@ -43,15 +43,27 @@
((some (lambda (x) (search x (second line))) '("&" "#$")) (+ pc 2))
(t (+ pc 3)))))
+(defgeneric asm (source)
+ (:documentation "Assemble SOURCE into a bytevector and return it.")
+ (:method :before (source) (clrhash *symtable*)))
+
+(defun process-statement (statement)
+ "Given a symbolic assembly STATEMENT, convert it to a list of bytes."
+ (destructuring-bind (op &rest args)
+ (mapcar (compose 'string-upcase 'symbol-name) statement)
+ (let ((mode (match-mode args)))
+ (list* (find-opcode op mode) (process-args args mode)))))
+
+(defmethod asm ((source list))
+ (apply 'concatenate 'vector (mapcar #'process-statement source)))
+
(defmacro with-src-pass ((src) &body body)
"Loop over SRC, tracking the PC and binding LINE. BODY should be a LOOP expr."
`(loop for pc = 0 then (next-pc line pc)
for line in (mapcar #'tokenize (cl-ppcre:split "\\n" ,src))
,@body))
-(defun asm (source)
- "Assemble SOURCE string into a bytevector and return it."
- (clrhash *symtable*)
+(defmethod asm ((source string))
(with-src-pass (source) if (preprocess-p line) do (preprocess (first line) pc))
(let ((results (with-src-pass (source)
unless (or (preprocess-p line) (emptyp line))
View
53 src/disassemble.lisp
@@ -1,31 +1,50 @@
(in-package :6502)
-(defun disasm (start end)
- "Disassemble memory from START to END."
- (loop with index = start while (< index end)
- do (incf index (disasm-ins index))))
-
-(defun disasm-ins (index)
+(defun disasm-ins (index &optional (disasm-op #'print-instruction))
"Lookup the metadata for the instruction at INDEX and pass it to
-print-instruction for formatting and display, returning the instruction length."
+DISASM-OP for formatting and display, returning the instruction length."
(destructuring-bind (name cycles length mode) (aref *opcodes* (get-byte index))
(declare (ignore cycles))
(let ((code-block (coerce (get-range index (+ index length)) 'list)))
- (print-instruction code-block index name mode)
- length)))
+ (list length (funcall disasm-op code-block index name mode)))))
+
+(defun arg-formatter (arg mode)
+ "Given an instruction's ARG, format it for display using the MODE's PRINTER."
+ (if (member mode '(absolute absolute-x absolute-y indirect))
+ (format nil (printer mode) (reverse arg))
+ (format nil (printer mode) arg)))
(defun print-instruction (bytes index name mode)
"Format the instruction at INDEX and its operands for display."
- (flet ((arg-formatter (arg)
- (if (member mode '(absolute absolute-x absolute-y indirect))
- (format nil (printer mode) (reverse arg))
- (format nil (printer mode) arg))))
- (let ((byte-str (format nil "~{~2,'0x ~}" bytes))
- (args-str (format nil "~A ~A" name (arg-formatter (subseq bytes 1))))
- (docs (documentation name 'function)))
- (format t "$~4,'0x ~9A ;; ~14A ~A~%" index byte-str args-str docs))))
+ (let ((byte-str (format nil "~{~2,'0x ~}" bytes))
+ (args-str (format nil "~A ~A" name (arg-formatter (rest bytes) mode)))
+ (docs (documentation name 'function)))
+ (format t "$~4,'0x ~9A ;; ~14A ~A~%" index byte-str args-str docs)))
+
+(defun symbolize-instruction (bytes index name mode)
+ "Given BYTES and metadata, return a SEXP-format representation of it."
+ (declare (ignore index))
+ (alexandria:if-let ((args (rest bytes))
+ (args-str (arg-formatter (rest bytes) mode)))
+ (mapcar #'make-keyword (list name args-str))
+ (mapcar #'make-keyword (list name))))
+
+(defmacro with-disasm ((start end &key op) &body body)
+ "Loop from START to END, passing each instruction to OP and execute BODY."
+ `(loop with index = ,start while (< index ,end)
+ for (step result) = (disasm-ins index ,@(when op (list op)))
+ ,@body))
+
+(defun disasm (start end)
+ "Disassemble memory from START to END."
+ (with-disasm (start end) do (incf index step)))
(defun disasm-to-str (start end)
"Call DISASM with the provided args and return its output as a string."
(with-output-to-string (*standard-output*)
(disasm start end)))
+
+(defun disasm-to-list (start end)
+ "Disassemble a given region of memory into a SEXP-based format."
+ (with-disasm (start end :op #'symbolize-instruction)
+ do (incf index step) collect result))
View
9 src/packages.lisp
@@ -1,8 +1,9 @@
(defpackage :6502
- (:use :cl :alexandria)
+ (:use :cl)
+ (:import-from :alexandria #:compose #:emptyp #:flatten #:make-keyword)
(:shadow #:bit #:and)
(:export ;; Public API
- #:execute #:6502-step #:asm #:disasm #:disasm-to-str
+ #:execute #:6502-step #:asm #:disasm #:disasm-to-str #:disasm-to-list
#:get-byte #:get-word #:get-range #:*cpu* #:cpu #:nmi #:reset
;; CPU struct
#:make-cpu #:cpu-ar #:cpu-xr #:cpu-yr #:cpu-sr #:cpu-sp #:cpu-pc #:cpu-cc #:u8
@@ -15,7 +16,7 @@
(defpackage :cl-6502
(:documentation "Homepage: <a href=\"http://github.com/redline6561/cl-6502\">Github</a>")
(:use :cl)
- (:import-from :6502 #:execute #:6502-step #:asm #:disasm #:disasm-to-str
+ (:import-from :6502 #:execute #:6502-step #:asm #:disasm #:disasm-to-str #:disasm-to-list
#:get-byte #:get-word #:get-range #:*cpu* #:cpu #:nmi #:reset)
- (:export #:execute #:6502-step #:asm #:disasm #:disasm-to-str
+ (:export #:execute #:6502-step #:asm #:disasm #:disasm-to-str #:disasm-to-list
#:get-byte #:get-word #:get-range #:*cpu* #:cpu #:nmi #:reset))
View
13 tests/assembler.lisp
@@ -100,4 +100,17 @@
loop:~% INY~% bne &loop~% sbc $0001~% brk")))
(is (equalp (asm code) #(76 8 0 24 169 0 160 0 200 208 253 237 1 0 0)))))
+(deftest assemble-symbolic
+ "A sexp-format program should assemble correctly."
+ (is (equalp (asm '((:brk))) #(0)))
+ (is (equalp (asm '((:nop))) #(234))))
+
+(deftest assemble-symbolic-with-args
+ "A sexp-format program with args should assemble correctly."
+ (let ((code '((:ldy :#$00)
+ (:iny)
+ (:bne :&fd)
+ (:sbc :$0001))))
+ (is (equalp (asm code) #(160 0 200 208 253 237 1 0)))))
+
; (deftest assemble-pc "*" nil)?
View
13 tests/disassembler.lisp
@@ -9,3 +9,16 @@
(is (search "BRK" (disasm-to-str 0 1)))
(setf (get-byte 0) 234)
(is (search "NOP" (disasm-to-str 0 1))))
+
+(deftest disasm-to-list
+ "We should be able to disassemble code to a sexp-based format."
+ (setf (get-byte 0) 0)
+ (is (equalp (6502::disasm-to-list 0 1) '((:brk))))
+ (setf (get-byte 0) 234)
+ (is (equalp (6502::disasm-to-list 0 1) '((:nop)))))
+
+(deftest disasm-to-list-with-args
+ "We should be able to disassemble code with args in a sexp-based format."
+ (setf (get-range 0) #(160 0 200 208 253 237 1 0))
+ (is (equalp (6502::disasm-to-list 0 7)
+ '((:ldy :#$00) (:iny) (:bne :&fd) (:sbc :$0001)))))

0 comments on commit 75fffbd

Please sign in to comment.
Something went wrong with that request. Please try again.