cs: include accounting time in reports GC time

When logging GC debugging, a pecentage after the time for a GC reports
what fraction was extra steps after GCing proper, especially the extra
step of memory acounting when that is enabled.

Also, avoid Chez Scheme gensyms even more. Otherwise, using low-level
facilities like `dump-memory-stats` can force the unique name of a
gensym used for a structure type, which causes it to be permanent,
which could be exactly what you don't want when debugging a
memory-rentention problem.

racket/src/cs/linklet.sls

@@ -1273,6 +1273,12 @@
   (expand-omit-library-invocations #t)
   (enable-error-source-expression #f)
 
+  ;; Avoid gensyms for generated record-tyope UIDs. Otherwise,
+  ;; printing one of those gensyms --- perhaps when producing a trace
+  ;; via `dump-memory-stats` --- causes the gensym to be permanent
+  ;; (since it has properties).
+  (current-generate-id (lambda (sym) (gensym sym)))
+
   ;; Since the schemify layer inserts `|#%app|` any time the rator of
   ;; an application might not be a procedure, we can avoid redundant
   ;; checks for other applications by enabling unsafe mode. Ditto for

racket/src/cs/main.sps

@@ -634,7 +634,8 @@
      (let ([root-logger (current-logger)])
        ;; This function can be called in any Chez Scheme thread
        (lambda (gen pre-allocated pre-allocated+overhead pre-time pre-cpu-time
-                    post-allocated post-allocated+overhead post-time post-cpu-time)
+                    post-allocated post-allocated+overhead proper-post-time proper-post-cpu-time
+                    post-time post-cpu-time)
          (let ([minor? (< gen (collect-maximum-generation))])
            (if minor?
                (set! minor-gcs (add1 minor-gcs))
@@ -644,14 +645,23 @@
              (when (or debug-GC?
                        (and (not minor?)
                             (log-level?* root-logger 'debug 'GC:major)))
-               (let ([delta (- pre-allocated post-allocated)])
+               (let ([delta (- pre-allocated post-allocated)]
+                     [account-str (let ([proper (if (= post-cpu-time pre-cpu-time)
+                                                    100
+                                                    (quotient (* 100 (- proper-post-cpu-time pre-cpu-time))
+                                                              (- post-cpu-time pre-cpu-time)))])
+                                    (if (fx>= proper 99)
+                                        ""
+                                        (string-append "[" (number->string (fx- 100 proper)) "%]")))])
                  (log-message* root-logger 'debug (if debug-GC? 'GC 'GC:major)
-                               (chez:format "GC: 0:~a~a @ ~a(~a); free ~a(~a) ~ams @ ~a"
+                               (chez:format "GC: 0:~a~a @ ~a(~a); free ~a(~a) ~ams~a @ ~a"
                                             (if minor? "min" "MAJ") gen
                                             (K "" pre-allocated) (K "+" (- pre-allocated+overhead pre-allocated))
                                             (K "" delta) (K "+" (- (- pre-allocated+overhead post-allocated+overhead)
                                                                    delta))
-                                            (- post-cpu-time pre-cpu-time) pre-cpu-time)
+                                            (- post-cpu-time pre-cpu-time)
+                                            account-str
+                                            pre-cpu-time)
                                (make-gc-info (if minor? 'minor 'major) pre-allocated pre-allocated+overhead 0
                                              post-allocated post-allocated+overhead
                                              pre-cpu-time post-cpu-time

racket/src/cs/rumble/define.ss

@@ -241,7 +241,7 @@
                                   [(called-var ...) called-vars]
                                   [new-name (datum->syntax
                                              name
-                                             (chez:gensym (chez:symbol->string (syntax->datum name))))]
+                                             (#%gensym (#%symbol->string (syntax->datum name))))]
                                   [body (let loop ([body body]
                                                    [binds binds])
                                           (cond

racket/src/cs/rumble/impersonator.ss

@@ -596,7 +596,7 @@
                              (lambda (v info)
                                (check 'guard-for-prop:impersonator-of (procedure-arity-includes/c 1) v)
                                ;; Add a tag to track origin of the `prop:impersonator-of` value
-                               (cons (gensym "tag") v))))
+                               (cons (box 'impersonator-of) v))))
 
 (define (extract-impersonator-of who a)
   (and (impersonator-of-redirect? a)

racket/src/cs/rumble/memory.ss

@@ -16,7 +16,9 @@
 
 (define garbage-collect-notify
   (lambda (gen pre-allocated pre-allocated+overhead pre-time re-cpu-time
-               post-allocated post-allocated+overhead post-time post-cpu-time)
+               post-allocated post-allocated+overhead
+               proper-post-time proper-post-cpu-time
+               post-time post-cpu-time)
     (void)))
 
 ;; #f or a procedure that accepts `compute-size-increments` to be
@@ -76,7 +78,9 @@
       (run-collect-callbacks car)
       (collect gen)
       (let ([post-allocated (bytes-allocated)]
-            [post-allocated+overhead (current-memory-bytes)])
+            [post-allocated+overhead (current-memory-bytes)]
+            [post-time (real-time)]
+            [post-cpu-time (cpu-time)])
         (when (= gen (collect-maximum-generation))
           ;; Trigger a major GC when twice as much memory is used. Twice
           ;; `post-allocated+overhead` seems to be too long a wait, because
@@ -85,15 +89,16 @@
           ;; immediate major GC too soon. Split the difference.
           (set! trigger-major-gc-allocated (* GC-TRIGGER-FACTOR post-allocated))
           (set! trigger-major-gc-allocated+overhead (* GC-TRIGGER-FACTOR post-allocated+overhead)))
+        (update-eq-hash-code-table-size!)
+        (poll-foreign-guardian)
+        (when (and reachable-size-increments-callback
+                   (fx= gen (collect-maximum-generation)))
+          (reachable-size-increments-callback compute-size-increments))
+        (run-collect-callbacks cdr)
         (garbage-collect-notify gen
                                 pre-allocated pre-allocated+overhead pre-time pre-cpu-time
-                                post-allocated  post-allocated+overhead (real-time) (cpu-time)))
+                                post-allocated  post-allocated+overhead post-time post-cpu-time
-      (update-eq-hash-code-table-size!)
+                                (real-time) (cpu-time)))
-      (poll-foreign-guardian)
-      (run-collect-callbacks cdr)
-      (when (and reachable-size-increments-callback
-                 (fx= gen (collect-maximum-generation)))
-        (reachable-size-increments-callback compute-size-increments))
       (when (and (= gen (collect-maximum-generation))
                  (currently-in-engine?))
         ;; This `set-timer` doesn't necessarily penalize the right thread,

racket/src/cs/rumble/prefab.ss

@@ -305,8 +305,9 @@
 (define (encode-prefab-key+count-as-symbol prefab-key+count)
   ;; The symbol has to be uninterned, because we're going to attach
   ;; properties to it, and an interned symbol with properties is never
-  ;; reclaimed by the garbage collector
+  ;; reclaimed by the garbage collector. Beware that a gensym is
-  (#%gensym (#%format "~s" prefab-key+count)))
+  ;; retained, too, if its unique name is forced.
+  (#%string->uninterned-symbol (#%format "~s" prefab-key+count)))
 
 (define (immutables->mutables immutables init-count auto-count)
   (vector->immutable-vector

racket/src/cs/rumble/struct.ss

@@ -1070,7 +1070,7 @@
                                                  "        (procedure-arity-includes/c 2)\n"
                                                  "        (procedure-arity-includes/c 2))")
                                       val)
-                               (cons (#%gensym) val))))
+                               (cons (box 'equal+hash) val))))
 
 (define-values (prop:authentic authentic? authentic-ref)
   (make-struct-type-property 'authentic (lambda (val info) #t)))

racket/src/thread/custodian.rkt

@@ -450,9 +450,9 @@
          (unless (zero? compute-memory-sizes)
            (host:call-with-current-place-continuation
             (lambda (starting-k)
-              ;; A place may have future pthreads, and each ptherad may
+              ;; A place may have future pthreads, and each pthread may
               ;; be running a future that becomes to a particular custodian;
-              ;; build up a custodian-to-pthtread mapping in this table:
+              ;; build up a custodian-to-pthread mapping in this table:
               (define custodian-future-threads (make-hasheq))
               (future-scheduler-add-thread-custodian-mapping! (place-future-scheduler initial-place)
                                                               custodian-future-threads)