mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

add registry of vector constructors, make-generalized-vector

Browse source 
* libguile/generalized-vectors.h:
* libguile/generalized-vectors.c: Add a registry of vector constructors.
  (scm_make_generalized_vector): New public function, constructs a
  vector of a given type.

* libguile/bitvectors.c:
* libguile/bytevectors.c:
* libguile/srfi-4.c:
* libguile/strings.c:
* libguile/vectors.c: Register vector constructors.

* libguile/extensions.c (scm_init_extensions): No need to NULL the list
  of registered extensions here, the static init does it for us. Allows
  scm_c_register_extension to be called before scm_init_extensions.

* libguile/init.c (scm_i_init_guile): Move array initialization earlier,
  so e.g. scm_init_strings has access to a valid list of array element
  types when registering its vector constructor.
This commit is contained in:
Andy Wingo 2009-07-18 12:43:54 +02:00
parent 476b894c71
commit f45eccffa7
9 changed files with 85 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

1
libguile/bitvectors.c
View file

@ -891,6 +891,7 @@ bitvector_get_handle (SCM bv, scm_t_array_handle *h)
SCM_ARRAY_IMPLEMENTATION (scm_tc16_bitvector, 0xffff,
bitvector_handle_ref, bitvector_handle_set,
bitvector_get_handle);
SCM_VECTOR_IMPLEMENTATION (SCM_ARRAY_ELEMENT_TYPE_BIT, scm_make_bitvector);
void
scm_init_bitvectors ()

4
libguile/bytevectors.c
View file

@ -2117,12 +2117,16 @@ scm_bootstrap_bytevectors (void)
{
scm_t_array_implementation impl;
impl.tag = scm_tc16_bytevector;
impl.mask = 0xffff;
impl.vref = bv_handle_ref;
impl.vset = bv_handle_set_x;
impl.get_handle = bytevector_get_handle;
scm_i_register_array_implementation (&impl);
scm_i_register_vector_constructor
(scm_i_array_element_types[SCM_ARRAY_ELEMENT_TYPE_VU8],
scm_make_bytevector);
}
}

5
libguile/extensions.c
View file

