Locale have static tc16

* libguile/print.c (iprin1):
* libguile/eq.c (scm_equal_p): Add case for locales and also regexps
which we missed in the past.
* libguile/finalizers.h:
* libguile/finalizers.c (scm_i_add_locale_finalizer):
(run_finalizer): Add locale finalizers.
* libguile/scm.h (scm_tc16_locale): New tc16.
* module/oop/goops.scm:
* libguile/goops.c: Add locale class.
* libguile/i18n.c: Give locale objects their own tc16.

libguile/eq.c

@@ -394,6 +394,8 @@ scm_equal_p (SCM x, SCM y)
         case scm_tc16_directory:
         case scm_tc16_syntax_transformer:
         case scm_tc16_random_state:
+        case scm_tc16_regexp:
+        case scm_tc16_locale:
           return SCM_BOOL_F;
         default:
           abort ();

libguile/finalizers.c

@@ -41,6 +41,7 @@
 #include "gc-internal.h"
 #include "gsubr.h"
 #include "init.h"
+#include "i18n.h"
 #include "numbers.h"
 #include "ports.h"
 #ifdef ENABLE_REGEX
@@ -82,6 +83,7 @@ enum builtin_finalizer_kind
     FINALIZE_KIND_PORT,
     FINALIZE_KIND_DIRECTORY,
     FINALIZE_KIND_REGEXP,
+    FINALIZE_KIND_LOCALE,
   };
 
 static SCM
@@ -137,6 +139,12 @@ scm_i_add_directory_finalizer (struct scm_thread *thread, SCM obj)
   return add_builtin_finalizer (thread, obj, FINALIZE_KIND_DIRECTORY);
 }
 
+SCM
+scm_i_add_locale_finalizer (struct scm_thread *thread, SCM obj)
+{
+  return add_builtin_finalizer (thread, obj, FINALIZE_KIND_LOCALE);
+}
+
 SCM
 scm_i_add_regexp_finalizer (struct scm_thread *thread, SCM obj)
 {
@@ -201,6 +209,9 @@ run_finalizer (struct scm_thread *thread, SCM obj, SCM closure)
           abort ();
 #endif
           break;
+        case FINALIZE_KIND_LOCALE:
+          scm_i_finalize_locale (thread, obj);
+          break;
         default:
           abort ();
         }

libguile/finalizers.h

@@ -34,6 +34,8 @@ SCM_INTERNAL SCM scm_i_add_port_finalizer (struct scm_thread *thread,
                                            SCM obj);
 SCM_INTERNAL SCM scm_i_add_directory_finalizer (struct scm_thread *thread,
                                                 SCM obj);
+SCM_INTERNAL SCM scm_i_add_locale_finalizer (struct scm_thread *thread,
+                                             SCM obj);
 SCM_INTERNAL SCM scm_i_add_regexp_finalizer (struct scm_thread *thread,
                                              SCM obj);
 SCM_INTERNAL SCM scm_i_add_pointer_finalizer (struct scm_thread *thread,

libguile/goops.c

@@ -145,6 +145,7 @@ static SCM class_directory;
 static SCM class_macro;
 static SCM class_random_state;
 static SCM class_regexp;
+static SCM class_locale;
 
 static struct scm_ephemeron_table *vtable_class_map;
 static SCM pre_goops_vtables = SCM_EOL;
@@ -360,6 +361,8 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
                 return class_random_state;
               case scm_tc16_regexp:
                 return class_regexp;
+              case scm_tc16_locale:
+                return class_locale;
               default:
                 abort ();
               }
