Add safepoint mechanism

[sbcl.git] / src / code / target-thread.lisp

diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp
index 82ce827..3b00593 100644 (file)
--- a/src/code/target-thread.lisp
+++ b/src/code/target-thread.lisp
@@ -1418,13 +1418,16 @@ See also: RETURN-FROM-THREAD, ABORT-THREAD."
                                      (with-local-interrupts
                                        (sb!unix::unblock-deferrable-signals)
                                        (setf (thread-result thread)
-                                             (cons t
-                                                   (multiple-value-list
-                                                    (unwind-protect
-                                                         (catch '%return-from-thread
-                                                           (apply real-function arguments))
-                                                      (when *exit-in-process*
-                                                        (sb!impl::call-exit-hooks)))))))
+                                             (prog1
+                                                 (cons t
+                                                       (multiple-value-list
+                                                        (unwind-protect
+                                                             (catch '%return-from-thread
+                                                               (apply real-function arguments))
+                                                          (when *exit-in-process*
+                                                            (sb!impl::call-exit-hooks)))))
+                                               #!+sb-safepoint
+                                               (sb!kernel::gc-safepoint))))
                                   ;; We're going down, can't handle interrupts
                                   ;; sanely anymore. GC remains enabled.
                                   (block-deferrable-signals)