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

Fixed a bunch of bugs in localify. We call GC-GROVEL-STACK before doing

localify so that GGS doesn't get confused by objects being trashed with GC
forwards.

In TRANSPORT-FUNCTION, we must be prepared to find closure-entry objects (and
treat them the same as normal entries.)  Also, we must check if the entry for a
closure is pure before transporting the entry.

In various places, I had to flush uses of INFO, since this accesses global
variables (*info-environment*).
parent 2606985b
No related branches found
No related tags found
No related merge requests found
...@@ -30,12 +30,14 @@ ...@@ -30,12 +30,14 @@
(force-output) (force-output)
(setq *already-maybe-gcing* t) (setq *already-maybe-gcing* t)
;; ;;
;; Move symbols to static space, constants to read-only space. ;; Find GC stack fixups before we go around trashing vector headers.
(localify root-structures)
;;
;; Move everything else to either static or read-only space, depending
;; on type.
(let ((fixups (gc-grovel-stack))) (let ((fixups (gc-grovel-stack)))
;;
;; Move symbols to static space, constants to read-only space.
(localify root-structures)
;;
;; Move everything else to either static or read-only space, depending
;; on type.
(%primitive clear-registers) (%primitive clear-registers)
(%primitive purify) (%primitive purify)
(gc-fixup-stack fixups)) (gc-fixup-stack fixups))
...@@ -108,11 +110,14 @@ ...@@ -108,11 +110,14 @@
;;; to be coded inline. ;;; to be coded inline.
;;; ;;;
(defmacro inlinep (sym) (defmacro inlinep (sym)
#|Accesses global vars, so can't work....
`(or (info function source-transform ,sym) `(or (info function source-transform ,sym)
(let ((info (info function info ,sym))) (let ((info (info function info ,sym)))
(and info (and info
(or (c::function-info-templates info) (or (c::function-info-templates info)
(c::function-info-ir2-convert info)))))) (c::function-info-ir2-convert info)))))
|#
nil)
;;; Next-Symbol, Next-Cons -- Internal ;;; Next-Symbol, Next-Cons -- Internal
...@@ -268,15 +273,16 @@ ...@@ -268,15 +273,16 @@
(defun transport-function (fun) (defun transport-function (fun)
(unless (purep fun) (unless (purep fun)
(let ((def (ecase (%primitive get-vector-subtype fun) (let ((def (ecase (%primitive get-vector-subtype fun)
(#.%function-entry-subtype ((#.%function-entry-subtype #.%function-closure-entry-subtype)
(transport-function-object fun) (transport-function-object fun)
(%primitive header-ref fun %function-entry-constants-slot)) (%primitive header-ref fun %function-entry-constants-slot))
(#.%function-closure-subtype (#.%function-closure-subtype
(let ((entry (%primitive header-ref fun (let ((entry (%primitive header-ref fun
%function-name-slot))) %function-name-slot)))
(transport-function-object entry) (unless (purep entry)
(%primitive header-ref entry (transport-function-object entry)
%function-entry-constants-slot))) (%primitive header-ref entry
%function-entry-constants-slot))))
(#.%function-funcallable-instance-subtype (#.%function-funcallable-instance-subtype
nil)))) nil))))
(when (and def (not (purep def))) (when (and def (not (purep def)))
...@@ -415,10 +421,13 @@ ...@@ -415,10 +421,13 @@
(when (boundp sym) (when (boundp sym)
(let ((val (symbol-value sym))) (let ((val (symbol-value sym)))
(cond ((purep val)) (cond ((purep val))
#|Accesses global vars, so can't work...
((eq (info variable kind sym) :constant) ((eq (info variable kind sym) :constant)
(typecase val (typecase val
(cons (transport-cons val)) (cons (transport-cons val))
(simple-vector (transport-g-vector val t))))))) (simple-vector (transport-g-vector val t))))
|#
)))
;; ;;
;; Move any interned symbol that's left... ;; Move any interned symbol that's left...
(unless (or (purep sym) (not (symbol-package sym))) (unless (or (purep sym) (not (symbol-package sym)))
......
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