@@ -1002,6 +1005,7 @@ SCM_DEFINE (scm_sys_goops_early_init, "%goops-early-init", 0, 0, 0,
   class_macro = scm_variable_ref (scm_c_lookup ("<macro>"));
   class_random_state = scm_variable_ref (scm_c_lookup ("<random-state>"));
   class_regexp = scm_variable_ref (scm_c_lookup ("<regexp>"));
+  class_locale = scm_variable_ref (scm_c_lookup ("<locale>"));
 
   create_smob_classes ();
   create_struct_classes ();

libguile/i18n.c

@@ -34,13 +34,13 @@
 #include "dynwind.h"
 #include "extensions.h"
 #include "feature.h"
+#include "finalizers.h"
 #include "gsubr.h"
 #include "list.h"
 #include "modules.h"
 #include "numbers.h"
 #include "pairs.h"
 #include "posix.h"  /* for `scm_i_locale_mutex' */
-#include "smob.h"
 #include "strings.h"
 #include "symbols.h"
 #include "syscalls.h"
@@ -131,13 +131,44 @@ typedef locale_t scm_t_locale;
 SCM_GLOBAL_VARIABLE (scm_global_locale, "%global-locale");
 
 
+struct scm_locale
+{
+  scm_t_bits tag;
+  locale_t locale;
+};
+
+static inline int
+scm_is_locale (SCM x)
+{
+  return SCM_HAS_TYP16 (x, scm_tc16_locale);
+}
+
+static inline struct scm_locale *
+scm_to_locale (SCM x)
+{
+  if (!scm_is_locale (x))
+    abort ();
+  return (struct scm_locale *) SCM_UNPACK_POINTER (x);
+}
+
+static inline SCM
+scm_from_locale (struct scm_locale *x)
+{
+  return SCM_PACK_POINTER (x);
+}
+
+#define SCM_LOCALE_P(x) (scm_is_locale (x))
+#define SCM_VALIDATE_LOCALE(pos, x) \
+  SCM_MAKE_VALIDATE_MSG (pos, x, LOCALE_P, "locale")
+
+
 /* Validate parameter ARG as a locale object and set C_LOCALE to the
    corresponding C locale object.  */
 #define SCM_VALIDATE_LOCALE_COPY(_pos, _arg, _c_locale)		\
   do								\
     {								\
-      SCM_VALIDATE_SMOB ((_pos), (_arg), locale_smob_type);	\
+      SCM_VALIDATE_LOCALE ((_pos), (_arg));                     \
-      (_c_locale) = (locale_t)SCM_SMOB_DATA (_arg);		\
+      (_c_locale) = scm_to_locale (_arg)->locale;               \
     }								\
   while (0)
 
@@ -154,17 +185,12 @@ SCM_GLOBAL_VARIABLE (scm_global_locale, "%global-locale");
   while (0)
 
 
-SCM_SMOB (scm_tc16_locale_smob_type, "locale", 0);
+void
-
+scm_i_finalize_locale (struct scm_thread *thread, SCM locale)
-SCM_SMOB_FREE (scm_tc16_locale_smob_type, smob_locale_free, locale)
 {
-  locale_t c_locale;
+  locale_t c_locale = (locale_t) scm_to_locale (locale)->locale;
-
-  c_locale = (locale_t) SCM_SMOB_DATA (locale);
   if (c_locale)
     freelocale (c_locale);
-
-  return 0;
 }
 
 
@@ -272,7 +298,6 @@ SCM_DEFINE (scm_make_locale, "make-locale", 2, 1, 0,
 	    "categories not listed in @var{category_list}.")
 #define FUNC_NAME s_scm_make_locale
 {
-  SCM locale = SCM_BOOL_F;
   int err = 0;
   int c_category_mask;
   char *c_locale_name;
@@ -313,10 +338,13 @@ SCM_DEFINE (scm_make_locale, "make-locale", 2, 1, 0,
 	freelocale (c_base_locale);
       scm_locale_error (FUNC_NAME, errno);
     }
-  else
-    SCM_NEWSMOB (locale, scm_tc16_locale_smob_type, c_locale);
 
-  return locale;
+  struct scm_locale *locale = scm_gc_malloc (sizeof (*locale), "locale");
+  locale->tag = scm_tc16_locale;
+  locale->locale = c_locale;
+  scm_i_add_locale_finalizer (SCM_I_CURRENT_THREAD, scm_from_locale (locale));
+
+  return scm_from_locale (locale);
 
  fail:
   free (c_locale_name);
@@ -331,7 +359,7 @@ SCM_DEFINE (scm_locale_p, "locale?", 1, 0, 0,
 	    "Return true if @var{obj} is a locale object.")
 #define FUNC_NAME s_scm_locale_p
 {
-  return scm_from_bool (SCM_SMOB_PREDICATE (scm_tc16_locale_smob_type, obj));
+  return scm_from_bool (scm_is_locale (obj));
 }
 #undef FUNC_NAME
 
@@ -1441,19 +1469,20 @@ define_langinfo_items (void)
 void
 scm_init_i18n ()
 {
-  SCM global_locale_smob;
-
   scm_add_feature ("nl-langinfo");
   define_langinfo_items ();
 
 #include "i18n.x"
 
-  /* Initialize the global locale object with a special `locale' SMOB.  */
+  /* Initialize the global locale object with a special `locale'
+     object.  */
   /* XXX: We don't define it as `LC_GLOBAL_LOCALE' because of bugs as of
      glibc <= 2.11 not (yet) worked around by Gnulib.  See
      http://sourceware.org/bugzilla/show_bug.cgi?id=11009 for details.  */
-  SCM_NEWSMOB (global_locale_smob, scm_tc16_locale_smob_type, NULL);
+  struct scm_locale *locale = scm_gc_malloc (sizeof (*locale), "locale");
-  SCM_VARIABLE_SET (scm_global_locale, global_locale_smob);
+  locale->tag = scm_tc16_locale;
+  locale->locale = NULL;
+  SCM_VARIABLE_SET (scm_global_locale, scm_from_locale (locale));
 }
 
 void
@@ -1463,6 +1492,4 @@ scm_bootstrap_i18n ()
                             "scm_init_i18n",
 			    (scm_t_extension_init_func) scm_init_i18n,
 			    NULL);
-
 }
