Chez Scheme GC: faster record type handling

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

View File

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