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))
|
if (SCM_FIXABLE (val))
|
||||||
return SCM_I_MAKINUM (val);
|
return SCM_I_MAKINUM (val);
|
||||||
else if (val >= LONG_MIN && val <= LONG_MAX)
|
else if (val >= LONG_MIN && val <= LONG_MAX)
|
||||||
{
|
return scm_i_long2big (val);
|
||||||
SCM z = scm_double_cell (scm_tc16_big, 0, 0, 0);
|
|
||||||
mpz_init_set_si (SCM_I_BIG_MPZ (z), val);
|
|
||||||
return z;
|
|
||||||
}
|
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
SCM z = scm_double_cell (scm_tc16_big, 0, 0, 0);
|
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))
|
if (SCM_POSFIXABLE (val))
|
||||||
return SCM_I_MAKINUM (val);
|
return SCM_I_MAKINUM (val);
|
||||||
else if (val <= ULONG_MAX)
|
else if (val <= ULONG_MAX)
|
||||||
{
|
return scm_i_ulong2big (val);
|
||||||
SCM z = scm_double_cell (scm_tc16_big, 0, 0, 0);
|
|
||||||
mpz_init_set_ui (SCM_I_BIG_MPZ (z), val);
|
|
||||||
return z;
|
|
||||||
}
|
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
SCM z = scm_double_cell (scm_tc16_big, 0, 0, 0);
|
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;
|
res = SCM_EOL;
|
||||||
for (md = registered_mods; md; md = md->link)
|
for (md = registered_mods; md; md = md->link)
|
||||||
res = scm_cons (scm_cons (scm_makfrom0str (md->module_name),
|
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);
|
res);
|
||||||
return 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)))
|
#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.
|
/* 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;
|
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_C_INLINE_KEYWORD static SCM
|
||||||
scm_i_clonebig (SCM src_big, int same_sign_p)
|
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);
|
scm_remember_upto_here_1 (x);
|
||||||
return (SCM_POSFIXABLE (result)
|
return (SCM_POSFIXABLE (result)
|
||||||
? SCM_I_MAKINUM (result)
|
? SCM_I_MAKINUM (result)
|
||||||
: scm_ulong2num (result));
|
: scm_from_ulong (result));
|
||||||
}
|
}
|
||||||
else if (SCM_BIGP (y))
|
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:
|
/* Emulating 2's complement bignums with sign magnitude arithmetic:
|
||||||
|
|
||||||
Logand:
|
Logand:
|
||||||
|
|
@ -4114,7 +4126,8 @@ scm_difference (SCM x, SCM y)
|
||||||
|
|
||||||
scm_remember_upto_here_1 (x);
|
scm_remember_upto_here_1 (x);
|
||||||
if (sgn_x == 0)
|
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
|
else
|
||||||
{
|
{
|
||||||
SCM result = scm_i_mkbig ();
|
SCM result = scm_i_mkbig ();
|
||||||
|
|
@ -5517,124 +5530,6 @@ SCM_DEFINE (scm_rationalize, "rationalize", 2, 0, 0,
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#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 NUM2FLOAT scm_num2float
|
||||||
#define FLOAT2NUM scm_float2num
|
#define FLOAT2NUM scm_float2num
|
||||||
#define FTYPE float
|
#define FTYPE float
|
||||||
|
|
@ -5852,116 +5747,6 @@ scm_from_double (double val)
|
||||||
return scm_make_real (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
|
void
|
||||||
scm_init_numbers ()
|
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_inexact_to_exact (SCM z);
|
||||||
SCM_API SCM scm_trunc (SCM x);
|
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_float2num (float n);
|
||||||
SCM_API SCM scm_double2num (double n);
|
SCM_API SCM scm_double2num (double n);
|
||||||
SCM_API float scm_num2float (SCM num, unsigned long int pos,
|
SCM_API float scm_num2float (SCM num, unsigned long int pos,
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue