wingo pushed a commit to branch wip-whippet
in repository guile.

commit 2463a0741f45e42b1ed93e948d839c7bda98e317
Author: Andy Wingo <wi...@pobox.com>
AuthorDate: Fri May 9 12:49:42 2025 +0200

    Rework fluids to use ephemeron hash tables
    
    * libguile/ephemerons.c (scm_from_ephemeron, scm_to_ephemeron):
    (scm_from_ephemeron_table, scm_to_ephemeron_table): New interfaces.
    (scm_c_ephemeron_table_copy): Rename from
    scm_c_ephemeron_hash_table_copy, as it's not specific to hash tables.
    
    * libguile/fluids.h:
    * libguile/fluids.c (restore_dynamic_state, save_dynamic_state)
    (saved_dynamic_state_ref, fluid_set_x, fluid_ref)
    (scm_fluid_ref_star, scm_i_make_initial_dynamic_state): Use ephemeron
    hash tables.
---
 libguile/ephemerons.c | 70 ++++++++++++++++++++++++++++++++++++---------------
 libguile/ephemerons.h |  8 ++++--
 libguile/fluids.c     | 53 ++++++++++++++++----------------------
 libguile/fluids.h     |  5 ++--
 4 files changed, 80 insertions(+), 56 deletions(-)

diff --git a/libguile/ephemerons.c b/libguile/ephemerons.c
index 25fc760b2..7a2f75076 100644
--- a/libguile/ephemerons.c
+++ b/libguile/ephemerons.c
@@ -57,6 +57,8 @@ static inline struct gc_ref scm_to_ref (SCM scm)
 
 
 
+#define SCM_EPHEMERON_P(X) (SCM_HAS_TYP7 (X, scm_tc7_ephemeron))
+
 struct gc_ephemeron*
 scm_c_make_ephemeron (SCM key, SCM val)
 {
@@ -74,6 +76,20 @@ scm_as_ephemeron (SCM x)
   return (struct gc_ephemeron*) SCM_UNPACK_POINTER (x);
 }
 
+SCM
+scm_from_ephemeron (struct gc_ephemeron *e)
+{
+  return PTR2SCM (e);
+}
+
+struct gc_ephemeron*
+scm_to_ephemeron (SCM e)
+{
+  if (!SCM_EPHEMERON_P (e))
+    abort ();
+  return scm_as_ephemeron (e);
+}
+
 SCM
 scm_c_ephemeron_key (struct gc_ephemeron *e)
 {
@@ -109,9 +125,8 @@ scm_c_ephemeron_next (struct gc_ephemeron *e)
   return gc_ephemeron_chain_next (e);
 }
 
-
 
-#define SCM_EPHEMERON_P(X) (SCM_HAS_TYP7 (X, scm_tc7_ephemeron))
+
 
 #define SCM_VALIDATE_EPHEMERON(pos, x) \
   SCM_MAKE_VALIDATE_MSG (pos, x, EPHEMERON_P, "ephemeron")
@@ -214,6 +229,20 @@ scm_as_ephemeron_table (SCM x)
   return (struct scm_ephemeron_table*) SCM_UNPACK_POINTER (x);
 }
 
