X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Ftarget-disassem.lisp;h=b004f451c3092293bdacb2c19bde1f384931f0b1;hb=0bca0cb1bf5ce5572ab5cd7ba59f87fed1f2edb0;hp=600442e4615f3f4e0b2be2694a1ba8f3667d3e4e;hpb=1bfc464c657a8f4ad24ef612f76a38d8f6f1bbad;p=sbcl.git

diff --git a/src/compiler/target-disassem.lisp b/src/compiler/target-disassem.lisp
index 600442e..b004f45 100644
--- a/src/compiler/target-disassem.lisp
+++ b/src/compiler/target-disassem.lisp
@@ -252,7 +252,7 @@
 
 (defstruct (offs-hook (:copier nil))
   (offset 0 :type offset)
-  (function (missing-arg) :type function)
+  (fun (missing-arg) :type function)
   (before-address nil :type (member t nil)))
 
 (defstruct (segment (:conc-name seg-)
@@ -314,8 +314,8 @@
   (fun-hooks nil :type list) 		
 
   ;; alist of (address . label-number), popped as it's used
-  (cur-labels nil :type list)		; 
-  ;; list of offs-hook, 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
@@ -384,11 +384,14 @@
   (declare (type sb!kernel:code-component code-component))
   (sb!sys:sap-int (sb!kernel:code-instructions code-component)))
 
+;;; unused as of sbcl-0.pre7.129
+#|
 ;;; Return the first function in CODE-COMPONENT.
 (defun code-first-function (code-component)
   (declare (type sb!kernel:code-component code-component))
   (sb!kernel:code-header-ref code-component
 			     sb!vm:code-trace-table-offset-slot))
+|#
 
 (defun segment-offs-to-code-offs (offset segment)
   (sb!sys:without-gcing
@@ -503,7 +506,7 @@
   (setf (dstate-cur-offs dstate) 0)
   (setf (dstate-cur-labels dstate) (dstate-labels dstate)))
 
-(defun do-offs-hooks (before-address stream dstate)
+(defun call-offs-hooks (before-address stream dstate)
   (declare (type (or null stream) stream)
 	   (type disassem-state dstate))
   (let ((cur-offs (dstate-cur-offs dstate)))
@@ -519,12 +522,12 @@
 			 (not (offs-hook-before-address next-hook))))
 	    (return))
 	  (unless (< hook-offs cur-offs)
-	    (funcall (offs-hook-function next-hook) stream dstate))
+	    (funcall (offs-hook-fun next-hook) stream dstate))
 	  (pop (dstate-cur-offs-hooks dstate))
 	  (unless (= (dstate-next-offs dstate) cur-offs)
 	    (return)))))))
 
