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

Chez Scheme GC: faster record type handling

Browse Source 
When the GC needs to copy/mark a record, it previously forced a
copy/mark on the record's type descriptor, since the copy/mark needs
information from the descriptor. But the needed information is not in
danger of being overwritten for forwading (since it's after the first
two words of the type descriptor), so it's ok to use the old reference
as-is --- at least in non-counting mode. Simplifying record-type
handling and deferring the record-type update to the sweep phase, the
same as for other components of the record type, makes the GC slightly
faster.
This commit is contained in:
Matthew Flatt 2020-09-22 07:30:20 -06:00
parent 54367de430
commit d24cbd4344
1 changed files with 24 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
racket/src/ChezScheme/s/mkgc.ss
View File

@ -307,11 +307,10 @@
[record [record
(trace-early-rtd record-type) (trace-early-rtd record-type)
;; If the rtd is the only pointer and is immutable, put the record ;; If the record contains only pointers, put it into space-pure
;; into space-data. If the record contains only pointers, put it ;; or space-impure. Otherwise, put it into
;; into space-pure or space-impure. Otherwise, put it into ;; space-pure-typed-object or space-impure-record. We could put
;; space-pure-typed-object or space-impure-record. We could put all ;; all records into space-{pure,impure}-record or even into
;; records into space-{pure,impure}-record or even into
;; space-impure-record, but by picking the target space more ;; space-impure-record, but by picking the target space more
;; carefully, we may reduce fragmentation and sweeping cost. ;; carefully, we may reduce fragmentation and sweeping cost.
(define rtd : ptr (record-type _)) (define rtd : ptr (record-type _))
@ -319,10 +318,6 @@
(cond (cond
[(and-counts (is_counting_root si _)) [(and-counts (is_counting_root si _))
space-count-impure] space-count-impure]
[(&& (== (record-type-pm rtd) (FIX 1))
(== (record-type-mpm rtd) (FIX 0)))
;; No pointers except for type
space-data]
[(== (record-type-pm rtd) (FIX -1)) [(== (record-type-pm rtd) (FIX -1))
;; All pointers ;; All pointers
(cond (cond
@ -1568,18 +1563,23 @@
(statements (append body (cdr l)) config))] (statements (append body (cdr l)) config))]
[`(trace-early-rtd ,field) [`(trace-early-rtd ,field)
(code (case (and (not (lookup 'as-dirty? config #f)) (code (case (and (not (lookup 'as-dirty? config #f))
(not (lookup 'rtd-relocated? config #f))
(lookup 'mode config)) (lookup 'mode config))
[(copy sweep sweep-in-old mark) [(copy mark)
(code (cond
"/* Relocate to make sure we aren't using an oldspace descriptor" [(lookup 'counts? config #f)
" that has been overwritten by a forwarding marker, but don't loop" (code
" on tag-reflexive base descriptor */" "/* Relocate to make sure we aren't using an oldspace descriptor"
(format "if (p != ~a)" " that has been overwritten by a forwarding marker, but don't loop"
(lookup 'tf config (format "TYPEFIELD(p)"))) " on tag-reflexive base descriptor */"
(code-block (format "if (p != ~a)"
(statements `((trace-early ,field)) config)))] (lookup 'tf config (format "TYPEFIELD(p)")))
[(measure) (code-block
(statements `((trace-early ,field)) config)))]
[else
(code
"/* Do not inspect the type or first field of the rtd, because"
" it may have been overwritten for forwarding. */")])]
[(measure sweep sweep-in-old)
(statements `((trace-early ,field)) config)] (statements `((trace-early ,field)) config)]
[else #f]) [else #f])
(statements (cdr l) (cons `(copy-extra-rtd ,field) config)))] (statements (cdr l) (cons `(copy-extra-rtd ,field) config)))]
@ -1782,7 +1782,8 @@
(lookup 'copy-extra-rtd config #f))]) (lookup 'copy-extra-rtd config #f))])
(if extra (if extra
(cons `(set! (,extra _copy_) (cons `(set! (,extra _copy_)
,(case mode ,(case (and (lookup 'counts? config #f)
mode)
[(copy) [(copy)
`(cond `(cond
[(== tf _) _copy_] [(== tf _) _copy_]
@ -2565,9 +2566,8 @@
(known-types (,type)) (known-types (,type))
(maybe-backreferences? ,count?) (maybe-backreferences? ,count?)
(counts? ,count?)))))])]) (counts? ,count?)))))])])
(sweep1 'record "sweep_record" '((rtd-relocated? #t))) (sweep1 'record "sweep_record" '())
(sweep1 'record "sweep_dirty_record" '((rtd-relocated? #t) (sweep1 'record "sweep_dirty_record" '((as-dirty? #t)))
(as-dirty? #t)))
(sweep1 'symbol) (sweep1 'symbol)
(sweep1 'symbol "sweep_dirty_symbol" '((as-dirty? #t))) (sweep1 'symbol "sweep_dirty_symbol" '((as-dirty? #t)))
(sweep1 'thread "sweep_thread" '((no-from-g? #t))) (sweep1 'thread "sweep_thread" '((no-from-g? #t)))