From 7cf668a2141d2aa6f5fc1386345699b40d3e7845 Mon Sep 17 00:00:00 2001
From: Christophe Rhodes <csr21@cam.ac.uk>
Date: Thu, 17 Jul 2003 16:34:16 +0000
Subject: [PATCH] 0.8.1.39: 	WARNING: here be low-quality code 	...
 implement more disassembly notes for PPC. 	... full of
 horrible literal constants.  Needs refactoring.

---
 BUGS                        |    6 ++++++
 src/compiler/ppc/insts.lisp |   38 +++++++++++++++++++++++++++++---------
 version.lisp-expr           |    2 +-
 3 files changed, 36 insertions(+), 10 deletions(-)

diff --git a/BUGS b/BUGS
index 8163c56..ad13ce5 100644
--- a/BUGS
+++ b/BUGS
@@ -1092,6 +1092,12 @@ WORKAROUND:
 
   (fixed in 0.8.1.37)
 
+265:
+  SB-EXT:RUN-PROGRAM is currently non-functional on Linux/PPC;
+  attempting to use it leads to segmentation violations.  This is
+  probably because of a bogus implementation of
+  os_restore_fp_control().
+
 DEFUNCT CATEGORIES OF BUGS
   IR1-#:
     These labels were used for bugs related to the old IR1 interpreter.
diff --git a/src/compiler/ppc/insts.lisp b/src/compiler/ppc/insts.lisp
index b782a2f..f99ad4a 100644
--- a/src/compiler/ppc/insts.lisp
+++ b/src/compiler/ppc/insts.lisp
@@ -69,16 +69,36 @@
 		 (t (make-symbol (concatenate 'string "$" name)))))
        *register-names*))
 
+(defun maybe-add-notes (regno dstate)
+  (let* ((inst (sb!disassem::sap-ref-int
+		(sb!disassem::dstate-segment-sap dstate)
+		(sb!disassem::dstate-cur-offs dstate)
+		n-word-bytes
+		(sb!disassem::dstate-byte-order dstate)))
+	 (op (ldb (byte 6 26) inst)))
+    (case op
+      ;; lwz
+      (32
+       (when (= regno (ldb (byte 5 16) inst)) ; only for the second 
+	 (case (ldb (byte 5 16) inst)
+	   ;; reg_CODE
+	   (19
+	    (sb!disassem:note-code-constant (ldb (byte 16 0) inst) dstate)))))
+      ;; addi
+      (14
+       (when (= regno null-offset)
+	 (sb!disassem:maybe-note-nil-indexed-object
+	  (ldb (byte 16 0) inst) dstate))))))
+
 (sb!disassem:define-arg-type reg
-  :printer #'(lambda (value stream dstate)
-	       (declare (type stream stream) (fixnum value))
-	       (let ((regname (aref reg-symbols value)))
-		 (princ regname stream)
-		 (sb!disassem:maybe-note-associated-storage-ref
-		  value
-		  'registers
-		  regname
-		  dstate))))
+  :printer 
+  (lambda (value stream dstate)
+    (declare (type stream stream) (fixnum value))
+    (let ((regname (aref reg-symbols value)))
+      (princ regname stream)
+      (sb!disassem:maybe-note-associated-storage-ref
+       value 'registers regname dstate)
+      (maybe-add-notes value dstate))))
 
 (defparameter float-reg-symbols
   #.(coerce 
diff --git a/version.lisp-expr b/version.lisp-expr
index fa433f2..4e7038f 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.1.38"
+"0.8.1.39"
-- 
1.7.10.4