mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

* convert.i.c: Convert srfi-4 style uniform vectors when

Browse source 
requested.
* convert.c (scm_c_scm2chars, scm_c_chars2scm,
scm_c_chars2byvect): Use a s8vector instead of a scm_tc7_byvect.
This commit is contained in:
Marius Vollmer 2004-10-27 19:32:11 +00:00
parent 46d25cffa8
commit d1d2f0941c
2 changed files with 53 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

5
libguile/convert.c
View file

@ -28,6 +28,7 @@
#if SCM_HAVE_ARRAYS
# include "libguile/unif.h"
#endif
#include "libguile/srfi-4.h"
#include "libguile/convert.h"
@ -43,10 +44,10 @@
#define CTYPES2SCM scm_c_chars2scm
#define CTYPES2UVECT_FN "scm_c_chars2byvect"
#define CTYPES2UVECT scm_c_chars2byvect
#define UVECTTYPE scm_tc7_byvect
#define UVEC_CREATOR scm_take_s8vector
#define SIZEOF_UVECTTYPE 1
#define UVECTCTYPE char
#define ARRAYTYPE scm_tc7_byvect
#define UVEC_PREDICATE scm_s8vector_p
#define SIZEOF_ARRAYTYPE 1
#define ARRAYCTYPE char
#include "convert.i.c"

53
libguile/convert.i.c
View file

@ -70,6 +70,31 @@ SCM2CTYPES (SCM obj, CTYPE *data)
return data;
}
/* uniform vectors */
#ifdef UVEC_PREDICATE
if (scm_is_true (UVEC_PREDICATE (obj)))
{
n = scm_c_uniform_vector_length (obj);
ARRAYCTYPE *elts = (ARRAYCTYPE *)scm_uniform_vector_elements (obj);
/* allocate new memory if necessary */
if (data == NULL)
if ((data = (CTYPE *) malloc (n * sizeof (CTYPE))) == NULL)
return NULL;
#if SIZEOF_CTYPE != SIZEOF_ARRAYTYPE
/* copy array element by element */
for (i = 0; i < n; i++)
data[i] = (CTYPE) elts[i];
#else
/* copy whole array */
memcpy (data, (CTYPE *) elts, n * sizeof (CTYPE));
#endif
scm_uniform_vector_release (obj);
return data;
}
#endif
/* other conversions */
switch (SCM_TYP7 (obj))
{
@ -127,7 +152,7 @@ SCM2CTYPES (SCM obj, CTYPE *data)
#endif
}
break;
#ifdef ARRAYTPE
#if SCM_HAVE_ARRAYS
/* array conversions (uniform vectors) */
case ARRAYTYPE:
@ -160,6 +185,7 @@ SCM2CTYPES (SCM obj, CTYPE *data)
#endif
break;
#endif /* SCM_HAVE_ARRAYS */
#endif
#if SIZEOF_CTYPE == 1
case scm_tc7_string:
@ -204,11 +230,16 @@ CTYPES2UVECT (const CTYPE *data, long n)
v = scm_gc_malloc (n * sizeof (CTYPE), "uvect");
memcpy (v, data, n * sizeof (CTYPE));
#endif
#ifdef UVEC_CREATOR
return UVEC_CREATOR (v, n);
#else
return scm_cell (SCM_MAKE_UVECTOR_TAG (n, UVECTTYPE), (scm_t_bits) v);
#endif
}
#undef FUNC_NAME
#ifdef UVECTTYPE_OPTIONAL
#if defined(UVECTTYPE_OPTIONAL) || defined(UVEC_CREATOR_OPTIONAL)
#define FUNC_NAME CTYPES2UVECT_FN_OPTIONAL
SCM
CTYPES2UVECT_OPTIONAL (const unsigned CTYPE *data, long n)
@ -230,11 +261,15 @@ CTYPES2UVECT_OPTIONAL (const unsigned CTYPE *data, long n)
v = scm_gc_malloc (n * sizeof (CTYPE), "uvect");
memcpy (v, data, n * sizeof (CTYPE));
#endif
#ifdef UVEC_CREATOR_OPTIONAL
return UVEC_CREATOR_OPTIONAL (v, n);
#else
return scm_cell (SCM_MAKE_UVECTOR_TAG (n, UVECTTYPE_OPTIONAL),
(scm_t_bits) v);
#endif
}
#undef FUNC_NAME
#endif /* UVECTTYPE_OPTIONAL */
#endif /* UVECTTYPE_OPTIONAL || UVEC_CREATOR_OPTIONAL */
#endif /* SCM_HAVE_ARRAYS */
@ -278,7 +313,9 @@ CTYPES2SCM (const CTYPE *data, long n)
#undef SIZEOF_CTYPE
#undef SIZEOF_UVECTTYPE
#undef SIZEOF_ARRAYTYPE
#ifdef ARRAYTYPE
#undef ARRAYTYPE
#endif
#ifdef ARRAYTYPE_OPTIONAL
#undef ARRAYTYPE_OPTIONAL
#endif
@ -294,6 +331,16 @@ CTYPES2SCM (const CTYPE *data, long n)
#ifdef ARRAYCTYPE
#undef ARRAYCTYPE
#endif
#ifdef UVEC_PREDICATE
#undef UVEC_PREDICATE
#endif
#ifdef UVEC_CREATOR
#undef UVEC_CREATOR
#endif
#ifdef UVEC_CREATOR_OPTIONAL
#undef UVEC_CREATOR_OPTIONAL
#endif
/*
Local Variables: