summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/bitvectors.c1
-rw-r--r--libguile/bytevectors.c4
-rw-r--r--libguile/extensions.c5
-rw-r--r--libguile/generalized-vectors.c37
-rw-r--r--libguile/generalized-vectors.h6
-rw-r--r--libguile/init.c24
-rw-r--r--libguile/srfi-4.c18
-rw-r--r--libguile/strings.c2
-rw-r--r--libguile/vectors.c2
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 ()