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:
parent
46d25cffa8
commit
d1d2f0941c
2 changed files with 53 additions and 5 deletions
|
@ -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"
|
||||||
|
|
|
@ -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:
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue