From: Taylor R Campbell <campbell@mumble.net>
Date: Wed, 9 Jan 2019 04:04:12 +0000 (+0000)
Subject: Avoid consing closures if we're low on space.
X-Git-Tag: mit-scheme-pucked-10.1.10~6^2~16
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=991a80069f3f0471a46487109e30e2ffaa3c8fc6;p=mit-scheme.git

Avoid consing closures if we're low on space.
---

diff --git a/src/runtime/gcnote.scm b/src/runtime/gcnote.scm
index 58d9429e6..b90f92868 100644
--- a/src/runtime/gcnote.scm
+++ b/src/runtime/gcnote.scm
@@ -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))