mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-14 15:40:19 +02:00
Code Activity

* Removed deprecated stuff.

Browse source 
* Some more renamings to SCM_<filename>_H.
This commit is contained in:
Dirk Herrmann 2001-08-31 12:13:50 +00:00
parent b29058ffee
commit dee01b012c
27 changed files with 132 additions and 728 deletions
Download patch file Download diff file Expand all files Collapse all files

82
libguile/vectors.c
View file

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