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 ("#", 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); - return result; + 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 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 -static inline size_t -scm_i_nvalues (SCM x) +struct scm_values { - return SCM_CELL_WORD_0 (x) >> 8; + 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_i_value_ref (SCM x, size_t n) +scm_from_values (struct scm_values *values) { - return SCM_CELL_OBJECT (x, n+1); + return SCM_PACK_POINTER (values); +} + +static inline size_t +scm_values_count (struct scm_values *x) +{ + return x->tag_and_count >> 8; +} + +static inline SCM +scm_values_ref (struct scm_values *values, size_t n) +{ + 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