Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

[ perf ] Use alternative better GC on chez #3331

Merged
merged 1 commit into from
Jun 24, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 2 additions & 0 deletions CHANGELOG_NEXT.md
Original file line number Diff line number Diff line change
Expand Up @@ -115,6 +115,8 @@ This CHANGELOG describes the merged but unreleased changes. Please see [CHANGELO
evaluated. Now when a delayed expression is lifted by CSE, it is compiled
using Scheme's `delay` and `force` to memoize them.

* More efficient `collect-request-handler` is used.

#### Racket

* Fixed CSE soundness bug that caused delayed expressions to sometimes be eagerly
Expand Down
40 changes: 38 additions & 2 deletions src/Compiler/Scheme/Chez.idr
Original file line number Diff line number Diff line change
Expand Up @@ -449,6 +449,42 @@ startChezWinSh chez appdir target progType = """
"\{ chez }" \{ progType } "$DIR/\{ target }" "$@"
"""

-- This handler turned out to be much more effective than the original simple
-- `(collect-request-handler (lambda () (collect) (blodwen-run-finalisers)))`
export
collectRequestHandler : Builder
collectRequestHandler = """
(collect-request-handler
(let* ([gc-counter 1]
[log-radix 2]
[radix-mask (sub1 (bitwise-arithmetic-shift 1 log-radix))]
[major-gc-factor 2]
[trigger-major-gc-allocated (* major-gc-factor (bytes-allocated))])
(lambda ()
(cond
[(>= (bytes-allocated) trigger-major-gc-allocated)
;; Force a major collection if memory use has doubled
(collect (collect-maximum-generation))
(blodwen-run-finalisers)
(set! trigger-major-gc-allocated (* major-gc-factor (bytes-allocated)))]
[else
;; Imitate the built-in rule, but without ever going to a major collection
(let ([this-counter gc-counter])
(if (> (add1 this-counter)
(bitwise-arithmetic-shift-left 1 (* log-radix (sub1 (collect-maximum-generation)))))
(set! gc-counter 1)
(set! gc-counter (add1 this-counter)))
(collect
;; Find the minor generation implied by the counter
(let loop ([c this-counter] [gen 0])
(cond
[(zero? (bitwise-and c radix-mask))
(loop (bitwise-arithmetic-shift-right c log-radix)
(add1 gen))]
[else
gen]))))]))))
"""

||| Compile a TT expression to Chez Scheme
compileToSS : Ref Ctxt Defs ->
Bool -> -- profiling
Expand Down Expand Up @@ -480,7 +516,7 @@ compileToSS c prof appdir tm outfile
, fromString support
, fromString extraRuntime
, code
, "(collect-request-handler (lambda () (collect) (blodwen-run-finalisers)))\n"
, collectRequestHandler ++ "\n"
, main
, schFooter prof True
]
Expand Down Expand Up @@ -525,7 +561,7 @@ compileToSSInc c mods libs appdir tm outfile
fromString support ++
concat loadlibs ++
concat loadsos ++
"(collect-request-handler (lambda () (collect) (blodwen-run-finalisers)))\n" ++
collectRequestHandler ++ "\n" ++
main ++ schFooter False False

Right () <- coreLift $ writeFile outfile $ build scm
Expand Down
2 changes: 1 addition & 1 deletion src/Compiler/Scheme/ChezSep.idr
Original file line number Diff line number Diff line change
Expand Up @@ -237,7 +237,7 @@ compileToSS c chez appdir tm = do
main <- schExp empty (Chez.chezExtPrim empty) Chez.chezString 0 ctm
Core.writeFile (appdir </> "mainprog.ss") $ build $ sepBy "\n"
[ schHeader (map snd libs) [lib.name | lib <- chezLibs]
, "(collect-request-handler (lambda () (collect) (blodwen-run-finalisers)))"
, collectRequestHandler
, main
, schFooter
]
Expand Down
Loading