mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-20 02:30:23 +02:00
* discouraged.h, discouraged.c: New files.
* deprecated.h (SCM_FALSEP, SCM_NFALSEP, SCM_BOOLP, SCM_EQ_P, SCM_NEGATE_BOOL, SCM_BOOL, SCM_BOOT_NOT): Promoted from being deprecated to being discouraged by moving to discouraged.h. * numbers.h, numbers.c, discouraged.h, discouraged.c (scm_short2num, scm_ushort2num, scm_int2num, scm_uint2num, scm_long2num, scm_ulong2num, scm_size2num, scm_ptrdiff2num, scm_num2short, scm_num2ushort, scm_num2int, scm_num2uint, scm_num2long, scm_num2ulong, scm_num2size, scm_num2ptrdiff, scm_long_long2num, scm_ulong_long2num, scm_num2long_long, scm_num2ulong_long): Discouraged by moving to discouraged.h and discouraged.c and reimplementing in terms of scm_from_* and scm_to_*. * numbers.h, numbers.c: Removed GUILE_DEBUG code. (scm_i_short2big, scm_i_ushort2big, scm_i_int2big, scm_i_uint2big, scm_i_size2big, scm_i_ptrdiff2big): Removed. (scm_i_long2big, scm_i_ulong2big): New, explicit definitions. * conv-integer.i.c, conv-uinteger.i.c: Use them instead of explicit code.
This commit is contained in:
Marius Vollmer
parent
385609b992
commit
c71b07063e
8 changed files with 191 additions and 304 deletions
|
|
@ -112,11 +112,7 @@ SCM_FROM_TYPE_PROTO (TYPE val)
|
|||
if (SCM_FIXABLE (val))
|
||||
return SCM_I_MAKINUM (val);
|
||||
else if (val >= LONG_MIN && val <= LONG_MAX)
|
||||
{
|
||||
SCM z = scm_double_cell (scm_tc16_big, 0, 0, 0);
|
||||
mpz_init_set_si (SCM_I_BIG_MPZ (z), val);
|
||||
return z;
|
||||
}
|
||||
return scm_i_long2big (val);
|
||||
else
|
||||
{
|
||||
SCM z = scm_double_cell (scm_tc16_big, 0, 0, 0);
|
||||
|
|
|
|||
|
|
@ -96,11 +96,7 @@ SCM_FROM_TYPE_PROTO (TYPE val)
|
|||
if (SCM_POSFIXABLE (val))
|
||||
return SCM_I_MAKINUM (val);
|
||||
else if (val <= ULONG_MAX)
|
||||
{
|
||||
SCM z = scm_double_cell (scm_tc16_big, 0, 0, 0);
|
||||
mpz_init_set_ui (SCM_I_BIG_MPZ (z), val);
|
||||
return z;
|
||||
}
|
||||
return scm_i_ulong2big (val);
|
||||
else
|
||||
{
|
||||
SCM z = scm_double_cell (scm_tc16_big, 0, 0, 0);
|
||||
|
|
|
|||
|
|
@ -180,7 +180,7 @@ SCM_DEFINE (scm_registered_modules, "c-registered-modules", 0, 0, 0,
|
|||
res = SCM_EOL;
|
||||
for (md = registered_mods; md; md = md->link)
|
||||
res = scm_cons (scm_cons (scm_makfrom0str (md->module_name),
|
||||
scm_ulong2num ((unsigned long) md->init_func)),
|
||||
scm_from_ulong ((unsigned long) md->init_func)),
|
||||
res);
|
||||
return res;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -305,30 +305,6 @@ SCM_API SCM scm_gentemp (SCM prefix, SCM obarray);
|
|||
|
||||
#define SCM_CELL_WORD_LOC(x, n) ((scm_t_bits*)SCM_CELL_OBJECT_LOC((x),(n)))
|
||||
|
||||
/* Deprecated because they do not follow the naming convention. that
|
||||
is, they endiin "P" but return a C boolean. Also, SCM_BOOLP
|
||||
evaluates its argument twice.
|
||||
*/
|
||||
|
||||
#define SCM_FALSEP scm_is_false
|
||||
#define SCM_NFALSEP scm_is_true
|
||||
#define SCM_BOOLP scm_is_bool
|
||||
#define SCM_EQ_P scm_is_eq
|
||||
|
||||
|
||||
/* Convert from a C boolean to a SCM boolean value */
|
||||
#define SCM_BOOL scm_from_bool
|
||||
|
||||
/* Convert from a C boolean to a SCM boolean value and negate it */
|
||||
#define SCM_NEGATE_BOOL(f) scm_from_bool(!(f))
|
||||
|
||||
/* SCM_BOOL_NOT returns the other boolean.
|
||||
* The order of ^s here is important for Borland C++ (!?!?!)
|
||||
*/
|
||||
#define SCM_BOOL_NOT(x) (SCM_PACK (SCM_UNPACK (x) \
|
||||
^ (SCM_UNPACK (SCM_BOOL_T) \
|
||||
^ SCM_UNPACK (SCM_BOOL_F))))
|
||||
|
||||
/* Users shouldn't know about INUMs.
|
||||
*/
|
||||
|
||||
|
|
|
|||
62
libguile/discouraged.c
Normal file
62
libguile/discouraged.c
Normal file
|
|
@ -0,0 +1,62 @@
|
|||
/* This file contains definitions for discouraged features. When you
|
||||
discourage something, move it here when that is feasible.
|
||||
*/
|
||||
|
||||
/* Copyright (C) 2003 Free Software Foundation, Inc.
|
||||
*
|
||||
* This library is free software; you can redistribute it and/or
|
||||
* modify it under the terms of the GNU Lesser General Public
|
||||
* License as published by the Free Software Foundation; either
|
||||
* version 2.1 of the License, or (at your option) any later version.
|
||||
*
|
||||
* This library 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
|
||||
* Lesser General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU Lesser General Public
|
||||
* License along with this library; if not, write to the Free Software
|
||||
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
||||
*/
|
||||
|
||||
#include "libguile.h"
|
||||
|
||||
#if (SCM_ENABLE_DISCOURAGED == 1)
|
||||
|
||||
#define DEFFROM(t,f1,f2) SCM f1(t x) { return f2 (x); }
|
||||
#define DEFTO(t,f1,f2) t f1(SCM x, unsigned long pos, const char *s_caller) \
|
||||
{ return f2 (x); }
|
||||
|
||||
DEFFROM (short, scm_short2num, scm_from_short);
|
||||
DEFFROM (unsigned short, scm_ushort2num, scm_from_ushort);
|
||||
DEFFROM (int, scm_int2num, scm_from_int);
|
||||
DEFFROM (unsigned int, scm_uint2num, scm_from_uint);
|
||||
DEFFROM (long, scm_long2num, scm_from_long);
|
||||
DEFFROM (unsigned long, scm_ulong2num, scm_from_ulong);
|
||||
DEFFROM (size_t, scm_size2num, scm_from_size_t);
|
||||
DEFFROM (ptrdiff_t, scm_ptrdiff2num, scm_from_ssize_t);
|
||||
|
||||
DEFTO (short, scm_num2short, scm_to_short);
|
||||
DEFTO (unsigned short, scm_num2ushort, scm_to_ushort);
|
||||
DEFTO (int, scm_num2int, scm_to_int);
|
||||
DEFTO (unsigned int, scm_num2uint, scm_to_uint);
|
||||
DEFTO (long, scm_num2long, scm_to_long);
|
||||
DEFTO (unsigned long, scm_num2ulong, scm_to_ulong);
|
||||
DEFTO (size_t, scm_num2size, scm_to_size_t);
|
||||
DEFTO (ptrdiff_t, scm_num2ptrdiff, scm_to_ssize_t);
|
||||
|
||||
#if SCM_SIZEOF_LONG_LONG != 0
|
||||
DEFFROM (long long, scm_long_long2num, scm_from_long_long);
|
||||
DEFFROM (unsigned long long, scm_ulong_long2num, scm_from_ulong_long);
|
||||
DEFTO (long long, scm_num2long_long, scm_to_long_long);
|
||||
DEFTO (unsigned long long, scm_num2ulong_long, scm_to_ulong_long);
|
||||
#endif
|
||||
|
||||
|
||||
void
|
||||
scm_i_init_discouraged (void)
|
||||
{
|
||||
#include "libguile/discouraged.x"
|
||||
}
|
||||
|
||||
#endif
|
||||
105
libguile/discouraged.h
Normal file
105
libguile/discouraged.h
Normal file
|
|
@ -0,0 +1,105 @@
|
|||
/* This file contains definitions for discouraged features. When you
|
||||
discourage something, move it here when that is feasible.
|
||||
|
||||
A discouraged feature is one that shouldn't be used in new code
|
||||
since we have a better alternative now. However, there is nothing
|
||||
wrong with using the old feature, so it is OK to continue to use
|
||||
it.
|
||||
|
||||
Eventually, discouraged features can be deprecated since removing
|
||||
them will make Guile simpler.
|
||||
*/
|
||||
|
||||
#ifndef SCM_DISCOURAGED_H
|
||||
#define SCM_DISCOURAGED_H
|
||||
|
||||
/* Copyright (C) 2004 Free Software Foundation, Inc.
|
||||
*
|
||||
* This library is free software; you can redistribute it and/or
|
||||
* modify it under the terms of the GNU Lesser General Public
|
||||
* License as published by the Free Software Foundation; either
|
||||
* version 2.1 of the License, or (at your option) any later version.
|
||||
*
|
||||
* This library 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
|
||||
* Lesser General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU Lesser General Public
|
||||
* License along with this library; if not, write to the Free Software
|
||||
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
||||
*/
|
||||
|
||||
#include "libguile/__scm.h"
|
||||
|
||||
#if SCM_ENABLE_DISCOURAGED == 1
|
||||
|
||||
/* Discouraged because they do not follow the naming convention. That
|
||||
is, they end in "P" but return a C boolean. Also, SCM_BOOLP
|
||||
evaluates its argument twice.
|
||||
*/
|
||||
|
||||
#define SCM_FALSEP scm_is_false
|
||||
#define SCM_NFALSEP scm_is_true
|
||||
#define SCM_BOOLP scm_is_bool
|
||||
#define SCM_EQ_P scm_is_eq
|
||||
|
||||
|
||||
/* Convert from a C boolean to a SCM boolean value */
|
||||
#define SCM_BOOL scm_from_bool
|
||||
|
||||
/* Convert from a C boolean to a SCM boolean value and negate it */
|
||||
#define SCM_NEGATE_BOOL(f) scm_from_bool(!(f))
|
||||
|
||||
/* SCM_BOOL_NOT returns the other boolean.
|
||||
* The order of ^s here is important for Borland C++ (!?!?!)
|
||||
*/
|
||||
#define SCM_BOOL_NOT(x) (SCM_PACK (SCM_UNPACK (x) \
|
||||
^ (SCM_UNPACK (SCM_BOOL_T) \
|
||||
^ SCM_UNPACK (SCM_BOOL_F))))
|
||||
|
||||
/* scm_to_int, scm_from_int are the official functions to do the job,
|
||||
but there is nothing wrong with using scm_num2int, etc.
|
||||
|
||||
These could be trivially defined via macros, but we leave them as
|
||||
functions since existing code may take their addresses.
|
||||
*/
|
||||
|
||||
SCM_API SCM scm_short2num (short n);
|
||||
SCM_API SCM scm_ushort2num (unsigned short n);
|
||||
SCM_API SCM scm_int2num (int n);
|
||||
SCM_API SCM scm_uint2num (unsigned int n);
|
||||
SCM_API SCM scm_long2num (long n);
|
||||
SCM_API SCM scm_ulong2num (unsigned long n);
|
||||
SCM_API SCM scm_size2num (size_t n);
|
||||
SCM_API SCM scm_ptrdiff2num (scm_t_ptrdiff n);
|
||||
SCM_API short scm_num2short (SCM num, unsigned long int pos,
|
||||
const char *s_caller);
|
||||
SCM_API unsigned short scm_num2ushort (SCM num, unsigned long int pos,
|
||||
const char *s_caller);
|
||||
SCM_API int scm_num2int (SCM num, unsigned long int pos,
|
||||
const char *s_caller);
|
||||
SCM_API unsigned int scm_num2uint (SCM num, unsigned long int pos,
|
||||
const char *s_caller);
|
||||
SCM_API long scm_num2long (SCM num, unsigned long int pos,
|
||||
const char *s_caller);
|
||||
SCM_API unsigned long scm_num2ulong (SCM num, unsigned long int pos,
|
||||
const char *s_caller);
|
||||
SCM_API scm_t_ptrdiff scm_num2ptrdiff (SCM num, unsigned long int pos,
|
||||
const char *s_caller);
|
||||
SCM_API size_t scm_num2size (SCM num, unsigned long int pos,
|
||||
const char *s_caller);
|
||||
#if SCM_SIZEOF_LONG_LONG != 0
|
||||
SCM_API SCM scm_long_long2num (long long sl);
|
||||
SCM_API SCM scm_ulong_long2num (unsigned long long sl);
|
||||
SCM_API long long scm_num2long_long (SCM num, unsigned long int pos,
|
||||
const char *s_caller);
|
||||
SCM_API unsigned long long scm_num2ulong_long (SCM num, unsigned long int pos,
|
||||
const char *s_caller);
|
||||
#endif
|
||||
|
||||
void scm_i_init_discouraged (void);
|
||||
|
||||
#endif /* SCM_ENABLE_DISCOURAGED == 1 */
|
||||
|
||||
#endif /* SCM_DISCOURAGED_H */
|
||||
|
|
@ -164,6 +164,24 @@ scm_i_mkbig ()
|
|||
return z;
|
||||
}
|
||||
|
||||
SCM_C_INLINE_KEYWORD SCM
|
||||
scm_i_long2big (long x)
|
||||
{
|
||||
/* Return a newly created bignum initialized to X. */
|
||||
SCM z = scm_double_cell (scm_tc16_big, 0, 0, 0);
|
||||
mpz_init_set_si (SCM_I_BIG_MPZ (z), x);
|
||||
return z;
|
||||
}
|
||||
|
||||
SCM_C_INLINE_KEYWORD SCM
|
||||
scm_i_ulong2big (unsigned long x)
|
||||
{
|
||||
/* Return a newly created bignum initialized to X. */
|
||||
SCM z = scm_double_cell (scm_tc16_big, 0, 0, 0);
|
||||
mpz_init_set_ui (SCM_I_BIG_MPZ (z), x);
|
||||
return z;
|
||||
}
|
||||
|
||||
SCM_C_INLINE_KEYWORD static SCM
|
||||
scm_i_clonebig (SCM src_big, int same_sign_p)
|
||||
{
|
||||
|
|
@ -1048,7 +1066,7 @@ scm_gcd (SCM x, SCM y)
|
|||
scm_remember_upto_here_1 (x);
|
||||
return (SCM_POSFIXABLE (result)
|
||||
? SCM_I_MAKINUM (result)
|
||||
: scm_ulong2num (result));
|
||||
: scm_from_ulong (result));
|
||||
}
|
||||
else if (SCM_BIGP (y))
|
||||
{
|
||||
|
|
@ -1131,12 +1149,6 @@ scm_lcm (SCM n1, SCM n2)
|
|||
}
|
||||
}
|
||||
|
||||
#ifndef scm_long2num
|
||||
#define SCM_LOGOP_RETURN(x) scm_ulong2num(x)
|
||||
#else
|
||||
#define SCM_LOGOP_RETURN(x) SCM_I_MAKINUM(x)
|
||||
#endif
|
||||
|
||||
/* Emulating 2's complement bignums with sign magnitude arithmetic:
|
||||
|
||||
Logand:
|
||||
|
|
@ -4114,7 +4126,8 @@ scm_difference (SCM x, SCM y)
|
|||
|
||||
scm_remember_upto_here_1 (x);
|
||||
if (sgn_x == 0)
|
||||
return SCM_FIXABLE (-yy) ? SCM_I_MAKINUM (-yy) : scm_long2num (-yy);
|
||||
return (SCM_FIXABLE (-yy) ?
|
||||
SCM_I_MAKINUM (-yy) : scm_from_long (-yy));
|
||||
else
|
||||
{
|
||||
SCM result = scm_i_mkbig ();
|
||||
|
|
@ -5517,124 +5530,6 @@ SCM_DEFINE (scm_rationalize, "rationalize", 2, 0, 0,
|
|||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
/* Parameters for creating integer conversion routines.
|
||||
|
||||
Define the following preprocessor macros before including
|
||||
"libguile/num2integral.i.c":
|
||||
|
||||
NUM2INTEGRAL - the name of the function for converting from a
|
||||
Scheme object to the integral type. This function will be
|
||||
defined when including "num2integral.i.c".
|
||||
|
||||
INTEGRAL2NUM - the name of the function for converting from the
|
||||
integral type to a Scheme object. This function will be defined.
|
||||
|
||||
INTEGRAL2BIG - the name of an internal function that createas a
|
||||
bignum from the integral type. This function will be defined.
|
||||
The name should start with "scm_i_".
|
||||
|
||||
ITYPE - the name of the integral type.
|
||||
|
||||
UNSIGNED - Define this to 1 when ITYPE is an unsigned type. Define
|
||||
it to 0 otherwise.
|
||||
|
||||
UNSIGNED_ITYPE - the name of the the unsigned variant of the
|
||||
integral type. If you don't define this, it defaults to
|
||||
"unsigned ITYPE" for signed types and simply "ITYPE" for unsigned
|
||||
ones.
|
||||
|
||||
SIZEOF_ITYPE - an expression giving the size of the integral type
|
||||
in bytes. This expression must be computable by the
|
||||
preprocessor. (SIZEOF_FOO values are calculated by configure.in
|
||||
for common types).
|
||||
|
||||
*/
|
||||
|
||||
#define NUM2INTEGRAL scm_num2short
|
||||
#define INTEGRAL2NUM scm_short2num
|
||||
#define INTEGRAL2BIG scm_i_short2big
|
||||
#define UNSIGNED 0
|
||||
#define ITYPE short
|
||||
#define SIZEOF_ITYPE SIZEOF_SHORT
|
||||
#include "libguile/num2integral.i.c"
|
||||
|
||||
#define NUM2INTEGRAL scm_num2ushort
|
||||
#define INTEGRAL2NUM scm_ushort2num
|
||||
#define INTEGRAL2BIG scm_i_ushort2big
|
||||
#define UNSIGNED 1
|
||||
#define ITYPE unsigned short
|
||||
#define SIZEOF_ITYPE SIZEOF_UNSIGNED_SHORT
|
||||
#include "libguile/num2integral.i.c"
|
||||
|
||||
#define NUM2INTEGRAL scm_num2int
|
||||
#define INTEGRAL2NUM scm_int2num
|
||||
#define INTEGRAL2BIG scm_i_int2big
|
||||
#define UNSIGNED 0
|
||||
#define ITYPE int
|
||||
#define SIZEOF_ITYPE SIZEOF_INT
|
||||
#include "libguile/num2integral.i.c"
|
||||
|
||||
#define NUM2INTEGRAL scm_num2uint
|
||||
#define INTEGRAL2NUM scm_uint2num
|
||||
#define INTEGRAL2BIG scm_i_uint2big
|
||||
#define UNSIGNED 1
|
||||
#define ITYPE unsigned int
|
||||
#define SIZEOF_ITYPE SIZEOF_UNSIGNED_INT
|
||||
#include "libguile/num2integral.i.c"
|
||||
|
||||
#define NUM2INTEGRAL scm_num2long
|
||||
#define INTEGRAL2NUM scm_long2num
|
||||
#define INTEGRAL2BIG scm_i_long2big
|
||||
#define UNSIGNED 0
|
||||
#define ITYPE long
|
||||
#define SIZEOF_ITYPE SIZEOF_LONG
|
||||
#include "libguile/num2integral.i.c"
|
||||
|
||||
#define NUM2INTEGRAL scm_num2ulong
|
||||
#define INTEGRAL2NUM scm_ulong2num
|
||||
#define INTEGRAL2BIG scm_i_ulong2big
|
||||
#define UNSIGNED 1
|
||||
#define ITYPE unsigned long
|
||||
#define SIZEOF_ITYPE SIZEOF_UNSIGNED_LONG
|
||||
#include "libguile/num2integral.i.c"
|
||||
|
||||
#define NUM2INTEGRAL scm_num2ptrdiff
|
||||
#define INTEGRAL2NUM scm_ptrdiff2num
|
||||
#define INTEGRAL2BIG scm_i_ptrdiff2big
|
||||
#define UNSIGNED 0
|
||||
#define ITYPE scm_t_ptrdiff
|
||||
#define UNSIGNED_ITYPE size_t
|
||||
#define SIZEOF_ITYPE SCM_SIZEOF_SCM_T_PTRDIFF
|
||||
#include "libguile/num2integral.i.c"
|
||||
|
||||
#define NUM2INTEGRAL scm_num2size
|
||||
#define INTEGRAL2NUM scm_size2num
|
||||
#define INTEGRAL2BIG scm_i_size2big
|
||||
#define UNSIGNED 1
|
||||
#define ITYPE size_t
|
||||
#define SIZEOF_ITYPE SIZEOF_SIZE_T
|
||||
#include "libguile/num2integral.i.c"
|
||||
|
||||
#if SCM_SIZEOF_LONG_LONG != 0
|
||||
|
||||
#define NUM2INTEGRAL scm_num2long_long
|
||||
#define INTEGRAL2NUM scm_long_long2num
|
||||
#define INTEGRAL2BIG scm_i_long_long2big
|
||||
#define UNSIGNED 0
|
||||
#define ITYPE long long
|
||||
#define SIZEOF_ITYPE SIZEOF_LONG_LONG
|
||||
#include "libguile/num2integral.i.c"
|
||||
|
||||
#define NUM2INTEGRAL scm_num2ulong_long
|
||||
#define INTEGRAL2NUM scm_ulong_long2num
|
||||
#define INTEGRAL2BIG scm_i_ulong_long2big
|
||||
#define UNSIGNED 1
|
||||
#define ITYPE unsigned long long
|
||||
#define SIZEOF_ITYPE SIZEOF_UNSIGNED_LONG_LONG
|
||||
#include "libguile/num2integral.i.c"
|
||||
|
||||
#endif /* SCM_SIZEOF_LONG_LONG != 0 */
|
||||
|
||||
#define NUM2FLOAT scm_num2float
|
||||
#define FLOAT2NUM scm_float2num
|
||||
#define FTYPE float
|
||||
|
|
@ -5852,116 +5747,6 @@ scm_from_double (double val)
|
|||
return scm_make_real (val);
|
||||
}
|
||||
|
||||
#ifdef GUILE_DEBUG
|
||||
|
||||
#ifndef SIZE_MAX
|
||||
#define SIZE_MAX ((size_t) (-1))
|
||||
#endif
|
||||
#ifndef PTRDIFF_MIN
|
||||
#define PTRDIFF_MIN \
|
||||
((scm_t_ptrdiff) ((scm_t_ptrdiff) 1 \
|
||||
<< ((sizeof (scm_t_ptrdiff) * SCM_CHAR_BIT) - 1)))
|
||||
#endif
|
||||
#ifndef PTRDIFF_MAX
|
||||
#define PTRDIFF_MAX (~ PTRDIFF_MIN)
|
||||
#endif
|
||||
|
||||
#define CHECK(type, v) \
|
||||
do \
|
||||
{ \
|
||||
if ((v) != scm_num2##type (scm_##type##2num (v), 1, "check_sanity")) \
|
||||
abort (); \
|
||||
} \
|
||||
while (0)
|
||||
|
||||
static void
|
||||
check_sanity ()
|
||||
{
|
||||
CHECK (short, 0);
|
||||
CHECK (ushort, 0U);
|
||||
CHECK (int, 0);
|
||||
CHECK (uint, 0U);
|
||||
CHECK (long, 0L);
|
||||
CHECK (ulong, 0UL);
|
||||
CHECK (size, 0);
|
||||
CHECK (ptrdiff, 0);
|
||||
|
||||
CHECK (short, -1);
|
||||
CHECK (int, -1);
|
||||
CHECK (long, -1L);
|
||||
CHECK (ptrdiff, -1);
|
||||
|
||||
CHECK (short, SHRT_MAX);
|
||||
CHECK (short, SHRT_MIN);
|
||||
CHECK (ushort, USHRT_MAX);
|
||||
CHECK (int, INT_MAX);
|
||||
CHECK (int, INT_MIN);
|
||||
CHECK (uint, UINT_MAX);
|
||||
CHECK (long, LONG_MAX);
|
||||
CHECK (long, LONG_MIN);
|
||||
CHECK (ulong, ULONG_MAX);
|
||||
CHECK (size, SIZE_MAX);
|
||||
CHECK (ptrdiff, PTRDIFF_MAX);
|
||||
CHECK (ptrdiff, PTRDIFF_MIN);
|
||||
|
||||
#if SCM_SIZEOF_LONG_LONG != 0
|
||||
CHECK (long_long, 0LL);
|
||||
CHECK (ulong_long, 0ULL);
|
||||
CHECK (long_long, -1LL);
|
||||
CHECK (long_long, SCM_I_LLONG_MAX);
|
||||
CHECK (long_long, SCM_I_LLONG_MIN);
|
||||
CHECK (ulong_long, SCM_I_ULLONG_MAX);
|
||||
#endif
|
||||
}
|
||||
|
||||
#undef CHECK
|
||||
|
||||
#define CHECK \
|
||||
scm_internal_catch (SCM_BOOL_T, check_body, &data, check_handler, &data); \
|
||||
if (scm_is_true (data)) abort();
|
||||
|
||||
static SCM
|
||||
check_body (void *data)
|
||||
{
|
||||
SCM num = *(SCM *) data;
|
||||
scm_num2ulong (num, 1, NULL);
|
||||
|
||||
return SCM_UNSPECIFIED;
|
||||
}
|
||||
|
||||
static SCM
|
||||
check_handler (void *data, SCM tag, SCM throw_args)
|
||||
{
|
||||
SCM *num = (SCM *) data;
|
||||
*num = SCM_BOOL_F;
|
||||
|
||||
return SCM_UNSPECIFIED;
|
||||
}
|
||||
|
||||
SCM_DEFINE (scm_sys_check_number_conversions, "%check-number-conversions", 0, 0, 0,
|
||||
(void),
|
||||
"Number conversion sanity checking.")
|
||||
#define FUNC_NAME s_scm_sys_check_number_conversions
|
||||
{
|
||||
SCM data = SCM_I_MAKINUM (-1);
|
||||
CHECK;
|
||||
data = scm_int2num (INT_MIN);
|
||||
CHECK;
|
||||
data = scm_ulong2num (ULONG_MAX);
|
||||
data = scm_difference (SCM_INUM0, data);
|
||||
CHECK;
|
||||
data = scm_ulong2num (ULONG_MAX);
|
||||
data = scm_sum (SCM_I_MAKINUM (1), data); data = scm_difference (SCM_INUM0, data);
|
||||
CHECK;
|
||||
data = scm_int2num (-10000); data = scm_product (data, data); data = scm_product (data, data);
|
||||
CHECK;
|
||||
|
||||
return SCM_UNSPECIFIED;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
#endif
|
||||
|
||||
void
|
||||
scm_init_numbers ()
|
||||
{
|
||||
|
|
|
|||
|
|
@ -258,39 +258,6 @@ SCM_API SCM scm_exact_to_inexact (SCM z);
|
|||
SCM_API SCM scm_inexact_to_exact (SCM z);
|
||||
SCM_API SCM scm_trunc (SCM x);
|
||||
|
||||
SCM_API SCM scm_short2num (short n);
|
||||
SCM_API SCM scm_ushort2num (unsigned short n);
|
||||
SCM_API SCM scm_int2num (int n);
|
||||
SCM_API SCM scm_uint2num (unsigned int n);
|
||||
SCM_API SCM scm_long2num (long n);
|
||||
SCM_API SCM scm_ulong2num (unsigned long n);
|
||||
SCM_API SCM scm_size2num (size_t n);
|
||||
SCM_API SCM scm_ptrdiff2num (scm_t_ptrdiff n);
|
||||
SCM_API short scm_num2short (SCM num, unsigned long int pos,
|
||||
const char *s_caller);
|
||||
SCM_API unsigned short scm_num2ushort (SCM num, unsigned long int pos,
|
||||
const char *s_caller);
|
||||
SCM_API int scm_num2int (SCM num, unsigned long int pos,
|
||||
const char *s_caller);
|
||||
SCM_API unsigned int scm_num2uint (SCM num, unsigned long int pos,
|
||||
const char *s_caller);
|
||||
SCM_API long scm_num2long (SCM num, unsigned long int pos,
|
||||
const char *s_caller);
|
||||
SCM_API unsigned long scm_num2ulong (SCM num, unsigned long int pos,
|
||||
const char *s_caller);
|
||||
SCM_API scm_t_ptrdiff scm_num2ptrdiff (SCM num, unsigned long int pos,
|
||||
const char *s_caller);
|
||||
SCM_API size_t scm_num2size (SCM num, unsigned long int pos,
|
||||
const char *s_caller);
|
||||
#if SCM_SIZEOF_LONG_LONG != 0
|
||||
SCM_API SCM scm_long_long2num (long long sl);
|
||||
SCM_API SCM scm_ulong_long2num (unsigned long long sl);
|
||||
SCM_API long long scm_num2long_long (SCM num, unsigned long int pos,
|
||||
const char *s_caller);
|
||||
SCM_API unsigned long long scm_num2ulong_long (SCM num, unsigned long int pos,
|
||||
const char *s_caller);
|
||||
#endif
|
||||
|
||||
SCM_API SCM scm_float2num (float n);
|
||||
SCM_API SCM scm_double2num (double n);
|
||||
SCM_API float scm_num2float (SCM num, unsigned long int pos,
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue