suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

cs: check memory limit in make-phantom-bytes

Browse Source
This commit is contained in:
Matthew Flatt 2020-06-29 13:44:07 -06:00
parent 9e74f2d6c8
commit b00e8415b7
2 changed files with 8 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
pkgs/racket-test-core/tests/racket/will.rktl
View File

@ -247,6 +247,10 @@
(unless (eq? 'cgc (system-type 'gc)) (unless (eq? 'cgc (system-type 'gc))
(define s (make-semaphore)) (define s (make-semaphore))
(define c (make-custodian)) (define c (make-custodian))
(define bits (let loop ([bits 29])
(if (fixnum? (expt 2 bits))
bits
(loop (sub1 bits)))))
(define t (parameterize ([current-custodian c]) (define t (parameterize ([current-custodian c])
(thread (lambda () (thread (lambda ()
(semaphore-wait s) (semaphore-wait s)

3
racket/src/cs/rumble/memory.ss
View File

@ -490,6 +490,7 @@
(define/who (make-phantom-bytes k) (define/who (make-phantom-bytes k)
(check who exact-nonnegative-integer? k) (check who exact-nonnegative-integer? k)
(guard-large-allocation who "byte string" k 1)
(let ([ph (create-phantom-bytes (make-phantom-bytevector k))]) (let ([ph (create-phantom-bytes (make-phantom-bytevector k))])
(when (or (>= (bytes-allocated) trigger-major-gc-allocated) (when (or (>= (bytes-allocated) trigger-major-gc-allocated)
(>= (current-memory-bytes) trigger-major-gc-allocated+overhead)) (>= (current-memory-bytes) trigger-major-gc-allocated+overhead))
@ -499,6 +500,8 @@
(define/who (set-phantom-bytes! phantom-bstr k) (define/who (set-phantom-bytes! phantom-bstr k)
(check who phantom-bytes? phantom-bstr) (check who phantom-bytes? phantom-bstr)
(check who exact-nonnegative-integer? k) (check who exact-nonnegative-integer? k)
(when (> k (phantom-bytevector-length (phantom-bytes-pbv phantom-bstr)))
(guard-large-allocation who "byte string" k 1))
(set-phantom-bytevector-length! (phantom-bytes-pbv phantom-bstr) k)) (set-phantom-bytevector-length! (phantom-bytes-pbv phantom-bstr) k))
;; ---------------------------------------- ;; ----------------------------------------