diff --git a/ChangeLog b/ChangeLog index 88b3a520e..dfac20bd8 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2002-01-31 Stefan Jahn + + * configure.in: Add -DLIBLTDL_DLL_IMPORT to INCLTDL when using + `libltdl.dll'. + 2002-01-28 Stefan Jahn * configure.in (guile_cv_have_uint32_t): Look also in diff --git a/configure.in b/configure.in index 4607b4d76..2e0e2c0e5 100644 --- a/configure.in +++ b/configure.in @@ -251,6 +251,9 @@ if test "$MINGW32" = "yes" ; then AC_DEFINE(USE_DLL_IMPORT, 1, [Define if you need additional CPP macros on Win32 platforms.]) fi + if test x"$enable_ltdl_install" = x"yes" ; then + INCLTDL="-DLIBLTDL_DLL_IMPORT $INCLTDL" + fi fi AC_SUBST(EXTRA_DEFS) @@ -273,6 +276,7 @@ if test "$use_modules" != no; then done fi fi + AC_SUBST(INCLTDL) AC_SUBST(LIBLTDL) AC_SUBST(DLPREOPEN) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index bd6395e74..e4bab308a 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,11 @@ +2002-01-31 Stefan Jahn + + * convert.c, convert.h, convert.i.c: New files containing C + array to Scheme conversion helpers meant to be replacement + functions for the deprecated gh interface. + + * Makefile.am: Setup rules for new `convert.*' files. + 2002-01-28 Stefan Jahn * symbols.c (scm_c_symbol2str): New function, replacement for diff --git a/libguile/Makefile.am b/libguile/Makefile.am index e3bb3b3ea..c11ef267e 100644 --- a/libguile/Makefile.am +++ b/libguile/Makefile.am @@ -41,8 +41,8 @@ guile_LDFLAGS = @DLPREOPEN@ guile_filter_doc_snarfage_SOURCES = c-tokenize.c libguile_la_SOURCES = alist.c arbiters.c async.c backtrace.c boolean.c \ - chars.c continuations.c debug.c deprecation.c dynl.c dynwind.c \ - environments.c eq.c error.c eval.c evalext.c extensions.c \ + chars.c continuations.c convert.c debug.c deprecation.c dynl.c \ + dynwind.c environments.c eq.c error.c eval.c evalext.c extensions.c \ feature.c fluids.c fports.c \ gc.c gc_os_dep.c gdbint.c gh_data.c gh_eval.c gh_funcs.c gh_init.c \ gh_io.c gh_list.c gh_predicates.c goops.c gsubr.c guardians.c hash.c \ @@ -117,7 +117,7 @@ install-exec-hook: ## Perhaps we can deal with them normally once the merge seems to be ## working. noinst_HEADERS = coop-threads.c coop-threads.h coop.c \ - num2integral.i.c num2float.i.c \ + num2integral.i.c num2float.i.c convert.i.c \ win32-uname.h win32-dirent.h win32-socket.h libguile_la_DEPENDENCIES = @LIBLOBJS@ @@ -130,9 +130,9 @@ pkginclude_HEADERS = gh.h # These are headers visible as . modincludedir = $(includedir)/libguile modinclude_HEADERS = __scm.h alist.h arbiters.h async.h backtrace.h boolean.h \ - chars.h continuations.h coop-defs.h debug.h debug-malloc.h deprecation.h \ - dynl.h dynwind.h environments.h eq.h error.h eval.h evalext.h \ - extensions.h feature.h filesys.h fluids.h fports.h gc.h \ + chars.h continuations.h convert.h coop-defs.h debug.h debug-malloc.h \ + deprecation.h dynl.h dynwind.h environments.h eq.h error.h eval.h \ + evalext.h extensions.h feature.h filesys.h fluids.h fports.h gc.h \ gdb_interface.h gdbint.h \ goops.h gsubr.h guardians.h hash.h hashtab.h hooks.h init.h \ inline.h ioext.h \ diff --git a/libguile/convert.c b/libguile/convert.c new file mode 100644 index 000000000..43d5d7107 --- /dev/null +++ b/libguile/convert.c @@ -0,0 +1,146 @@ +/* Copyright (C) 2002 Free Software Foundation, Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA + * + * As a special exception, the Free Software Foundation gives permission + * for additional uses of the text contained in its release of GUILE. + * + * The exception is that, if you link the GUILE library with other files + * to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the GUILE library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the + * Free Software Foundation under the name GUILE. If you copy + * code from other Free Software Foundation releases into a copy of + * GUILE, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for GUILE, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. */ + + + +#include "libguile/_scm.h" +#include "libguile/validate.h" +#include "libguile/strings.h" +#include "libguile/vectors.h" +#include "libguile/pairs.h" +#if HAVE_ARRAYS +# include "libguile/unif.h" +#endif + +#include "libguile/convert.h" + +#define CTYPE char +#define SCM2CTYPES_FN "scm_c_scm2chars" +#define SCM2CTYPES scm_c_scm2chars +#define CTYPES2SCM_FN "scm_c_chars2scm" +#define CTYPES2SCM scm_c_chars2scm +#define CTYPEFIXABLE +#define CTYPES2UVECT_FN "scm_c_chars2byvect" +#define CTYPES2UVECT scm_c_chars2byvect +#define UVECTTYPE scm_tc7_byvect +#define CTYPEMIN -128 +#define CTYPEMAX +255 +#define ARRAYTYPE1 scm_tc7_byvect +#define STRINGTYPE +#include "convert.i.c" + +#define CTYPE short +#define SCM2CTYPES_FN "scm_c_scm2shorts" +#define SCM2CTYPES scm_c_scm2shorts +#define CTYPES2SCM_FN "scm_c_shorts2scm" +#define CTYPES2SCM scm_c_shorts2scm +#define CTYPEFIXABLE +#define CTYPES2UVECT_FN "scm_c_shorts2svect" +#define CTYPES2UVECT scm_c_shorts2svect +#define UVECTTYPE scm_tc7_svect +#define CTYPEMIN -32768 +#define CTYPEMAX +65535 +#define ARRAYTYPE1 scm_tc7_svect +#include "convert.i.c" + +#define CTYPE int +#define SCM2CTYPES_FN "scm_c_scm2ints" +#define SCM2CTYPES scm_c_scm2ints +#define CTYPES2SCM_FN "scm_c_ints2scm" +#define CTYPES2SCM scm_c_ints2scm +#define CTYPES2UVECT_FN "scm_c_ints2ivect" +#define CTYPES2UVECT scm_c_ints2ivect +#define UVECTTYPE scm_tc7_ivect +#define CTYPES2UVECT_FN2 "scm_c_uints2uvect" +#define CTYPES2UVECT2 scm_c_uints2uvect +#define UVECTTYPE2 scm_tc7_uvect +#define ARRAYTYPE1 scm_tc7_ivect +#define ARRAYTYPE2 scm_tc7_uvect +#include "convert.i.c" + +#define CTYPE long +#define SCM2CTYPES_FN "scm_c_scm2longs" +#define SCM2CTYPES scm_c_scm2longs +#define CTYPES2SCM_FN "scm_c_longs2scm" +#define CTYPES2SCM scm_c_longs2scm +#define CTYPES2UVECT_FN "scm_c_longs2ivect" +#define CTYPES2UVECT scm_c_longs2ivect +#define UVECTTYPE scm_tc7_ivect +#define CTYPES2UVECT_FN2 "scm_c_ulongs2uvect" +#define CTYPES2UVECT2 scm_c_ulongs2uvect +#define UVECTTYPE2 scm_tc7_uvect +#define ARRAYTYPE1 scm_tc7_ivect +#define ARRAYTYPE2 scm_tc7_uvect +#include "convert.i.c" + +#define CTYPE float +#define SCM2CTYPES_FN "scm_c_scm2floats" +#define SCM2CTYPES scm_c_scm2floats +#define CTYPES2SCM_FN "scm_c_floats2scm" +#define CTYPES2SCM scm_c_floats2scm +#define CTYPES2UVECT_FN "scm_c_floats2fvect" +#define CTYPES2UVECT scm_c_floats2fvect +#define UVECTTYPE scm_tc7_fvect +#define ARRAYTYPE1 scm_tc7_fvect +#define ARRAYTYPE2 scm_tc7_dvect +#define FLOATTYPE1 float +#define FLOATTYPE2 double +#include "convert.i.c" + +#define CTYPE double +#define SCM2CTYPES_FN "scm_c_scm2doubles" +#define SCM2CTYPES scm_c_scm2doubles +#define CTYPES2SCM_FN "scm_c_doubles2scm" +#define CTYPES2SCM scm_c_doubles2scm +#define CTYPES2UVECT_FN "scm_c_doubles2dvect" +#define CTYPES2UVECT scm_c_doubles2dvect +#define UVECTTYPE scm_tc7_dvect +#define ARRAYTYPE1 scm_tc7_dvect +#define ARRAYTYPE2 scm_tc7_fvect +#define FLOATTYPE1 double +#define FLOATTYPE2 float +#include "convert.i.c" + +/* + Local Variables: + c-file-style: "gnu" + End: +*/ diff --git a/libguile/convert.h b/libguile/convert.h new file mode 100644 index 000000000..ec350fef4 --- /dev/null +++ b/libguile/convert.h @@ -0,0 +1,76 @@ +/* classes: h_files */ + +#ifndef SCM_CONVERT_H +#define SCM_CONVERT_H + +/* Copyright (C) 2002 Free Software Foundation, Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA + * + * As a special exception, the Free Software Foundation gives permission + * for additional uses of the text contained in its release of GUILE. + * + * The exception is that, if you link the GUILE library with other files + * to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the GUILE library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the + * Free Software Foundation under the name GUILE. If you copy + * code from other Free Software Foundation releases into a copy of + * GUILE, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for GUILE, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. */ + + + +#include "libguile/__scm.h" + +SCM_API char *scm_c_scm2chars (SCM obj, char *dst); +SCM_API short *scm_c_scm2shorts (SCM obj, short *dst); +SCM_API int *scm_c_scm2ints (SCM obj, int *dst); +SCM_API long *scm_c_scm2longs (SCM obj, long *dst); +SCM_API float *scm_c_scm2floats (SCM obj, float *dst); +SCM_API double *scm_c_scm2doubles (SCM obj, double *dst); + +SCM_API SCM scm_c_chars2scm (const char *src, long n); +SCM_API SCM scm_c_shorts2scm (const short *src, long n); +SCM_API SCM scm_c_ints2scm (const int *src, long n); +SCM_API SCM scm_c_longs2scm (const long *src, long n); +SCM_API SCM scm_c_floats2scm (const float *src, long n); +SCM_API SCM scm_c_doubles2scm (const double *src, long n); + +#if HAVE_ARRAYS +SCM_API SCM scm_c_chars2byvect (const char *src, long n); +SCM_API SCM scm_c_shorts2svect (const short *src, long n); +SCM_API SCM scm_c_ints2ivect (const int *src, long n); +SCM_API SCM scm_c_uints2uvect (const unsigned int *src, long n); +SCM_API SCM scm_c_longs2ivect (const long *src, long n); +SCM_API SCM scm_c_ulongs2uvect (const unsigned long *src, long n); +SCM_API SCM scm_c_floats2fvect (const float *src, long n); +SCM_API SCM scm_c_doubles2dvect (const double *src, long n); +#endif + +#endif /* SCM_CONVERT_H */ diff --git a/libguile/convert.i.c b/libguile/convert.i.c new file mode 100644 index 000000000..118182943 --- /dev/null +++ b/libguile/convert.i.c @@ -0,0 +1,247 @@ +/* this file is #include'd (x times) by convert.c */ + +/* FIXME: Should we use exported wrappers for malloc (and free), which + * allow windows DLLs to call the correct freeing function? */ + + +/* Convert a vector, weak vector, (if possible string, substring), list + or uniform vector into an C array. If result array in argument 2 is + NULL, malloc() a new one. If out of memory, return NULL. */ +#define FUNC_NAME SCM2CTYPES_FN +CTYPE * +SCM2CTYPES (SCM obj, CTYPE *data) +{ + long i, n; + SCM val; + + SCM_ASSERT (SCM_NIMP (obj) || SCM_NFALSEP (scm_list_p (obj)), + obj, SCM_ARG1, FUNC_NAME); + + if (SCM_NFALSEP (scm_list_p (obj))) + { + SCM list = obj; + for (n = 0; SCM_NFALSEP (scm_pair_p (list)); list = SCM_CDR (list), n++) + { + val = SCM_CAR (list); +#if defined (CTYPEMIN) && defined (CTYPEMAX) + if (SCM_INUMP (val)) + { + long v = SCM_INUM (val); + SCM_ASSERT_RANGE (SCM_ARG1, obj, v >= CTYPEMIN && v <= CTYPEMAX); + } + else +#elif defined (FLOATTYPE1) + if (!SCM_INUMP (val) && !(SCM_BIGP (val) || SCM_REALP (val))) +#else + if (!SCM_INUMP (val) && !SCM_BIGP (val)) +#endif + SCM_WRONG_TYPE_ARG (SCM_ARG1, obj); + } + if (data == NULL) + data = (CTYPE *) malloc (n * sizeof (CTYPE)); + if (data == NULL) + return NULL; + + list = obj; + for (i = 0; SCM_NFALSEP (scm_pair_p (list)); list = SCM_CDR (list), i++) + { + val = SCM_CAR (list); + if (SCM_INUMP (val)) + data[i] = SCM_INUM (val); + else if (SCM_BIGP (val)) + data[i] = (CTYPE) scm_num2long (val, SCM_ARG1, FUNC_NAME); +#ifdef FLOATTYPE1 + else + data[i] = (CTYPE) SCM_REAL_VALUE (val); +#endif + } + return data; + } + + switch (SCM_TYP7 (obj)) + { + case scm_tc7_vector: + case scm_tc7_wvect: + n = SCM_VECTOR_LENGTH (obj); + for (i = 0; i < n; i++) + { + val = SCM_VELTS (obj)[i]; + +#if defined (CTYPEMIN) && defined (CTYPEMAX) + if (SCM_INUMP (val)) + { + long v = SCM_INUM (val); + SCM_ASSERT_RANGE (SCM_ARG1, obj, v >= CTYPEMIN && v <= CTYPEMAX); + } + else +#elif defined (FLOATTYPE1) + if (!SCM_INUMP (val) && !(SCM_BIGP (val) || SCM_REALP (val))) +#else + if (!SCM_INUMP (val) && !SCM_BIGP (val)) +#endif + SCM_WRONG_TYPE_ARG (SCM_ARG1, obj); + } + if (data == NULL) + data = (CTYPE *) malloc (n * sizeof (CTYPE)); + if (data == NULL) + return NULL; + for (i = 0; i < n; i++) + { + val = SCM_VELTS (obj)[i]; + if (SCM_INUMP (val)) + data[i] = (CTYPE) SCM_INUM (val); + else if (SCM_BIGP (val)) + data[i] = (CTYPE) scm_num2long (val, SCM_ARG1, FUNC_NAME); +#ifdef FLOATTYPE1 + else + data[i] = (CTYPE) SCM_REAL_VALUE (val); +#endif + } + break; + +#ifdef HAVE_ARRAYS + case ARRAYTYPE1: +#ifdef ARRAYTYPE2 + case ARRAYTYPE2: +#endif + n = SCM_UVECTOR_LENGTH (obj); + if (data == NULL) + data = (CTYPE *) malloc (n * sizeof (CTYPE)); + if (data == NULL) + return NULL; +#ifdef FLOATTYPE2 + if (SCM_TYP7 (obj) == ARRAYTYPE2) + { + for (i = 0; i < n; i++) + data[i] = ((FLOATTYPE2 *) SCM_UVECTOR_BASE (obj))[i]; + } + else +#endif + memcpy (data, (CTYPE *) SCM_UVECTOR_BASE (obj), n * sizeof (CTYPE)); + break; +#endif /* HAVE_ARRAYS */ + +#ifdef STRINGTYPE + case scm_tc7_string: + n = SCM_STRING_LENGTH (obj); + if (data == NULL) + data = (CTYPE *) malloc (n * sizeof (CTYPE)); + if (data == NULL) + return NULL; + memcpy (data, SCM_STRING_CHARS (obj), n * sizeof (CTYPE)); + break; +#endif /* STRINGTYPE */ + + default: + SCM_WRONG_TYPE_ARG (SCM_ARG1, obj); + } + return data; +} +#undef FUNC_NAME + + +#if HAVE_ARRAYS + +/* Converts a C array into a uniform vector, returns SCM_UNDEFINED if out + of memory. */ +#define FUNC_NAME CTYPES2UVECT_FN +SCM +CTYPES2UVECT (const CTYPE *data, long n) +{ + char *v; + + SCM_ASSERT_RANGE (SCM_ARG2, scm_long2num (n), + n > 0 && n <= SCM_UVECTOR_MAX_LENGTH); + if ((v = (char *) SCM_MUST_MALLOC_TYPE_NUM (CTYPE, n)) == NULL) + return SCM_UNDEFINED; + memcpy (v, data, n * sizeof (CTYPE)); + return scm_alloc_cell (SCM_MAKE_UVECTOR_TAG (n, UVECTTYPE), (scm_t_bits) v); +} +#undef FUNC_NAME + +#ifdef UVECTTYPE2 +#define FUNC_NAME CTYPES2UVECT_FN2 +SCM +CTYPES2UVECT2 (const unsigned CTYPE *data, long n) +{ + char *v; + + SCM_ASSERT_RANGE (SCM_ARG2, scm_long2num (n), + n > 0 && n <= SCM_UVECTOR_MAX_LENGTH); + if ((v = (char *) SCM_MUST_MALLOC_TYPE_NUM (unsigned CTYPE, n)) == NULL) + return SCM_UNDEFINED; + memcpy (v, data, n * sizeof (unsigned CTYPE)); + return scm_alloc_cell (SCM_MAKE_UVECTOR_TAG (n, UVECTTYPE2), (scm_t_bits) v); +} +#undef FUNC_NAME +#endif /* UVECTTYPE2 */ + +#endif /* HAVE_ARRAYS */ + +/* Converts a C array into a vector. */ +#define FUNC_NAME CTYPES2SCM_FN +SCM +CTYPES2SCM (const CTYPE *data, long n) +{ + long i; + SCM v, *velts; + + SCM_ASSERT_RANGE (SCM_ARG2, scm_long2num (n), + n > 0 && n <= SCM_VECTOR_MAX_LENGTH); + v = scm_c_make_vector (n, SCM_UNSPECIFIED); + velts = SCM_VELTS (v); + for (i = 0; i < n; i++) +#ifdef FLOATTYPE1 + velts[i] = scm_make_real ((double) data[i]); +#elif defined (CTYPEFIXABLE) + velts[i] = SCM_MAKINUM (data[i]); +#else + velts[i] = (SCM_FIXABLE (data[i]) ? SCM_MAKINUM (data[i]) : + scm_i_long2big (data[i])); +#endif + return v; +} +#undef FUNC_NAME + +/* cleanup of conditionals */ +#undef SCM2CTYPES +#undef SCM2CTYPES_FN +#undef CTYPES2SCM +#undef CTYPES2SCM_FN +#undef CTYPE +#undef CTYPES2UVECT +#undef CTYPES2UVECT_FN +#ifdef CTYPEFIXABLE +#undef CTYPEFIXABLE +#endif +#undef UVECTTYPE +#ifdef UVECTTYPE2 +#undef CTYPES2UVECT2 +#undef CTYPES2UVECT_FN2 +#undef UVECTTYPE2 +#endif +#ifdef CTYPEMIN +#undef CTYPEMIN +#endif +#ifdef CTYPEMAX +#undef CTYPEMAX +#endif +#undef ARRAYTYPE1 +#ifdef ARRAYTYPE2 +#undef ARRAYTYPE2 +#endif +#ifdef FLOATTYPE1 +#undef FLOATTYPE1 +#endif +#ifdef FLOATTYPE2 +#undef FLOATTYPE2 +#endif +#ifdef STRINGTYPE +#undef STRINGTYPE +#endif + +/* + Local Variables: + c-file-style: "gnu" + End: +*/