From bcfbf2249e9bbd0cfd44b14ba99ac124dfaf21fd Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 15 Dec 2020 19:09:56 -0700 Subject: [PATCH] cs: avoid race with GC in `(current-memory-use 'cumulative)` Thanks to Alex Harsanyi for reporting the problem. --- .../tests/racket/stress/cumulative-memory.rkt | 17 +++++++++++++++++ racket/src/cs/rumble/memory.ss | 3 ++- 2 files changed, 19 insertions(+), 1 deletion(-) create mode 100644 pkgs/racket-test/tests/racket/stress/cumulative-memory.rkt diff --git a/pkgs/racket-test/tests/racket/stress/cumulative-memory.rkt b/pkgs/racket-test/tests/racket/stress/cumulative-memory.rkt new file mode 100644 index 0000000000..99d045bd2d --- /dev/null +++ b/pkgs/racket-test/tests/racket/stress/cumulative-memory.rkt @@ -0,0 +1,17 @@ +#lang racket/base + +;; Check whether `(current-memory-use 'cumulative)` is always increasing + +(define (work n) + (length (let loop ([n n]) + (if (zero? n) + '() + (cons (make-vector n) (loop (sub1 n))))))) + +(let loop ([n 20000] [u (current-memory-use 'cumulative)]) + (unless (zero? n) + (work (random 1000)) + (let ([u2 (current-memory-use 'cumulative)]) + (if (u2 . < . u) + (error "oops") + (loop (sub1 n) u2))))) diff --git a/racket/src/cs/rumble/memory.ss b/racket/src/cs/rumble/memory.ss index 6e2c07b47c..c0ad360caa 100644 --- a/racket/src/cs/rumble/memory.ss +++ b/racket/src/cs/rumble/memory.ss @@ -190,7 +190,8 @@ [(mode) (cond [(not mode) (bytes-allocated)] - [(eq? mode 'cumulative) (+ (bytes-deallocated) (bytes-allocated))] + [(eq? mode 'cumulative) (with-interrupts-disabled + (+ (bytes-deallocated) (bytes-allocated)))] ;; must be a custodian; hook is reposnsible for complaining if not [else (custodian-memory-use mode (bytes-allocated))])]))