ephemeron-value: add optional "retain" argument

When an ephemeron is accessed through a weak mapping from the same key
that is used in the ephemeron, and when the key is not otherwise
reachable, there can be a race between extracting the value from the
ephemeron and performing a GC that reclaims the key. Avoid that race
by supplying the key back to `ephemeron-value`, which ensures that the
key remains reachable until the value is extracted.

In many cases, supplying the key as the second argument would also
work --- since that argument is used as a replacement value when the
key is inaccessible, but the key can't become inaccessible if it's
pending as a replacement value. A separarate optional argument to
`ephemeron-value` seems clearer and more general, though.

pkgs/base/info.rkt

@@ -12,7 +12,7 @@
 
 (define collection 'multi)
 
-(define version "7.1.0.9")
+(define version "7.1.0.10")
 
 (define deps `("racket-lib"
                ["racket" #:version ,version]))

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

@@ -177,7 +177,13 @@ the table refers back to its key, then the table will retain the value
 and therefore the key; the mapping will never be removed from the
 table even if the key becomes otherwise inaccessible. To avoid that
 problem, instead of mapping the key to the value, map the key to an
-@tech{ephemeron} that pairs the key and value.}
+@tech{ephemeron} that pairs the key and value. Beware further,
+however, that an ephemeron's value might be cleared between retrieving
+an ephemeron and extracting its value, depending on whether the key is
+otherwise reachable. For @racket[eq?]-based mappings, consider using
+the pattern @racket[(ephemeron-value _ephemeron #f _key)] to extract
+the value of @racket[_ephemeron] while ensuring that @racket[_key] is
+retained until the value is extracted.}
 
 @deftogether[(
 @defproc[(make-immutable-hash [assocs (listof pair?) null])

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

@@ -85,11 +85,22 @@ Returns a new @tech{ephemeron} whose key is @racket[key] and whose
 value is initially @racket[v].}
 
 
-@defproc[(ephemeron-value [ephemeron ephemeron?] [gced-v any/c #f]) any/c]{
+@defproc[(ephemeron-value [ephemeron ephemeron?] [gced-v any/c #f] [retain-v any/c #f]) any/c]{
 
 Returns the value contained in @racket[ephemeron]. If the garbage
 collector has proven that the key for @racket[ephemeron] is only
-weakly reachable, then the result is @racket[gced-v] (which defaults to @racket[#f]).}
+weakly reachable, then the result is @racket[gced-v] (which defaults to @racket[#f]).
+
+The @racket[retain-v] argument is retained as reachable until the
+ephemeron's value is extracted. It is useful, for example, when
+@racket[_ephemeron] was obtained through a weak, @racket[eq?]-based
+mapping from @racket[_key] and @racket[_ephemeron] was created with
+@racket[_key] as the key; in that case, supplying @racket[_key] as
+@racket[retain-v] ensures that @racket[_ephemeron] retains its value
+long enough for it to be extracted, even if @racket[_key] is otherwise
+unreachable.
+
+@history[#:changed "7.1.0.10" @elem{Added the @racket[retain-v] argument.}]}
 
 
 @defproc[(ephemeron? [v any/c]) boolean?]{

racket/collects/ffi/unsafe.rkt

@@ -2081,8 +2081,11 @@
 ;; optimize away the call or arguments, so that calling
 ;; `void/reference-sink` ensures that arguments are retained.
 (define* void/reference-sink
-  (let ([proc void])
+  (let ([e (make-ephemeron (void) (void))])
     (case-lambda
-      [(v) (proc v)]
-      [(v1 v2) (proc v1 v2)]
-      [args (set! proc (lambda args (void))) (proc args)])))
+      [(v) (ephemeron-value e (void) v)]
+      [(v1 v2)
+       (ephemeron-value e (ephemeron-value e (void) v1) v2)]
+      [args
+       (for/fold ([r (void)]) ([v (in-list args)])
+         (ephemeron-value e r v))])))

racket/collects/racket/private/custom-hash.rkt

@@ -176,10 +176,10 @@
      (hash-set! intern key (make-ephemeron key wrapped-key))
      wrapped-key]
     [else
-     (define wrapped-key (ephemeron-value e))
-     (or wrapped-key
-         ;; Ephemeron was just cleared; try again
-         (wrap-key spec key))]))
+     ;; Supplying `key` as the third argument to `ephemeron-value`
+     ;; ensures that the  value isn't lost between the time that
+     ;; we get the ephemeron and the time that we get the value:
+     (ephemeron-value e #f key)]))
 
 (define (hash-check-key who d key)
   (define spec (custom-hash-spec d))

racket/src/cs/rumble.sls

@@ -687,7 +687,7 @@
                 record-field-mutator))
 
   (define/no-lift none (chez:gensym "none"))
-  (define/no-lift none2 (chez:gensym "none2"))
+  (define/no-lift none2 (chez:gensym "none2")) ; never put this in an emphemeron
 
   (include "rumble/define.ss")
   (include "rumble/virtual-register.ss")

racket/src/cs/rumble/ephemeron.ss

@@ -14,4 +14,11 @@
     (let ([v (cdr (ephemeron-p e))])
       (if (eq? v #!bwp)
           gced-v
+          v))]
+   [(e gced-v keep-live)
+    (let ([v (ephemeron-value e gced-v)])
+      ;; This comparsion will never be true, but the
+      ;; compiler and GC don't know that:
+      (if (eq? v none2)
+          keep-live
           v))]))

racket/src/racket/src/list.c

@@ -776,7 +776,7 @@ scheme_init_list (Scheme_Startup_Env *env)
   scheme_addto_prim_instance("ephemeron-value",
 			     scheme_make_immed_prim(ephemeron_value,
 						    "ephemeron-value",
-						    1, 2),
+						    1, 3),
 			     env);
   scheme_addto_prim_instance("ephemeron?",
 			     scheme_make_folding_prim(ephemeronp,
@@ -4064,6 +4064,10 @@ static Scheme_Object *ephemeron_value(int argc, Scheme_Object **argv)
 {
   Scheme_Object *v;
 
+  /* If there's an argv[2], it will stay live until here, since
+     there's no way for the GC to know that we're not using that
+     value. */
+
   if (!SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_ephemeron_type))
     scheme_wrong_contract("ephemeron-value", "ephemeron?", 0, argc, argv);
   v = scheme_ephemeron_value(argv[0]);

racket/src/racket/src/schvers.h

@@ -13,12 +13,12 @@
    consistently.)
 */
 
-#define MZSCHEME_VERSION "7.1.0.9"
+#define MZSCHEME_VERSION "7.1.0.10"
 
 #define MZSCHEME_VERSION_X 7
 #define MZSCHEME_VERSION_Y 1
 #define MZSCHEME_VERSION_Z 0
-#define MZSCHEME_VERSION_W 9
+#define MZSCHEME_VERSION_W 10
 
 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
 #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)