Changeset 13764

Timestamp:

Jun 1, 2010, 4:23:54 AM (14 years ago)

Author:

Gary Byers

Message:

Some fixes (may still be some inconsistencies) in handling memory
operands with 8-bit offsets.
Some sugraring: nil, sp jump labels, etc.

File:

• branches/arm/compiler/ARM/arm-disassemble.lisp (modified) (2 diffs)

branches/arm/compiler/ARM/arm-disassemble.lisp

@@ -192 +192 @@
 (defun extract-arm-m8-operand (opcodes i)
   (let* ((opcode (adi-opcode (svref opcodes i))))
-    (let* ((immediate (not (logbitp 25 opcode)))
+    (let* ((immediate (logbitp 22 opcode))
            (disp (dpb (ldb (byte 4 8) opcode)
                       (byte 4 4)
@@ -319 +319 @@
 (defun disassemble-arm-xfunction (xfunction &optional (stream *debug-io*))
   (let* ((adi-vector (process-adi-vector (make-adi-vector (uvref xfunction 1)))))
-    (dotimes (i (length adi-vector))
-      (let* ((info (svref adi-vector i)))
-        (when (adi-labeled info)
-          (format stream "~&L~d~&" (ash i 2)))
-        (let* ((name (adi-mnemonic info)))
+    (labels ((format-spname (name stream)
+               (let* ((string (string name))
+                      (n (length string))
+                      (copy (make-string n)))
+                 (declare (dynamic-extent copy))
+                 (dotimes (i n (format stream "~a" copy))
+                   (let* ((ch (char string i)))
+                     (setf (schar copy i)
+                           (if (< i 3)
+                             ch
+                             (char-downcase ch))))))))
+      (do* ((j (1- (length adi-vector)) (1- j)))
+           ((< j 0))
+        (let* ((info (svref adi-vector j))
+               (name (adi-mnemonic info)))
           (when name
-            (let* ((condition-name (or (adi-condition-name info) "")))
+            (unless (equal name ":word")
+              (unless (equal name "ba")
+                (return))
+              (unless (eq (adi-labeled info) t)
+                (return))
+              (setf (adi-labeled info)
+                    (concatenate 'string "L"
+                                 (with-output-to-string (s)
+                                                        (format-spname (cadr (car (adi-operands info))) s))))))))
+      (dotimes (i (length adi-vector))
+        (let* ((info (svref adi-vector i))
+               (labeled (adi-labeled info)))
+          (when labeled
+            (if (eq t labeled)
+              (format stream "~&L~d~&" (ash i 2))
+              (format stream "~&~a~&" labeled)))
+          (let* ((name (adi-mnemonic info)))
+            (when name
+              (let* ((condition-name (or (adi-condition-name info) "")))
                 (format stream "~&  (~a~a" name condition-name))
-            (labels ((format-operand (operand)
-                       (write-char #\space stream)
-                       (if (atom operand)
-                         (if (and (typep operand 'integer)
-                                  (> (abs operand) 100))
-                           (format stream "#x~x" operand)
-                           (format stream "~d" operand))
-                         (ecase (car operand)
-                           (:= (format stream "(:=")
-                               (format-operand (cadr operand))
-                               (write-char #\) stream))
-                           (:label (format stream "L~d" (ash (cadr operand) 2)))
-                           (:constant (format stream "~s" (list 'quote (uvref xfunction (cadr operand)))))
-                           ((:lsl :lsr :asr :ror :rrx)
-                            (format stream "(:~a" (string-downcase (car operand)))
-                            (dolist (sub (cdr operand))
-                              (format-operand sub))
-                            (write-char #\) stream))
-                           (:spname
-                            (let* ((string (string (cadr operand)))
-                                   (n (length string))
-                                   (copy (make-string n)))
-                              (declare (dynamic-extent copy))
-                              (dotimes (i n (format stream "~a" copy))
-                                (let* ((ch (char string i)))
-                                  (setf (schar copy i)
-                                        (if (< i 3)
-                                          ch
-                                          (char-downcase ch)))))))
-                           (:$ (format stream "(:$")
-                               (format-operand (cadr operand))
-                               (write-char #\) stream))
-                           (:? (format stream "(:? ~a)" (cadr operand)))
-                           (:gpr (format stream "~a" (svref *arm-gpr-names* (cadr operand))))
-                           (:single (format stream "s~d" (cadr operand)))
-                           (:double (format stream "d~d" (cadr operand)))
-                           (:reglist (format stream "~a"
-                                             (mapcar (lambda (r)
-                                                       (svref *arm-gpr-names* r))
-                                                     (cadr operand))))
-                           ((:@ :@! :+@ :+@! :-@ :-@! :@+ :@-)
-                            (format stream "(~s" (car operand))
-                            (dolist (sub (cdr operand))
-                              (format-operand sub))
-                            (write-char #\) stream))
-                           (:!
-                            (format stream "(:!")
-                            (format-operand (cadr operand))
-                            (write-char #\) stream))))))
-              (dolist (op (adi-operands info))
-                (format-operand op))
-              (write-char #\) stream))))))))
+              (labels ((format-operand (operand)
+                         (write-char #\space stream)
+                         (if (atom operand)
+                           (if (and (typep operand 'integer)
+                                    (> (abs operand) 100))
+                             (format stream "#x~x" operand)
+                             (format stream "~d" operand))
+                           (ecase (car operand)
+                             (:= (format stream "(:=")
+                                 (format-operand (cadr operand))
+                                 (write-char #\) stream))
+                             (:label
+                              (let* ((target (if (< (cadr operand) (length adi-vector))
+                                               (svref adi-vector (cadr operand))))
+                                     (target-labeled (and target (adi-labeled target)))
+                                     (target-label (and (not (eq target-labeled t))
+                                                        target-labeled)))
+                                (if target-label
+                                  (format stream "~a" target-label)
+                                  (format stream "L~d" (ash (cadr operand) 2)))))
+                             (:constant (format stream "~s" (list 'quote (uvref xfunction (cadr operand)))))
+                             ((:lsl :lsr :asr :ror :rrx)
+                              (format stream "(:~a" (string-downcase (car operand)))
+                              (dolist (sub (cdr operand))
+                                (format-operand sub))
+                              (write-char #\) stream))
+                             (:spname
+                              (format-spname (cadr operand) stream))
+                             (:$
+                              (if (eql (cadr operand) arm::nil-value)
+                                (format stream "'nil")
+                                (progn
+                                  (format stream "(:$")
+                                  (format-operand (cadr operand))
+                                  (write-char #\) stream))))
+                             (:? (format stream "(:? ~a)" (cadr operand)))
+                             (:gpr (format stream "~a" (svref *arm-gpr-names* (cadr operand))))
+                             (:single (format stream "s~d" (cadr operand)))
+                             (:double (format stream "d~d" (cadr operand)))
+                             (:reglist (format stream "~a"
+                                               (mapcar (lambda (r)
+                                                         (svref *arm-gpr-names* r))
+                                                       (cadr operand))))
+                             ((:@ :@! :+@ :+@! :-@ :-@! :@+ :@-)
+                              (format stream "(~s" (car operand))
+                              (dolist (sub (cdr operand))
+                                (format-operand sub))
+                              (write-char #\) stream))
+                             (:!
+                              (format stream "(:!")
+                              (format-operand (cadr operand))
+                              (write-char #\) stream))))))
+                (dolist (op (adi-operands info))
+                  (format-operand op))
+                (write-char #\) stream)))))))))