~ chicken-core (chicken-5) 63ebf0fa4b5b7644720c2d674366c72fb6b67659

commit 63ebf0fa4b5b7644720c2d674366c72fb6b67659
Author:     megane <meganeka@gmail.com>
AuthorDate: Fri Aug 9 13:39:36 2019 +0300
Commit:     Peter Bex <peter@more-magic.net>
CommitDate: Sat Sep 14 16:04:45 2019 +0200

    Fix couple of hangs related to finalizers and (gc #t)
    
    Calling (gc #t) would get into an infinite no-progress loop in
    was being run in another thread.
    
    In that case the (##sys#run-pending-finalizers #f) call in
    is compiled with interrupts disabled the other thread never got to run
    again.
    
    * library.scm (##sys#run-pending-finalizers): Yield the current thread
      if pending finalizers are being run in another thread.
    
      Also signal an error if trying to re-enter without "state". This
      also would cause an infinite loop (when calling (gc #t) inside a
      finalizer). It would need special handling if re-entry is to be
      supported.
    
    Fixes #1586
    
    Signed-off-by: Peter Bex <peter@more-magic.net>

diff --git a/NEWS b/NEWS
index 7d216375..c4ebe555 100644
--- a/NEWS
+++ b/NEWS
@@ -18,6 +18,8 @@
     (fixes #1627, thanks to John Cowan).
   - ##sys#check-exact and its C implementations C_i_check_exact and
     C_i_check_exact_2 have been deprecated (see also #1631).
+  - When garbage collector is manually invoked from a finalizer, raise
+    an error instead of hanging forever (fixes #1586).
 
 - Core libraries
   - There is now a srfi-88 module which contains just the three
diff --git a/library.scm b/library.scm
index bc0ef42c..2b5f4ef6 100644
--- a/library.scm
+++ b/library.scm
@@ -6072,10 +6072,11 @@ static C_word C_fcall C_setenv(C_word x, C_word y) {
 (define ##sys#run-pending-finalizers
   (let ((vector-fill! vector-fill!)
 	(string-append string-append)
-	(working #f) )
+	(working-thread #f) )
     (lambda (state)
-      (unless working
-	(set! working #t)
+      (cond
+       ((not working-thread)
+	(set! working-thread ##sys#current-thread)
 	(let* ((c (##sys#slot ##sys#pending-finalizers 0)) )
 	  (when (##sys#debug-mode?)
 	    (##sys#print 
@@ -6097,7 +6098,15 @@ static C_word C_fcall C_setenv(C_word x, C_word y) {
 		 (##sys#slot ##sys#pending-finalizers i2)) ) ))
 	  (vector-fill! ##sys#pending-finalizers (##core#undefined))
 	  (##sys#setislot ##sys#pending-finalizers 0 0) 
-	  (set! working #f) ) )
+	  (set! working-thread #f)))
+       (state)         ; Got here due to interrupt; continue w/o error
+       ((eq? working-thread ##sys#current-thread)
+	 (##sys#signal-hook
+	  #:error '##sys#run-pending-finalizers
+	  "re-entry from finalizer thread (maybe (gc #t) was called from a finalizer)"))
+       (else
+	;; Give finalizer thread a change to run
+	(##sys#thread-yield!)))
       (cond ((not state))
 	    ((procedure? state) (state))
 	    (state (##sys#context-switch state) ) ) ) ))