1.0.41.15: gencgc: Implement object pinning for non-x86oids.

  * Add a new static symbol for all non-x86oid gencgc targets,
*pinned-objects*.

  * Bind *pinned-objects* to NIL during thread creation if it is
defined.

  * During garbage collection, where x86oids preserve pointers on
the various thread stacks, use the same mechanism to preserve
pointers linked on *pinned-objects* for each thread.

  * Change the PPC version of with-pinned-objects to rebind
*pinned-objects* with the new objects to pin prepended when using
gencgc.

diff --git a/src/code/sysmacs.lisp b/src/code/sysmacs.lisp
index f9970c6..3ca4ff8 100644 (file)
--- a/src/code/sysmacs.lisp
+++ b/src/code/sysmacs.lisp
@@ -25,6 +25,13 @@
 #!+sb-thread
 (defvar *stop-for-gc-pending*)
 
+;;; This one is initialized by the runtime, at thread creation.  On
+;;; non-x86oid gencgc targets, this is a per-thread list of objects
+;;; which must not be moved during GC.  It is frobbed by the code for
+;;; with-pinned-objects in src/compiler/target/macros.lisp.
+#!+(and gencgc (not (or x86 x86-64)))
+(defvar sb!vm::*pinned-objects*)
+
 (defmacro without-gcing (&body body)
   #!+sb-doc
   "Executes the forms in the body without doing a garbage collection. It

diff --git a/src/compiler/generic/parms.lisp b/src/compiler/generic/parms.lisp
index 3995376..88471d4 100644 (file)
--- a/src/compiler/generic/parms.lisp
+++ b/src/compiler/generic/parms.lisp
@@ -71,6 +71,10 @@
     sb!impl::*data-vector-reffers/check-bounds*
     sb!impl::*data-vector-setters/check-bounds*
 
+    ;; non-x86oid gencgc object pinning
+    #!+(and gencgc (not (or x86 x86-64)))
+    *pinned-objects*
+
     ;; hash table weaknesses
     :key
     :value

diff --git a/src/compiler/ppc/macros.lisp b/src/compiler/ppc/macros.lisp
index e566001..e8de508 100644 (file)
--- a/src/compiler/ppc/macros.lisp
+++ b/src/compiler/ppc/macros.lisp
@@ -319,6 +319,11 @@
 OBJECTS will not be moved in memory for the duration of BODY.
 Useful for e.g. foreign calls where another thread may trigger
 garbage collection.  This is currently implemented by disabling GC"
+  #!-gencgc
   (declare (ignore objects))            ; should we eval these for side-effect?
+  #!-gencgc
   `(without-gcing
-    ,@body))
+    ,@body)
+  #!+gencgc
+  `(let ((*pinned-objects* (list* ,@objects *pinned-objects*)))
+     ,@body))

diff --git a/src/runtime/gencgc.c b/src/runtime/gencgc.c
index 910b913..74b818e 100644 (file)
--- a/src/runtime/gencgc.c
+++ b/src/runtime/gencgc.c
@@ -55,6 +55,9 @@
 #if defined(LUTEX_WIDETAG)
 #include "pthread-lutex.h"
 #endif
+#if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
+#include "genesis/cons.h"
+#endif
 
 /* forward declarations */
 page_index_t  gc_find_freeish_pages(long *restart_page_ptr, long nbytes,
@@ -2533,6 +2536,8 @@ possibly_valid_dynamic_space_pointer(lispobj *pointer)
     return looks_like_valid_lisp_pointer_p(pointer, start_addr);
 }
 
+#endif  // defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
+
 /* Adjust large bignum and vector objects. This will adjust the
  * allocated region if the size has shrunk, and move unboxed objects
  * into unboxed pages. The pages are not promoted here, and the
@@ -2751,11 +2756,17 @@ preserve_pointer(void *addr)
      * address referring to something in a CodeObject). This is
      * expensive but important, since it vastly reduces the
      * probability that random garbage will be bogusly interpreted as
-     * a pointer which prevents a page from moving. */
+     * a pointer which prevents a page from moving.
+     *
+     * This only needs to happen on x86oids, where this is used for
+     * conservative roots.  Non-x86oid systems only ever call this
+     * function on known-valid lisp objects. */
+#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
     if (!(code_page_p(addr_page_index)
           || (is_lisp_pointer((lispobj)addr) &&
               possibly_valid_dynamic_space_pointer(addr))))
         return;
+#endif
 
     /* Find the beginning of the region.  Note that there may be
      * objects in the region preceding the one that we were passed a
@@ -2834,9 +2845,6 @@ preserve_pointer(void *addr)
     /* Check that the page is now static. */
     gc_assert(page_table[addr_page_index].dont_move != 0);
 }
-
-#endif  // defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
-
 \f
 /* If the given page is not write-protected, then scan it for pointers
  * to younger generations or the top temp. generation, if no
@@ -3888,9 +3896,8 @@ garbage_collect_generation(generation_index_t generation, int raise)
     unsigned long bytes_freed;
     page_index_t i;
     unsigned long static_space_size;
-#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
     struct thread *th;
-#endif
+
     gc_assert(generation <= HIGHEST_NORMAL_GENERATION);
 
     /* The oldest generation can't be raised. */
@@ -3990,6 +3997,19 @@ garbage_collect_generation(generation_index_t generation, int raise)
             }
         }
     }
+#else
+    /* Non-x86oid systems don't have "conservative roots" as such, but
+     * the same mechanism is used for objects pinned for use by alien
+     * code. */
+    for_each_thread(th) {
+        lispobj pin_list = SymbolTlValue(PINNED_OBJECTS,th);
+        while (pin_list != NIL) {
+            struct cons *list_entry =
+                (struct cons *)native_pointer(pin_list);
+            preserve_pointer(list_entry->car);
+            pin_list = list_entry->cdr;
+        }
+    }
 #endif
 
 #if QSHOW

diff --git a/src/runtime/thread.c b/src/runtime/thread.c
index 862e9f8..2e61302 100644 (file)
--- a/src/runtime/thread.c
+++ b/src/runtime/thread.c
@@ -473,6 +473,9 @@ create_thread_struct(lispobj initial_function) {
     bind_variable(ALLOW_WITH_INTERRUPTS,T,th);
     bind_variable(GC_PENDING,NIL,th);
     bind_variable(ALLOC_SIGNAL,NIL,th);
+#ifdef PINNED_OBJECTS
+    bind_variable(PINNED_OBJECTS,NIL,th);
+#endif
 #ifdef LISP_FEATURE_SB_THREAD
     bind_variable(STOP_FOR_GC_PENDING,NIL,th);
 #endif

diff --git a/version.lisp-expr b/version.lisp-expr
index 6361fd1..68e6274 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.41.14"
+"1.0.41.15"