From 822276f5bb7db21447b89131e214baee4768a048 Mon Sep 17 00:00:00 2001
From: ram <ram>
Date: Mon, 19 Mar 1990 12:05:33 +0000
Subject: [PATCH] Changed TRANSPORT-FUNCTION to transport all objects in the
 constants, not just real constants.  This is to get debug-info in read-only
 space since the PURIFY miscop doesn't seem to be doing this right.  Also
 specify read-only T to TRANSPORT-G-VECTOR when transporting function
 constants.

---
 code/purify.lisp | 17 +++++++++--------
 1 file changed, 9 insertions(+), 8 deletions(-)

diff --git a/code/purify.lisp b/code/purify.lisp
index aa33b3093..c41786d68 100644
--- a/code/purify.lisp
+++ b/code/purify.lisp
@@ -49,6 +49,10 @@
 
 ;;;; Localify
 
+(defconstant marked-bit		#b001)
+(defconstant worthwhile-bit	#b010)
+(defconstant referenced-bit	#b100)
+
 (eval-when (compile eval)
 ;;; Peek, Poke  --  Internal
 ;;;
@@ -75,10 +79,6 @@
      (prog1 (setf (get ,sym 'purify-symbol-bits) ,val)
 	    (%primitive set-allocation-space space))))
 
-(defconstant marked-bit		#b001)
-(defconstant worthwhile-bit	#b010)
-(defconstant referenced-bit	#b100)
-
 ;;; Do-Allocated-Symbols  --  Internal
 ;;;
 ;;;    Iterate over all the symbols allocated in some space.
@@ -288,7 +288,8 @@
       (when (and def (not (purep def)))
 	(let ((length (%primitive header-length def)))
 	  (transport-function-object def)
-	  (do ((i %function-constants-constants-offset (1+ i)))
+	  (do ((i 0 ;%function-constants-constants-offset
+		  (1+ i)))
 	      ((= i length))
 	    (let ((const (%primitive header-ref def i)))
 	      (typecase const
@@ -300,7 +301,7 @@
 		(compiled-function
 		 (transport-function const))
 		(simple-vector
-		 (transport-g-vector const))))))))))
+		 (transport-g-vector const t))))))))))
 
 
 ;;; TRANSPORT-FUNCTION-OBJECT  --  Internal
@@ -346,8 +347,8 @@
 
 ;;; Transport-G-Vector  --  Internal
 ;;;
-;;;    Transport a G-Vector into static space.  We only bother with
-;;; the top level, and leave the rest to GC.
+;;;    Transport a G-Vector into static or read-only space.  We only bother
+;;; with the top level, and leave the rest to GC.
 ;;;
 (defun transport-g-vector (vec &optional read-only)
   (unless (purep vec)
-- 
GitLab