@ -1,6 +1,6 @@
/* extensions.c - registering and loading extensions.
*
* Copyright (C) 2001, 2006 Free Software Foundation, Inc.
* Copyright (C) 2001, 2006, 2009 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@ -41,7 +41,7 @@ typedef struct extension_t
void *data;
} extension_t;
static extension_t *registered_extensions;
static extension_t *registered_extensions = NULL;
/* Register a LIB/INIT pair for use by `scm_load_extension'. LIB is
allowed to be NULL and then only INIT is used to identify the
@ -157,7 +157,6 @@ SCM_DEFINE (scm_load_extension, "load-extension", 2, 0, 0,
void
scm_init_extensions ()
{
registered_extensions = NULL;
#include "libguile/extensions.x"
}

37
libguile/generalized-vectors.c
View file

@ -31,6 +31,43 @@
#include "libguile/generalized-vectors.h"
struct scm_t_vector_ctor
{
SCM tag;
SCM (*ctor)(SCM, SCM);
};
#define VECTOR_CTORS_N_STATIC_ALLOC 20
static struct scm_t_vector_ctor vector_ctors[VECTOR_CTORS_N_STATIC_ALLOC];
static int num_vector_ctors_registered = 0;
void
scm_i_register_vector_constructor (SCM type, SCM (*ctor)(SCM, SCM))
{
if (num_vector_ctors_registered >= VECTOR_CTORS_N_STATIC_ALLOC)
/* need to increase VECTOR_CTORS_N_STATIC_ALLOC, buster */
abort ();
else
{
vector_ctors[num_vector_ctors_registered].tag = type;
vector_ctors[num_vector_ctors_registered].ctor = ctor;
num_vector_ctors_registered++;
}
}
SCM_DEFINE (scm_make_generalized_vector, "make-generalized-vector", 2, 1, 0,
(SCM type, SCM len, SCM fill),
"Make a generalized vector")
#define FUNC_NAME s_scm_make_generalized_vector
{
int i;
for (i = 0; i < num_vector_ctors_registered; i++)
if (vector_ctors[i].tag == type)
return vector_ctors[i].ctor(len, fill);
scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, type, "array type");
}
#undef FUNC_NAME
int
scm_is_generalized_vector (SCM obj)
{

6
libguile/generalized-vectors.h
View file

@ -43,6 +43,12 @@ SCM_API void scm_c_generalized_vector_set_x (SCM v, size_t idx, SCM val);
SCM_API void scm_generalized_vector_get_handle (SCM vec,
scm_t_array_handle *h);
SCM_API SCM scm_make_generalized_vector (SCM type, SCM len, SCM fill);
SCM_INTERNAL void scm_i_register_vector_constructor (SCM type, SCM (*ctor)(SCM, SCM));
#define SCM_VECTOR_IMPLEMENTATION(type, ctor) \
SCM_SNARF_INIT (scm_i_register_vector_constructor \
(scm_i_array_element_types[type], ctor))
SCM_INTERNAL void scm_init_generalized_vectors (void);

24
libguile/init.c
View file

@ -521,7 +521,19 @@ scm_i_init_guile (SCM_STACKITEM *base)
scm_init_sort ();
scm_init_srcprop ();
scm_init_stackchk ();
scm_init_strings ();
scm_init_array_handle ();
scm_init_generalized_arrays ();
scm_init_generalized_vectors ();
scm_init_vectors ();
scm_init_uniform ();
scm_init_bitvectors ();
scm_bootstrap_bytevectors ();
scm_init_srfi_4 ();
scm_init_arrays ();
scm_init_array_map ();
scm_init_strings (); /* Requires array-handle */
scm_init_struct (); /* Requires strings */
scm_init_stacks (); /* Requires strings, struct */
scm_init_symbols ();
@ -535,7 +547,6 @@ scm_i_init_guile (SCM_STACKITEM *base)
scm_init_srfi_13 ();
scm_init_srfi_14 ();
scm_init_throw ();
scm_init_vectors ();
scm_init_version ();
scm_init_weaks ();
scm_init_guardians ();
@ -544,13 +555,6 @@ scm_i_init_guile (SCM_STACKITEM *base)
scm_init_evalext ();
scm_init_debug (); /* Requires macro smobs */
scm_init_random ();
scm_init_array_handle ();
scm_init_generalized_arrays ();
scm_init_generalized_vectors ();
scm_init_uniform ();
scm_init_bitvectors ();
scm_init_array_map ();
scm_init_arrays ();
scm_init_simpos ();
scm_init_load_path ();
scm_init_standard_ports (); /* Requires fports */
@ -559,7 +563,6 @@ scm_i_init_guile (SCM_STACKITEM *base)
scm_init_lang ();
#endif /* SCM_ENABLE_ELISP */
scm_init_script ();
scm_init_srfi_4 ();
scm_init_goops ();
@ -583,7 +586,6 @@ scm_i_init_guile (SCM_STACKITEM *base)
scm_init_rw ();
scm_init_extensions ();
scm_bootstrap_bytevectors ();
scm_bootstrap_vm ();
atexit (cleanup_for_exit);

18
libguile/srfi-4.c
View file

@ -920,6 +920,24 @@ scm_init_srfi_4 (void)
scm_permanent_object (scm_c_read_string ("9223372036854775807"));
#endif
#define REGISTER(tag, TAG) \
scm_i_register_vector_constructor \
(scm_i_array_element_types[SCM_ARRAY_ELEMENT_TYPE_##TAG], \
scm_make_##tag##vector)
REGISTER (u8, U8);
REGISTER (s8, S8);
REGISTER (u16, U16);
REGISTER (s16, S16);
REGISTER (u32, U32);
REGISTER (s32, S32);
REGISTER (u64, U64);
REGISTER (s64, S64);
REGISTER (f32, F32);
REGISTER (f64, F64);
REGISTER (c32, C32);
REGISTER (c64, C64);
#include "libguile/srfi-4.x"
}

2
libguile/strings.c
View file

@ -29,6 +29,7 @@
#include "libguile/chars.h"
#include "libguile/root.h"
#include "libguile/strings.h"
#include "libguile/generalized-vectors.h"
#include "libguile/deprecation.h"
#include "libguile/validate.h"
#include "libguile/dynwind.h"
@ -1124,6 +1125,7 @@ string_get_handle (SCM v, scm_t_array_handle *h)
SCM_ARRAY_IMPLEMENTATION (scm_tc7_string, 0x7f & ~2,
string_handle_ref, string_handle_set,
string_get_handle);
SCM_VECTOR_IMPLEMENTATION (SCM_ARRAY_ELEMENT_TYPE_CHAR, scm_make_string);
void
scm_init_strings ()

2
libguile/vectors.c
View file

@ -562,6 +562,8 @@ SCM_ARRAY_IMPLEMENTATION (scm_tc7_vector, 0x7f & ~2,
SCM_ARRAY_IMPLEMENTATION (scm_tc7_wvect, 0x7f & ~2,
vector_handle_ref, vector_handle_set,
vector_get_handle);
SCM_VECTOR_IMPLEMENTATION (SCM_ARRAY_ELEMENT_TYPE_SCM, scm_make_vector);
void
scm_init_vectors ()