cs: react to (collection-garbage 'incremental)

When incremental mode is enabled, adjust garbage collection to avoid
promoting objects from the next-to-oldest generation into the oldest
generation. This change produces a good approximation to incremental
collection for game-like programs (although probably not server-like
programs with large, temporary jobs).

pkgs/racket-doc/scribblings/reference/memory.scrbl

@@ -347,18 +347,19 @@ garbage-collection mode, depending on @racket[request]:
        triggered by @racket[(collect-garbage 'minor)] do not cause
        major collections any sooner than they would occur otherwise.}
 
- @item{@racket['incremental] --- Requests that each minor
+ @item{@racket['incremental] --- Does not request an immediate
-       collection performs incremental work toward a major collection
+       collection, but requests extra effort going forward to avoid
-       (but does not request an immediate minor collection).
+       major collections, even if it requires more work per minor
-       This incremental-mode request expires at the next major
+       collection to incrementally perform the work of a major
-       collection.
+       collection. This incremental-mode request expires at the next
+       major collection.
 
        The intent of incremental mode is to significantly reduce pause
-       times due to major collections, but incremental mode typically
+       times due to major collections, but incremental mode may imply
-       implies longer minor-collection times and higher memory use.
+       longer minor-collection times and higher memory use. Currently,
-       Currently, incremental mode is only really supported when
+       incremental mode is only meaningful when @racket[(system-type
-       @racket[(system-type 'gc)] returns @racket['3m]; it has no
+       'gc)] returns @racket['3m] or @racket['cs]; it has no effect in
-       effect in other Racket variants.
+       other Racket variants.
 
        If the @envvar{PLT_INCREMENTAL_GC} environment variable's value
        starts with @litchar{0}, @litchar{n}, or @litchar{N} on
@@ -367,7 +368,9 @@ garbage-collection mode, depending on @racket[request]:
 ]
 
 @history[#:changed "6.3" @elem{Added the @racket[request] argument.}
-         #:changed "6.3.0.2" @elem{Added @racket['incremental] mode.}]}
+         #:changed "6.3.0.2" @elem{Added @racket['incremental] mode.}
+         #:changed "7.7.0.4" @elem{Added @racket['incremental] effect
+                                   for Racket CS.}]}
 
 
 @defproc[(current-memory-use [mode (or/c #f 'cumulative custodian?) #f])

racket/src/cs/main.sps

@@ -834,6 +834,12 @@
    (when (getenv "PLT_MAX_COMPACT_GC")
      (in-place-minimum-generation 254))
 
+   (let ([s (getenv "PLT_INCREMENTAL_GC")])
+     (when (and s
+                (>= (string-length s) 1)
+                (#%memv (string-ref s 0) '(#\0 #\n #\N)))
+       (set-incremental-collection-enabled! #f)))
+
    (when version?
      (display (banner)))
    (call/cc ; Chez Scheme's `call/cc`, used here to escape from the Racket-thread engine loop

racket/src/cs/rumble.sls

@@ -482,6 +482,7 @@
           set-reachable-size-increments-callback! ; not exported to Racket
           set-custodian-memory-use-proc!          ; not exported to Racket
           set-immediate-allocation-check-proc!    ; not exported to Racket
+          set-incremental-collection-enabled!     ; not exported to Racket
           unsafe-add-collect-callbacks
           unsafe-remove-collect-callbacks
 

racket/src/cs/rumble/memory.ss

@@ -1,5 +1,7 @@
 
 (define collect-request (box #f))
+(define request-incremental? #f)
+(define disable-incremental? #f)
 
 (define (set-collect-handler!)
   (collect-request-handler (lambda ()
@@ -101,10 +103,17 @@
                         ;; Accounting collection:
                         (let ([counts (collect gen gen (weaken-accounting-roots roots))])
                           (lambda () (k counts domains))))])))]
+               [(and request-incremental?
+                     (fx= gen (sub1 (collect-maximum-generation))))
+                ;; "Incremental" mode by not promoting to the maximum generation
+                (collect gen gen)
+                #f]
                [else
                 ;; Plain old collection:
                 (collect gen)
                 #f])])
+        (when (fx= gen (collect-maximum-generation))
+          (set! request-incremental? #f))
         (let ([post-allocated (bytes-allocated)]
               [post-allocated+overhead (current-memory-bytes)]
               [post-time (real-time)]
@@ -145,7 +154,8 @@
    [(request)
     (cond
      [(eq? request 'incremental)
-      (void)]
+      (unless disable-incremental?
+        (set! request-incremental? #t))]
      [else
       (let ([req (case request
                    [(minor) 0]
@@ -187,6 +197,9 @@
                 (current-continuation-marks))))
       (immediate-allocation-check n))))
 
+(define (set-incremental-collection-enabled! on?)
+  (set! disable-incremental? (not on?)))
+
 ;; ----------------------------------------
 
 (define (weaken-accounting-roots roots)