Changeset 14859


Ignore:
Timestamp:
09/04/16 07:01:06 (5 years ago)
Author:
Mark Evenson
Message:

[PATCH 3/5] Add multiple disassembler selector.
From 1dbd917a36154ab22bf0ddf58b6d5b7ba50603b4 Mon Sep 17 00:00:00 2001
Which allows for different disassembler backends to be used, choosing
the "best" one available by default.
---

src/org/armedbear/lisp/disassemble.lisp | 94 ++++++++++++++++++++++++++++-----
1 file changed, 82 insertions(+), 12 deletions(-)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/disassemble.lisp

    r12749 r14859  
    3434(require '#:clos)
    3535
     36(defvar *disassembler-function* NIL)
     37
     38(defvar *disassemblers*
     39  `((:objectweb . objectweb-test)
     40    (:external . external-test)))
     41
     42(defun choose-disassembler (&optional name)
     43  (setf *disassembler-function*
     44        (if name
     45            (or (funcall (cdr (assoc name *disassemblers*)))
     46                (error "Can't find suitable disassembler."))
     47            (loop
     48              for (NIL . test) in *disassemblers*
     49              for result = (funcall test)
     50              when result
     51                do (return result)
     52              finally (warn "Can't find suitable disassembler.")))))
     53
     54(eval-when (:compile-toplevel :load-toplevel :execute)
     55  (defmacro with-open ((name value) &body body)
     56    `(let ((,name ,value))
     57       (unwind-protect
     58           (progn ,@body)
     59         (java:jcall-raw "close" ,name)))))
     60
     61(defun read-byte-array-from-stream (stream)
     62  (let ((buffer (java:jnew-array (java:jclass "byte") 4096)))
     63    (with-open (output (java:jnew "java.io.ByteArrayOutputStream"))
     64      (loop
     65        for length = (java:jcall "read" stream buffer)
     66        until (eql length -1)
     67        do (java:jcall-raw "write" output buffer 0 length))
     68      (java:jcall-raw "flush" output)
     69      (java:jcall-raw "toByteArray" output))))
     70
     71(defun class-resource-path (class)
     72  (format NIL "~A.class" (substitute #\/ #\. (java:jcall "getName" class))))
     73
     74(defun class-bytes (class)
     75  (with-open (stream (java:jcall-raw
     76                      "getResourceAsStream"
     77                      (java:jcall-raw "getClassLoader" class)
     78                      (class-resource-path class)))
     79    (read-byte-array-from-stream stream)))
     80
    3681(defun disassemble (arg)
    3782  (require-type arg '(OR FUNCTION
     
    4893      (unless (compiled-function-p function)
    4994        (setf function (compile nil function)))
    50       (let ((class-bytes (function-class-bytes function)))
    51   (when class-bytes
    52     (with-input-from-string
    53         (stream (disassemble-class-bytes class-bytes))
    54       (loop
    55          (let ((line (read-line stream nil)))
    56      (unless line (return))
    57      (write-string "; ")
    58      (write-string line)
    59      (terpri))))
    60     (return-from disassemble)))
    61       (%format t "; Disassembly is not available.~%"))))
     95      (let ((class-bytes (or (function-class-bytes function)
     96                             (class-bytes (java:jcall-raw "getClass" function)))))
     97        (if class-bytes
     98            (let ((disassembler (or *disassembler-function*
     99                                    (choose-disassembler))))
     100              (and disassembler (funcall disassembler class-bytes)))
     101            (%format t "; Disassembly is not available.~%"))))))
     102
     103(defun print-lines-with-prefix (string)
     104  (with-input-from-string (stream string)
     105    (loop
     106      (let ((line (read-line stream nil)))
     107        (unless line (return))
     108        (write-string "; ")
     109        (write-string line)
     110        (terpri)))))
     111
     112(defun external-disassemble (object)
     113  (print-lines-with-prefix (disassemble-class-bytes object)))
     114
     115(defun external-test ()
     116  (ignore-errors
     117    (and (disassemble-class-bytes #'cons) #'external-disassemble)))
     118
     119(defun objectweb-disassemble (object)
     120  (let* ((reader (java:jnew "org.objectweb.asm.ClassReader" object))
     121         (writer (java:jnew "java.io.StringWriter"))
     122         (printer (java:jnew "java.io.PrintWriter" writer))
     123         (tracer (java:jnew "org.objectweb.asm.util.TraceClassVisitor" java:+null+ printer))
     124         ;; this is to support both the 1.X and subsequent releases
     125         (flags (ignore-errors (java:jfield "org.objectweb.asm.ClassReader" "SKIP_DEBUG"))))
     126    (java:jcall-raw "accept" reader tracer (or flags java:+false+))
     127    (print-lines-with-prefix (java:jcall "toString" writer))))
     128
     129(defun objectweb-test ()
     130  (ignore-errors
     131    (and (java:jclass "org.objectweb.asm.ClassReader") #'objectweb-disassemble)))
Note: See TracChangeset for help on using the changeset viewer.