Index: disassem.lisp
===================================================================
RCS file: /usr/home/pfgroup/cvs/cmucl/src/compiler/disassem.lisp,v
retrieving revision 1.1.1.2
diff -d -u -r1.1.1.2 disassem.lisp
--- disassem.lisp	2000/05/18 03:51:29	1.1.1.2
+++ disassem.lisp	2000/06/15 05:39:03
@@ -3489,17 +3489,45 @@
 	 t)
 	(values nil nil))))
 
+(defun get-code-constant-absolute (addr dstate)
+  (declare (type address addr))
+  (declare (type disassem-state dstate))
+  (let ((code (seg-code (dstate-segment dstate))))
+    (if (null code)
+	(return-from get-code-constant-absolute (values nil nil)))
+    (let ((code-size (ash (kernel:get-header-data code) vm:word-shift)))
+      (system:without-gcing
+       (let ((code-addr (- (kernel:get-lisp-obj-address code)
+			   vm:other-pointer-type)))
+	 (if (or (< addr code-addr) (>= addr (+ code-addr code-size)))
+	     (values nil nil)
+	     (values (kernel:code-header-ref
+			code
+			(ash (- addr code-addr) (- vm:word-shift)))
+		       t)))))))
+
+
 (defvar *assembler-routines-by-addr* nil)
 
+(defvar *foreign-symbols-by-addr* nil)
+
+(defun invert-address-hash (htable &optional (addr-hash (make-hash-table)))
+  "Build an address-name hash-table from the name-address hash"
+  (maphash #'(lambda (name address)
+	       (setf (gethash address addr-hash) name))
+	     htable)
+  addr-hash)
+
 (defun find-assembler-routine (address)
   "Returns the name of the primitive lisp assembler routine located at
   ADDRESS, or NIL if there isn't one."
   (declare (type address address))
   (when (null *assembler-routines-by-addr*)
-    (setf *assembler-routines-by-addr* (make-hash-table))
-    (maphash #'(lambda (name address)
-		 (setf (gethash address *assembler-routines-by-addr*) name))
-	     lisp::*assembler-routines*))
+    (setf *assembler-routines-by-addr*
+	  (invert-address-hash lisp::*assembler-routines*))
+    (setf *assembler-routines-by-addr*
+	  (invert-address-hash lisp::*foreign-symbols*
+			       *assembler-routines-by-addr*)))
   (gethash address *assembler-routines-by-addr*))
 
 ;;; ----------------------------------------------------------------
@@ -3577,6 +3605,20 @@
 	   (type disassem-state dstate))
   (multiple-value-bind (const valid)
       (get-code-constant byte-offset dstate)
+    (when valid
+      (note #'(lambda (stream)
+		(prin1-quoted-short const stream))
+	    dstate))
+    const))
+
+(defun note-code-constant-absolute (addr dstate)
+  "Store a note about the lisp constant located at ADDR in the
+  current code-component, to be printed as an end-of-line comment after the
+  current instruction is disassembled."
+  (declare (type address addr)
+	   (type disassem-state dstate))
+  (multiple-value-bind (const valid)
+      (get-code-constant-absolute addr dstate)
     (when valid
       (note #'(lambda (stream)
 		(prin1-quoted-short const stream))
Index: x86/insts.lisp
===================================================================
RCS file: /usr/home/pfgroup/cvs/cmucl/src/compiler/x86/insts.lisp,v
retrieving revision 1.1.1.2
diff -d -u -r1.1.1.2 insts.lisp
--- x86/insts.lisp	2000/05/18 03:51:35	1.1.1.2
+++ x86/insts.lisp	2000/06/14 00:36:45
@@ -423,7 +423,10 @@
 	  (unless (or firstp (minusp offset))
 	    (write-char #\+ stream))
 	  (if firstp
-	      (disassem:princ16 offset stream)
+	      (progn
+		(disassem:princ16 offset stream)
+		(unless (minusp offset)
+		  (disassem::note-code-constant-absolute offset dstate)))
 	      (princ offset stream))))))
   (write-char #\] stream))
 
@@ -1696,7 +1699,10 @@
 
 (disassem:define-argument-type displacement
   :sign-extend t
-  :use-label #'offset-next)
+  :use-label #'offset-next
+  :printer #'(lambda (value stream dstate)
+	       (disassem:maybe-note-assembler-routine value nil dstate)
+	       (print-label value stream dstate)))
 
 (disassem:define-instruction-format (short-cond-jump 16)
   (op    :field (byte 4 4))