From ae1bf1b9fcaa1ea12ef7438b096ea21e239c0f99 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Sun, 16 Jun 2019 10:36:41 -0600
Subject: [PATCH] cs: lock-free `eq-hash-code`

Chez Scheme doesn't provide `eq-hash-code`, so it's implemented with a
weak `eq?`-based hash table that maps values to fixnums (except for
numbers, symbols, and characters). The table had a lock to support
concurrent use in multiple places, and that became a major source of
contention in parallel builds. Change the implementation to use a new
`eq-hashtable-try-atomic-cell` operation, which effectively moves
contention from the hash table to individual buckets (where it should
be much rarer).
---
 pkgs/base/info.rkt                |  2 +-
 racket/src/cs/compile-file.ss     |  1 +
 racket/src/cs/rumble/hash-code.ss | 29 ++++++++++++++++++++++-------
 racket/src/cs/rumble/memory.ss    |  1 +
 racket/src/racket/src/schvers.h   |  2 +-
 5 files changed, 26 insertions(+), 9 deletions(-)

diff --git a/pkgs/base/info.rkt b/pkgs/base/info.rkt
index a6632b56af..de48f2090c 100644
--- a/pkgs/base/info.rkt
+++ b/pkgs/base/info.rkt
@@ -12,7 +12,7 @@
 
 (define collection 'multi)
 
-(define version "7.3.0.7")
+(define version "7.3.0.8")
 
 (define deps `("racket-lib"
                ["racket" #:version ,version]))
diff --git a/racket/src/cs/compile-file.ss b/racket/src/cs/compile-file.ss
index 7878da6089..a8f93399fc 100644
--- a/racket/src/cs/compile-file.ss
+++ b/racket/src/cs/compile-file.ss
@@ -56,6 +56,7 @@
 (check-defined 'procedure-known-single-valued?)
 (check-defined 'compress-format)
 (check-defined '#%$record-cas!)
+(check-defined 'eq-hashtable-try-atomic-cell)
 
 ;; ----------------------------------------
 
diff --git a/racket/src/cs/rumble/hash-code.ss b/racket/src/cs/rumble/hash-code.ss
index 7b7777b2a5..889e2d4dfd 100644
--- a/racket/src/cs/rumble/hash-code.ss
+++ b/racket/src/cs/rumble/hash-code.ss
@@ -15,9 +15,21 @@
 ;;; See the License for the specific language governing permissions and
 ;;; limitations under the License.
 
+;; Use only `eq-hashtable-try-atomic-cell` on this table,
+;; except in `update-eq-hash-code-table-size!`:
 (define codes (make-weak-eq-hashtable))
+
 (define counter 12345)
 
+;; Called by the collect handler when no other threads are running.
+;; Calling `eq-hashtable-set!` and `eq-hashtable-delete!` here gives
+;; the table a chance to resize either larger or smaller, since we
+;; otherwise use only `eq-hashtable-try-atomic-cell` on the table.
+(define (update-eq-hash-code-table-size!)
+  (let ([p (cons #f #f)])
+    (eq-hashtable-set! codes p 0)
+    (eq-hashtable-delete! codes p)))
+
 (define (eq-hash-code x)
   (cond
    [(and (symbol? x)
@@ -29,13 +41,16 @@
    [(number? x) (number-hash x)]
    [(char? x) (char->integer x)]
    [else
-    (with-global-lock
-     (let ([p (eq-hashtable-cell codes x #f)])
-       (or (cdr p)
-           (let ([c (fx1+ counter)])
-             (set! counter c)
-             (set-cdr! p c)
-             c))))]))
+    (let ([p (eq-hashtable-try-atomic-cell codes x counter)])
+      (cond
+       [p
+        (let ([n (cdr p)])
+          (when (fx= counter n)
+            (set! counter (fx1+ n)))
+          n)]
+       [else
+        ;; There was contention, so try again
+        (eq-hash-code x)]))]))
 
 ;; Mostly copied from Chez Scheme's "newhash.ss":
 (define number-hash
diff --git a/racket/src/cs/rumble/memory.ss b/racket/src/cs/rumble/memory.ss
index 6eca4439a0..dabdf23f6c 100644
--- a/racket/src/cs/rumble/memory.ss
+++ b/racket/src/cs/rumble/memory.ss
@@ -69,6 +69,7 @@
         (garbage-collect-notify gen
                                 pre-allocated pre-allocated+overhead pre-time pre-cpu-time
                                 post-allocated  (current-memory-bytes) (real-time) (cpu-time)))
+      (update-eq-hash-code-table-size!)
       (poll-foreign-guardian)
       (run-collect-callbacks cdr)
       (when (and reachable-size-increments-callback
diff --git a/racket/src/racket/src/schvers.h b/racket/src/racket/src/schvers.h
index 9154979438..d7977911c2 100644
--- a/racket/src/racket/src/schvers.h
+++ b/racket/src/racket/src/schvers.h
@@ -16,7 +16,7 @@
 #define MZSCHEME_VERSION_X 7
 #define MZSCHEME_VERSION_Y 3
 #define MZSCHEME_VERSION_Z 0
-#define MZSCHEME_VERSION_W 7
+#define MZSCHEME_VERSION_W 8
 
 /* A level of indirection makes `#` work as needed: */
 #define AS_a_STR_HELPER(x) #x