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

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

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

View file

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

View file

@ -70,6 +70,31 @@ SCM2CTYPES (SCM obj, CTYPE *data)
return 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 */ /* other conversions */
switch (SCM_TYP7 (obj)) switch (SCM_TYP7 (obj))
{ {
@ -127,7 +152,7 @@ SCM2CTYPES (SCM obj, CTYPE *data)
#endif #endif
} }
break; break;
#ifdef ARRAYTPE
#if SCM_HAVE_ARRAYS #if SCM_HAVE_ARRAYS
/* array conversions (uniform vectors) */ /* array conversions (uniform vectors) */
case ARRAYTYPE: case ARRAYTYPE:
@ -160,6 +185,7 @@ SCM2CTYPES (SCM obj, CTYPE *data)
#endif #endif
break; break;
#endif /* SCM_HAVE_ARRAYS */ #endif /* SCM_HAVE_ARRAYS */
#endif
#if SIZEOF_CTYPE == 1 #if SIZEOF_CTYPE == 1
case scm_tc7_string: case scm_tc7_string:
@ -204,11 +230,16 @@ CTYPES2UVECT (const CTYPE *data, long n)
v = scm_gc_malloc (n * sizeof (CTYPE), "uvect"); v = scm_gc_malloc (n * sizeof (CTYPE), "uvect");
memcpy (v, data, n * sizeof (CTYPE)); memcpy (v, data, n * sizeof (CTYPE));
#endif #endif
#ifdef UVEC_CREATOR
return UVEC_CREATOR (v, n);
#else
return scm_cell (SCM_MAKE_UVECTOR_TAG (n, UVECTTYPE), (scm_t_bits) v); return scm_cell (SCM_MAKE_UVECTOR_TAG (n, UVECTTYPE), (scm_t_bits) v);
#endif
} }
#undef FUNC_NAME #undef FUNC_NAME
#ifdef UVECTTYPE_OPTIONAL #if defined(UVECTTYPE_OPTIONAL) || defined(UVEC_CREATOR_OPTIONAL)
#define FUNC_NAME CTYPES2UVECT_FN_OPTIONAL #define FUNC_NAME CTYPES2UVECT_FN_OPTIONAL
SCM SCM
CTYPES2UVECT_OPTIONAL (const unsigned CTYPE *data, long n) 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"); v = scm_gc_malloc (n * sizeof (CTYPE), "uvect");
memcpy (v, data, n * sizeof (CTYPE)); memcpy (v, data, n * sizeof (CTYPE));
#endif #endif
#ifdef UVEC_CREATOR_OPTIONAL
return UVEC_CREATOR_OPTIONAL (v, n);
#else
return scm_cell (SCM_MAKE_UVECTOR_TAG (n, UVECTTYPE_OPTIONAL), return scm_cell (SCM_MAKE_UVECTOR_TAG (n, UVECTTYPE_OPTIONAL),
(scm_t_bits) v); (scm_t_bits) v);
#endif
} }
#undef FUNC_NAME #undef FUNC_NAME
#endif /* UVECTTYPE_OPTIONAL */ #endif /* UVECTTYPE_OPTIONAL || UVEC_CREATOR_OPTIONAL */
#endif /* SCM_HAVE_ARRAYS */ #endif /* SCM_HAVE_ARRAYS */
@ -278,7 +313,9 @@ CTYPES2SCM (const CTYPE *data, long n)
#undef SIZEOF_CTYPE #undef SIZEOF_CTYPE
#undef SIZEOF_UVECTTYPE #undef SIZEOF_UVECTTYPE
#undef SIZEOF_ARRAYTYPE #undef SIZEOF_ARRAYTYPE
#ifdef ARRAYTYPE
#undef ARRAYTYPE #undef ARRAYTYPE
#endif
#ifdef ARRAYTYPE_OPTIONAL #ifdef ARRAYTYPE_OPTIONAL
#undef ARRAYTYPE_OPTIONAL #undef ARRAYTYPE_OPTIONAL
#endif #endif
@ -294,6 +331,16 @@ CTYPES2SCM (const CTYPE *data, long n)
#ifdef ARRAYCTYPE #ifdef ARRAYCTYPE
#undef ARRAYCTYPE #undef ARRAYCTYPE
#endif #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: Local Variables: