diff --git a/libguile/eq.c b/libguile/eq.c index bbcd158d4..73bb73795 100644 --- a/libguile/eq.c +++ b/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 (); diff --git a/libguile/finalizers.c b/libguile/finalizers.c index 5bf68602a..0ef7a2b64 100644 --- a/libguile/finalizers.c +++ b/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 (); } diff --git a/libguile/finalizers.h b/libguile/finalizers.h index b3dd8160a..7f3512270 100644 --- a/libguile/finalizers.h +++ b/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, diff --git a/libguile/goops.c b/libguile/goops.c index 80e0b3040..a2eec14ae 100644 --- a/libguile/goops.c +++ b/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 ("")); class_random_state = scm_variable_ref (scm_c_lookup ("")); class_regexp = scm_variable_ref (scm_c_lookup ("")); + class_locale = scm_variable_ref (scm_c_lookup ("")); create_smob_classes (); create_struct_classes (); diff --git a/libguile/i18n.c b/libguile/i18n.c index 30a640aaf..153225911 100644 --- a/libguile/i18n.c +++ b/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); \ - (_c_locale) = (locale_t)SCM_SMOB_DATA (_arg); \ + SCM_VALIDATE_LOCALE ((_pos), (_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); - -SCM_SMOB_FREE (scm_tc16_locale_smob_type, smob_locale_free, locale) +void +scm_i_finalize_locale (struct scm_thread *thread, SCM locale) { - locale_t c_locale; - - c_locale = (locale_t) SCM_SMOB_DATA (locale); + locale_t c_locale = (locale_t) scm_to_locale (locale)->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); - SCM_VARIABLE_SET (scm_global_locale, global_locale_smob); + struct scm_locale *locale = scm_gc_malloc (sizeof (*locale), "locale"); + 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); - } - diff --git a/libguile/i18n.h b/libguile/i18n.h index 8ce1ce8e6..c38891f3e 100644 --- a/libguile/i18n.h +++ b/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); diff --git a/libguile/print.c b/libguile/print.c index 45d8c9d00..93f928120 100644 --- a/libguile/print.c +++ b/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 ("#', port); + break; + case scm_tc16_locale: + scm_puts ("#', port); + break; default: abort (); } diff --git a/libguile/scm.h b/libguile/scm.h index 9f7054d43..feccfc533 100644 --- a/libguile/scm.h +++ b/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: */ diff --git a/module/oop/goops.scm b/module/oop/goops.scm index 6a18b9691..ccc68db6b 100644 --- a/module/oop/goops.scm +++ b/module/oop/goops.scm @@ -72,7 +72,7 @@ - + ;; Numbers. @@ -1089,6 +1089,7 @@ slots as we go." (define-standard-class ()) (define-standard-class ()) (define-standard-class ()) +(define-standard-class ()) (define-standard-class ()) (define-standard-class ()) (define-standard-class ())