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