Skip to content
Snippets Groups Projects
Commit 822276f5 authored by ram's avatar ram
Browse files

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