Allocate symbols into permgen if enabled

And track the permgen->dynspace pointers in a remembered set
of specific objects.

src/assembly/x86-64/assem-rtns.lisp

@@ -478,3 +478,103 @@
       (inst stc)
       (inst leave)
       (inst ret))))
+
+;; Adding to the thread-local remset has to be pseudo-atomic because GC takes
+;; ownership of the the vector when it inserts rememberd objects into the common
+;; remset and it assigns 0 into the thread slot.
+;;
+;; For now, a CALL to this routine need not be inside a pseudo-atomic section
+;; because objects are _never_ _removed_ from the permgen remembered set.
+;; This wouldn't be the case if we use the same remembered sets for immobile-space.
+;; If the GC were to remove objects that lack old->young pointers, then the store
+;; would indeed have to be pseudo-atomic with respect to the bit test.
+;;
+(eval-when (:load-toplevel :execute)
+  ;; I want to try different parameters using 'slam' on this file
+  ;; without getting complaints about uneql constants
+  (defparameter remset-vector-capacity 124)
+  (defparameter remset-vector-len (fixnumize (+ remset-vector-capacity 2)))
+  (defparameter remset-vector-words (+ remset-vector-len vector-data-offset)))
+#+(and permgen sb-assembling)
+(progn
+(define-assembly-routine (remset-insert (:return-style :none)) ()
+  (let ((insert (gen-label)))
+  (assemble ()
+  (inst push rbx-tn)
+  ;; Stack:
+  ;;     object
+  ;;     return PC
+  ;;     RAX spill
+  ;;     RBX spill <- sp now
+  ;;     RCX spill
+  ;; Filter out non-permgen objects. RAX is the object
+  (inst mov rbx-tn (rip-relative-ea (make-fixup "permgen_bounds" :foreign-dataref)))
+  (inst cmp rax-tn (ea rbx-tn))
+  (inst jmp :b SET-BIT-AND-DONE)
+  (inst cmp rax-tn (ea 8 rbx-tn))
+  (inst jmp :ae SET-BIT-AND-DONE)
+  (inst push rcx-tn)
+  (pseudo-atomic ()
+   (inst lfence) ; Don't speculate load of RBX prior to setting P-A
+   (inst mov rbx-tn (thread-slot-ea thread-remset-slot)) ; current remset into RBX
+   (inst test :dword rbx-tn rbx-tn)
+   (inst jmp :z GROW)
+   ;; vector element 0 = item count (max. REMSET-VECTOR-CAPACITY)
+   (inst mov :dword rcx-tn (object-slot-ea rbx-tn vector-data-offset other-pointer-lowtag))
+   (inst cmp :byte rcx-tn (fixnumize remset-vector-capacity))
+   (inst jmp :e GROW)
+   (emit-label INSERT)
+   ;; Check that another thread didn't also insert into its remset.
+   ;; Alternatively, GC could de-duplicate though it currently does not.
+   (inst test :byte rax-tn #b1000) ; SYMBOLP if bit 3
+   (inst jmp :z INSTANCEP)
+   ;; it's a non-NIL symbol
+   (inst bts :lock :dword (ea (- other-pointer-lowtag) rax-tn) 31)
+   (inst jmp MAYBE-SKIP)
+   INSTANCEP
+   (inst bts :lock :dword (ea (- instance-pointer-lowtag) rax-tn) 31)
+   MAYBE-SKIP (inst jmp :c DONE-PA)
+   (inst add :byte (ea (- (ash vector-data-offset word-shift) other-pointer-lowtag) rbx-tn)
+         (fixnumize 1))
+   (inst mov (ea (- (ash (+ 2 vector-data-offset) word-shift) other-pointer-lowtag)
+                 rbx-tn rcx-tn 4)
+         rax-tn) ; RAX=object, RBX=vector, RCX=index(fixnum)
+   DONE-PA)
+  (inst pop rcx-tn)
+  DONE
+  (inst pop rbx-tn) (inst pop rax-tn)
+  (inst ret 8) ; remove arg
+  SET-BIT-AND-DONE
+  ;; layouts and symbol that are not below the core permgen limit reach here.
+  ;; Mark them as remembered to prevent further calls to the slow path.
+  (inst and rax-tn #x-10)
+  (inst or :lock :byte (ea 3 rax-tn) #x80)
+  (inst jmp DONE)
+  GROW
+  ;; if temps regs were needed here, RAX or RBX would be fine to use and reload
+  (allocation simple-vector-widetag (ash remset-vector-words word-shift)
+              ;; lowtag, result-tn, node, allocation-temp
+              0 rcx-tn nil nil thread-tn :systemp t)
+  ;; ASSUMPTION: pre-zeroed memory
+  (inst mov :byte (object-slot-ea rcx-tn 0 0) simple-vector-widetag) ; header
+  (inst mov :byte (object-slot-ea rcx-tn vector-length-slot 0) remset-vector-len)
+  (inst mov (object-slot-ea rcx-tn (1+ vector-data-offset) 0) rbx-tn) ; link buffers
+  (inst lea rbx-tn (ea other-pointer-lowtag rcx-tn)) ; tagify
+  (inst mov (thread-slot-ea thread-remset-slot) rbx-tn) ; writeback
+  (zeroize rcx-tn)
+  (inst jmp INSERT))))
+(define-assembly-routine (gc-remember-symbol (:return-style :none)) ()
+  (inst push rax-tn)
+  (inst mov rax-tn (ea (ash 2 word-shift) rsp-tn)) ; OBJECT
+  (inst test :byte (ea (- 3 other-pointer-lowtag) rax-tn) #x80)
+  (inst jmp :z (make-fixup 'remset-insert :assembly-routine))
+  (inst pop rax-tn)
+  (inst ret 8))
+(define-assembly-routine (gc-remember-layout (:return-style :none)) ()
+  (inst push rax-tn)
+  (inst mov rax-tn (ea (ash 2 word-shift) rsp-tn)) ; OBJECT
+  (inst test :byte (ea (- 3 instance-pointer-lowtag) rax-tn) #x80)
+  (inst jmp :z (make-fixup 'remset-insert :assembly-routine))
+  (inst pop rax-tn)
+  (inst ret 8))
+)

src/code/alloc.lisp

@@ -288,6 +288,20 @@
     t))
 
 #+permgen
+(progn
+(defun sb-impl::allocate-permgen-symbol (name)
+  (with-system-mutex (*allocator-mutex* :without-gcing t)
+    (let ((freeptr *permgen-space-free-pointer*))
+      (setf *permgen-space-free-pointer*
+            (sap+ freeptr (ash symbol-size word-shift)))
+      (aver (<= (sap-int *permgen-space-free-pointer*)
+                (+ permgen-space-start permgen-space-size)))
+      (setf (sap-ref-word freeptr 0) symbol-widetag)
+      (setf (sap-ref-lispobj freeptr (ash symbol-name-slot word-shift)) name
+            (sap-ref-lispobj freeptr (ash symbol-info-slot word-shift)) nil
+            (sap-ref-word freeptr (ash symbol-value-slot word-shift))
+            unbound-marker-widetag)
+      (%make-lisp-obj (sap-int (sap+ freeptr other-pointer-lowtag))))))
 (defun sb-kernel::allocate-permgen-layout (nwords)
   (with-system-mutex (*allocator-mutex* :without-gcing t)
     (let ((freeptr *permgen-space-free-pointer*))
@@ -298,4 +312,4 @@
                 (+ permgen-space-start permgen-space-size)))
       (setf (sap-ref-word freeptr 0)
             (logior (ash nwords instance-length-shift) instance-widetag))
-      (%make-lisp-obj (sap-int (sap+ freeptr instance-pointer-lowtag))))))
+      (%make-lisp-obj (sap-int (sap+ freeptr instance-pointer-lowtag)))))))

src/code/misc-aliens.lisp

@@ -21,7 +21,7 @@
 
 #+permgen
 (progn
-(define-alien-variable ("PERMGEN_SPACE_START" sb-vm:permgen-space-start) sb-kernel::os-vm-size-t)
+(define-alien-variable ("permgen_bounds" sb-vm:permgen-space-start) sb-kernel::os-vm-size-t)
 (define-alien-variable ("permgen_space_free_pointer" sb-vm:*permgen-space-free-pointer*)
     system-area-pointer))
 

src/code/symbol.lisp

@@ -395,6 +395,11 @@ distinct from the global value. Can also be SETF."
           (logior-array-flags name sb-vm:+vector-shareable+))) ; Set "logically read-only" bit
        (name-hash (calc-symbol-name-hash name (length name)))
        (symbol
+         #+permgen
+         (truly-the symbol (if (eql kind 0) ; uninterned
+                               (sb-vm::%alloc-symbol name)
+                               (allocate-permgen-symbol name)))
+         #-permgen
          (truly-the symbol
           ;; If no immobile-space, easy: all symbols go in dynamic-space
           #-immobile-space (sb-vm::%alloc-symbol name)

src/compiler/generic/genesis.lisp

@@ -780,8 +780,13 @@
    LENGTH must count the header word itself as 1 word.  The header word is
    initialized with the payload size as (1- LENGTH), and WIDETAG."
   (let ((des (allocate-cold-descriptor gspace (ash length sb-vm:word-shift)
-                                       sb-vm:other-pointer-lowtag)))
-    (write-header-word des (sb-vm::compute-object-header length widetag))
+                                       sb-vm:other-pointer-lowtag))
+        (header-word (sb-vm::compute-object-header length widetag)))
+    #+permgen
+    (when (and (= widetag sb-vm:symbol-widetag) (eq gspace *static*))
+      ;; Set the "in-remset" bit so rutime won't call REMEMBER-OBJECT on static symbols
+      (setf header-word (logior header-word (ash 1 31))))
+    (write-header-word des header-word)
     des))
 (defvar *simple-vector-0-descriptor*)
 (defun allocate-vector (widetag length words &optional (gspace *dynamic*))
@@ -1144,7 +1149,9 @@ core and return a descriptor to it."
           (cold-assign-tls-index cold-sym tls-index)))
       tls-index)))
 
