diff options
Diffstat (limited to 'libguile/vectors.c')
-rw-r--r-- | libguile/vectors.c | 82 |
1 files changed, 0 insertions, 82 deletions
diff --git a/libguile/vectors.c b/libguile/vectors.c index 1cc666a99..cd194a905 100644 --- a/libguile/vectors.c +++ b/libguile/vectors.c @@ -52,88 +52,6 @@ #include "libguile/unif.h" -#if (SCM_DEBUG_DEPRECATED == 0) - -/* The function scm_vector_set_length_x will disappear in the next release of - * guile. - */ - -/* - * This complicates things too much if allowed on any array. - * C code can safely call it on arrays known to be used in a single - * threaded manner. - * - * SCM_REGISTER_PROC(s_vector_set_length_x, "vector-set-length!", 2, 0, 0, scm_vector_set_length_x); - */ -static char s_vector_set_length_x[] = "vector-set-length!"; - - -SCM -scm_vector_set_length_x (SCM vect, SCM len) -{ - long l; - size_t siz; - size_t sz; - char *base; - - l = SCM_INUM (len); - SCM_ASRTGO (SCM_NIMP (vect), badarg1); - -#ifdef HAVE_ARRAYS - if (SCM_TYP7 (vect) == scm_tc7_bvect) - { - l = (l + SCM_LONG_BIT - 1) / SCM_LONG_BIT; - } - sz = scm_uniform_element_size (vect); - if (sz != 0) - base = SCM_UVECTOR_BASE (vect); - else -#endif - switch (SCM_TYP7 (vect)) - { - default: - badarg1: scm_wta (vect, (char *) SCM_ARG1, s_vector_set_length_x); - case scm_tc7_string: - SCM_ASRTGO (!SCM_EQ_P (vect, scm_nullstr), badarg1); - sz = sizeof (char); - base = SCM_STRING_CHARS (vect); - l++; - break; - case scm_tc7_vector: - case scm_tc7_wvect: - SCM_ASRTGO (!SCM_EQ_P (vect, scm_nullvect), badarg1); - sz = sizeof (SCM); - base = (char *) SCM_VECTOR_BASE (vect); - break; - } - SCM_ASSERT (SCM_INUMP (len), len, SCM_ARG2, s_vector_set_length_x); - if (!l) - l = 1L; - siz = l * sz; - if (siz != l * sz) - scm_memory_error (s_vector_set_length_x); - SCM_REDEFER_INTS; - SCM_SETCHARS (vect, - ((char *) - scm_must_realloc (base, - (size_t) SCM_LENGTH (vect) * sz, - (size_t) siz, - s_vector_set_length_x))); - if (SCM_VECTORP (vect)) - { - sz = SCM_LENGTH (vect); - while (l > sz) - SCM_VELTS (vect)[--l] = SCM_UNSPECIFIED; - } - else if (SCM_STRINGP (vect)) - SCM_STRING_CHARS (vect)[l - 1] = 0; - SCM_SETLENGTH (vect, SCM_INUM (len), SCM_TYP7 (vect)); - SCM_REALLOW_INTS; - return vect; -} - -#endif /* (SCM_DEBUG_DEPRECATED == 0) */ - SCM_DEFINE (scm_vector_p, "vector?", 1, 0, 0, (SCM obj), "Return @code{#t} if @var{obj} is a vector, otherwise return\n" |