X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fdisassem.lisp;fp=src%2Fcompiler%2Fdisassem.lisp;h=2341203f7714737b4e4c0c0eccf88860ce964767;hb=8a19c6876412b8ad1cf729297c2a373d63a0d0ec;hp=f25e4909875a08f07b5022b23c78dbd0f835cd99;hpb=1fd80272bd0a0510113978a33066622e4fd506a7;p=sbcl.git

diff --git a/src/compiler/disassem.lisp b/src/compiler/disassem.lisp
index f25e490..2341203 100644
--- a/src/compiler/disassem.lisp
+++ b/src/compiler/disassem.lisp
@@ -1553,6 +1553,71 @@
            (type disassem-state dstate)
            (optimize (speed 3) (safety 0)))
   (sign-extend (read-suffix length dstate) length))
+
+;;; All state during disassembly. We store some seemingly redundant
+;;; information so that we can allow garbage collect during disassembly and
+;;; not get tripped up by a code block being moved...
+(defstruct (disassem-state (:conc-name dstate-)
+			   (:constructor %make-dstate)
+			   (:copier nil))
+  ;; offset of current pos in segment
+  (cur-offs 0 :type offset)		
+  ;; offset of next position
+  (next-offs 0 :type offset)		
+  ;; a sap pointing to our segment
+  (segment-sap (missing-arg) :type sb!sys:system-area-pointer)
+  ;; the current segment					
+  (segment nil :type (or null segment))	
+  ;; what to align to in most cases
+  (alignment sb!vm:n-word-bytes :type alignment) 
+  (byte-order :little-endian
+	      :type (member :big-endian :little-endian))
+  ;; for user code to hang stuff off of
+  (properties nil :type list)
+  (filtered-values (make-array max-filtered-value-index)
+		   :type filtered-value-vector)
+  ;; used for prettifying printing
+  (addr-print-len nil :type (or null (integer 0 20)))
+  (argument-column 0 :type column)
+  ;; to make output look nicer
+  (output-state :beginning		
+		:type (member :beginning
+			      :block-boundary
+			      nil))
+
+  ;; alist of (address . label-number)
+  (labels nil :type list)		
+  ;; same as LABELS slot data, but in a different form
+  (label-hash (make-hash-table) :type hash-table)
+  ;; list of function
+  (fun-hooks nil :type list) 		
+
+  ;; alist of (address . label-number), popped as it's used
+  (cur-labels nil :type list)
+  ;; OFFS-HOOKs, popped as they're used
+  (cur-offs-hooks nil :type list) 	
+
+  ;; for the current location
+  (notes nil :type list)
+
+  ;; currently active source variables
+  (current-valid-locations nil :type (or null (vector bit))))
+(def!method print-object ((dstate disassem-state) stream)
+  (print-unreadable-object (dstate stream :type t)
+    (format stream
+	    "+~W~@[ in ~S~]"
+	    (dstate-cur-offs dstate)
+	    (dstate-segment dstate))))
+
+;;; Return the absolute address of the current instruction in DSTATE.
+(defun dstate-cur-addr (dstate)
+  (the address (+ (seg-virtual-location (dstate-segment dstate))
+		  (dstate-cur-offs dstate))))
+
+;;; Return the absolute address of the next instruction in DSTATE.
+(defun dstate-next-addr (dstate)
+  (the address (+ (seg-virtual-location (dstate-segment dstate))
+		  (dstate-next-offs dstate))))
 
 ;;; Get the value of the property called NAME in DSTATE. Also SETF'able.
 ;;;