added some error checking for debugging clarity
Thu Oct 25 00:09:50 PDT 2007 Ties Stuij <ties@stuij.se>
* added some error checking for debugging clarity
diff -rN -u old-armish/src/arm-instructions.lisp new-armish/src/arm-instructions.lisp
--- old-armish/src/arm-instructions.lisp 2014-04-23 23:47:17.000000000 -0700
+++ new-armish/src/arm-instructions.lisp 2014-04-23 23:47:17.000000000 -0700
@@ -478,7 +478,10 @@
(progn
(define-arm-instruction b (label)
- (let ((offset (- (label-address label) (+ *here* 8))))
+ (let* ((l-addr (label-address label))
+ (offset (if l-addr
+ (- l-addr (+ *here* 8))
+ (error "label :~A in (b :~A) was never defined" label label))))
(assert (zerop (logand offset 3))) ; 4-byte aligned offset
(+ (ash #b101 25)
(encode-twos-complement (ash offset -2) 24))))
@@ -493,7 +496,10 @@
(assert (not (= it 15)))
(+ #x12FFF30
it))
- (let ((offset (- (label-address target) (+ *here* 8))))
+ (let* ((l-addr (label-address target))
+ (offset (if l-addr
+ (- l-addr (+ *here* 8))
+ (error "label :~A in (blx :~A) was never defined" target target))))
(assert (zerop (logand offset 3))) ; 4-byte aligned offset
(+ (ash #b1111101 25)
(logand (ash offset -2) #xffffff)
diff -rN -u old-armish/src/assembler.lisp new-armish/src/assembler.lisp
--- old-armish/src/assembler.lisp 2014-04-23 23:47:17.000000000 -0700
+++ new-armish/src/assembler.lisp 2014-04-23 23:47:17.000000000 -0700
@@ -12,10 +12,10 @@
(defvar *size*) ; final size of pass
(defvar *mode*) ; arm or thumb
(defvar *labels*) ; local assembly labels
-(defvar *version*) ; processor capabilities and enhancements
+(defvar *version*) ; processor capabilities and enhancements
(defvar *pool*) ; current active literal pool
(defvar *pool-position*) ; position of the current pool
-(defvar *pool-pairs*) ; list of cons who's car is a literary pool and who's cdr is
+(defvar *pool-pairs*) ; list of cons who's car is a literary pool and who's cdr is
; the end address of it's offset
;; setters, getters and checkers
@@ -95,9 +95,9 @@
(defun resolve-symbol (symbol)
(case symbol
(code32 (progn (set-mode *arm*)
- (align-assembled)))
+ (align-assembled)))
(code16 (progn (set-mode *thumb*)
- (align-assembled 2)))
+ (align-assembled 2)))
(align (align-assembled))
(align-hw (align-assembled 2))
(pool (dump-pool))
@@ -106,14 +106,15 @@
(defun assemble-form (form)
"Looks up an instruction in the instruction set and assembles with arguments."
- (let ((ass-fn (gethash (first form) *mode*)))
- (if ass-fn
- (mapcan #'(lambda (opcode)
- (when opcode
- (cond ((eq *mode* *arm*) (nr-to-big-endian-word-byte-list opcode))
- ((eq *mode* *thumb*) (nr-to-big-endian-halfword-byte-list opcode)))))
- (ensure-list (apply ass-fn (rest form))))
- (apply (gethash (first form) *directives*) (rest form)))))
+ (aif (gethash (first form) *mode*)
+ (mapcan #'(lambda (opcode)
+ (when opcode
+ (cond ((eq *mode* *arm*) (nr-to-big-endian-word-byte-list opcode))
+ ((eq *mode* *thumb*) (nr-to-big-endian-halfword-byte-list opcode)))))
+ (ensure-list (apply it (rest form))))
+ (aif (gethash (first form) *directives*)
+ (apply it (rest form))
+ (error "mnemonic ~A from form ~A not recognized" (first form) form))))
(defun reform-string (string)
(vector-to-list (string-to-octets string :utf-8)))