From 991a80069f3f0471a46487109e30e2ffaa3c8fc6 Mon Sep 17 00:00:00 2001 From: Taylor R Campbell Date: Wed, 9 Jan 2019 04:04:12 +0000 Subject: [PATCH] Avoid consing closures if we're low on space. --- src/runtime/gcnote.scm | 56 +++++++++++++++++++++++------------------- 1 file changed, 31 insertions(+), 25 deletions(-) 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)) -- 2.25.1