-(defvar *cold-symbol-gspace* (or #+immobile-space '*immobile-fixedobj* '*dynamic*))
+(defvar *cold-symbol-gspace* (or #+permgen '*permgen*
+                                 #+immobile-space '*immobile-fixedobj*
+                                 '*dynamic*))
 (defun encode-symbol-name (package-id name)
   (declare (ignorable package-id))
   (logior #+compact-symbol (ash package-id sb-impl::symbol-name-bits)

src/compiler/generic/objdef.lisp

@@ -645,6 +645,7 @@ during backtrace.
   (symbol-tlab :c-type "struct alloc_region" :length 3)
   (sys-mixed-tlab :c-type "struct alloc_region" :length 3)
   (sys-cons-tlab :c-type "struct alloc_region" :length 3)
+  (remset)
   ;; allocation instrumenting
   (tot-bytes-alloc-boxed)
   (tot-bytes-alloc-unboxed)

src/compiler/tn.lisp

@@ -253,8 +253,7 @@
               ;; because liveness depends on pointer tracing without looking at code-fixups.
               (when (and sc
                          (or (not immed)
-                             #+permgen (typep (constant-value constant) 'layout)
-                             #+immobile-space
+                             #+(or immobile-space permgen)
                              (let ((val (constant-value constant)))
                                (or (and (symbolp val) (not (sb-vm:static-symbol-p val)))
                                    (typep val 'layout))))

src/compiler/x86-64/alloc.lisp

@@ -200,7 +200,7 @@
 ;;; 3. node (for determining immobile-space-p) and a scratch register or two
 (defun allocation (type size lowtag alloc-tn node temp thread-temp
                    &key overflow
-                   &aux (systemp (system-tlab-p type node)))
+                        (systemp (system-tlab-p type node)))
   (declare (ignorable thread-temp))
   (flet ((fallback (size)
            ;; Call an allocator trampoline and get the result in the proper register.

src/compiler/x86-64/cell.lisp

@@ -58,9 +58,18 @@
              (emit-code-page-gengc-barrier object val-temp)
              (emit-store (object-slot-ea object offset lowtag) value val-temp)))
           (t
-           (emit-gengc-barrier object nil val-temp (vop-nth-arg 1 vop) value name)
+           (if (eq name '%set-symbol-global-value)
+               (emit-symbol-write-barrier vop object val-temp (vop-nth-arg 1 vop) value)
+               (emit-gengc-barrier object nil val-temp (vop-nth-arg 1 vop) value name))
            (emit-store (object-slot-ea object offset lowtag) value val-temp)))))
 
+(defun add-symbol-to-remset (vop symbol)
+  (declare (ignorable vop symbol))
+  #+permgen
+  (unless (and (sc-is symbol immediate) (static-symbol-p (tn-value symbol)))
+    (inst push symbol)
+    (invoke-asm-routine 'call 'gc-remember-symbol vop)))
+
 (define-vop (compare-and-swap-slot)
   (:args (object :scs (descriptor-reg) :to :eval)
          (old :scs (descriptor-reg any-reg) #|:target rax|#)
@@ -71,10 +80,11 @@
                    #|:from (:argument 1)|# :to :result :target result)
               rax)
   (:info name offset lowtag)
-  (:ignore name)
   (:results (result :scs (descriptor-reg any-reg)))
   (:vop-var vop)
   (:generator 5
+     (when (member name '(cas-symbol-fdefn sb-impl::cas-symbol-%info))
+       (add-symbol-to-remset vop object))
      (emit-gengc-barrier object nil rax (vop-nth-arg 2 vop) new)
      (move rax old)
      (inst cmpxchg :lock (ea (- (* offset n-word-bytes) lowtag) object) new)
@@ -88,10 +98,13 @@
   (:generator 1
     (inst mov result (unbound-marker-bits))))
 
-(defmacro emit-symbol-write-barrier (sym &rest rest)
+(defun emit-symbol-write-barrier (vop symbol temp newval-tn-ref newval)
+  (when (require-gengc-barrier-p symbol newval-tn-ref newval)
+    (add-symbol-to-remset vop symbol))
   ;; IMMEDIATE sc means that the symbol is static or immobile.
   ;; Static symbols are roots, and immobile symbols use page fault handling.
-  `(unless (sc-is ,sym immediate) (emit-gengc-barrier ,sym ,@rest)))
+  (unless (sc-is symbol immediate)
+    (emit-gengc-barrier symbol nil temp newval-tn-ref newval)))
 
 (define-vop (%set-symbol-global-value)
   (:args (symbol :scs (descriptor-reg immediate))
@@ -100,7 +113,7 @@
   (:temporary (:sc unsigned-reg) val-temp)
   (:vop-var vop)
   (:generator 4
-    (emit-symbol-write-barrier symbol nil val-temp (vop-nth-arg 1 vop) value)
+    (emit-symbol-write-barrier vop symbol val-temp (vop-nth-arg 1 vop) value)
     (emit-store (if (sc-is symbol immediate)
                       (symbol-slot-ea (tn-value symbol) symbol-value-slot)
                       (object-slot-ea symbol symbol-value-slot other-pointer-lowtag))
@@ -170,7 +183,7 @@
              (inst add cell thread-tn))))
     (inst cmp :qword (ea cell) no-tls-value-marker)
     (inst jmp :ne STORE)
-    (emit-symbol-write-barrier symbol nil val-temp (vop-nth-arg 1 vop) value)
+    (emit-symbol-write-barrier vop symbol val-temp (vop-nth-arg 1 vop) value)
     (get-symbol-value-slot-ea cell symbol)
     STORE
     (emit-store (ea cell) value val-temp)))
@@ -234,7 +247,7 @@
     (:policy :fast-safe)
     (:vop-var vop)
     (:generator 10
-      (emit-symbol-write-barrier symbol nil rax (vop-nth-arg 2 vop) new)
+      (emit-symbol-write-barrier vop symbol rax (vop-nth-arg 2 vop) new)
       (load-oldval)
       (inst cmpxchg :lock (if (sc-is symbol immediate)
                               (symbol-slot-ea (tn-value symbol) symbol-value-slot)
@@ -270,7 +283,7 @@
       (inst cmp :qword (ea cell) no-tls-value-marker)
       (inst jmp :ne CAS))
       ;; GLOBAL. All logic that follows is for both + and - sb-thread
-      (emit-symbol-write-barrier symbol nil cell (vop-nth-arg 2 vop) new)
+      (emit-symbol-write-barrier vop symbol cell (vop-nth-arg 2 vop) new)
       (get-symbol-value-slot-ea cell symbol)
       CAS
       (load-oldval)
@@ -852,6 +865,7 @@
 (define-vop (instance-set-multiple)
   (:args (instance :scs (descriptor-reg))
          (values :more t :scs (descriptor-reg constant immediate)))
+  (:arg-refs obj-ref)
   (:temporary (:sc unsigned-reg) val-temp)
   ;; Would like to try to store adjacent 0s (and/or NILs) using 16 byte stores.
   (:temporary (:sc int-sse-reg) xmm-temp)
@@ -879,6 +893,8 @@
       (setq use-xmm-p (or (>= (logcount zerop-mask) 3)
                           (loop for slot below max-index
                              thereis (= (ldb (byte 2 slot) zerop-mask) #b11))))
+      (when (eq (tn-ref-type obj-ref) (specifier-type 'layout))
+        (bug "unexpected set-multiple"))
       (emit-gengc-barrier instance nil val-temp values)
       (when use-xmm-p
         (inst xorpd xmm-temp xmm-temp))

src/compiler/x86-64/macros.lisp

@@ -430,10 +430,18 @@
                                               (and (integerp value)
                                                    (plausible-signed-imm32-operand-p (,(if tagged 'fixnumize 'progn) value)))))))))
        (:arg-types ,type tagged-num ,el-type)
+       (:arg-refs obj-ref ind-ref val-ref)
        (:vop-var vop)
        ,@(and barrier
               `((:temporary (:sc unsigned-reg) val-temp)))
        (:generator 4
+         #+permgen
+         ,@(when (string= name 'instance-index-set)
+             `((when (and (eq (tn-ref-type obj-ref) (specifier-type 'layout))
+                          ;; since ANY-REG is non-pointer, OBJECT doesn't need remembering
+                          (not (sc-is value any-reg)))
+                 (inst push object)
+                 (invoke-asm-routine 'call 'gc-remember-layout vop))))
          ,@(when (eq translate 'sb-bignum:%bignum-set)
              '((bignum-index-check object index 0 vop)))
          (let ((ea (if (sc-is index immediate)

src/compiler/x86-64/move.lisp

@@ -66,7 +66,8 @@
   (:temporary (:sc any-reg :from (:argument 0) :to (:result 0)
                :unused-if (or (not (sc-is x immediate))
                               (typep (encode-value-if-immediate x)
-                                     '(or (signed-byte 32) #+immobile-space fixup))))
+                                     '(or (signed-byte 32)
+                                          #+(or immobile-space permgen) fixup))))
               temp)
   (:generator 0
     (if (sc-is x immediate)
@@ -88,7 +89,7 @@
      (cond ((and (numberp val) (zerop val)) (zeroize target))
            (t (inst mov target val))))
     ;; Likewise if the value is small enough.
-    ((typep val '(or (signed-byte 32) #+immobile-space fixup))
+    ((typep val '(or (signed-byte 32) #+(or immobile-space permgen) fixup))
      ;; This logic is similar to that of STOREW*.
      ;; It would be nice to pull it all together in one place.
      ;; The basic idea is that storing any byte-aligned 8-bit value

src/compiler/x86-64/vm.lisp

@@ -460,8 +460,9 @@
      (when (or (static-symbol-p value)
                ;; The cross-compiler always uses immobile-space if it exists.
                #+(and immobile-space sb-xc-host) t
-               ;; With #+immobile-symbols, all interned symbols are in immobile-space.
-               #+immobile-symbols (sb-xc:symbol-package value)
+               ;; With either of these two features, all interned symbols are
+               ;; as-if static
+               #+(or permgen immobile-symbols) (sb-xc:symbol-package value)
                #-sb-xc-host
                (if (immobile-space-obj-p value)
                    (or (= (generation-of value) +pseudo-static-generation+)

src/runtime/coreparse.c

@@ -1185,6 +1185,11 @@ void gc_load_corefile_ptes(int card_table_nbits,
     generations[gen].bytes_allocated = bytes_allocated;
     gc_assert((ssize_t)bytes_allocated <= (ssize_t)(n_ptes * GENCGC_PAGE_BYTES));
 
+    /* Record the demarcation point in permgen space between objects mapped from core
+     * and new objects so that GC can potentially treat them differently.
+     * (below it: visit only if touched, above it: always visit) */
+    permgen_bounds[1] = (uword_t)permgen_space_free_pointer;
+
     // Adjust for discrepancies between actually-allocated space addresses
     // and desired addresses.
     if (adj->n_ranges) relocate_heap(adj);

src/runtime/globals.c

@@ -52,7 +52,6 @@ lispobj *current_binding_stack_pointer;
 
 lispobj *read_only_space_free_pointer;
 lispobj *static_space_free_pointer;
-lispobj *permgen_space_free_pointer;
 
 #ifdef LISP_FEATURE_DARWIN_JIT
 lispobj *static_code_space_free_pointer;
@@ -94,7 +93,10 @@ void globals_init(void)
 #endif
 }
 
-uword_t FIXEDOBJ_SPACE_START, TEXT_SPACE_START, PERMGEN_SPACE_START;
+uword_t permgen_bounds[2];
+lispobj *permgen_space_free_pointer;
+
+uword_t FIXEDOBJ_SPACE_START, TEXT_SPACE_START;
 lispobj *text_space_highwatermark;
 #ifndef LISP_FEATURE_IMMOBILE_SPACE
 /* this is a KLUDGE. If #+immobile-space then text_space_size gets statically

src/runtime/globals.h

@@ -61,7 +61,7 @@ extern uword_t DYNAMIC_0_SPACE_START, DYNAMIC_1_SPACE_START;
 #else
 extern uword_t DYNAMIC_SPACE_START;
 #endif
-extern uword_t FIXEDOBJ_SPACE_START, TEXT_SPACE_START, PERMGEN_SPACE_START;
+extern uword_t FIXEDOBJ_SPACE_START, TEXT_SPACE_START;
 extern unsigned int text_space_size;
 #ifdef LISP_FEATURE_IMMOBILE_SPACE
 extern uword_t immobile_space_lower_bound, immobile_space_max_offset;
@@ -92,6 +92,9 @@ extern lispobj *current_binding_stack_pointer;
 extern lispobj *read_only_space_free_pointer;
 extern lispobj *static_space_free_pointer;
 extern lispobj *permgen_space_free_pointer;
+extern uword_t permgen_bounds[2];
+#define PERMGEN_SPACE_START permgen_bounds[0]
+#define CORE_PERMGEN_END permgen_bounds[1]
 
 static inline bool readonly_space_p(lispobj ptr) {
     return ptr >= READ_ONLY_SPACE_START && (lispobj*)ptr < read_only_space_free_pointer;

src/runtime/mark-region.c

@@ -923,13 +923,63 @@ void mr_trace_bump_range(lispobj* start, lispobj *end) {
   }
 }
 
+/* This limit is adequate for testing, but a better way to handle it
+ * would be to size the remset at half the objects in core permgen.
+ * If that limit is reached, then don't remember individual objects
+ * but instead flag all of permgen as needing to be scavenged. */
+#define REMSET_GLOBAL_MAX 20000
+lispobj permgen_remset[REMSET_GLOBAL_MAX];
+int permgen_remset_count;
+
+static void remset_append1(lispobj x)
+{
+    int n = permgen_remset_count;
+    if (n == REMSET_GLOBAL_MAX) lose("global remset overflow");
+    permgen_remset[n] = x;
+    ++permgen_remset_count;
+}
+
+void remset_union(lispobj remset)
+{
+    while (remset) {
+        struct vector* v = VECTOR(remset);
+        int count = fixnum_value(v->data[0]);
+        int i;
+        for (i=0; i<count; ++i) remset_append1(v->data[i+2]);
+        remset = v->data[1];
+    }
+}
+
+void remember_all_permgen()
+{
+    permgen_bounds[1] = PERMGEN_SPACE_START;
+    memset(permgen_remset, 0, permgen_remset_count*N_WORD_BYTES);
+    permgen_remset_count = 0;
+}
+
 extern lispobj lisp_init_function;
 static void trace_static_roots() {
   source_object = native_pointer(NIL) - 1;
   trace_other_object((lispobj*)NIL_SYMBOL_SLOTS_START);
   mr_trace_bump_range((lispobj*)STATIC_SPACE_OBJECTS_START,
                       static_space_free_pointer);
-  mr_trace_bump_range((lispobj*)PERMGEN_SPACE_START, permgen_space_free_pointer);
+#ifdef LISP_FEATURE_PERMGEN
+  if (new_space == PSEUDO_STATIC_GENERATION) {
+    remember_all_permgen();
+  }
+  // Remembered objects below the core permgen end, and all objects above it, are roots.
+  mr_trace_bump_range((lispobj*)permgen_bounds[1], permgen_space_free_pointer);
+  int i, n = permgen_remset_count;
+  if (gencgc_verbose)
+    printf("remset count: %d, permgen new-obj-range %p..%p (%d words)\n", n,
+           (void*)permgen_bounds[1], permgen_space_free_pointer,
+           (int)(permgen_space_free_pointer - (lispobj*)(permgen_bounds[1])));
+  for (i=0; i<n; ++i) {
+    lispobj o = permgen_remset[i];
+    source_object = native_pointer(o);
+    trace_object(o);
+  }
+#endif
 
   // TODO: use an explicit remembered set of modified objects in this range
   if (TEXT_SPACE_START) mr_trace_bump_range((lispobj*)TEXT_SPACE_START, text_space_highwatermark);

src/runtime/pmrgc.c

@@ -1052,8 +1052,22 @@ collect_garbage(generation_index_t last_gen)
      *   in a unithread build.
      * So we need to close them for those two cases.
      */
+    extern void remset_union(lispobj);
     struct thread *th;
-    for_each_thread(th) gc_close_thread_regions(th, 0);
+    for_each_thread(th) {
+        gc_close_thread_regions(th, 0);
+#ifdef LISP_FEATURE_PERMGEN
+        // transfer the thread-local remset to the global remset
+        remset_union(th->remset);
+        th->remset = 0;
+#endif
+    }
+#ifdef LISP_FEATURE_PERMGEN
+    extern lispobj remset_transfer_list;
+    // transfer the remsets from threads that exited
+    remset_union(remset_transfer_list);
+    remset_transfer_list = 0;
+#endif
     ensure_region_closed(code_region, PAGE_TYPE_CODE);
     if (gencgc_verbose > 2) fprintf(stderr, "[%d] BEGIN gc(%d)\n", n_lisp_gcs, last_gen);
 
@@ -1980,6 +1994,9 @@ int verify_heap(__attribute__((unused)) lispobj* cur_thread_approx_stackptr,
     // Just don't worry about NIL, it's seldom the problem
     // if (verify(NIL_SYMBOL_SLOTS_START, (lispobj*)NIL_SYMBOL_SLOTS_END, &state, 0)) goto out;
     if (verify(STATIC_SPACE_OBJECTS_START, static_space_free_pointer, &state, 0)) goto out;
+    if (verbose)
+        fprintf(stderr, " [permgen]");
+    if (verify(PERMGEN_SPACE_START, permgen_space_free_pointer, &state, 0)) goto out;
     if (verbose)
         fprintf(stderr, " [dynamic]");
     state.flags |= VERIFYING_GENERATIONAL;

src/runtime/save.c

@@ -308,6 +308,13 @@ bool save_to_filehandle(FILE *file, char *filename, lispobj init_function,
                  core_start_pos,
                  core_compression_level), ++count;
 #ifdef LISP_FEATURE_PERMGEN
+    {
+#define REMEMBERED_BIT (uword_t)0x80000000
+        lispobj* where = (void*)PERMGEN_SPACE_START;
+        // clear every object's bit
+        for ( ; where < permgen_space_free_pointer ; where += object_size(where) )
+            *where &= ~REMEMBERED_BIT;
+    }
     output_space(file,
                  PERMGEN_CORE_SPACE_ID,
                  (lispobj *)PERMGEN_SPACE_START,
@@ -605,6 +612,10 @@ static void prepare_dynamic_space_for_final_gc(struct thread* thread)
         }
     }
 #ifdef LISP_FEATURE_MARK_REGION_GC
+#ifdef LISP_FEATURE_PERMGEN
+    extern void remember_all_permgen();
+    remember_all_permgen();
+#endif
     for (generation_index_t g = 1; g <= PSEUDO_STATIC_GENERATION; g++) {
       generations[0].bytes_allocated += generations[g].bytes_allocated;
       generations[g].bytes_allocated = 0;

src/runtime/thread.c

@@ -461,11 +461,27 @@ init_new_thread(struct thread *th,
 #endif
 }
 
+lispobj remset_transfer_list;
+
 static void
 unregister_thread(struct thread *th,
                   init_thread_data __attribute__((unused)) *scribble)
 {
     block_blockable_signals(0);
+#ifdef LISP_FEATURE_PERMGEN
+    lispobj my_remset = th->remset;
+    if (my_remset) {
+        lispobj tail = remset_transfer_list;
+        while (1) {
+            VECTOR(my_remset)->data[1] = tail;
+            lispobj actual_old = __sync_val_compare_and_swap(
+                &remset_transfer_list, tail, my_remset);
+            if (actual_old == tail) break;
+            tail = actual_old;
+        }
+        th->remset = 0;
+    }
+#endif
     gc_close_thread_regions(th, LOCK_PAGE_TABLE|CONSUME_REMAINDER);
 #ifdef LISP_FEATURE_SB_SAFEPOINT
     pop_gcing_safety(&scribble->safety);