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

cs: include accounting time in reports GC time

Browse Source 
When logging GC debugging, a pecentage after the time for a GC reports
what fraction was extra steps after GCing proper, especially the extra
step of memory acounting when that is enabled.

Also, avoid Chez Scheme gensyms even more. Otherwise, using low-level
facilities like `dump-memory-stats` can force the unique name of a
gensym used for a structure type, which causes it to be permanent,
which could be exactly what you don't want when debugging a
memory-rentention problem.
This commit is contained in:
Matthew Flatt 2020-02-01 07:30:00 -07:00
parent eeb73a6c05
commit 67595cc255
8 changed files with 42 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
racket/src/cs/linklet.sls
View File

@ -1273,6 +1273,12 @@
(expand-omit-library-invocations #t)
(enable-error-source-expression #f)
;; Avoid gensyms for generated record-tyope UIDs. Otherwise,
;; printing one of those gensyms --- perhaps when producing a trace
;; via `dump-memory-stats` --- causes the gensym to be permanent
;; (since it has properties).
(current-generate-id (lambda (sym) (gensym sym)))
;; Since the schemify layer inserts `|#%app|` any time the rator of
;; an application might not be a procedure, we can avoid redundant
;; checks for other applications by enabling unsafe mode. Ditto for

18
racket/src/cs/main.sps
View File

@ -634,7 +634,8 @@
(let ([root-logger (current-logger)])
;; This function can be called in any Chez Scheme thread
(lambda (gen pre-allocated pre-allocated+overhead pre-time pre-cpu-time
post-allocated post-allocated+overhead post-time post-cpu-time)
post-allocated post-allocated+overhead proper-post-time proper-post-cpu-time
post-time post-cpu-time)
(let ([minor? (< gen (collect-maximum-generation))])
(if minor?
(set! minor-gcs (add1 minor-gcs))
@ -644,14 +645,23 @@
(when (or debug-GC?
(and (not minor?)
(log-level?* root-logger 'debug 'GC:major)))
(let ([delta (- pre-allocated post-allocated)])
(let ([delta (- pre-allocated post-allocated)]
[account-str (let ([proper (if (= post-cpu-time pre-cpu-time)
100
(quotient (* 100 (- proper-post-cpu-time pre-cpu-time))
(- post-cpu-time pre-cpu-time)))])
(if (fx>= proper 99)
""
(string-append "[" (number->string (fx- 100 proper)) "%]")))])
(log-message* root-logger 'debug (if debug-GC? 'GC 'GC:major)
(chez:format "GC: 0:~a~a @ ~a(~a); free ~a(~a) ~ams @ ~a"
(chez:format "GC: 0:~a~a @ ~a(~a); free ~a(~a) ~ams~a @ ~a"
(if minor? "min" "MAJ") gen
(K "" pre-allocated) (K "+" (- pre-allocated+overhead pre-allocated))
(K "" delta) (K "+" (- (- pre-allocated+overhead post-allocated+overhead)
delta))
(- post-cpu-time pre-cpu-time) pre-cpu-time)
(- post-cpu-time pre-cpu-time)
account-str
pre-cpu-time)
(make-gc-info (if minor? 'minor 'major) pre-allocated pre-allocated+overhead 0
post-allocated post-allocated+overhead
pre-cpu-time post-cpu-time

2
racket/src/cs/rumble/define.ss
View File

@ -241,7 +241,7 @@
[(called-var ...) called-vars]
[new-name (datum->syntax
name
(chez:gensym (chez:symbol->string (syntax->datum name))))]
(#%gensym (#%symbol->string (syntax->datum name))))]
[body (let loop ([body body]
[binds binds])
(cond

2
racket/src/cs/rumble/impersonator.ss
View File

@ -596,7 +596,7 @@
(lambda (v info)
(check 'guard-for-prop:impersonator-of (procedure-arity-includes/c 1) v)
;; Add a tag to track origin of the `prop:impersonator-of` value
(cons (gensym "tag") v))))
(cons (box 'impersonator-of) v))))
(define (extract-impersonator-of who a)
(and (impersonator-of-redirect? a)

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

@ -16,7 +16,9 @@
(define garbage-collect-notify
(lambda (gen pre-allocated pre-allocated+overhead pre-time re-cpu-time
post-allocated post-allocated+overhead post-time post-cpu-time)
post-allocated post-allocated+overhead
proper-post-time proper-post-cpu-time
post-time post-cpu-time)
(void)))
;; #f or a procedure that accepts `compute-size-increments` to be
@ -76,7 +78,9 @@
(run-collect-callbacks car)
(collect gen)
(let ([post-allocated (bytes-allocated)]
[post-allocated+overhead (current-memory-bytes)])
[post-allocated+overhead (current-memory-bytes)]
[post-time (real-time)]
[post-cpu-time (cpu-time)])
(when (= gen (collect-maximum-generation))
;; Trigger a major GC when twice as much memory is used. Twice
;; `post-allocated+overhead` seems to be too long a wait, because
@ -85,15 +89,16 @@
;; immediate major GC too soon. Split the difference.
(set! trigger-major-gc-allocated (* GC-TRIGGER-FACTOR post-allocated))
(set! trigger-major-gc-allocated+overhead (* GC-TRIGGER-FACTOR post-allocated+overhead)))
(update-eq-hash-code-table-size!)
(poll-foreign-guardian)
(when (and reachable-size-increments-callback
(fx= gen (collect-maximum-generation)))
(reachable-size-increments-callback compute-size-increments))
(run-collect-callbacks cdr)
(garbage-collect-notify gen
pre-allocated pre-allocated+overhead pre-time pre-cpu-time
post-allocated post-allocated+overhead (real-time) (cpu-time)))
(update-eq-hash-code-table-size!)
(poll-foreign-guardian)
(run-collect-callbacks cdr)
(when (and reachable-size-increments-callback
(fx= gen (collect-maximum-generation)))
(reachable-size-increments-callback compute-size-increments))
post-allocated post-allocated+overhead post-time post-cpu-time
(real-time) (cpu-time)))
(when (and (= gen (collect-maximum-generation))
(currently-in-engine?))
;; This `set-timer` doesn't necessarily penalize the right thread,

5
racket/src/cs/rumble/prefab.ss
View File

@ -305,8 +305,9 @@
(define (encode-prefab-key+count-as-symbol prefab-key+count)
;; The symbol has to be uninterned, because we're going to attach
;; properties to it, and an interned symbol with properties is never
;; reclaimed by the garbage collector
(#%gensym (#%format "~s" prefab-key+count)))
;; reclaimed by the garbage collector. Beware that a gensym is
;; retained, too, if its unique name is forced.
(#%string->uninterned-symbol (#%format "~s" prefab-key+count)))
(define (immutables->mutables immutables init-count auto-count)
(vector->immutable-vector

2
racket/src/cs/rumble/struct.ss
View File

@ -1070,7 +1070,7 @@
" (procedure-arity-includes/c 2)\n"
" (procedure-arity-includes/c 2))")
val)
(cons (#%gensym) val))))
(cons (box 'equal+hash) val))))
(define-values (prop:authentic authentic? authentic-ref)
(make-struct-type-property 'authentic (lambda (val info) #t)))

4
racket/src/thread/custodian.rkt
View File

@ -450,9 +450,9 @@
(unless (zero? compute-memory-sizes)
(host:call-with-current-place-continuation
(lambda (starting-k)
;; A place may have future pthreads, and each ptherad may
;; A place may have future pthreads, and each pthread may
;; be running a future that becomes to a particular custodian;
;; build up a custodian-to-pthtread mapping in this table:
;; build up a custodian-to-pthread mapping in this table:
(define custodian-future-threads (make-hasheq))
(future-scheduler-add-thread-custodian-mapping! (place-future-scheduler initial-place)
custodian-future-threads)