[Guile-commits] 01/07: Give reified value objects a proper data type

[Andy Wingo]

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

commit 224fb82a398b02beca36d5f8f18b7c8ccd26e0c5
Author: Andy Wingo <wingo@pobox.com>
AuthorDate: Fri May 30 09:57:08 2025 +0200

    Give reified value objects a proper data type
    
    * libguile/values.h (struct scm_values): New build-time definition.
    (scm_to_values):
    (scm_from_values):
    (scm_values_count):
    (scm_values_ref): New helpers.
    * libguile/vm.c:
    * libguile/values.c:
    * libguile/print.c:
    * libguile/numbers.c:
    * libguile/eval.c: Adapt all callers.
---
 libguile/eval.c    | 10 ++++---
 libguile/numbers.c |  2 +-
 libguile/print.c   |  4 +--
 libguile/values.c  | 83 +++++++++++++++++++++++++++++-------------------------
 libguile/values.h  | 32 +++++++++++++++++----
 libguile/vm.c      |  5 ++--
 6 files changed, 82 insertions(+), 54 deletions(-)

diff --git a/libguile/eval.c b/libguile/eval.c
index 21b2e8c17..32e76fe3f 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -228,8 +228,9 @@ truncate_values (SCM x)
     return x;
   else
     {
-      if (SCM_LIKELY (scm_i_nvalues (x) > 0))
-        return scm_i_value_ref (x, 0);
+      struct scm_values *values = scm_to_values (x);
+      if (SCM_LIKELY (scm_values_count (values) > 0))
+        return scm_values_ref (values, 0);
       else
         {
           scm_ithrow (scm_from_utf8_symbol ("vm-run"),
@@ -369,10 +370,11 @@ eval (SCM x, SCM env)
         v = scm_call_0 (producer);
         if (scm_is_values (v))
           {
-            size_t i = scm_i_nvalues (v);
+            struct scm_values *values = scm_to_values (v);
+            size_t i = scm_values_count (values);
             args = SCM_EOL;
             while (i--)
-              args = scm_cons (scm_i_value_ref (v, i), args);
+              args = scm_cons (scm_values_ref (values, i), args);
           }
         else
           args = scm_list_1 (v);
diff --git a/libguile/numbers.c b/libguile/numbers.c
index 80ace24f6..95f272387 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -788,7 +788,7 @@ two_valued_wta_dispatch_2 (SCM gf, SCM a1, SCM a2, int pos,
 {
   SCM vals = scm_wta_dispatch_2 (gf, a1, a2, pos, subr);
   
-  scm_i_extract_values_2 (vals, rp1, rp2);
+  scm_values_extract_2 (vals, rp1, rp2);
 }
 
 SCM_DEFINE (scm_euclidean_quotient, "euclidean-quotient", 2, 0, 0,
diff --git a/libguile/print.c b/libguile/print.c
index ab4abb8d9..f2921d5cc 100644
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -707,8 +707,8 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
          break;
         case scm_tc7_values:
           scm_puts ("#<values (", port);
-          print_vector (exp, scm_i_nvalues (exp), scm_c_value_ref, port,
-                        pstate);
+          print_vector (exp, scm_values_count (scm_to_values (exp)),
+                        scm_c_value_ref, port, pstate);
           scm_puts (">", port);
           break;
        case scm_tc7_program:
diff --git a/libguile/values.c b/libguile/values.c
index 522a8f5e5..50d24f1e4 100644
--- a/libguile/values.c
+++ b/libguile/values.c
@@ -1,4 +1,4 @@
-/* Copyright 2000-2001,2006,2008-2009,2011-2013,2016-2019
+/* Copyright 2000-2001,2006,2008-2009,2011-2013,2016-2019,2025
      Free Software Foundation, Inc.
 
    This file is part of Guile.
@@ -32,26 +32,27 @@
 
 
 /* OBJ must be a values object containing exactly two values.
-   scm_i_extract_values_2 puts those two values into *p1 and *p2.  */
+   scm_values_extract_2 puts those two values into *p1 and *p2.  */
 void
-scm_i_extract_values_2 (SCM obj, SCM *p1, SCM *p2)
+scm_values_extract_2 (SCM obj, SCM *p1, SCM *p2)
 {
   SCM_ASSERT_TYPE (scm_is_values (obj), obj, SCM_ARG1,
-                  "scm_i_extract_values_2", "values");
-  if (scm_i_nvalues (obj) != 2)
+                  "scm_values_extract_2", "values");
+  struct scm_values *values = scm_to_values (obj);
+  if (scm_values_count (values) != 2)
     scm_wrong_type_arg_msg
-      ("scm_i_extract_values_2", SCM_ARG1, obj,
+      ("scm_values_extract_2", SCM_ARG1, obj,
        "a values object containing exactly two values");
 
-  *p1 = scm_i_value_ref (obj, 0);
-  *p2 = scm_i_value_ref (obj, 1);
+  *p1 = scm_values_ref (values, 0);
+  *p2 = scm_values_ref (values, 1);
 }
 
 size_t
 scm_c_nvalues (SCM obj)
 {
   if (SCM_LIKELY (scm_is_values (obj)))
-    return scm_i_nvalues (obj);
+    return scm_values_count (scm_to_values (obj));
   else
     return 1;
 }
@@ -61,8 +62,9 @@ scm_c_value_ref (SCM obj, size_t idx)
 {
   if (scm_is_values (obj))
     {
-      if (idx < scm_i_nvalues (obj))
-        return scm_i_value_ref (obj, idx);
+      struct scm_values *values = scm_to_values (obj);
+      if (idx < scm_values_count (values))
+        return scm_values_ref (values, idx);
     }
   else
     {
@@ -87,32 +89,30 @@ SCM_DEFINE (scm_values, "values", 0, 0, 1,
 #define FUNC_NAME s_scm_values
 {
   long n;
-  SCM result;
 
   SCM_VALIDATE_LIST_COPYLEN (1, args, n);
   if (n == 1)
-    result = SCM_CAR (args);
-  else
-    {
-      size_t i;
+    return SCM_CAR (args);
 
-      if ((size_t) n > (size_t) (UINTPTR_MAX >> 8))
-        scm_error (scm_out_of_range_key, FUNC_NAME, "Too many values",
-                   SCM_EOL, SCM_EOL);
+  size_t i;
 
-      result = scm_words ((((scm_t_bits) n) << 8) | scm_tc7_values, n + 1);
-      for (i = 0; i < n; i++, args = SCM_CDR (args))
-        SCM_SET_CELL_OBJECT (result, i + 1, SCM_CAR (args));
-    }
+  if ((size_t) n > (size_t) (UINTPTR_MAX >> 8))
+    scm_error (scm_out_of_range_key, FUNC_NAME, "Too many values",
+               SCM_EOL, SCM_EOL);
+
+  struct scm_values *values =
+    scm_gc_malloc (sizeof (struct scm_values) + n * sizeof (SCM), "values");
+  values->tag_and_count = scm_tc7_values | (n << 8);
+  for (i = 0; i < n; i++, args = SCM_CDR (args))
+    values->values[i] = SCM_CAR (args);
 
-  return result;
+  return scm_from_values (values);
 }
 #undef FUNC_NAME
 
 SCM
 scm_c_values (SCM *base, size_t nvalues)
 {
-  SCM ret;
   size_t i;
 
   if (nvalues == 1)
@@ -122,37 +122,42 @@ scm_c_values (SCM *base, size_t nvalues)
     scm_error (scm_out_of_range_key, "scm_c_values", "Too many values",
                SCM_EOL, SCM_EOL);
 
-  ret = scm_words ((((scm_t_bits) nvalues) << 8) | scm_tc7_values, nvalues + 
1);
+  struct scm_values *values =
+    scm_gc_malloc (sizeof (struct scm_values) + nvalues * sizeof (SCM), 
"values");
+
+  values->tag_and_count = scm_tc7_values | (nvalues << 8);
 
   for (i = 0; i < nvalues; i++)
-    SCM_SET_CELL_OBJECT (ret, i + 1, base[i]);
+    values->values[i] = base[i];
 
-  return ret;
+  return scm_from_values (values);
 }
 
 SCM
 scm_values_2 (SCM a, SCM b)
 {
-  SCM ret;
+  struct scm_values *values =
+    scm_gc_malloc (sizeof (struct scm_values) + 2 * sizeof (SCM), "values");
 
-  ret = scm_words ((2 << 8) | scm_tc7_values, 3);
-  SCM_SET_CELL_OBJECT_1 (ret, a);
-  SCM_SET_CELL_OBJECT_2 (ret, b);
+  values->tag_and_count = scm_tc7_values | (2 << 8);
+  values->values[0] = a;
+  values->values[1] = b;
 
-  return ret;
+  return scm_from_values (values);
 }
 
 SCM
 scm_values_3 (SCM a, SCM b, SCM c)
 {
-  SCM ret;
+  struct scm_values *values =
+    scm_gc_malloc (sizeof (struct scm_values) + 3 * sizeof (SCM), "values");
 
-  ret = scm_words ((3 << 8) | scm_tc7_values, 4);
-  SCM_SET_CELL_OBJECT_1 (ret, a);
-  SCM_SET_CELL_OBJECT_2 (ret, b);
-  SCM_SET_CELL_OBJECT_3 (ret, c);
+  values->tag_and_count = scm_tc7_values | (3 << 8);
+  values->values[0] = a;
+  values->values[1] = b;
+  values->values[2] = c;
 
-  return ret;
+  return scm_from_values (values);
 }
 
 void
diff --git a/libguile/values.h b/libguile/values.h
index e5f004332..f8a4ef8bc 100644
--- a/libguile/values.h
+++ b/libguile/values.h
@@ -1,7 +1,7 @@
 #ifndef SCM_VALUES_H
 #define SCM_VALUES_H
 
-/* Copyright 2000-2001,2006,2008,2012,2018
+/* Copyright 2000-2001,2006,2008,2012,2018,2025
      Free Software Foundation, Inc.
 
    This file is part of Guile.
@@ -31,22 +31,42 @@ scm_is_values (SCM x)
 }
 
 #ifdef BUILDING_LIBGUILE
+struct scm_values
+{
+  scm_t_bits tag_and_count;
+  SCM values[];
+};
+
+static inline struct scm_values*
+scm_to_values (SCM x)
+{
+  if (!scm_is_values (x))
+    abort ();
+  return (struct scm_values*) SCM_UNPACK_POINTER (x);
+}
+
+static inline SCM
+scm_from_values (struct scm_values *values)
+{
+  return SCM_PACK_POINTER (values);
+}
+
 static inline size_t
-scm_i_nvalues (SCM x)
+scm_values_count (struct scm_values *x)
 {
-  return SCM_CELL_WORD_0 (x) >> 8;
+  return x->tag_and_count >> 8;
 }
 
 static inline SCM
-scm_i_value_ref (SCM x, size_t n)
+scm_values_ref (struct scm_values *values, size_t n)
 {
-  return SCM_CELL_OBJECT (x, n+1);
+  return values->values[n];
 }
 #endif
 
 #define SCM_VALUESP(x) (scm_is_values (x))
 
-SCM_INTERNAL void scm_i_extract_values_2 (SCM obj, SCM *p1, SCM *p2);
+SCM_INTERNAL void scm_values_extract_2 (SCM obj, SCM *p1, SCM *p2);
 
 SCM_API SCM scm_values (SCM args);
 SCM_API SCM scm_c_values (SCM *base, size_t n);
diff --git a/libguile/vm.c b/libguile/vm.c
index 97695bedb..1fcadab98 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -1228,10 +1228,11 @@ expand_apply_argument (scm_thread *thread)
 static void
 unpack_values_object (scm_thread *thread, SCM obj)
 {
-  size_t n, nvals = scm_i_nvalues (obj);
+  struct scm_values *values = scm_to_values (obj);
+  size_t n, nvals = scm_values_count (values);
   alloc_frame (thread, nvals);
   for (n = 0; n < nvals; n++)
-    SCM_FRAME_LOCAL (thread->vm.fp, n) = scm_i_value_ref (obj, n);
+    SCM_FRAME_LOCAL (thread->vm.fp, n) = scm_values_ref (values, n);
 }
 
 static void