+SCM
+scm_from_ephemeron_table (struct scm_ephemeron_table *et)
+{
+  return PTR2SCM (et);
+}
+
+struct scm_ephemeron_table*
+scm_to_ephemeron_table (SCM et)
+{
+  if (!SCM_EPHEMERON_TABLE_P (et))
+    abort ();
+  return scm_as_ephemeron_table (et);
+}
+
 struct scm_ephemeron_table
 {
   scm_t_bits tag;
@@ -270,6 +299,25 @@ scm_c_ephemeron_table_try_push_x (struct 
scm_ephemeron_table *et, size_t idx,
   return prev;
 }
 
+struct scm_ephemeron_table*
+scm_c_ephemeron_table_copy (struct scm_ephemeron_table *et)
+{
+  struct scm_ephemeron_table *ret = scm_c_make_ephemeron_table (et->size);
+
+  for (size_t idx = 0; idx < ret->size; idx++)
+    for (struct gc_ephemeron *e = scm_c_ephemeron_table_ref (et, idx);
+         e;
+         e = scm_c_ephemeron_next (e))
+      {
+        SCM key = scm_c_ephemeron_key (e);
+        SCM value = scm_c_ephemeron_value (e);
+        struct gc_ephemeron *copy = scm_c_make_ephemeron (key, value);
+        scm_c_ephemeron_table_push_x (ret, idx, copy);
+      }
+
+  return ret;
+}
+
 SCM_DEFINE_STATIC (scm_ephemeron_table_p, "ephemeron-table?", 1, 0, 0,
                    (SCM x),
                    "Return @code{#t} if @var{x} is an ephemeron table, or "
@@ -409,24 +457,6 @@ scm_c_ephemeron_hash_table_setq_x (struct 
scm_ephemeron_table *et, SCM key,
     } while (prev != chain);
 }
 
-struct scm_ephemeron_table*
-scm_c_ephemeron_hash_table_copy (struct scm_ephemeron_table *et)
-{
-  struct scm_ephemeron_table *ret = scm_c_make_ephemeron_table (et->size);
-
-  for (size_t idx = 0; idx < ret->size; idx++)
-    for (struct gc_ephemeron *e = scm_c_ephemeron_table_ref (et, idx);
-         e;
-         e = scm_c_ephemeron_next (e))
-      {
-        SCM key = scm_c_ephemeron_key (e);
-        SCM value = scm_c_ephemeron_value (e);
-        struct gc_ephemeron *copy = scm_c_make_ephemeron (key, value);
-        scm_c_ephemeron_table_push_x (ret, idx, copy);
-      }
-
-  return ret;
-}
 
 
 
diff --git a/libguile/ephemerons.h b/libguile/ephemerons.h
index d3f403a70..d1eb9e548 100644
--- a/libguile/ephemerons.h
+++ b/libguile/ephemerons.h
@@ -36,6 +36,8 @@ SCM_INTERNAL SCM scm_c_ephemeron_swap_x (struct gc_ephemeron 
*e, SCM new_val);
 SCM_INTERNAL void scm_c_ephemeron_mark_dead_x (struct gc_ephemeron *e);
 SCM_INTERNAL int scm_i_print_ephemeron (SCM exp, SCM port,
                                         scm_print_state *pstate SCM_UNUSED);
+SCM_INTERNAL struct gc_ephemeron* scm_to_ephemeron (SCM e);
+SCM_INTERNAL SCM scm_from_ephemeron (struct gc_ephemeron *e);
 
 SCM_INTERNAL struct scm_ephemeron_table* scm_c_make_ephemeron_table (size_t 
count);
 SCM_INTERNAL size_t scm_c_ephemeron_table_length (struct scm_ephemeron_table 
*et);
@@ -49,16 +51,18 @@ scm_c_ephemeron_table_try_push_x (struct 
scm_ephemeron_table *et,
                                   size_t idx,
                                   struct gc_ephemeron * e,
                                   struct gc_ephemeron *prev);
+SCM_INTERNAL struct scm_ephemeron_table*
+scm_c_ephemeron_table_copy (struct scm_ephemeron_table *et);
 SCM_INTERNAL int scm_i_print_ephemeron_table (SCM exp, SCM port,
                                               scm_print_state *pstate 
SCM_UNUSED);
+SCM_INTERNAL struct scm_ephemeron_table* scm_to_ephemeron_table (SCM e);
+SCM_INTERNAL SCM scm_from_ephemeron_table (struct scm_ephemeron_table *e);
 
 SCM_INTERNAL SCM
 scm_c_ephemeron_hash_table_refq (struct scm_ephemeron_table *et, SCM k,
                                  SCM default_value);
 SCM_INTERNAL void
 scm_c_ephemeron_hash_table_setq_x (struct scm_ephemeron_table *et, SCM k, SCM 
v);
-SCM_INTERNAL struct scm_ephemeron_table*
-scm_c_ephemeron_hash_table_copy (struct scm_ephemeron_table *et);
 
 
 SCM_INTERNAL void scm_register_ephemerons (void);
diff --git a/libguile/fluids.c b/libguile/fluids.c
index ebdb48fbc..a2fadbd8a 100644
--- a/libguile/fluids.c
+++ b/libguile/fluids.c
@@ -1,4 +1,4 @@
-/* Copyright 1996-1997,2000-2001,2004,2006-2013,2017-2018
+/* Copyright 1996-1997,2000-2001,2004,2006-2013,2017-2018,2025
      Free Software Foundation, Inc.
 
    This file is part of Guile.
@@ -30,6 +30,7 @@
 #include "cache-internal.h"
 #include "deprecation.h"
 #include "dynwind.h"
+#include "ephemerons.h"
 #include "eval.h"
 #include "gsubr.h"
 #include "hashtab.h"
@@ -132,7 +133,7 @@ restore_dynamic_state (SCM saved, scm_t_dynamic_state 
*state)
       else
         entry->key = entry->value = 0;
     }
-  state->values = saved;
+  state->values = scm_to_ephemeron_table (saved);
   state->has_aliased_values = 1;
 }
 
@@ -140,7 +141,7 @@ static inline SCM
 save_dynamic_state (scm_t_dynamic_state *state)
 {
   int slot;
-  SCM saved = state->values;
+  SCM saved = scm_from_ephemeron_table (state->values);
   for (slot = 0; slot < SCM_CACHE_SIZE; slot++)
     {
       struct scm_cache_entry *entry = &state->cache.entries[slot];
@@ -157,14 +158,14 @@ save_dynamic_state (scm_t_dynamic_state *state)
              cache.  */
           scm_hashq_set_x (state->thread_local_values, key, value);
         }
