From 7e8e844c110dbbce5d5da06baba02bd511bcdbc3 Mon Sep 17 00:00:00 2001
From: hallgren <hallgren>
Date: Fri, 16 Oct 1992 15:07:28 +0000
Subject: [PATCH] Added patches from Miles for an aligment problem and lra and
 function header problems.

---
 compiler/disassem.lisp | 36 ++++++++++++++++++++++++++----------
 1 file changed, 26 insertions(+), 10 deletions(-)

diff --git a/compiler/disassem.lisp b/compiler/disassem.lisp
index a8f280ab1..a0bb375ec 100644
--- a/compiler/disassem.lisp
+++ b/compiler/disassem.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/disassem.lisp,v 1.13 1992/09/08 16:27:00 hallgren Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/disassem.lisp,v 1.14 1992/10/16 15:07:28 hallgren Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -2084,7 +2084,9 @@
 	   (ignore chunk)
 	   (type (or null stream) stream)
 	   (type disassem-state dstate))
-  (when (and (aligned-p (dstate-cur-offs dstate) (* 2 vm:word-bytes))
+  (when (and (aligned-p (+ (seg-virtual-location (dstate-segment dstate))
+			   (dstate-cur-offs dstate))
+			(* 2 vm:word-bytes))
 	     ;; check type
 	     (= (system:sap-ref-8 (dstate-segment-sap dstate)
 				  (if (eq (dstate-byte-order dstate)
@@ -2132,14 +2134,17 @@
 	   (ignore chunk)
 	   (type (or null stream) stream)
 	   (type disassem-state dstate))
-  (let ((offs (dstate-cur-offs dstate))
+  (let ((location
+	 (+ (seg-virtual-location (dstate-segment dstate))
+	    (dstate-cur-offs dstate)))
 	(alignment (dstate-alignment dstate)))
-    (unless (aligned-p offs alignment)
+    (unless (aligned-p location alignment)
       (when stream
 	(format stream "~a~vt~d~%" '.align
 		(dstate-argument-column dstate)
 		alignment))
-      (setf (dstate-next-offs dstate) (align offs alignment)))
+      (incf(dstate-next-offs dstate)
+	   (- (align location alignment) location)))
     nil))
 
 (defun rewind-current-segment (dstate segment)
@@ -2462,12 +2467,23 @@
 	   (type disassem-state dstate))
   (format stream "~a~vt" 'WORD (dstate-argument-column dstate))
   (let ((sap (dstate-segment-sap dstate))
-	(start-offs (dstate-cur-offs dstate)))
-    (dotimes (offs num)
-      (unless (zerop offs)
+	(start-offs (dstate-cur-offs dstate))
+	(byte-order (dstate-byte-order dstate)))
+    (dotimes (word-offs num)
+      (unless (zerop word-offs)
 	(write-string ", " stream))
-      (format stream "#x~8,'0x"
-	      (system:sap-ref-32 sap (+ offs start-offs))))))
+      (let ((word 0) (bit-shift 0))
+	(dotimes (byte-offs vm:word-bytes)
+	  (let ((byte
+		 (system:sap-ref-8
+			sap
+			(+ start-offs (* word-offs vm:word-bytes) byte-offs))))
+	    (setf word
+		  (if (eq byte-order :big-endian)
+		      (+ (ash word vm:byte-bits) byte)
+		      (+ word (ash byte bit-shift))))
+	    (incf bit-shift vm:byte-bits)))
+	(format stream "#x~v,'0x" (ash vm:word-bits -2) word)))))
 
 ;;; ----------------------------------------------------------------
 
-- 
GitLab