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

@@ -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]))

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)
 
 ;; ----------------------------------------
 

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-try-atomic-cell codes x counter)])
-     (let ([p (eq-hashtable-cell codes x #f)])
+      (cond
-       (or (cdr p)
+       [p
-           (let ([c (fx1+ counter)])
+        (let ([n (cdr p)])
-             (set! counter c)
+          (when (fx= counter n)
-             (set-cdr! p c)
+            (set! counter (fx1+ n)))
-             c))))]))
+          n)]
+       [else
+        ;; There was contention, so try again
+        (eq-hash-code x)]))]))
 
 ;; Mostly copied from Chez Scheme's "newhash.ss":
 (define number-hash

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

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