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:
parent
54367de430
commit
d24cbd4344
|
@ -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,9 +1563,10 @@
|
||||||
(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)
|
||||||
|
(cond
|
||||||
|
[(lookup 'counts? config #f)
|
||||||
(code
|
(code
|
||||||
"/* Relocate to make sure we aren't using an oldspace descriptor"
|
"/* Relocate to make sure we aren't using an oldspace descriptor"
|
||||||
" that has been overwritten by a forwarding marker, but don't loop"
|
" that has been overwritten by a forwarding marker, but don't loop"
|
||||||
|
@ -1579,7 +1575,11 @@
|
||||||
(lookup 'tf config (format "TYPEFIELD(p)")))
|
(lookup 'tf config (format "TYPEFIELD(p)")))
|
||||||
(code-block
|
(code-block
|
||||||
(statements `((trace-early ,field)) config)))]
|
(statements `((trace-early ,field)) config)))]
|
||||||
[(measure)
|
[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)))
|
||||||
|
|
Loading…
Reference in New Issue
Block a user