mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-07-01 23:30:28 +02:00
Code Activity

Locale have static tc16

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2025-06-18 12:18:24 +02:00
parent a5c70aa914
commit bc43d4f9a7
9 changed files with 84 additions and 25 deletions
Download patch file Download diff file Expand all files Collapse all files

2
libguile/eq.c
View file

@ -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 ();

11
libguile/finalizers.c
View file

@ -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 ();
}

2
libguile/finalizers.h
View file

@ -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,

4
libguile/goops.c
View file

@ -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 ();

73
libguile/i18n.c
View file

@ -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);
}

3
libguile/i18n.h
View file

@ -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);

10
libguile/print.c
View file

@ -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 ();
}

1
libguile/scm.h
View file

@ -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: */

3
module/oop/goops.scm
View file

@ -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>))