Skip to content
Snippets Groups Projects
Commit 7e8e844c authored by hallgren's avatar hallgren
Browse files

Added patches from Miles for an aligment problem and lra and function

header problems.
parent 910f273a
No related branches found
No related tags found
No related merge requests found
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; ;;;
(ext:file-comment (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 @@ ...@@ -2084,7 +2084,9 @@
(ignore chunk) (ignore chunk)
(type (or null stream) stream) (type (or null stream) stream)
(type disassem-state dstate)) (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 ;; check type
(= (system:sap-ref-8 (dstate-segment-sap dstate) (= (system:sap-ref-8 (dstate-segment-sap dstate)
(if (eq (dstate-byte-order dstate) (if (eq (dstate-byte-order dstate)
...@@ -2132,14 +2134,17 @@ ...@@ -2132,14 +2134,17 @@
(ignore chunk) (ignore chunk)
(type (or null stream) stream) (type (or null stream) stream)
(type disassem-state dstate)) (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))) (alignment (dstate-alignment dstate)))
(unless (aligned-p offs alignment) (unless (aligned-p location alignment)
(when stream (when stream
(format stream "~a~vt~d~%" '.align (format stream "~a~vt~d~%" '.align
(dstate-argument-column dstate) (dstate-argument-column dstate)
alignment)) alignment))
(setf (dstate-next-offs dstate) (align offs alignment))) (incf(dstate-next-offs dstate)
(- (align location alignment) location)))
nil)) nil))
(defun rewind-current-segment (dstate segment) (defun rewind-current-segment (dstate segment)
...@@ -2462,12 +2467,23 @@ ...@@ -2462,12 +2467,23 @@
(type disassem-state dstate)) (type disassem-state dstate))
(format stream "~a~vt" 'WORD (dstate-argument-column dstate)) (format stream "~a~vt" 'WORD (dstate-argument-column dstate))
(let ((sap (dstate-segment-sap dstate)) (let ((sap (dstate-segment-sap dstate))
(start-offs (dstate-cur-offs dstate))) (start-offs (dstate-cur-offs dstate))
(dotimes (offs num) (byte-order (dstate-byte-order dstate)))
(unless (zerop offs) (dotimes (word-offs num)
(unless (zerop word-offs)
(write-string ", " stream)) (write-string ", " stream))
(format stream "#x~8,'0x" (let ((word 0) (bit-shift 0))
(system:sap-ref-32 sap (+ offs start-offs)))))) (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)))))
;;; ---------------------------------------------------------------- ;;; ----------------------------------------------------------------
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment