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

2002-03-02 Stefan Jahn <stefan@lkcc.org>

Browse source 
* convert.i.c: Fixed int <-> long conversions which would have
        failed if their sizes were different.
This commit is contained in:
Stefan Jahn 2002-03-02 14:18:38 +00:00
parent 38ace99eb3
commit 97820583b4
3 changed files with 89 additions and 34 deletions
Download patch file Download diff file Expand all files Collapse all files

5
libguile/ChangeLog
View file

@ -1,3 +1,8 @@
2002-03-02 Stefan Jahn <stefan@lkcc.org>
* convert.i.c: Fixed int <-> long conversions which would have
failed if their sizes were different.
2002-03-02 Dirk Herrmann <D.Herrmann@tu-bs.de> 2002-03-02 Dirk Herrmann <D.Herrmann@tu-bs.de>
* eval.c (SCM_CEVAL): Cleaned up the handling of 'if', 'let', * eval.c (SCM_CEVAL): Cleaned up the handling of 'if', 'let',

60
libguile/convert.c
View file

@ -56,28 +56,36 @@
#include <string.h> #include <string.h>
#endif #endif
#define CTYPE char #define CTYPE char
#define SIZEOF_CTYPE 1 #define SIZEOF_CTYPE 1
#define SCM2CTYPES_FN "scm_c_scm2chars" #define SCM2CTYPES_FN "scm_c_scm2chars"
#define SCM2CTYPES scm_c_scm2chars #define SCM2CTYPES scm_c_scm2chars
#define CTYPES2SCM_FN "scm_c_chars2scm" #define CTYPES2SCM_FN "scm_c_chars2scm"
#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 UVECTTYPE scm_tc7_byvect
#define ARRAYTYPE scm_tc7_byvect #define SIZEOF_UVECTTYPE 1
#define UVECTCTYPE char
#define ARRAYTYPE scm_tc7_byvect
#define SIZEOF_ARRAYTYPE 1
#define ARRAYCTYPE char
#include "convert.i.c" #include "convert.i.c"
#define CTYPE short #define CTYPE short
#define SIZEOF_CTYPE SIZEOF_SHORT #define SIZEOF_CTYPE SIZEOF_SHORT
#define SCM2CTYPES_FN "scm_c_scm2shorts" #define SCM2CTYPES_FN "scm_c_scm2shorts"
#define SCM2CTYPES scm_c_scm2shorts #define SCM2CTYPES scm_c_scm2shorts
#define CTYPES2SCM_FN "scm_c_shorts2scm" #define CTYPES2SCM_FN "scm_c_shorts2scm"
#define CTYPES2SCM scm_c_shorts2scm #define CTYPES2SCM scm_c_shorts2scm
#define CTYPES2UVECT_FN "scm_c_shorts2svect" #define CTYPES2UVECT_FN "scm_c_shorts2svect"
#define CTYPES2UVECT scm_c_shorts2svect #define CTYPES2UVECT scm_c_shorts2svect
#define UVECTTYPE scm_tc7_svect #define UVECTTYPE scm_tc7_svect
#define ARRAYTYPE scm_tc7_svect #define SIZEOF_UVECTTYPE SIZEOF_SHORT
#define UVECTCTYPE short
#define ARRAYTYPE scm_tc7_svect
#define SIZEOF_ARRAYTYPE SIZEOF_SHORT
#define ARRAYCTYPE short
#include "convert.i.c" #include "convert.i.c"
#define CTYPE int #define CTYPE int
@ -89,10 +97,14 @@
#define CTYPES2UVECT_FN "scm_c_ints2ivect" #define CTYPES2UVECT_FN "scm_c_ints2ivect"
#define CTYPES2UVECT scm_c_ints2ivect #define CTYPES2UVECT scm_c_ints2ivect
#define UVECTTYPE scm_tc7_ivect #define UVECTTYPE scm_tc7_ivect
#define SIZEOF_UVECTTYPE SIZEOF_LONG
#define UVECTCTYPE long
#define CTYPES2UVECT_FN_OPTIONAL "scm_c_uints2uvect" #define CTYPES2UVECT_FN_OPTIONAL "scm_c_uints2uvect"
#define CTYPES2UVECT_OPTIONAL scm_c_uints2uvect #define CTYPES2UVECT_OPTIONAL scm_c_uints2uvect
#define UVECTTYPE_OPTIONAL scm_tc7_uvect #define UVECTTYPE_OPTIONAL scm_tc7_uvect
#define ARRAYTYPE scm_tc7_ivect #define ARRAYTYPE scm_tc7_ivect
#define SIZEOF_ARRAYTYPE SIZEOF_LONG
#define ARRAYCTYPE long
#define ARRAYTYPE_OPTIONAL scm_tc7_uvect #define ARRAYTYPE_OPTIONAL scm_tc7_uvect
#include "convert.i.c" #include "convert.i.c"
@ -105,10 +117,14 @@
#define CTYPES2UVECT_FN "scm_c_longs2ivect" #define CTYPES2UVECT_FN "scm_c_longs2ivect"
#define CTYPES2UVECT scm_c_longs2ivect #define CTYPES2UVECT scm_c_longs2ivect
#define UVECTTYPE scm_tc7_ivect #define UVECTTYPE scm_tc7_ivect
#define SIZEOF_UVECTTYPE SIZEOF_LONG
#define UVECTCTYPE long
#define CTYPES2UVECT_FN_OPTIONAL "scm_c_ulongs2uvect" #define CTYPES2UVECT_FN_OPTIONAL "scm_c_ulongs2uvect"
#define CTYPES2UVECT_OPTIONAL scm_c_ulongs2uvect #define CTYPES2UVECT_OPTIONAL scm_c_ulongs2uvect
#define UVECTTYPE_OPTIONAL scm_tc7_uvect #define UVECTTYPE_OPTIONAL scm_tc7_uvect
#define ARRAYTYPE scm_tc7_ivect #define ARRAYTYPE scm_tc7_ivect
#define SIZEOF_ARRAYTYPE SIZEOF_LONG
#define ARRAYCTYPE long
#define ARRAYTYPE_OPTIONAL scm_tc7_uvect #define ARRAYTYPE_OPTIONAL scm_tc7_uvect
#include "convert.i.c" #include "convert.i.c"
@ -121,7 +137,9 @@
#define CTYPES2UVECT_FN "scm_c_floats2fvect" #define CTYPES2UVECT_FN "scm_c_floats2fvect"
#define CTYPES2UVECT scm_c_floats2fvect #define CTYPES2UVECT scm_c_floats2fvect
#define UVECTTYPE scm_tc7_fvect #define UVECTTYPE scm_tc7_fvect
#define SIZEOF_UVECTTYPE 0
#define ARRAYTYPE scm_tc7_fvect #define ARRAYTYPE scm_tc7_fvect
#define SIZEOF_ARRAYTYPE 0
#define ARRAYTYPE_OPTIONAL scm_tc7_dvect #define ARRAYTYPE_OPTIONAL scm_tc7_dvect
#define FLOATTYPE float #define FLOATTYPE float
#define FLOATTYPE_OPTIONAL double #define FLOATTYPE_OPTIONAL double
@ -136,7 +154,9 @@
#define CTYPES2UVECT_FN "scm_c_doubles2dvect" #define CTYPES2UVECT_FN "scm_c_doubles2dvect"
#define CTYPES2UVECT scm_c_doubles2dvect #define CTYPES2UVECT scm_c_doubles2dvect
#define UVECTTYPE scm_tc7_dvect #define UVECTTYPE scm_tc7_dvect
#define SIZEOF_UVECTTYPE 0
#define ARRAYTYPE scm_tc7_dvect #define ARRAYTYPE scm_tc7_dvect
#define SIZEOF_ARRAYTYPE 0
#define ARRAYTYPE_OPTIONAL scm_tc7_fvect #define ARRAYTYPE_OPTIONAL scm_tc7_fvect
#define FLOATTYPE double #define FLOATTYPE double
#define FLOATTYPE_OPTIONAL float #define FLOATTYPE_OPTIONAL float

58
libguile/convert.i.c
View file

@ -54,10 +54,8 @@ SCM2CTYPES (SCM obj, CTYPE *data)
/* allocate new memory if necessary */ /* allocate new memory if necessary */
if (data == NULL) if (data == NULL)
{ if ((data = (CTYPE *) malloc (n * sizeof (CTYPE))) == NULL)
if ((data = (CTYPE *) malloc (n * sizeof (CTYPE))) == NULL) return NULL;
return NULL;
}
/* traverse the list once more and convert each member */ /* traverse the list once more and convert each member */
list = obj; list = obj;
@ -116,10 +114,8 @@ SCM2CTYPES (SCM obj, CTYPE *data)
/* allocate new memory if necessary */ /* allocate new memory if necessary */
if (data == NULL) if (data == NULL)
{ if ((data = (CTYPE *) malloc (n * sizeof (CTYPE))) == NULL)
if ((data = (CTYPE *) malloc (n * sizeof (CTYPE))) == NULL) return NULL;
return NULL;
}
/* traverse the vector once more and convert each member */ /* traverse the vector once more and convert each member */
for (i = 0; i < n; i++) for (i = 0; i < n; i++)
@ -146,10 +142,8 @@ SCM2CTYPES (SCM obj, CTYPE *data)
/* allocate new memory if necessary */ /* allocate new memory if necessary */
if (data == NULL) if (data == NULL)
{ if ((data = (CTYPE *) malloc (n * sizeof (CTYPE))) == NULL)
if ((data = (CTYPE *) malloc (n * sizeof (CTYPE))) == NULL) return NULL;
return NULL;
}
#ifdef FLOATTYPE_OPTIONAL #ifdef FLOATTYPE_OPTIONAL
/* float <-> double conversions */ /* float <-> double conversions */
@ -160,8 +154,14 @@ SCM2CTYPES (SCM obj, CTYPE *data)
} }
else else
#endif #endif
#if SIZEOF_CTYPE != SIZEOF_ARRAYTYPE
/* copy array element by element */
for (i = 0; i < n; i++)
data[i] = (CTYPE) ((ARRAYCTYPE *) SCM_UVECTOR_BASE (obj))[i];
#else
/* copy whole array */ /* copy whole array */
memcpy (data, (CTYPE *) SCM_UVECTOR_BASE (obj), n * sizeof (CTYPE)); memcpy (data, (CTYPE *) SCM_UVECTOR_BASE (obj), n * sizeof (CTYPE));
#endif
break; break;
#endif /* HAVE_ARRAYS */ #endif /* HAVE_ARRAYS */
@ -191,12 +191,23 @@ SCM2CTYPES (SCM obj, CTYPE *data)
SCM SCM
CTYPES2UVECT (const CTYPE *data, long n) CTYPES2UVECT (const CTYPE *data, long n)
{ {
#if SIZEOF_CTYPE != SIZEOF_UVECTTYPE
UVECTCTYPE *v;
long i;
#else
char *v; char *v;
#endif
SCM_ASSERT_RANGE (SCM_ARG2, scm_long2num (n), SCM_ASSERT_RANGE (SCM_ARG2, scm_long2num (n),
n > 0 && n <= SCM_UVECTOR_MAX_LENGTH); n > 0 && n <= SCM_UVECTOR_MAX_LENGTH);
#if SIZEOF_CTYPE != SIZEOF_UVECTTYPE
v = scm_gc_malloc (n * SIZEOF_UVECTTYPE, "uvect");
for (i = 0; i < n; i++)
v[i] = (UVECTCTYPE) data[i];
#else
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
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);
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -206,12 +217,23 @@ CTYPES2UVECT (const CTYPE *data, long n)
SCM SCM
CTYPES2UVECT_OPTIONAL (const unsigned CTYPE *data, long n) CTYPES2UVECT_OPTIONAL (const unsigned CTYPE *data, long n)
{ {
#if SIZEOF_CTYPE != SIZEOF_UVECTTYPE
unsigned UVECTCTYPE *v;
long i;
#else
char *v; char *v;
#endif
SCM_ASSERT_RANGE (SCM_ARG2, scm_long2num (n), SCM_ASSERT_RANGE (SCM_ARG2, scm_long2num (n),
n > 0 && n <= SCM_UVECTOR_MAX_LENGTH); n > 0 && n <= SCM_UVECTOR_MAX_LENGTH);
v = scm_gc_malloc (n * sizeof (unsigned CTYPE) * n, "uvect"); #if SIZEOF_CTYPE != SIZEOF_UVECTTYPE
memcpy (v, data, n * sizeof (unsigned CTYPE)); v = scm_gc_malloc (n * SIZEOF_UVECTTYPE, "uvect");
for (i = 0; i < n; i++)
v[i] = (unsigned UVECTCTYPE) data[i];
#else
v = scm_gc_malloc (n * sizeof (CTYPE), "uvect");
memcpy (v, data, n * sizeof (CTYPE));
#endif
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);
} }
@ -258,6 +280,8 @@ CTYPES2SCM (const CTYPE *data, long n)
#undef UVECTTYPE_OPTIONAL #undef UVECTTYPE_OPTIONAL
#endif #endif
#undef SIZEOF_CTYPE #undef SIZEOF_CTYPE
#undef SIZEOF_UVECTTYPE
#undef SIZEOF_ARRAYTYPE
#undef ARRAYTYPE #undef ARRAYTYPE
#ifdef ARRAYTYPE_OPTIONAL #ifdef ARRAYTYPE_OPTIONAL
#undef ARRAYTYPE_OPTIONAL #undef ARRAYTYPE_OPTIONAL
@ -268,6 +292,12 @@ CTYPES2SCM (const CTYPE *data, long n)
#ifdef FLOATTYPE_OPTIONAL #ifdef FLOATTYPE_OPTIONAL
#undef FLOATTYPE_OPTIONAL #undef FLOATTYPE_OPTIONAL
#endif #endif
#ifdef UVECTCTYPE
#undef UVECTCTYPE
#endif
#ifdef ARRAYCTYPE
#undef ARRAYCTYPE
#endif
/* /*
Local Variables: Local Variables: