Implement and document SET-EPHEMERON-KEY!.

diff --git a/doc/ref-manual/misc-datatypes.texi b/doc/ref-manual/misc-datatypes.texi
index 5de60c18cfb58d0535d239fc23fa518f0d4251ff..3218ed685faf8ee6477a0f8ff4566f9ef641209a 100644 (file)
--- a/doc/ref-manual/misc-datatypes.texi
+++ b/doc/ref-manual/misc-datatypes.texi
@@ -959,8 +959,9 @@ there are no strong references to the key.  In other words, an
 ephemeron is broken when nobody else cares about its key.  Note that
 an ephemeron's reference to its datum may be dropped even if the datum
 is still reachable; all that matters is whether the key is reachable.
-Once broken, ephemerons never cease to be broken; setting the datum of
-a broken ephemeron with @code{set-ephemeron-datum!}  has no effect.
+Once broken, ephemerons never cease to be broken; setting the key or
+datum of a broken ephemeron with @code{set-ephemeron-key!} or
+@code{set-ephemeron-datum!} has no effect.
 
 Ephemerons are considerably heavier-weight than weak pairs, because
 garbage-collecting ephemerons is more complicated than
@@ -993,16 +994,17 @@ Returns @code{#t} if the garbage collector has dropped
 @deffnx procedure ephemeron-datum ephemeron
 @cindex selection, of ephemeron component
 @cindex component selection, of ephemeron
-These return the key or datum components, respectively, of
-@var{ephemeron}.  If @var{ephemeron} has been broken, these operation
+These return the key or datum component, respectively, of
+@var{ephemeron}.  If @var{ephemeron} has been broken, these operations
 return @code{#f}, but they can also return @code{#f} if that is the
 value that was stored in the key or value component.
 @end deffn
 
-@deffn procedure set-ephemeron-datum! ephemeron object
-Sets the datum component of @var{ephemeron} to @var{object} and
-returns an unspecified result.  If @var{ephemeron} is broken, this has
-no effect.
+@deffn procedure set-ephemeron-key! ephemeron object
+@deffnx procedure set-ephemeron-datum! ephemeron object
+These set the key or datum component, respectively, of @var{ephemeron}
+to @var{object} and return an unspecified result.  If @var{ephemeron}
+is broken, neither of these operations has any effect.
 @end deffn
 
 Like @code{weak-pair/car?}, @code{ephemeron-broken?} must be used with

diff --git a/src/runtime/global.scm b/src/runtime/global.scm
index 07d9fb92e265cf2d663f53641b217526e9a59cae..03538fd533058fc64db525596f6f07c66dad68b4 100644 (file)
--- a/src/runtime/global.scm
+++ b/src/runtime/global.scm
@@ -472,6 +472,16 @@ USA.
 \f
 ;;;; Ephemerons
 
+;;; The layout of an ephemeron is as follows:
+;;;
+;;;   0 vector (marked or non-marked) manifest
+;;;   1 key
+;;;   2 datum
+;;;   3 extra
+;;;   .  slots
+;;;   .    for
+;;;   .      GC
+
 (define canonical-false (list 'FALSE))
 
 (define (canonicalize object)
@@ -500,13 +510,18 @@ USA.
   (guarantee-ephemeron ephemeron 'EPHEMERON-DATUM)
   (decanonicalize (primitive-object-ref ephemeron 2)))
 
+(define (set-ephemeron-key! ephemeron key)
+  (guarantee-ephemeron ephemeron 'SET-EPHEMERON-KEY!)
+  (let ((key* (primitive-object-ref ephemeron 1)))
+    (if key* (primitive-object-set! ephemeron 1 (canonicalize key)))
+    (reference-barrier key*))
+  unspecific)
+
 (define (set-ephemeron-datum! ephemeron datum)
   (guarantee-ephemeron ephemeron 'SET-EPHEMERON-DATUM!)
   (let ((key (primitive-object-ref ephemeron 1)))
     (if key (primitive-object-set! ephemeron 2 (canonicalize datum)))
-    ;; Guarantee that the key is referenced until this procedure
-    ;; returns.
-    (identity-procedure key))
+    (reference-barrier key))
   unspecific)
 
 (define (ephemeron-broken? ephemeron)

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 88dd9dc8c96c4e0238077fd5d1ef2279d3bf467d..d98dc2b9fcde536e4fcecc4916ef6132a751bc46 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -374,6 +374,7 @@ USA.
          scode-eval
          set-cell-contents!
          set-ephemeron-datum!
+         set-ephemeron-key!
          set-interrupt-enables!
          show-time
          system-hunk3-cons