-(defun do-fun-hooks (chunk stream dstate)
+(defun call-fun-hooks (chunk stream dstate)
   (let ((hooks (dstate-fun-hooks dstate))
 	(cur-offs (dstate-cur-offs dstate)))
     (setf (dstate-next-offs dstate) cur-offs)
@@ -565,10 +568,10 @@
 
       (setf (dstate-next-offs dstate) (dstate-cur-offs dstate))
 
-      (do-offs-hooks t stream dstate)
+      (call-offs-hooks t stream dstate)
       (unless (or prefix-p (null stream))
 	(print-current-address stream dstate))
-      (do-offs-hooks nil stream dstate)
+      (call-offs-hooks nil stream dstate)
 
       (unless (> (dstate-next-offs dstate) (dstate-cur-offs dstate))
 	(sb!sys:without-gcing
@@ -578,7 +581,7 @@
 		(sap-ref-dchunk (dstate-segment-sap dstate)
 				(dstate-cur-offs dstate)
 				(dstate-byte-order dstate))))
-	   (let ((fun-prefix-p (do-fun-hooks chunk stream dstate)))
+	   (let ((fun-prefix-p (call-fun-hooks chunk stream dstate)))
 	     (if (> (dstate-next-offs dstate) (dstate-cur-offs dstate))
 		 (setf prefix-p fun-prefix-p)
 		 (let ((inst (find-inst chunk ispace)))
@@ -855,7 +858,7 @@
       ((null fun))
     (let ((offset (code-offs-to-segment-offs (fun-offset fun) segment)))
       (when (<= 0 offset length)
-	(push (make-offs-hook :offset offset :function #'fun-header-hook)
+	(push (make-offs-hook :offset offset :fun #'fun-header-hook)
 	      (seg-hooks segment))))))
 
 ;;; A SAP-MAKER is a no-argument function that returns a SAP.
@@ -1075,11 +1078,11 @@
       (values nil nil)
       (values (get-source-form loc context cache) t)))
 
-;;;; stuff to use debugging-info to augment the disassembly
+;;;; stuff to use debugging info to augment the disassembly
 
 (defun code-fun-map (code)
   (declare (type sb!kernel:code-component code))
-  (sb!di::get-debug-info-fun-map (sb!kernel:%code-debug-info code)))
+  (sb!c::compiled-debug-info-fun-map (sb!kernel:%code-debug-info code)))
 
 (defstruct (location-group (:copier nil))
   (locations #() :type (vector (or list fixnum))))
@@ -1233,8 +1236,8 @@
   (let ((last-block-pc -1))
     (flet ((add-hook (pc fun &optional before-address)
 	     (push (make-offs-hook
-		    :offset pc ;; ##### FIX to account for non-zero offs in code
-		    :function fun
+		    :offset pc ;; ### FIX to account for non-zero offs in code
+		    :fun fun
 		    :before-address before-address)
 		   (seg-hooks segment))))
       (handler-case
@@ -1300,24 +1303,24 @@
 	  (storage-info-for-debug-fun debug-fun))
     (add-source-tracking-hooks segment debug-fun sfcache)
     (let ((kind (sb!di:debug-fun-kind debug-fun)))
-      (flet ((anh (n)
+      (flet ((add-new-hook (n)
 	       (push (make-offs-hook
 		      :offset 0
-		      :function (lambda (stream dstate)
-				  (declare (ignore stream))
-				  (note n dstate)))
+		      :fun (lambda (stream dstate)
+			     (declare (ignore stream))
+			     (note n dstate)))
 		     (seg-hooks segment))))
 	(case kind
 	  (:external)
 	  ((nil)
-	   (anh "no-arg-parsing entry point"))
+	   (add-new-hook "no-arg-parsing entry point"))
 	  (t
-	   (anh (lambda (stream)
-		  (format stream "~S entry point" kind)))))))))
+	   (add-new-hook (lambda (stream)
+			   (format stream "~S entry point" kind)))))))))
 
 ;;; Return a list of the segments of memory containing machine code
 ;;; instructions for FUNCTION.
-(defun get-function-segments (function)
+(defun get-fun-segments (function)
   (declare (type compiled-function function))
   (let* ((code (fun-code function))
 	 (fun-map (code-fun-map code))
@@ -1364,8 +1367,7 @@
 			(when first-block-seen-p
 			  (setf nil-block-seen-p t))))
 		 (setf last-debug-fun
-		       (sb!di::make-compiled-debug-fun fmap-entry code))
-		 )))))
+		       (sb!di::make-compiled-debug-fun fmap-entry code)))))))
 	(let ((max-offset (code-inst-area-length code)))
 	  (when (and first-block-seen-p last-debug-fun)
 	    (add-seg last-offset
@@ -1505,18 +1507,20 @@
 ;;;; top level functions
 
 ;;; Disassemble the machine code instructions for FUNCTION.
-(defun disassemble-function (function &key
-				      (stream *standard-output*)
-				      (use-labels t))
-  (declare (type compiled-function function)
+(defun disassemble-fun (fun &key
+			    (stream *standard-output*)
+			    (use-labels t))
+  (declare (type compiled-function fun)
 	   (type stream stream)
 	   (type (member t nil) use-labels))
   (let* ((dstate (make-dstate))
-	 (segments (get-function-segments function)))
+	 (segments (get-fun-segments fun)))
     (when use-labels
       (label-segments segments dstate))
     (disassemble-segments segments stream dstate)))
 
+;;; FIXME: We probably don't need this any more now that there are
+;;; no interpreted functions, only compiled ones.
 (defun compile-function-lambda-expr (function)
   (declare (type function function))
   (multiple-value-bind (lambda closurep name)
@@ -1526,11 +1530,11 @@
       (error "can't compile a lexical closure"))
     (compile nil lambda)))
 
-(defun compiled-function-or-lose (thing &optional (name thing))
+(defun compiled-fun-or-lose (thing &optional (name thing))
   (cond ((or (symbolp thing)
 	     (and (listp thing)
 		  (eq (car thing) 'setf)))
-	 (compiled-function-or-lose (fdefinition thing) thing))
+	 (compiled-fun-or-lose (fdefinition thing) thing))
 	((functionp thing)
 	 thing)
 	((and (listp thing)
@@ -1551,9 +1555,9 @@
 	   (type (or (member t) stream) stream)
 	   (type (member t nil) use-labels))
   (pprint-logical-block (*standard-output* nil :per-line-prefix "; ")
-    (disassemble-function (compiled-function-or-lose object)
-			  :stream stream
-			  :use-labels use-labels)
+    (disassemble-fun (compiled-fun-or-lose object)
+		     :stream stream
+		     :use-labels use-labels)
     nil))
 
 ;;; Disassembles the given area of memory starting at ADDRESS and