mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
2002-01-31 Stefan Jahn <stefan@lkcc.org>
* 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-31 Stefan Jahn <stefan@lkcc.org>
* configure.in: Add -DLIBLTDL_DLL_IMPORT to INCLTDL when using
`libltdl.dll'.
This commit is contained in:
Stefan Jahn
parent
bbd26b5ae5
commit
1fa86ca526
7 changed files with 492 additions and 6 deletions
|
|
@ -1,3 +1,8 @@
|
|||
2002-01-31 Stefan Jahn <stefan@lkcc.org>
|
||||
|
||||
* configure.in: Add -DLIBLTDL_DLL_IMPORT to INCLTDL when using
|
||||
`libltdl.dll'.
|
||||
|
||||
2002-01-28 Stefan Jahn <stefan@lkcc.org>
|
||||
|
||||
* configure.in (guile_cv_have_uint32_t): Look also 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)
|
||||
|
|
|
|||
|
|
@ -1,3 +1,11 @@
|
|||
2002-01-31 Stefan Jahn <stefan@lkcc.org>
|
||||
|
||||
* 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 <stefan@lkcc.org>
|
||||
|
||||
* symbols.c (scm_c_symbol2str): New function, replacement for
|
||||
|
|
|
|||
|
|
@ -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 <libguile/mumble.h>.
|
||||
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 \
|
||||
|
|
|
|||
146
libguile/convert.c
Normal file
146
libguile/convert.c
Normal file
|
|
@ -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:
|
||||
*/
|
||||
76
libguile/convert.h
Normal file
76
libguile/convert.h
Normal file
|
|
@ -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 */
|
||||
247
libguile/convert.i.c
Normal file
247
libguile/convert.i.c
Normal file
|
|
@ -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:
|
||||
*/
|
||||
Loading…
Add table
Add a link
Reference in a new issue