diff --git a/pkgs/racket-test-core/tests/racket/number.rktl b/pkgs/racket-test-core/tests/racket/number.rktl index ef4dbad299..f9b194d9b8 100644 --- a/pkgs/racket-test-core/tests/racket/number.rktl +++ b/pkgs/racket-test-core/tests/racket/number.rktl @@ -2691,6 +2691,10 @@ (apply append (for/list ([i 10000]) (random-sample (range 10) 100))))))) +(parameterize ([current-pseudo-random-generator (make-pseudo-random-generator)]) + (random-seed 2) + (test '#(1062645402 3593208522 3838676319 2291995347 179540564 3081399108) + pseudo-random-generator->vector (current-pseudo-random-generator))) (test #t = 0 0) (test #f = 0 (expt 2 32)) diff --git a/racket/src/cs/rumble/foreign.ss b/racket/src/cs/rumble/foreign.ss index 0b3cbae7e1..0b14a0f77e 100644 --- a/racket/src/cs/rumble/foreign.ss +++ b/racket/src/cs/rumble/foreign.ss @@ -1402,7 +1402,7 @@ (let* ([bstr (make-bytevector size 0)] [p (make-cpointer bstr #f)]) (lock-object bstr) - (with-global-lock (the-foreign-guardian p (lambda () (unlock-object bstr)))) + (unsafe-add-global-finalizer p (lambda () (unlock-object bstr))) p)] [else (raise-unsupported-error 'malloc @@ -1464,7 +1464,7 @@ (poll-foreign-guardian)))) (define (unsafe-add-global-finalizer v proc) - (the-foreign-guardian v proc)) + (with-global-lock (the-foreign-guardian v proc))) ;; ---------------------------------------- @@ -1973,7 +1973,7 @@ (let* ([code (make-code proc)] [cb (create-callback code)]) (lock-object code) - (with-global-lock (the-foreign-guardian cb (lambda () (unlock-object code)))) + (unsafe-add-global-finalizer cb (lambda () (unlock-object code))) cb)))])) ;; ---------------------------------------- diff --git a/racket/src/cs/rumble/memory.ss b/racket/src/cs/rumble/memory.ss index 7630266c4d..efb53ac204 100644 --- a/racket/src/cs/rumble/memory.ss +++ b/racket/src/cs/rumble/memory.ss @@ -34,7 +34,8 @@ (define gc-counter 1) (define log-collect-generation-radix 2) (define collect-generation-radix-mask (sub1 (bitwise-arithmetic-shift 1 log-collect-generation-radix))) -(define allocated-after-major (* 32 1024 1024)) +(define allocated+overhead-after-major (* 32 1024 1024)) +(define non-full-gc-counter 0) ;; Called in any thread with all other threads paused. The Racket ;; thread scheduler may be in atomic mode. In fact, the engine @@ -51,7 +52,8 @@ (set! gc-counter (add1 this-counter))) (let ([gen (cond [(and (not g) - (>= pre-allocated (* 2 allocated-after-major))) + (or (>= pre-allocated+overhead (* 2 allocated+overhead-after-major)) + (>= non-full-gc-counter 10000))) ;; Force a major collection if memory use has doubled (collect-maximum-generation)] [else @@ -63,12 +65,13 @@ [else gen]))])]) (run-collect-callbacks car) (collect gen) - (let ([post-allocated (bytes-allocated)]) + (let ([post-allocated (bytes-allocated)] + [post-allocated+overhead (current-memory-bytes)]) (when (= gen (collect-maximum-generation)) - (set! allocated-after-major post-allocated)) + (set! allocated+overhead-after-major post-allocated+overhead)) (garbage-collect-notify gen pre-allocated pre-allocated+overhead pre-time pre-cpu-time - post-allocated (current-memory-bytes) (real-time) (cpu-time))) + post-allocated post-allocated+overhead (real-time) (cpu-time))) (update-eq-hash-code-table-size!) (poll-foreign-guardian) (run-collect-callbacks cdr) @@ -80,6 +83,11 @@ ;; This `set-timer` doesn't necessarily penalize the right thread, ;; but it's likely to penalize a thread that is allocating quickly: (set-timer 1)) + (cond + [(= gen (collect-maximum-generation)) + (set! non-full-gc-counter 0)] + [else + (set! non-full-gc-counter (add1 non-full-gc-counter))]) (void)))) (define collect-garbage @@ -349,7 +357,7 @@ (define/who (make-phantom-bytes k) (check who exact-nonnegative-integer? k) (let ([ph (create-phantom-bytes (make-phantom-bytevector k))]) - (when (>= (bytes-allocated) (* 2 allocated-after-major)) + (when (>= (current-memory-bytes) (* 2 allocated+overhead-after-major)) (collect-garbage)) ph))