-      else if (!scm_is_eq (scm_weak_table_refq (state->values, key,
-                                                SCM_UNDEFINED),
+      else if (!scm_is_eq (scm_c_ephemeron_hash_table_refq (state->values, key,
+                                                            SCM_UNDEFINED),
                            value))
         {
           if (state->has_aliased_values)
             saved = scm_acons (key, value, saved);
           else
-            scm_weak_table_putq_x (state->values, key, value);
+            scm_c_ephemeron_hash_table_setq_x (state->values, key, value);
         }
     }
   state->has_aliased_values = 1;
@@ -178,21 +179,8 @@ saved_dynamic_state_ref (SCM saved, SCM fluid, SCM dflt)
     if (scm_is_eq (SCM_CAAR (saved), fluid))
       return SCM_CDAR (saved);
 
-  return scm_weak_table_refq (saved, fluid, dflt);
-}
-
-static SCM
-add_entry (void *data, SCM k, SCM v, SCM result)
-{
-  scm_weak_table_putq_x (result, k, v);
-  return result;
-}
-
-static SCM
-copy_value_table (SCM tab)
-{
-  SCM ret = scm_c_make_weak_table (0, SCM_WEAK_TABLE_KIND_KEY);
-  return scm_c_weak_table_fold (add_entry, NULL, ret, tab);
+  return scm_c_ephemeron_hash_table_refq (scm_to_ephemeron_table (saved),
+                                          fluid, dflt);
 }
 
 
@@ -329,15 +317,17 @@ fluid_set_x (scm_t_dynamic_state *dynamic_state, SCM 
fluid, SCM value)
 
       if (dynamic_state->has_aliased_values)
         {
-          if (scm_is_eq (scm_weak_table_refq (dynamic_state->values,
-                                              fluid, SCM_UNDEFINED),
-                         value))
+          SCM existing =
+            scm_c_ephemeron_hash_table_refq (dynamic_state->values, fluid,
+                                             SCM_UNDEFINED);
+          if (scm_is_eq (existing, value))
             return;
-          dynamic_state->values = copy_value_table (dynamic_state->values);
+          dynamic_state->values =
+            scm_c_ephemeron_table_copy (dynamic_state->values);
           dynamic_state->has_aliased_values = 0;
         }
 
-      scm_weak_table_putq_x (dynamic_state->values, fluid, value);
+      scm_c_ephemeron_hash_table_setq_x (dynamic_state->values, fluid, value);
     }
 }
 
@@ -356,8 +346,8 @@ fluid_ref (scm_t_dynamic_state *dynamic_state, SCM fluid)
     val = scm_hashq_ref (dynamic_state->thread_local_values, fluid,
                          SCM_I_FLUID_DEFAULT (fluid));
   else
-    val = scm_weak_table_refq (dynamic_state->values, fluid,
-                         SCM_I_FLUID_DEFAULT (fluid));
+    val = scm_c_ephemeron_hash_table_refq (dynamic_state->values, fluid,
+                                           SCM_I_FLUID_DEFAULT (fluid));
 
   /* Cache this lookup.  */
   fluid_set_x (dynamic_state, fluid, val);
@@ -420,8 +410,8 @@ SCM_DEFINE (scm_fluid_ref_star, "fluid-ref*", 2, 0, 0,
             ret = scm_hashq_ref (dynamic_state->thread_local_values, fluid,
                                  SCM_UNDEFINED);
           else
-            ret = scm_weak_table_refq (dynamic_state->values, fluid,
-                                       SCM_UNDEFINED);
+            ret = scm_c_ephemeron_hash_table_refq (dynamic_state->values, 
fluid,
+                                                   SCM_UNDEFINED);
 
           if (SCM_UNBNDP (ret))
             ret = SCM_I_FLUID_DEFAULT (fluid);
@@ -581,8 +571,7 @@ SCM
 scm_i_make_initial_dynamic_state (void)
 {
   return scm_cell (scm_tc7_dynamic_state,
-                   SCM_UNPACK (scm_c_make_weak_table
-                               (0, SCM_WEAK_TABLE_KIND_KEY)));
+                   (uintptr_t) scm_c_make_ephemeron_table (47));
 }
 
 SCM_DEFINE (scm_dynamic_state_p, "dynamic-state?", 1, 0, 0,
diff --git a/libguile/fluids.h b/libguile/fluids.h
index ffcb48931..9153169d0 100644
--- a/libguile/fluids.h
+++ b/libguile/fluids.h
@@ -1,7 +1,7 @@
 #ifndef SCM_FLUIDS_H
 #define SCM_FLUIDS_H
 
-/* Copyright 1996,2000-2001,2006,2008-2013,2018
+/* Copyright 1996,2000-2001,2006,2008-2013,2018,2025
      Free Software Foundation, Inc.
 
    This file is part of Guile.
@@ -44,10 +44,11 @@
 #ifdef BUILDING_LIBGUILE
 # include <libguile/cache-internal.h>
 
+struct scm_ephemeron_table;
 struct scm_dynamic_state
 {
   SCM thread_local_values;
-  SCM values;
+  struct scm_ephemeron_table *values;
   uint8_t has_aliased_values;
   struct scm_cache cache;
 };

Reply via email to