-

libguile/i18n.h

@@ -1,7 +1,7 @@
 #ifndef SCM_I18N_H
 #define SCM_I18N_H
 
-/* Copyright 2006,2008-2009,2018
+/* Copyright 2006,2008-2009,2018,2025
      Free Software Foundation, Inc.
 
    This file is part of Guile.
@@ -45,6 +45,7 @@ SCM_API SCM scm_locale_string_to_integer (SCM str, SCM base, SCM locale);
 SCM_API SCM scm_locale_string_to_inexact (SCM str, SCM locale);
 
 SCM_INTERNAL SCM scm_nl_langinfo (SCM item, SCM locale);
+SCM_INTERNAL void scm_i_finalize_locale (struct scm_thread *thread, SCM locale);
 
 SCM_INTERNAL void scm_init_i18n (void);
 SCM_INTERNAL void scm_bootstrap_i18n (void);

libguile/print.c

@@ -760,6 +760,16 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
                 scm_uintprint (SCM_UNPACK (exp), 16, port);
                 scm_putc ('>', port);
                 break;
+              case scm_tc16_regexp:
+                scm_puts ("#<regexp ", port);
+                scm_uintprint (SCM_UNPACK (exp), 16, port);
+                scm_putc ('>', port);
+                break;
+              case scm_tc16_locale:
+                scm_puts ("#<locale ", port);
+                scm_uintprint (SCM_UNPACK (exp), 16, port);
+                scm_putc ('>', port);
+                break;
               default:
                 abort ();
             }

libguile/scm.h

@@ -516,6 +516,7 @@ typedef uintptr_t scm_t_bits;
 #define scm_tc16_syntax_transformer	0x057f
 #define scm_tc16_random_state		0x067f
 #define scm_tc16_regexp			0x077f
+#define scm_tc16_locale			0x087f
 
 
 /* Definitions for tc16: */

module/oop/goops.scm

@@ -72,7 +72,7 @@
             <keyword> <syntax> <atomic-box> <thread> <bitvector>
             <finalizer> <ephemeron> <ephemeron-table> <character-set>
             <mutex> <condition-variable> <continuation> <directory>
-            <array> <random-state> <regexp>
+            <array> <random-state> <regexp> <locale>
 
             ;; Numbers.
             <number> <complex> <real> <integer> <fraction>
@@ -1089,6 +1089,7 @@ slots as we go."
 (define-standard-class <macro> (<top>))
 (define-standard-class <random-state> (<top>))
 (define-standard-class <regexp> (<top>))
+(define-standard-class <locale> (<top>))
 (define-standard-class <thread> (<top>))
 (define-standard-class <number> (<top>))
 (define-standard-class <complex> (<number>))