Avoid consing closures if we're low on space.
authorTaylor R Campbell <campbell@mumble.net>
Wed, 9 Jan 2019 04:04:12 +0000 (04:04 +0000)
committerTaylor R Campbell <campbell@mumble.net>
Sat, 9 Feb 2019 17:00:11 +0000 (17:00 +0000)
src/runtime/gcnote.scm

index 58d9429e641617bdfb79f7d8b75380f7f6e9d5dc..b90f92868d14568be17d9ae78142088987e6df7a 100644 (file)
@@ -108,31 +108,37 @@ USA.
     (and entry (weak-cdr entry))))
 
 (define (signal-gc-events)
-  (let ((statistic last-statistic)
-       (signaled? #f))
-
-    (define (signal-event thread event)
-      (if (and thread (not (eq? 'dead (thread-execution-state thread))))
-         (begin
-           (%signal-thread-event thread event)
-           (set! signaled? #t))))
-
-    (without-interrupts
-     (lambda ()
-       (if (< (gc-statistic/heap-left statistic) 4096)
-          (if first-running-thread
-              (signal-event first-running-thread abort-heap-low)
-              (let ((thread (console-thread)))
-                (if thread
-                    (signal-event thread abort-heap-low))))
-          (for-each
-            (lambda (entry)
-              (let ((thread (weak-car entry))
-                    (event (weak-cdr entry)))
-                (signal-event thread (named-lambda (gc-event)
-                                       (event statistic)))))
-            gc-events))
-       (if signaled? (%maybe-toggle-thread-timer))))))
+  (without-interrupts
+   (lambda ()
+     (let ((statistic last-statistic))
+
+       (define (signal-event thread event)
+        (if (and thread (not (eq? 'dead (thread-execution-state thread))))
+            (begin
+              (%signal-thread-event thread event)
+              #t)
+            #f))
+
+       (let ((signaled?
+             (if (< (gc-statistic/heap-left statistic) 4096)
+                 (if first-running-thread
+                     (signal-event first-running-thread abort-heap-low)
+                     (let ((thread (console-thread)))
+                       (if thread
+                           (signal-event thread abort-heap-low)
+                           #f)))
+                 (let ((signaled? #f))
+                   (for-each
+                    (lambda (entry)
+                      (let ((thread (weak-car entry))
+                            (event (weak-cdr entry)))
+                        (if (signal-event thread (named-lambda (gc-event)
+                                                   (event statistic)))
+                            (set! signaled? #t))))
+                    gc-events)
+                   signaled?))))
+        (if signaled?
+            (%maybe-toggle-thread-timer)))))))
 
 (define (weak-assq obj alist)
   (let loop ((alist alist))