From 354e67acb24e94bfdaf0610e02085dcc20715ac4 Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Mon, 19 Mar 1990 11:59:23 +0000 Subject: [PATCH] In WRITE-VAR-INTEGER, fixed inverted sense of the test for 32bits. Changed WRITE-PACKED-BIT-VECTOR to bit-swap the bytes if the target byte order is different. In COMPILED-DEBUG-FUNCTION, changed the START-PC to be INDEX rather than UNSIGNED-BYTE, and added the ELSEWHERE-PC slot. --- code/debug-info.lisp | 40 ++++++++++++++++++++++++++++++++-------- 1 file changed, 32 insertions(+), 8 deletions(-) diff --git a/code/debug-info.lisp b/code/debug-info.lisp index e5c49b079..92cb44bde 100644 --- a/code/debug-info.lisp +++ b/code/debug-info.lisp @@ -71,7 +71,7 @@ (cond ((<= int 253) (vector-push-extend int vec)) (t - (let ((32-p (<= int #xFFFF))) + (let ((32-p (> int #xFFFF))) (vector-push-extend (if 32-p 255 254) vec) (vector-push-extend (ldb (byte 8 0) int) vec) (vector-push-extend (ldb (byte 8 8) int) vec) @@ -139,13 +139,34 @@ ;;; (defun write-packed-bit-vector (bits vec) (declare (type simple-bit-vector bits)) - (let ((len (ash (length bits) -3)) + (let ((len (length bits)) (start (fill-pointer vec))) - (dotimes (i len) - (vector-push-extend 0 vec)) - (lisp::with-array-data ((data vec) (ig1) (ig2)) - (declare (ignore ig1 ig2)) - (%primitive byte-blt bits 0 data start (+ start len)))) + (cond ((eq target-byte-order native-byte-order) + (let ((bytes (ash len -3))) + (dotimes (i bytes) + (vector-push-extend 0 vec)) + (lisp::with-array-data ((data vec) (ig1) (ig2)) + (declare (ignore ig1 ig2)) + (%primitive byte-blt bits 0 data start (+ start bytes))))) + (t + (macrolet ((frob (initial step done) + `(let ((shift ,initial) + (byte 0)) + (dotimes (i len) + (let ((int (aref bits i))) + (setq byte (logior byte (ash int shift))) + (,step shift)) + (when ,done + (vector-push-extend byte vec) + (setq shift ,initial byte 0))) + (unless (= shift ,initial) + (vector-push-extend byte vec))))) + (ecase target-byte-order + (:little-endian + (frob 0 incf (= shift 8))) + (:big-endian + (frob 7 decf (minusp shift)))))))) + (undefined-value)) @@ -281,7 +302,10 @@ ;; ;; The earliest PC in this function at which the environment is properly ;; initialized (arguments moved from passing locations, etc.) - (start-pc nil :type unsigned-byte)) + (start-pc nil :type index) + ;; + ;; The start of elsewhere code for this function (if any.) + (elsewhere-pc nil :type index)) (defstruct debug-source -- GitLab