1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-09 23:40:29 +02:00

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

* Makefile.am (SUBDIRS): Added the `am' directory.

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

        * gh.texi (scm transition summary): Documented some more
        gh equivalents and removed appropriate FIXME's.

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

        * Makefile.am (EXTRA_DIST): Added the `LIBGUILEREADLINE-VERSION'
        file.

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

        * convert.i.c, convert.c: Better range checking.

        * inet_aton.c, fports.c: Commented the inclusion of <winsock2.h>.

        * deprecation.c (vsnprintf): Define to `_vsnprintf' for
        Windows (MinGW).
This commit is contained in:
Stefan Jahn 2002-02-27 15:41:01 +00:00
parent d51b42e28b
commit edb810bb84
12 changed files with 223 additions and 163 deletions

View file

@ -1,3 +1,7 @@
2002-02-27 Stefan Jahn <stefan@lkcc.org>
* Makefile.am (SUBDIRS): Added the `am' directory.
2002-02-26 Thien-Thi Nguyen <ttn@giblet.glug.org> 2002-02-26 Thien-Thi Nguyen <ttn@giblet.glug.org>
* pre-inst-guile.in: New file. * pre-inst-guile.in: New file.

View file

@ -21,7 +21,7 @@
SUBDIRS = oop qt libltdl libguile ice-9 guile-config guile-readline \ SUBDIRS = oop qt libltdl libguile ice-9 guile-config guile-readline \
scripts srfi doc examples test-suite lang scripts srfi doc examples test-suite lang am
bin_SCRIPTS = guile-tools bin_SCRIPTS = guile-tools

View file

@ -1,3 +1,8 @@
2002-02-27 Stefan Jahn <stefan@lkcc.org>
* gh.texi (scm transition summary): Documented some more
gh equivalents and removed appropriate FIXME's.
2002-02-26 Thien-Thi Nguyen <ttn@giblet.glug.org> 2002-02-26 Thien-Thi Nguyen <ttn@giblet.glug.org>
* Makefile.am: Update path to pre-inst-guile automake frag. * Makefile.am: Update path to pre-inst-guile automake frag.

View file

@ -929,16 +929,16 @@ Use @code{scm_str2symbol} instead. [FIXME: inconsistent naming,
should be @code{scm_str02symbol}.] should be @code{scm_str02symbol}.]
@item @code{gh_ints2scm} and @code{gh_doubles2scm} @item @code{gh_ints2scm} and @code{gh_doubles2scm}
No direct scm equivalent. [FIXME] Use @code{scm_c_ints2scm} and @code{scm_c_doubles2scm} instead.
@item @code{gh_chars2byvect} and @code{gh_shorts2svect} @item @code{gh_chars2byvect} and @code{gh_shorts2svect}
No direct scm equivalent. [FIXME] Use @code{scm_c_chars2byvect} and @code{scm_c_shorts2svect} instead.
@item @code{gh_longs2ivect} and @code{gh_ulongs2uvect} @item @code{gh_longs2ivect} and @code{gh_ulongs2uvect}
No direct scm equivalent. [FIXME] Use @code{scm_c_longs2ivect} and @code{scm_c_ulongs2uvect} instead.
@item @code{gh_floats2fvect} and @code{gh_doubles2dvect} @item @code{gh_floats2fvect} and @code{gh_doubles2dvect}
No direct scm equivalent. [FIXME] Use @code{scm_c_floats2fvect} and @code{scm_c_doubles2dvect} instead.
@item @code{gh_scm2bool} @item @code{gh_scm2bool}
Use @code{SCM_NFALSEP} instead. Use @code{SCM_NFALSEP} instead.
@ -993,13 +993,13 @@ instead. With the additional @var{str} argument the user can pass a
pre-allocated memory chunk or leave it passing NULL. pre-allocated memory chunk or leave it passing NULL.
@item @code{gh_scm2chars} @item @code{gh_scm2chars}
No direct scm equivalent. [FIXME] Use @code{scm_c_scm2chars} instead.
@item @code{gh_scm2shorts} and @code{gh_scm2longs} @item @code{gh_scm2shorts} and @code{gh_scm2longs}
No direct scm equivalent. [FIXME] Use @code{scm_c_shorts2scm} and @code{scm_c_longs2scm} instead.
@item @code{gh_scm2floats} and @code{gh_scm2doubles} @item @code{gh_scm2floats} and @code{gh_scm2doubles}
No direct scm equivalent. [FIXME] Use @code{scm_c_floats2scm} and @code{scm_c_doubles2scm} instead.
@item @code{gh_boolean_p} @item @code{gh_boolean_p}
Use the @code{SCM_BOOLP} macro instead, or replace @code{gh_boolean_p Use the @code{SCM_BOOLP} macro instead, or replace @code{gh_boolean_p

View file

@ -1,3 +1,8 @@
2002-02-27 Stefan Jahn <stefan@lkcc.org>
* Makefile.am (EXTRA_DIST): Added the `LIBGUILEREADLINE-VERSION'
file.
2002-02-25 Thien-Thi Nguyen <ttn@giblet.glug.org> 2002-02-25 Thien-Thi Nguyen <ttn@giblet.glug.org>
* configure.in (LIBGUILEREADLINE-VERSION): * configure.in (LIBGUILEREADLINE-VERSION):

View file

@ -50,7 +50,7 @@ SUFFIXES = .x
$(GUILE_SNARF) $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS) $< > $@ \ $(GUILE_SNARF) $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS) $< > $@ \
|| { rm $@; false; } || { rm $@; false; }
EXTRA_DIST = $(ice9_DATA) EXTRA_DIST = $(ice9_DATA) LIBGUILEREADLINE-VERSION
ETAGS_ARGS = $(ice9_DATA) ETAGS_ARGS = $(ice9_DATA)
MKDEP = gcc -M -MG $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS) MKDEP = gcc -M -MG $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS)

View file

@ -1,3 +1,12 @@
2002-02-27 Stefan Jahn <stefan@lkcc.org>
* convert.i.c, convert.c: Better range checking.
* inet_aton.c, fports.c: Commented the inclusion of <winsock2.h>.
* deprecation.c (vsnprintf): Define to `_vsnprintf' for
Windows (MinGW).
2002-02-26 Thien-Thi Nguyen <ttn@giblet.glug.org> 2002-02-26 Thien-Thi Nguyen <ttn@giblet.glug.org>
* Makefile.am: Update path to pre-inst-guile automake frag. * Makefile.am: Update path to pre-inst-guile automake frag.

View file

@ -56,91 +56,90 @@
#include <string.h> #include <string.h>
#endif #endif
#define CTYPE char #define CTYPE char
#define SCM2CTYPES_FN "scm_c_scm2chars" #define SIZEOF_CTYPE 1
#define SCM2CTYPES scm_c_scm2chars #define SCM2CTYPES_FN "scm_c_scm2chars"
#define CTYPES2SCM_FN "scm_c_chars2scm" #define SCM2CTYPES scm_c_scm2chars
#define CTYPES2SCM scm_c_chars2scm #define CTYPES2SCM_FN "scm_c_chars2scm"
#define CTYPEFIXABLE #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 CTYPEMIN -128 #define ARRAYTYPE scm_tc7_byvect
#define CTYPEMAX +255
#define ARRAYTYPE1 scm_tc7_byvect
#define STRINGTYPE
#include "convert.i.c" #include "convert.i.c"
#define CTYPE short #define CTYPE short
#define SCM2CTYPES_FN "scm_c_scm2shorts" #define SIZEOF_CTYPE SIZEOF_SHORT
#define SCM2CTYPES scm_c_scm2shorts #define SCM2CTYPES_FN "scm_c_scm2shorts"
#define CTYPES2SCM_FN "scm_c_shorts2scm" #define SCM2CTYPES scm_c_scm2shorts
#define CTYPES2SCM scm_c_shorts2scm #define CTYPES2SCM_FN "scm_c_shorts2scm"
#define CTYPEFIXABLE #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 CTYPEMIN -32768 #define ARRAYTYPE scm_tc7_svect
#define CTYPEMAX +65535
#define ARRAYTYPE1 scm_tc7_svect
#include "convert.i.c" #include "convert.i.c"
#define CTYPE int #define CTYPE int
#define SCM2CTYPES_FN "scm_c_scm2ints" #define SIZEOF_CTYPE SIZEOF_INT
#define SCM2CTYPES scm_c_scm2ints #define SCM2CTYPES_FN "scm_c_scm2ints"
#define CTYPES2SCM_FN "scm_c_ints2scm" #define SCM2CTYPES scm_c_scm2ints
#define CTYPES2SCM scm_c_ints2scm #define CTYPES2SCM_FN "scm_c_ints2scm"
#define CTYPES2UVECT_FN "scm_c_ints2ivect" #define CTYPES2SCM scm_c_ints2scm
#define CTYPES2UVECT scm_c_ints2ivect #define CTYPES2UVECT_FN "scm_c_ints2ivect"
#define UVECTTYPE scm_tc7_ivect #define CTYPES2UVECT scm_c_ints2ivect
#define CTYPES2UVECT_FN2 "scm_c_uints2uvect" #define UVECTTYPE scm_tc7_ivect
#define CTYPES2UVECT2 scm_c_uints2uvect #define CTYPES2UVECT_FN_OPTIONAL "scm_c_uints2uvect"
#define UVECTTYPE2 scm_tc7_uvect #define CTYPES2UVECT_OPTIONAL scm_c_uints2uvect
#define ARRAYTYPE1 scm_tc7_ivect #define UVECTTYPE_OPTIONAL scm_tc7_uvect
#define ARRAYTYPE2 scm_tc7_uvect #define ARRAYTYPE scm_tc7_ivect
#define ARRAYTYPE_OPTIONAL scm_tc7_uvect
#include "convert.i.c" #include "convert.i.c"
#define CTYPE long #define CTYPE long
#define SCM2CTYPES_FN "scm_c_scm2longs" #define SIZEOF_CTYPE SIZEOF_LONG
#define SCM2CTYPES scm_c_scm2longs #define SCM2CTYPES_FN "scm_c_scm2longs"
#define CTYPES2SCM_FN "scm_c_longs2scm" #define SCM2CTYPES scm_c_scm2longs
#define CTYPES2SCM scm_c_longs2scm #define CTYPES2SCM_FN "scm_c_longs2scm"
#define CTYPES2UVECT_FN "scm_c_longs2ivect" #define CTYPES2SCM scm_c_longs2scm
#define CTYPES2UVECT scm_c_longs2ivect #define CTYPES2UVECT_FN "scm_c_longs2ivect"
#define UVECTTYPE scm_tc7_ivect #define CTYPES2UVECT scm_c_longs2ivect
#define CTYPES2UVECT_FN2 "scm_c_ulongs2uvect" #define UVECTTYPE scm_tc7_ivect
#define CTYPES2UVECT2 scm_c_ulongs2uvect #define CTYPES2UVECT_FN_OPTIONAL "scm_c_ulongs2uvect"
#define UVECTTYPE2 scm_tc7_uvect #define CTYPES2UVECT_OPTIONAL scm_c_ulongs2uvect
#define ARRAYTYPE1 scm_tc7_ivect #define UVECTTYPE_OPTIONAL scm_tc7_uvect
#define ARRAYTYPE2 scm_tc7_uvect #define ARRAYTYPE scm_tc7_ivect
#define ARRAYTYPE_OPTIONAL scm_tc7_uvect
#include "convert.i.c" #include "convert.i.c"
#define CTYPE float #define CTYPE float
#define SCM2CTYPES_FN "scm_c_scm2floats" #define SIZEOF_CTYPE 0
#define SCM2CTYPES scm_c_scm2floats #define SCM2CTYPES_FN "scm_c_scm2floats"
#define CTYPES2SCM_FN "scm_c_floats2scm" #define SCM2CTYPES scm_c_scm2floats
#define CTYPES2SCM scm_c_floats2scm #define CTYPES2SCM_FN "scm_c_floats2scm"
#define CTYPES2UVECT_FN "scm_c_floats2fvect" #define CTYPES2SCM scm_c_floats2scm
#define CTYPES2UVECT scm_c_floats2fvect #define CTYPES2UVECT_FN "scm_c_floats2fvect"
#define UVECTTYPE scm_tc7_fvect #define CTYPES2UVECT scm_c_floats2fvect
#define ARRAYTYPE1 scm_tc7_fvect #define UVECTTYPE scm_tc7_fvect
#define ARRAYTYPE2 scm_tc7_dvect #define ARRAYTYPE scm_tc7_fvect
#define FLOATTYPE1 float #define ARRAYTYPE_OPTIONAL scm_tc7_dvect
#define FLOATTYPE2 double #define FLOATTYPE float
#define FLOATTYPE_OPTIONAL double
#include "convert.i.c" #include "convert.i.c"
#define CTYPE double #define CTYPE double
#define SCM2CTYPES_FN "scm_c_scm2doubles" #define SIZEOF_CTYPE 0
#define SCM2CTYPES scm_c_scm2doubles #define SCM2CTYPES_FN "scm_c_scm2doubles"
#define CTYPES2SCM_FN "scm_c_doubles2scm" #define SCM2CTYPES scm_c_scm2doubles
#define CTYPES2SCM scm_c_doubles2scm #define CTYPES2SCM_FN "scm_c_doubles2scm"
#define CTYPES2UVECT_FN "scm_c_doubles2dvect" #define CTYPES2SCM scm_c_doubles2scm
#define CTYPES2UVECT scm_c_doubles2dvect #define CTYPES2UVECT_FN "scm_c_doubles2dvect"
#define UVECTTYPE scm_tc7_dvect #define CTYPES2UVECT scm_c_doubles2dvect
#define ARRAYTYPE1 scm_tc7_dvect #define UVECTTYPE scm_tc7_dvect
#define ARRAYTYPE2 scm_tc7_fvect #define ARRAYTYPE scm_tc7_dvect
#define FLOATTYPE1 double #define ARRAYTYPE_OPTIONAL scm_tc7_fvect
#define FLOATTYPE2 float #define FLOATTYPE double
#define FLOATTYPE_OPTIONAL float
#include "convert.i.c" #include "convert.i.c"
/* /*

View file

@ -5,8 +5,8 @@
/* Convert a vector, weak vector, (if possible string, substring), list /* Convert a vector, weak vector, (if possible string, substring), list
or uniform vector into an C array. If result array in argument 2 is or uniform vector into an C array. If the result array in argument 2
NULL, malloc() a new one. If out of memory, return NULL. */ is NULL, malloc() a new one. If out of memory, return NULL. */
#define FUNC_NAME SCM2CTYPES_FN #define FUNC_NAME SCM2CTYPES_FN
CTYPE * CTYPE *
SCM2CTYPES (SCM obj, CTYPE *data) SCM2CTYPES (SCM obj, CTYPE *data)
@ -17,40 +17,58 @@ SCM2CTYPES (SCM obj, CTYPE *data)
SCM_ASSERT (SCM_NIMP (obj) || SCM_NFALSEP (scm_list_p (obj)), SCM_ASSERT (SCM_NIMP (obj) || SCM_NFALSEP (scm_list_p (obj)),
obj, SCM_ARG1, FUNC_NAME); obj, SCM_ARG1, FUNC_NAME);
/* list conversion */
if (SCM_NFALSEP (scm_list_p (obj))) if (SCM_NFALSEP (scm_list_p (obj)))
{ {
/* traverse the given list and validate the range of each member */
SCM list = obj; SCM list = obj;
for (n = 0; SCM_NFALSEP (scm_pair_p (list)); list = SCM_CDR (list), n++) for (n = 0; SCM_NFALSEP (scm_pair_p (list)); list = SCM_CDR (list), n++)
{ {
val = SCM_CAR (list); val = SCM_CAR (list);
#if defined (CTYPEMIN) && defined (CTYPEMAX) #if SIZEOF_CTYPE && SIZEOF_CTYPE < SIZEOF_SCM_T_BITS
/* check integer ranges */
if (SCM_INUMP (val)) if (SCM_INUMP (val))
{ {
long v = SCM_INUM (val); scm_t_signed_bits v = SCM_INUM (val);
SCM_ASSERT_RANGE (SCM_ARG1, obj, v >= CTYPEMIN && v <= CTYPEMAX); CTYPE c = (CTYPE) v;
SCM_ASSERT_RANGE (SCM_ARG1, val, v != (scm_t_signed_bits) c);
} }
else /* check big number ranges */
#elif defined (FLOATTYPE1) else if (SCM_BIGP (val))
if (!SCM_INUMP (val) && !(SCM_BIGP (val) || SCM_REALP (val))) {
scm_t_signed_bits v = scm_num2long (val, SCM_ARG1, FUNC_NAME);
CTYPE c = (CTYPE) v;
SCM_ASSERT_RANGE (SCM_ARG1, val, v != (scm_t_signed_bits) c);
}
else
/* check float types */
#elif defined (FLOATTYPE)
/* real values, big numbers and immediate values are valid
for float conversions */
if (!SCM_REALP (val) && !SCM_BIGP (val) && !SCM_INUMP (val))
#else #else
if (!SCM_INUMP (val) && !SCM_BIGP (val)) if (!SCM_BIGP (val) && !SCM_INUMP (val))
#endif #endif /* FLOATTYPE */
SCM_WRONG_TYPE_ARG (SCM_ARG1, obj); SCM_WRONG_TYPE_ARG (SCM_ARG1, val);
} }
if (data == NULL)
data = (CTYPE *) malloc (n * sizeof (CTYPE));
if (data == NULL)
return NULL;
/* allocate new memory if necessary */
if (data == NULL)
{
if ((data = (CTYPE *) malloc (n * sizeof (CTYPE))) == NULL)
return NULL;
}
/* traverse the list once more and convert each member */
list = obj; list = obj;
for (i = 0; SCM_NFALSEP (scm_pair_p (list)); list = SCM_CDR (list), i++) for (i = 0; SCM_NFALSEP (scm_pair_p (list)); list = SCM_CDR (list), i++)
{ {
val = SCM_CAR (list); val = SCM_CAR (list);
if (SCM_INUMP (val)) if (SCM_INUMP (val))
data[i] = SCM_INUM (val); data[i] = (CTYPE) SCM_INUM (val);
else if (SCM_BIGP (val)) else if (SCM_BIGP (val))
data[i] = (CTYPE) scm_num2long (val, SCM_ARG1, FUNC_NAME); data[i] = (CTYPE) scm_num2long (val, SCM_ARG1, FUNC_NAME);
#ifdef FLOATTYPE1 #if defined (FLOATTYPE)
else else
data[i] = (CTYPE) SCM_REAL_VALUE (val); data[i] = (CTYPE) SCM_REAL_VALUE (val);
#endif #endif
@ -58,33 +76,52 @@ SCM2CTYPES (SCM obj, CTYPE *data)
return data; return data;
} }
/* other conversions */
switch (SCM_TYP7 (obj)) switch (SCM_TYP7 (obj))
{ {
/* vectors and weak vectors */
case scm_tc7_vector: case scm_tc7_vector:
case scm_tc7_wvect: case scm_tc7_wvect:
n = SCM_VECTOR_LENGTH (obj); n = SCM_VECTOR_LENGTH (obj);
/* traverse the given vector and validate each member */
for (i = 0; i < n; i++) for (i = 0; i < n; i++)
{ {
val = SCM_VELTS (obj)[i]; val = SCM_VELTS (obj)[i];
#if SIZEOF_CTYPE && SIZEOF_CTYPE < SIZEOF_SCM_T_BITS
#if defined (CTYPEMIN) && defined (CTYPEMAX) /* check integer ranges */
if (SCM_INUMP (val)) if (SCM_INUMP (val))
{ {
long v = SCM_INUM (val); scm_t_signed_bits v = SCM_INUM (val);
SCM_ASSERT_RANGE (SCM_ARG1, obj, v >= CTYPEMIN && v <= CTYPEMAX); CTYPE c = (CTYPE) v;
SCM_ASSERT_RANGE (SCM_ARG1, val, v != (scm_t_signed_bits) c);
} }
/* check big number ranges */
else if (SCM_BIGP (val))
{
scm_t_signed_bits v = scm_num2long (val, SCM_ARG1, FUNC_NAME);
CTYPE c = (CTYPE) v;
SCM_ASSERT_RANGE (SCM_ARG1, val, v != (scm_t_signed_bits) c);
}
else else
#elif defined (FLOATTYPE1) /* check float types */
if (!SCM_INUMP (val) && !(SCM_BIGP (val) || SCM_REALP (val))) #elif defined (FLOATTYPE)
/* real values, big numbers and immediate values are valid
for float conversions */
if (!SCM_REALP (val) && !SCM_BIGP (val) && !SCM_INUMP (val))
#else #else
if (!SCM_INUMP (val) && !SCM_BIGP (val)) if (!SCM_BIGP (val) && !SCM_INUMP (val))
#endif #endif /* FLOATTYPE */
SCM_WRONG_TYPE_ARG (SCM_ARG1, obj); SCM_WRONG_TYPE_ARG (SCM_ARG1, val);
} }
/* allocate new memory if necessary */
if (data == NULL) if (data == NULL)
data = (CTYPE *) malloc (n * sizeof (CTYPE)); {
if (data == NULL) if ((data = (CTYPE *) malloc (n * sizeof (CTYPE))) == NULL)
return NULL; return NULL;
}
/* traverse the vector once more and convert each member */
for (i = 0; i < n; i++) for (i = 0; i < n; i++)
{ {
val = SCM_VELTS (obj)[i]; val = SCM_VELTS (obj)[i];
@ -92,7 +129,7 @@ SCM2CTYPES (SCM obj, CTYPE *data)
data[i] = (CTYPE) SCM_INUM (val); data[i] = (CTYPE) SCM_INUM (val);
else if (SCM_BIGP (val)) else if (SCM_BIGP (val))
data[i] = (CTYPE) scm_num2long (val, SCM_ARG1, FUNC_NAME); data[i] = (CTYPE) scm_num2long (val, SCM_ARG1, FUNC_NAME);
#ifdef FLOATTYPE1 #if defined (FLOATTYPE)
else else
data[i] = (CTYPE) SCM_REAL_VALUE (val); data[i] = (CTYPE) SCM_REAL_VALUE (val);
#endif #endif
@ -100,37 +137,43 @@ SCM2CTYPES (SCM obj, CTYPE *data)
break; break;
#ifdef HAVE_ARRAYS #ifdef HAVE_ARRAYS
case ARRAYTYPE1: /* array conversions (uniform vectors) */
#ifdef ARRAYTYPE2 case ARRAYTYPE:
case ARRAYTYPE2: #ifdef ARRAYTYPE_OPTIONAL
case ARRAYTYPE_OPTIONAL:
#endif #endif
n = SCM_UVECTOR_LENGTH (obj); n = SCM_UVECTOR_LENGTH (obj);
/* allocate new memory if necessary */
if (data == NULL) if (data == NULL)
data = (CTYPE *) malloc (n * sizeof (CTYPE)); {
if (data == NULL) if ((data = (CTYPE *) malloc (n * sizeof (CTYPE))) == NULL)
return NULL; return NULL;
#ifdef FLOATTYPE2 }
if (SCM_TYP7 (obj) == ARRAYTYPE2)
#ifdef FLOATTYPE_OPTIONAL
/* float <-> double conversions */
if (SCM_TYP7 (obj) == ARRAYTYPE_OPTIONAL)
{ {
for (i = 0; i < n; i++) for (i = 0; i < n; i++)
data[i] = ((FLOATTYPE2 *) SCM_UVECTOR_BASE (obj))[i]; data[i] = ((FLOATTYPE_OPTIONAL *) SCM_UVECTOR_BASE (obj))[i];
} }
else else
#endif #endif
/* copy whole array */
memcpy (data, (CTYPE *) SCM_UVECTOR_BASE (obj), n * sizeof (CTYPE)); memcpy (data, (CTYPE *) SCM_UVECTOR_BASE (obj), n * sizeof (CTYPE));
break; break;
#endif /* HAVE_ARRAYS */ #endif /* HAVE_ARRAYS */
#ifdef STRINGTYPE #if SIZEOF_CTYPE == 1
case scm_tc7_string: case scm_tc7_string:
n = SCM_STRING_LENGTH (obj); n = SCM_STRING_LENGTH (obj);
if (data == NULL) if (data == NULL)
data = (CTYPE *) malloc (n * sizeof (CTYPE)); if ((data = (CTYPE *) malloc (n * sizeof (CTYPE))) == NULL)
if (data == NULL) return NULL;
return NULL;
memcpy (data, SCM_STRING_CHARS (obj), n * sizeof (CTYPE)); memcpy (data, SCM_STRING_CHARS (obj), n * sizeof (CTYPE));
break; break;
#endif /* STRINGTYPE */ #endif
default: default:
SCM_WRONG_TYPE_ARG (SCM_ARG1, obj); SCM_WRONG_TYPE_ARG (SCM_ARG1, obj);
@ -152,30 +195,32 @@ CTYPES2UVECT (const CTYPE *data, long n)
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 (sizeof (CTYPE) * n, "vector"); v = scm_gc_malloc (n * sizeof (CTYPE), "uvect");
memcpy (v, data, n * sizeof (CTYPE)); memcpy (v, data, n * sizeof (CTYPE));
return scm_alloc_cell (SCM_MAKE_UVECTOR_TAG (n, UVECTTYPE), (scm_t_bits) v); return scm_alloc_cell (SCM_MAKE_UVECTOR_TAG (n, UVECTTYPE), (scm_t_bits) v);
} }
#undef FUNC_NAME #undef FUNC_NAME
#ifdef UVECTTYPE2 #ifdef UVECTTYPE_OPTIONAL
#define FUNC_NAME CTYPES2UVECT_FN2 #define FUNC_NAME CTYPES2UVECT_FN_OPTIONAL
SCM SCM
CTYPES2UVECT2 (const unsigned CTYPE *data, long n) CTYPES2UVECT_OPTIONAL (const unsigned CTYPE *data, long n)
{ {
char *v; char *v;
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 (sizeof (unsigned CTYPE) * n, "vector"); v = scm_gc_malloc (n * sizeof (unsigned CTYPE) * n, "uvect");
memcpy (v, data, n * sizeof (unsigned CTYPE)); memcpy (v, data, n * sizeof (unsigned CTYPE));
return scm_alloc_cell (SCM_MAKE_UVECTOR_TAG (n, UVECTTYPE2), (scm_t_bits) v); return scm_alloc_cell (SCM_MAKE_UVECTOR_TAG (n, UVECTTYPE_OPTIONAL),
(scm_t_bits) v);
} }
#undef FUNC_NAME #undef FUNC_NAME
#endif /* UVECTTYPE2 */ #endif /* UVECTTYPE_OPTIONAL */
#endif /* HAVE_ARRAYS */ #endif /* HAVE_ARRAYS */
/* Converts a C array into a vector. */ /* Converts a C array into a vector. */
#define FUNC_NAME CTYPES2SCM_FN #define FUNC_NAME CTYPES2SCM_FN
SCM SCM
@ -189,13 +234,10 @@ CTYPES2SCM (const CTYPE *data, long n)
v = scm_c_make_vector (n, SCM_UNSPECIFIED); v = scm_c_make_vector (n, SCM_UNSPECIFIED);
velts = SCM_VELTS (v); velts = SCM_VELTS (v);
for (i = 0; i < n; i++) for (i = 0; i < n; i++)
#ifdef FLOATTYPE1 #ifdef FLOATTYPE
velts[i] = scm_make_real ((double) data[i]); velts[i] = scm_make_real ((double) data[i]);
#elif defined (CTYPEFIXABLE)
velts[i] = SCM_MAKINUM (data[i]);
#else #else
velts[i] = (SCM_FIXABLE (data[i]) ? SCM_MAKINUM (data[i]) : velts[i] = SCM_MAKINUM (data[i]);
scm_i_long2big (data[i]));
#endif #endif
return v; return v;
} }
@ -209,33 +251,22 @@ CTYPES2SCM (const CTYPE *data, long n)
#undef CTYPE #undef CTYPE
#undef CTYPES2UVECT #undef CTYPES2UVECT
#undef CTYPES2UVECT_FN #undef CTYPES2UVECT_FN
#ifdef CTYPEFIXABLE
#undef CTYPEFIXABLE
#endif
#undef UVECTTYPE #undef UVECTTYPE
#ifdef UVECTTYPE2 #ifdef UVECTTYPE_OPTIONAL
#undef CTYPES2UVECT2 #undef CTYPES2UVECT_OPTIONAL
#undef CTYPES2UVECT_FN2 #undef CTYPES2UVECT_FN_OPTIONAL
#undef UVECTTYPE2 #undef UVECTTYPE_OPTIONAL
#endif #endif
#ifdef CTYPEMIN #undef SIZEOF_CTYPE
#undef CTYPEMIN #undef ARRAYTYPE
#ifdef ARRAYTYPE_OPTIONAL
#undef ARRAYTYPE_OPTIONAL
#endif #endif
#ifdef CTYPEMAX #ifdef FLOATTYPE
#undef CTYPEMAX #undef FLOATTYPE
#endif #endif
#undef ARRAYTYPE1 #ifdef FLOATTYPE_OPTIONAL
#ifdef ARRAYTYPE2 #undef FLOATTYPE_OPTIONAL
#undef ARRAYTYPE2
#endif
#ifdef FLOATTYPE1
#undef FLOATTYPE1
#endif
#ifdef FLOATTYPE2
#undef FLOATTYPE2
#endif
#ifdef STRINGTYPE
#undef STRINGTYPE
#endif #endif
/* /*

View file

@ -51,6 +51,11 @@
#include "libguile/strings.h" #include "libguile/strings.h"
#include "libguile/ports.h" #include "libguile/ports.h"
/* Windows defines. */
#ifdef __MINGW32__
#define vsnprintf _vsnprintf
#endif
#if (SCM_ENABLE_DEPRECATED == 1) #if (SCM_ENABLE_DEPRECATED == 1)

View file

@ -69,7 +69,8 @@ size_t fwrite ();
#include <errno.h> #include <errno.h>
#include "libguile/iselect.h" #include "libguile/iselect.h"
/* Some defines for Windows. */
/* Some defines for Windows (native port, not Cygwin). */
#ifdef __MINGW32__ #ifdef __MINGW32__
# include <sys/stat.h> # include <sys/stat.h>
# include <winsock2.h> # include <winsock2.h>

View file

@ -39,6 +39,7 @@ static char sccsid[] = "@(#)inet_addr.c 8.1 (Berkeley) 6/17/93";
#include <ctype.h> #include <ctype.h>
#ifdef __MINGW32__ #ifdef __MINGW32__
/* Include for MinGW only. Cygwin will have the latter. */
#include <winsock2.h> #include <winsock2.h>
#else #else
#include <sys/param.h> #include <sys/param.h>