diff options
-rw-r--r-- | libguile/bitvectors.c | 1 | ||||
-rw-r--r-- | libguile/bytevectors.c | 4 | ||||
-rw-r--r-- | libguile/extensions.c | 5 | ||||
-rw-r--r-- | libguile/generalized-vectors.c | 37 | ||||
-rw-r--r-- | libguile/generalized-vectors.h | 6 | ||||
-rw-r--r-- | libguile/init.c | 24 | ||||
-rw-r--r-- | libguile/srfi-4.c | 18 | ||||
-rw-r--r-- | libguile/strings.c | 2 | ||||
-rw-r--r-- | libguile/vectors.c | 2 |
9 files changed, 85 insertions, 14 deletions
diff --git a/libguile/bitvectors.c b/libguile/bitvectors.c index ed2e9a09a..95d37a38a 100644 --- a/libguile/bitvectors.c +++ b/libguile/bitvectors.c @@ -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 () diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c index 75028aee1..9e9586d75 100644 --- a/libguile/bytevectors.c +++ b/libguile/bytevectors.c @@ -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); } } diff --git a/libguile/extensions.c b/libguile/extensions.c index 54351dd9c..d01e9c656 100644 --- a/libguile/extensions.c +++ b/libguile/extensions.c @@ -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" } diff --git a/libguile/generalized-vectors.c b/libguile/generalized-vectors.c index 0c85f368a..2d437a475 100644 --- a/libguile/generalized-vectors.c +++ b/libguile/generalized-vectors.c @@ -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) { diff --git a/libguile/generalized-vectors.h b/libguile/generalized-vectors.h index 08321d106..71b58d291 100644 --- a/libguile/generalized-vectors.h +++ b/libguile/generalized-vectors.h @@ -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); diff --git a/libguile/init.c b/libguile/init.c index 9e3151c82..da3bc0af2 100644 --- a/libguile/init.c +++ b/libguile/init.c @@ -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); diff --git a/libguile/srfi-4.c b/libguile/srfi-4.c index e87064569..117d1e3dd 100644 --- a/libguile/srfi-4.c +++ b/libguile/srfi-4.c @@ -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" } diff --git a/libguile/strings.c b/libguile/strings.c index a35b7bfdf..4d71fc74d 100644 --- a/libguile/strings.c +++ b/libguile/strings.c @@ -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 () diff --git a/libguile/vectors.c b/libguile/vectors.c index f1388cf12..89b822a76 100644 --- a/libguile/vectors.c +++ b/libguile/vectors.c @@ -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 () |