From d35ec29828b1cea129b2fa525146fe3105c1da7c Mon Sep 17 00:00:00 2001
From: Taylor R Campbell <campbell@mumble.net>
Date: Tue, 17 Aug 2010 18:46:26 +0000
Subject: [PATCH] Implement and document SET-EPHEMERON-KEY!.

---
 doc/ref-manual/misc-datatypes.texi | 18 ++++++++++--------
 src/runtime/global.scm             | 21 ++++++++++++++++++---
 src/runtime/runtime.pkg            |  1 +
 3 files changed, 29 insertions(+), 11 deletions(-)

diff --git a/doc/ref-manual/misc-datatypes.texi b/doc/ref-manual/misc-datatypes.texi
index 5de60c18c..3218ed685 100644
--- 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 07d9fb92e..03538fd53 100644
--- a/src/runtime/global.scm
+++ b/src/runtime/global.scm
@@ -472,6 +472,16 @@ USA.
 
 ;;;; 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 88dd9dc8c..d98dc2b9f 100644
--- 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
-- 
2.25.1