[Guile-commits] 09/10: Manage pre-goops port type list using pairs

[Andy Wingo]

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

commit 7d1eda149ee022c8d2f9dbdb77bedbddf6359f1f
Author: Andy Wingo <wi...@pobox.com>
AuthorDate: Wed Jun 25 12:41:34 2025 +0200

    Manage pre-goops port type list using pairs
    
    Avoids sloppy allocations.
    
    * libguile/ports-internal.h (scm_is_port_type):
    (scm_to_port_type, scm_from_port_type): New helpers.
    * libguile/goops.c (scm_make_port_classes):
    (create_port_classes): Use a list and be thread-safe.
---
 libguile/goops.c          | 39 ++++++++++++++++++---------------------
 libguile/ports-internal.h | 20 ++++++++++++++++++++
 2 files changed, 38 insertions(+), 21 deletions(-)

diff --git a/libguile/goops.c b/libguile/goops.c
index a2eec14ae..95736151f 100644
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -743,13 +743,6 @@ create_smob_classes (void)
                                                      scm_smobs[i].apply != 0);
 }
 
-struct pre_goops_port_type
-{
-  scm_t_port_type *ptob;
-  struct pre_goops_port_type *prev;
-};
-struct pre_goops_port_type *pre_goops_port_types;
-
 static void
 make_port_classes (scm_t_port_type *ptob)
 {
@@ -775,6 +768,8 @@ make_port_classes (scm_t_port_type *ptob)
     scm_make_standard_class (meta, name, supers, SCM_EOL);
 }
 
+static SCM pre_goops_port_types = SCM_EOL;
+
 void
 scm_make_port_classes (scm_t_port_type *ptob)
 {
@@ -782,28 +777,30 @@ scm_make_port_classes (scm_t_port_type *ptob)
   ptob->output_class = SCM_BOOL_F;
   ptob->input_output_class = SCM_BOOL_F;
 
+  scm_i_pthread_mutex_lock (&scm_i_misc_mutex);
   if (!goops_loaded_p)
     {
-      /* Not really a pair.  */
-      struct pre_goops_port_type *link;
-      link = scm_gc_typed_calloc (struct pre_goops_port_type);
-      link->ptob = ptob;
-      link->prev = pre_goops_port_types;
-      pre_goops_port_types = link;
-      return;
+      pre_goops_port_types = scm_cons (scm_from_port_type (ptob),
+                                       pre_goops_port_types);
+      scm_i_pthread_mutex_unlock (&scm_i_misc_mutex);
+    }
+  else
+    {
+      scm_i_pthread_mutex_unlock (&scm_i_misc_mutex);
+      make_port_classes (ptob);
     }
-
-  make_port_classes (ptob);
 }
 
 static void
 create_port_classes (void)
 {
-  while (pre_goops_port_types)
-    {
-      make_port_classes (pre_goops_port_types->ptob);
-      pre_goops_port_types = pre_goops_port_types->prev;
-    }
+  scm_i_pthread_mutex_lock (&scm_i_misc_mutex);
+  SCM ptobs = pre_goops_port_types;
+  pre_goops_port_types = SCM_EOL;
+  scm_i_pthread_mutex_unlock (&scm_i_misc_mutex);
+
+  for (; scm_is_pair (ptobs); ptobs = scm_cdr (ptobs))
+    make_port_classes (scm_to_port_type (scm_car (ptobs)));
 }
 
 SCM
diff --git a/libguile/ports-internal.h b/libguile/ports-internal.h
index 7b2bd68b2..fba84d10f 100644
--- a/libguile/ports-internal.h
+++ b/libguile/ports-internal.h
@@ -72,6 +72,26 @@ struct scm_t_port_type
   SCM input_class, output_class, input_output_class;
 };
 
+static inline int
+scm_is_port_type (SCM x)
+{
+  return SCM_HAS_TYP7 (x, scm_tc7_port_type);
+}
+
+static inline struct scm_t_port_type *
+scm_to_port_type (SCM x)
+{
+  if (!scm_is_port_type (x))
+    abort ();
+  return (struct scm_t_port_type *) SCM_UNPACK_POINTER (x);
+}
+
+static inline SCM
+scm_from_port_type (struct scm_t_port_type *x)
+{
+  return SCM_PACK_POINTER (x);
+}
+
 /* Port buffers.
 
    It's important to avoid calling into the kernel too many times.  For