[bpt/guile.git] / libguile / numbers.h

/* classes: h_files */

#ifndef NUMBERSH
#define NUMBERSH
/* Copyright (C) 1995,1996,1998,2000,2001 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.  */

/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
   gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
\f

#include "libguile/__scm.h"
#include "libguile/print.h"

\f

/* Immediate Numbers 
 *
 * Inums are exact integer data that fits within an SCM word.
 *
 * SCM_INUMP applies only to values known to be Scheme objects.
 * In particular, SCM_INUMP (SCM_CAR (x)) is valid only if x is known
 * to be a SCM_CONSP.  If x is only known to be a SCM_NIMP, 
 * SCM_INUMP (SCM_CAR (x)) can give wrong answers.
 */

#define SCM_I_FIXNUM_BIT (SCM_BITS_LENGTH - 2)
#define SCM_MOST_POSITIVE_FIXNUM ((1L << (SCM_I_FIXNUM_BIT - 1)) - 1)
#define SCM_MOST_NEGATIVE_FIXNUM (-SCM_MOST_POSITIVE_FIXNUM - 1)


/* SCM_SRS is signed right shift */
#if (-1 == (((-1) << 2) + 2) >> 2)
# define SCM_SRS(x, y) ((x) >> (y))
#else
# define SCM_SRS(x, y) ((SCM_UNPACK (x) < 0) ? ~((~SCM_UNPACK (x)) >> (y)) : (SCM_UNPACK (x) >> (y)))
#endif /* (-1 == (((-1) << 2) + 2) >> 2) */


#define SCM_INUMP(x)	(2 & SCM_UNPACK (x))
#define SCM_NINUMP(x) 	(!SCM_INUMP (x))
#define SCM_MAKINUM(x)  (SCM_PACK (((x) << 2) + 2L))
#define SCM_INUM(x)     (SCM_SRS (SCM_UNPACK (x), 2))


/* SCM_FIXABLE is true if its long argument can be encoded in an SCM_INUM. */
#define SCM_POSFIXABLE(n) ((n) <= SCM_MOST_POSITIVE_FIXNUM)
#define SCM_NEGFIXABLE(n) ((n) >= SCM_MOST_NEGATIVE_FIXNUM)
#define SCM_FIXABLE(n) (SCM_POSFIXABLE(n) && SCM_NEGFIXABLE(n))


/* A name for 0. */
#define SCM_INUM0 (SCM_MAKINUM (0))


/* SCM_MAXEXP is the maximum double precision expontent
 * SCM_FLTMAX is less than or scm_equal the largest single precision float
 */

#ifdef STDC_HEADERS
#ifndef GO32
#include <float.h>
#endif /* ndef GO32 */
#endif /* def STDC_HEADERS */
#ifdef DBL_MAX_10_EXP
#define SCM_MAXEXP DBL_MAX_10_EXP
#else
#define SCM_MAXEXP 308		/* IEEE doubles */
#endif /* def DBL_MAX_10_EXP */
#ifdef FLT_MAX
#define SCM_FLTMAX FLT_MAX
#else
#define SCM_FLTMAX 1e+23
#endif /* def FLT_MAX */


/* SCM_INTBUFLEN is the maximum number of characters neccessary for the
 * printed or scm_string representation of an exact immediate.
 */
#define SCM_INTBUFLEN (5 + SCM_BITS_LENGTH)

\f

/* Numbers 
 */

#define SCM_SLOPPY_INEXACTP(x) (SCM_TYP16S (x) == scm_tc16_real)
#define SCM_SLOPPY_REALP(x) (SCM_TYP16 (x) == scm_tc16_real)
#define SCM_SLOPPY_COMPLEXP(x) (SCM_TYP16 (x) == scm_tc16_complex)
#define SCM_INEXACTP(x) (SCM_NIMP (x) && SCM_TYP16S (x) == scm_tc16_real)
#define SCM_REALP(x) (SCM_NIMP (x) && SCM_TYP16 (x) == scm_tc16_real)
#define SCM_COMPLEXP(x) (SCM_NIMP (x) && SCM_TYP16 (x) == scm_tc16_complex)

#define SCM_REAL_VALUE(x) (((scm_double_t *) SCM2PTR (x))->real)
#define SCM_COMPLEX_MEM(x) ((scm_complex_t *) SCM_CELL_WORD_1 (x))
#define SCM_COMPLEX_REAL(x) (SCM_COMPLEX_MEM (x)->real)
#define SCM_COMPLEX_IMAG(x) (SCM_COMPLEX_MEM (x)->imag)

/* Define SCM_BIGDIG to an integer type whose size is smaller than long if
 * you want bignums.  SCM_BIGRAD is one greater than the biggest SCM_BIGDIG. 
 *
 * Define SCM_DIGSTOOBIG if the digits equivalent to a long won't fit in a long. 
 */
#ifdef BIGNUMS
# ifdef _UNICOS
#  define SCM_DIGSTOOBIG
#  if (1L << 31) <= SCM_USHRT_MAX
#   define SCM_BIGDIG unsigned  short
#  else
#   define SCM_BIGDIG unsigned int
#  endif /*  (1L << 31) <= USHRT_MAX */
#  define SCM_BITSPERDIG 32
# else
#  define SCM_BIGDIG unsigned short
#  define SCM_BITSPERDIG (sizeof(SCM_BIGDIG)*SCM_CHAR_BIT)
# endif /* def _UNICOS */

# define SCM_BIGRAD (1L << SCM_BITSPERDIG)
# define SCM_DIGSPERLONG ((size_t)((sizeof(long)*SCM_CHAR_BIT+SCM_BITSPERDIG-1)/SCM_BITSPERDIG))
# define SCM_I_BIGUP(type, x) ((type)(x) << SCM_BITSPERDIG)
# define SCM_BIGUP(x) SCM_I_BIGUP (unsigned long, x)
# define SCM_LONGLONGBIGUP(x) SCM_I_BIGUP (unsigned long long, x)
# define SCM_BIGDN(x) ((x) >> SCM_BITSPERDIG)
# define SCM_BIGLO(x) ((x) & (SCM_BIGRAD-1))
#endif /* def BIGNUMS */

#ifndef SCM_BIGDIG
/* Definition is not really used but helps various function
 * prototypes to compile with conditionalization.
 */
# define SCM_BIGDIG unsigned short
#endif /* ndef SCM_BIGDIG */

#define SCM_NUMBERP(x) (SCM_INUMP(x) || SCM_NUMP(x))
#define SCM_NUMP(x) (!SCM_IMP(x) && (0xfcff & SCM_CELL_TYPE (x)) == scm_tc7_smob)
#define SCM_BIGP(x) (!SCM_IMP (x) && (SCM_TYP16 (x) == scm_tc16_big))
#define SCM_BIGSIGNFLAG 0x10000L
#define SCM_BIGSIZEFIELD 17
#define SCM_BIGSIGN(x) (SCM_CELL_WORD_0 (x) & SCM_BIGSIGNFLAG)
#define SCM_BDIGITS(x) ((SCM_BIGDIG *) (SCM_CELL_WORD_1 (x)))
#define SCM_SET_BIGNUM_BASE(n, b) (SCM_SET_CELL_WORD_1 ((n), (b)))
#define SCM_NUMDIGS(x) ((size_t) ((scm_ubits_t) SCM_CELL_WORD_0 (x) >> SCM_BIGSIZEFIELD))
#define SCM_SETNUMDIGS(x, v, sign) \
  SCM_SET_CELL_WORD_0 (x, \
	      scm_tc16_big \
	      | ((sign) ? SCM_BIGSIGNFLAG : 0) \
	      | (((v) + 0L) << SCM_BIGSIZEFIELD))

\f

typedef struct scm_double_t
{
  SCM type;
  SCM pad;
  double real;
} scm_double_t;

typedef struct scm_complex_t
{
  double real;
  double imag;
} scm_complex_t;

\f

extern SCM scm_exact_p (SCM x);
extern SCM scm_odd_p (SCM n);
extern SCM scm_even_p (SCM n);
extern SCM scm_abs (SCM x);
extern SCM scm_quotient (SCM x, SCM y);
extern SCM scm_remainder (SCM x, SCM y);
extern SCM scm_modulo (SCM x, SCM y);
extern SCM scm_gcd (SCM x, SCM y);
extern SCM scm_lcm (SCM n1, SCM n2);
extern SCM scm_logand (SCM n1, SCM n2);
extern SCM scm_logior (SCM n1, SCM n2);
extern SCM scm_logxor (SCM n1, SCM n2);
extern SCM scm_logtest (SCM n1, SCM n2);
extern SCM scm_logbit_p (SCM n1, SCM n2);
extern SCM scm_lognot (SCM n);
extern SCM scm_integer_expt (SCM z1, SCM z2);
extern SCM scm_ash (SCM n, SCM cnt);
extern SCM scm_bit_extract (SCM n, SCM start, SCM end);
extern SCM scm_logcount (SCM n);
extern SCM scm_integer_length (SCM n);
extern SCM scm_i_mkbig (size_t nlen, int sign);
extern SCM scm_i_big2inum (SCM b, size_t l);
extern SCM scm_i_adjbig (SCM b, size_t nlen);
extern SCM scm_i_normbig (SCM b);
extern SCM scm_i_copybig (SCM b, int sign);
extern SCM scm_i_short2big (short n);
extern SCM scm_i_ushort2big (unsigned short n);
extern SCM scm_i_int2big (int n);
extern SCM scm_i_uint2big (unsigned int n);
extern SCM scm_i_long2big (long n);
extern SCM scm_i_ulong2big (unsigned long n);
extern SCM scm_i_bits2big (scm_bits_t n);
extern SCM scm_i_ubits2big (scm_ubits_t n);
extern SCM scm_i_size2big (size_t n);
extern SCM scm_i_ptrdiff2big (ptrdiff_t n);


#if (SCM_DEBUG_DEPRECATED == 0)
extern SCM scm_big2inum (SCM b, size_t l);
extern SCM scm_mkbig (size_t nlen, int sign);
extern SCM scm_adjbig (SCM b, size_t len);
extern SCM scm_normbig (SCM b);
extern SCM scm_copybig (SCM b, int sign);

#define SCM_FIXNUM_BIT SCM_I_FIXNUM_BIT
#endif

#ifdef HAVE_LONG_LONGS
extern SCM scm_i_long_long2big (long long n);
extern SCM scm_i_ulong_long2big (unsigned long long n);
#endif

#if (SCM_DEBUG_DEPRECATED == 0)
extern SCM scm_2ulong2big (unsigned long * np);
#endif

extern int scm_bigcomp (SCM x, SCM y);
extern long scm_pseudolong (long x);
extern void scm_longdigs (long x, SCM_BIGDIG digs[]);
extern SCM scm_addbig (SCM_BIGDIG *x, size_t nx, int xsgn, SCM bigy, int sgny);
extern SCM scm_mulbig (SCM_BIGDIG *x, size_t nx, SCM_BIGDIG *y, size_t ny, int sgn);
extern unsigned int scm_divbigdig (SCM_BIGDIG *ds, size_t h, SCM_BIGDIG div);
extern size_t scm_iint2str (long num, int rad, char *p);
extern SCM scm_number_to_string (SCM x, SCM radix);
extern int scm_print_real (SCM sexp, SCM port, scm_print_state *pstate);
extern int scm_print_complex (SCM sexp, SCM port, scm_print_state *pstate);
extern int scm_bigprint (SCM exp, SCM port, scm_print_state *pstate);
extern SCM scm_istr2int (char *str, long len, long radix);
extern SCM scm_istr2flo (char *str, long len, long radix);
extern SCM scm_istring2number (char *str, long len, long radix);
extern SCM scm_string_to_number (SCM str, SCM radix);
extern SCM scm_make_real (double x);
extern SCM scm_make_complex (double x, double y);
extern SCM scm_bigequal (SCM x, SCM y);
extern SCM scm_real_equalp (SCM x, SCM y);
extern SCM scm_complex_equalp (SCM x, SCM y);
extern SCM scm_number_p (SCM x);
extern SCM scm_real_p (SCM x);
extern SCM scm_integer_p (SCM x);
extern SCM scm_inexact_p (SCM x);
extern SCM scm_num_eq_p (SCM x, SCM y);
extern SCM scm_less_p (SCM x, SCM y);
extern SCM scm_gr_p (SCM x, SCM y);
extern SCM scm_leq_p (SCM x, SCM y);
extern SCM scm_geq_p (SCM x, SCM y);
extern SCM scm_zero_p (SCM z);
extern SCM scm_positive_p (SCM x);
extern SCM scm_negative_p (SCM x);
extern SCM scm_max (SCM x, SCM y);
extern SCM scm_min (SCM x, SCM y);
extern SCM scm_sum (SCM x, SCM y);
extern SCM scm_difference (SCM x, SCM y);
extern SCM scm_product (SCM x, SCM y);
extern double scm_num2dbl (SCM a, const char * why);
extern SCM scm_divide (SCM x, SCM y);
extern double scm_asinh (double x);
extern double scm_acosh (double x);
extern double scm_atanh (double x);
extern double scm_truncate (double x);
extern double scm_round (double x);
extern double scm_exact_to_inexact (double z);
extern SCM scm_sys_expt (SCM z1, SCM z2);
extern SCM scm_sys_atan2 (SCM z1, SCM z2);
extern SCM scm_make_rectangular (SCM z1, SCM z2);
extern SCM scm_make_polar (SCM z1, SCM z2);
extern SCM scm_real_part (SCM z);
extern SCM scm_imag_part (SCM z);
extern SCM scm_magnitude (SCM z);
extern SCM scm_angle (SCM z);
extern SCM scm_inexact_to_exact (SCM z);
extern SCM scm_trunc (SCM x);
extern SCM scm_i_dbl2big (double d);

#if (SCM_DEBUG_DEPRECATED == 0)
extern SCM scm_dbl2big (double d);
#endif

extern double scm_i_big2dbl (SCM b);

#if (SCM_DEBUG_DEPRECATED == 0)
extern double scm_big2dbl (SCM b);
#endif

extern SCM scm_short2num (short n);
extern SCM scm_ushort2num (unsigned short n);
extern SCM scm_int2num (int n);
extern SCM scm_uint2num (unsigned int n);
extern SCM scm_long2num (long n);
extern SCM scm_ulong2num (unsigned long n);
extern SCM scm_bits2num (scm_bits_t n);
extern SCM scm_ubits2num (scm_ubits_t n);
extern SCM scm_size2num (size_t n);
extern SCM scm_ptrdiff2num (ptrdiff_t n);
extern short scm_num2short (SCM num, unsigned long int pos,
                            const char *s_caller);
extern unsigned short scm_num2ushort (SCM num, unsigned long int pos,
                                      const char *s_caller);
extern int scm_num2int (SCM num, unsigned long int pos,
                        const char *s_caller);
extern unsigned int scm_num2uint (SCM num, unsigned long int pos,
                                  const char *s_caller);
extern long scm_num2long (SCM num, unsigned long int pos,
			  const char *s_caller);
extern unsigned long scm_num2ulong (SCM num, unsigned long int pos,
                                    const char *s_caller);
extern scm_bits_t scm_num2bits (SCM num, unsigned long int pos,
                                const char *s_caller);
extern scm_ubits_t scm_num2ubits (SCM num, unsigned long int pos,
                                  const char *s_caller);
extern ptrdiff_t scm_num2ptrdiff (SCM num, unsigned long int pos,
                                  const char *s_caller);
extern size_t scm_num2size (SCM num, unsigned long int pos,
                            const char *s_caller);
#ifdef HAVE_LONG_LONGS
extern SCM scm_long_long2num (long long sl);
extern SCM scm_ulong_long2num (unsigned long long sl);
extern long long scm_num2long_long (SCM num, unsigned long int pos,
                                    const char *s_caller);
extern unsigned long long scm_num2ulong_long (SCM num, unsigned long int pos,
				      const char *s_caller);
#endif

extern void scm_init_numbers (void);

#endif  /* NUMBERSH */

/*
  Local Variables:
  c-file-style: "gnu"
  End:
*/
Commit	Line	Data
0f2d19dd JB	1	/* classes: h_files */
	2
	3	#ifndef NUMBERSH
	4	#define NUMBERSH
e4b265d8	5	/* Copyright (C) 1995,1996,1998,2000,2001 Free Software Foundation, Inc.
0f2d19dd JB	6	*
	7	* This program is free software; you can redistribute it and/or modify
	8	* it under the terms of the GNU General Public License as published by
	9	* the Free Software Foundation; either version 2, or (at your option)
	10	* any later version.
	11	*
	12	* This program is distributed in the hope that it will be useful,
	13	* but WITHOUT ANY WARRANTY; without even the implied warranty of
	14	* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	15	* GNU General Public License for more details.
	16	*
	17	* You should have received a copy of the GNU General Public License
	18	* along with this software; see the file COPYING. If not, write to
82892bed JB	19	* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
82892bed JB	20	* Boston, MA 02111-1307 USA
0f2d19dd JB	21	*
	22	* As a special exception, the Free Software Foundation gives permission
	23	* for additional uses of the text contained in its release of GUILE.
	24	*
	25	* The exception is that, if you link the GUILE library with other files
	26	* to produce an executable, this does not by itself cause the
	27	* resulting executable to be covered by the GNU General Public License.
	28	* Your use of that executable is in no way restricted on account of
	29	* linking the GUILE library code into it.
	30	*
	31	* This exception does not however invalidate any other reasons why
	32	* the executable file might be covered by the GNU General Public License.
	33	*
	34	* This exception applies only to the code released by the
	35	* Free Software Foundation under the name GUILE. If you copy
	36	* code from other Free Software Foundation releases into a copy of
	37	* GUILE, as the General Public License permits, the exception does
	38	* not apply to the code that you add in this way. To avoid misleading
	39	* anyone as to the status of such modified files, you must delete
	40	* this exception notice from them.
	41	*
	42	* If you write modifications of your own for GUILE, it is your choice
	43	* whether to permit this exception to apply to your modifications.
82892bed	44	* If you do not wish that, delete this exception notice. */
d3a6bc94 GB	45
	46	/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
	47	gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
0f2d19dd JB	48	\f
0f2d19dd JB	49
b4309c3c	50	#include "libguile/__scm.h"
34f74fe1 MD	51	#include "libguile/print.h"
34f74fe1 MD	52
0f2d19dd JB	53	\f
0f2d19dd JB	54
0f2d19dd JB	55	/* Immediate Numbers
	56	*
	57	* Inums are exact integer data that fits within an SCM word.
	58	*
	59	* SCM_INUMP applies only to values known to be Scheme objects.
	60	* In particular, SCM_INUMP (SCM_CAR (x)) is valid only if x is known
	61	* to be a SCM_CONSP. If x is only known to be a SCM_NIMP,
	62	* SCM_INUMP (SCM_CAR (x)) can give wrong answers.
	63	*/
	64
1be6b49c ML	65	#define SCM_I_FIXNUM_BIT (SCM_BITS_LENGTH - 2)
1be6b49c ML	66	#define SCM_MOST_POSITIVE_FIXNUM ((1L << (SCM_I_FIXNUM_BIT - 1)) - 1)
5c75b29f DH	67	#define SCM_MOST_NEGATIVE_FIXNUM (-SCM_MOST_POSITIVE_FIXNUM - 1)
	68
	69
56100716 DH	70	/* SCM_SRS is signed right shift */
	71	#if (-1 == (((-1) << 2) + 2) >> 2)
	72	# define SCM_SRS(x, y) ((x) >> (y))
0f2d19dd	73	#else
56100716 DH	74	# define SCM_SRS(x, y) ((SCM_UNPACK (x) < 0) ? ~((~SCM_UNPACK (x)) >> (y)) : (SCM_UNPACK (x) >> (y)))
56100716 DH	75	#endif /* (-1 == (((-1) << 2) + 2) >> 2) */
0f2d19dd JB	76
0f2d19dd JB	77
56100716 DH	78	#define SCM_INUMP(x) (2 & SCM_UNPACK (x))
	79	#define SCM_NINUMP(x) (!SCM_INUMP (x))
	80	#define SCM_MAKINUM(x) (SCM_PACK (((x) << 2) + 2L))
	81	#define SCM_INUM(x) (SCM_SRS (SCM_UNPACK (x), 2))
0f2d19dd JB	82
0f2d19dd JB	83
894a712b DH	84	/* SCM_FIXABLE is true if its long argument can be encoded in an SCM_INUM. */
	85	#define SCM_POSFIXABLE(n) ((n) <= SCM_MOST_POSITIVE_FIXNUM)
	86	#define SCM_NEGFIXABLE(n) ((n) >= SCM_MOST_NEGATIVE_FIXNUM)
	87	#define SCM_FIXABLE(n) (SCM_POSFIXABLE(n) && SCM_NEGFIXABLE(n))
	88
	89
56100716	90	/* A name for 0. */
b82c6ce0	91	#define SCM_INUM0 (SCM_MAKINUM (0))
0f2d19dd JB	92
0f2d19dd JB	93
88eb6852 MD	94	/* SCM_MAXEXP is the maximum double precision expontent
	95	* SCM_FLTMAX is less than or scm_equal the largest single precision float
	96	*/
	97
	98	#ifdef STDC_HEADERS
	99	#ifndef GO32
	100	#include <float.h>
	101	#endif /* ndef GO32 */
	102	#endif /* def STDC_HEADERS */
	103	#ifdef DBL_MAX_10_EXP
	104	#define SCM_MAXEXP DBL_MAX_10_EXP
	105	#else
	106	#define SCM_MAXEXP 308 /* IEEE doubles */
	107	#endif /* def DBL_MAX_10_EXP */
	108	#ifdef FLT_MAX
	109	#define SCM_FLTMAX FLT_MAX
	110	#else
	111	#define SCM_FLTMAX 1e+23
	112	#endif /* def FLT_MAX */
	113
0f2d19dd	114
0f2d19dd JB	115	/* SCM_INTBUFLEN is the maximum number of characters neccessary for the
	116	* printed or scm_string representation of an exact immediate.
	117	*/
1be6b49c	118	#define SCM_INTBUFLEN (5 + SCM_BITS_LENGTH)
0f2d19dd JB	119
	120	\f
	121
	122	/* Numbers
	123	*/
	124
88eb6852 MD	125	#define SCM_SLOPPY_INEXACTP(x) (SCM_TYP16S (x) == scm_tc16_real)
	126	#define SCM_SLOPPY_REALP(x) (SCM_TYP16 (x) == scm_tc16_real)
	127	#define SCM_SLOPPY_COMPLEXP(x) (SCM_TYP16 (x) == scm_tc16_complex)
	128	#define SCM_INEXACTP(x) (SCM_NIMP (x) && SCM_TYP16S (x) == scm_tc16_real)
	129	#define SCM_REALP(x) (SCM_NIMP (x) && SCM_TYP16 (x) == scm_tc16_real)
	130	#define SCM_COMPLEXP(x) (SCM_NIMP (x) && SCM_TYP16 (x) == scm_tc16_complex)
	131
88eb6852	132	#define SCM_REAL_VALUE(x) (((scm_double_t *) SCM2PTR (x))->real)
405aaef9 DH	133	#define SCM_COMPLEX_MEM(x) ((scm_complex_t *) SCM_CELL_WORD_1 (x))
	134	#define SCM_COMPLEX_REAL(x) (SCM_COMPLEX_MEM (x)->real)
	135	#define SCM_COMPLEX_IMAG(x) (SCM_COMPLEX_MEM (x)->imag)
0f2d19dd JB	136
	137	/* Define SCM_BIGDIG to an integer type whose size is smaller than long if
	138	* you want bignums. SCM_BIGRAD is one greater than the biggest SCM_BIGDIG.
	139	*
	140	* Define SCM_DIGSTOOBIG if the digits equivalent to a long won't fit in a long.
	141	*/
	142	#ifdef BIGNUMS
	143	# ifdef _UNICOS
	144	# define SCM_DIGSTOOBIG
	145	# if (1L << 31) <= SCM_USHRT_MAX
	146	# define SCM_BIGDIG unsigned short
	147	# else
	148	# define SCM_BIGDIG unsigned int
	149	# endif /* (1L << 31) <= USHRT_MAX */
	150	# define SCM_BITSPERDIG 32
	151	# else
	152	# define SCM_BIGDIG unsigned short
	153	# define SCM_BITSPERDIG (sizeof(SCM_BIGDIG)*SCM_CHAR_BIT)
	154	# endif /* def _UNICOS */
	155
	156	# define SCM_BIGRAD (1L << SCM_BITSPERDIG)
1be6b49c ML	157	# define SCM_DIGSPERLONG ((size_t)((sizeof(long)*SCM_CHAR_BIT+SCM_BITSPERDIG-1)/SCM_BITSPERDIG))
	158	# define SCM_I_BIGUP(type, x) ((type)(x) << SCM_BITSPERDIG)
	159	# define SCM_BIGUP(x) SCM_I_BIGUP (unsigned long, x)
	160	# define SCM_LONGLONGBIGUP(x) SCM_I_BIGUP (unsigned long long, x)
0f2d19dd JB	161	# define SCM_BIGDN(x) ((x) >> SCM_BITSPERDIG)
	162	# define SCM_BIGLO(x) ((x) & (SCM_BIGRAD-1))
	163	#endif /* def BIGNUMS */
	164
	165	#ifndef SCM_BIGDIG
	166	/* Definition is not really used but helps various function
	167	* prototypes to compile with conditionalization.
	168	*/
	169	# define SCM_BIGDIG unsigned short
0f2d19dd JB	170	#endif /* ndef SCM_BIGDIG */
0f2d19dd JB	171
7a710745	172	#define SCM_NUMBERP(x) (SCM_INUMP(x) \|\| SCM_NUMP(x))
47457e8a	173	#define SCM_NUMP(x) (!SCM_IMP(x) && (0xfcff & SCM_CELL_TYPE (x)) == scm_tc7_smob)
7272f6d8	174	#define SCM_BIGP(x) (!SCM_IMP (x) && (SCM_TYP16 (x) == scm_tc16_big))
88eb6852 MD	175	#define SCM_BIGSIGNFLAG 0x10000L
88eb6852 MD	176	#define SCM_BIGSIZEFIELD 17
47457e8a DH	177	#define SCM_BIGSIGN(x) (SCM_CELL_WORD_0 (x) & SCM_BIGSIGNFLAG)
47457e8a DH	178	#define SCM_BDIGITS(x) ((SCM_BIGDIG *) (SCM_CELL_WORD_1 (x)))
6a0476fd	179	#define SCM_SET_BIGNUM_BASE(n, b) (SCM_SET_CELL_WORD_1 ((n), (b)))
1be6b49c	180	#define SCM_NUMDIGS(x) ((size_t) ((scm_ubits_t) SCM_CELL_WORD_0 (x) >> SCM_BIGSIZEFIELD))
88eb6852	181	#define SCM_SETNUMDIGS(x, v, sign) \
4260a7fc	182	SCM_SET_CELL_WORD_0 (x, \
88eb6852 MD	183	scm_tc16_big \
88eb6852 MD	184	\| ((sign) ? SCM_BIGSIGNFLAG : 0) \
f81e080b	185	\| (((v) + 0L) << SCM_BIGSIZEFIELD))
88eb6852	186
0f2d19dd JB	187	\f
0f2d19dd JB	188
88eb6852	189	typedef struct scm_double_t
0f2d19dd JB	190	{
0f2d19dd JB	191	SCM type;
88eb6852 MD	192	SCM pad;
	193	double real;
	194	} scm_double_t;
0f2d19dd	195
88eb6852	196	typedef struct scm_complex_t
0f2d19dd	197	{
88eb6852 MD	198	double real;
	199	double imag;
	200	} scm_complex_t;
0f2d19dd	201
0f2d19dd	202	\f
0f2d19dd	203
7866a09b GB	204	extern SCM scm_exact_p (SCM x);
	205	extern SCM scm_odd_p (SCM n);
	206	extern SCM scm_even_p (SCM n);
	207	extern SCM scm_abs (SCM x);
	208	extern SCM scm_quotient (SCM x, SCM y);
	209	extern SCM scm_remainder (SCM x, SCM y);
	210	extern SCM scm_modulo (SCM x, SCM y);
	211	extern SCM scm_gcd (SCM x, SCM y);
	212	extern SCM scm_lcm (SCM n1, SCM n2);
	213	extern SCM scm_logand (SCM n1, SCM n2);
	214	extern SCM scm_logior (SCM n1, SCM n2);
	215	extern SCM scm_logxor (SCM n1, SCM n2);
	216	extern SCM scm_logtest (SCM n1, SCM n2);
	217	extern SCM scm_logbit_p (SCM n1, SCM n2);
	218	extern SCM scm_lognot (SCM n);
	219	extern SCM scm_integer_expt (SCM z1, SCM z2);
	220	extern SCM scm_ash (SCM n, SCM cnt);
	221	extern SCM scm_bit_extract (SCM n, SCM start, SCM end);
	222	extern SCM scm_logcount (SCM n);
	223	extern SCM scm_integer_length (SCM n);
1be6b49c ML	224	extern SCM scm_i_mkbig (size_t nlen, int sign);
	225	extern SCM scm_i_big2inum (SCM b, size_t l);
	226	extern SCM scm_i_adjbig (SCM b, size_t nlen);
	227	extern SCM scm_i_normbig (SCM b);
	228	extern SCM scm_i_copybig (SCM b, int sign);
	229	extern SCM scm_i_short2big (short n);
	230	extern SCM scm_i_ushort2big (unsigned short n);
	231	extern SCM scm_i_int2big (int n);
	232	extern SCM scm_i_uint2big (unsigned int n);
	233	extern SCM scm_i_long2big (long n);
	234	extern SCM scm_i_ulong2big (unsigned long n);
	235	extern SCM scm_i_bits2big (scm_bits_t n);
	236	extern SCM scm_i_ubits2big (scm_ubits_t n);
	237	extern SCM scm_i_size2big (size_t n);
	238	extern SCM scm_i_ptrdiff2big (ptrdiff_t n);
	239
	240
	241	#if (SCM_DEBUG_DEPRECATED == 0)
	242	extern SCM scm_big2inum (SCM b, size_t l);
	243	extern SCM scm_mkbig (size_t nlen, int sign);
	244	extern SCM scm_adjbig (SCM b, size_t len);
7866a09b GB	245	extern SCM scm_normbig (SCM b);
7866a09b GB	246	extern SCM scm_copybig (SCM b, int sign);
1be6b49c ML	247
	248	#define SCM_FIXNUM_BIT SCM_I_FIXNUM_BIT
	249	#endif
	250
9ea8cdcb	251	#ifdef HAVE_LONG_LONGS
1be6b49c ML	252	extern SCM scm_i_long_long2big (long long n);
1be6b49c ML	253	extern SCM scm_i_ulong_long2big (unsigned long long n);
9ea8cdcb	254	#endif
1be6b49c ML	255
1be6b49c ML	256	#if (SCM_DEBUG_DEPRECATED == 0)
7866a09b	257	extern SCM scm_2ulong2big (unsigned long * np);
1be6b49c ML	258	#endif
1be6b49c ML	259
7866a09b GB	260	extern int scm_bigcomp (SCM x, SCM y);
	261	extern long scm_pseudolong (long x);
	262	extern void scm_longdigs (long x, SCM_BIGDIG digs[]);
1be6b49c ML	263	extern SCM scm_addbig (SCM_BIGDIG *x, size_t nx, int xsgn, SCM bigy, int sgny);
	264	extern SCM scm_mulbig (SCM_BIGDIG x, size_t nx, SCM_BIGDIG y, size_t ny, int sgn);
	265	extern unsigned int scm_divbigdig (SCM_BIGDIG *ds, size_t h, SCM_BIGDIG div);
	266	extern size_t scm_iint2str (long num, int rad, char *p);
7866a09b	267	extern SCM scm_number_to_string (SCM x, SCM radix);
88eb6852 MD	268	extern int scm_print_real (SCM sexp, SCM port, scm_print_state *pstate);
88eb6852 MD	269	extern int scm_print_complex (SCM sexp, SCM port, scm_print_state *pstate);
7866a09b GB	270	extern int scm_bigprint (SCM exp, SCM port, scm_print_state *pstate);
	271	extern SCM scm_istr2int (char *str, long len, long radix);
	272	extern SCM scm_istr2flo (char *str, long len, long radix);
	273	extern SCM scm_istring2number (char *str, long len, long radix);
	274	extern SCM scm_string_to_number (SCM str, SCM radix);
88eb6852 MD	275	extern SCM scm_make_real (double x);
88eb6852 MD	276	extern SCM scm_make_complex (double x, double y);
7866a09b	277	extern SCM scm_bigequal (SCM x, SCM y);
88eb6852 MD	278	extern SCM scm_real_equalp (SCM x, SCM y);
88eb6852 MD	279	extern SCM scm_complex_equalp (SCM x, SCM y);
7866a09b GB	280	extern SCM scm_number_p (SCM x);
	281	extern SCM scm_real_p (SCM x);
	282	extern SCM scm_integer_p (SCM x);
	283	extern SCM scm_inexact_p (SCM x);
	284	extern SCM scm_num_eq_p (SCM x, SCM y);
	285	extern SCM scm_less_p (SCM x, SCM y);
	286	extern SCM scm_gr_p (SCM x, SCM y);
	287	extern SCM scm_leq_p (SCM x, SCM y);
	288	extern SCM scm_geq_p (SCM x, SCM y);
	289	extern SCM scm_zero_p (SCM z);
	290	extern SCM scm_positive_p (SCM x);
	291	extern SCM scm_negative_p (SCM x);
	292	extern SCM scm_max (SCM x, SCM y);
	293	extern SCM scm_min (SCM x, SCM y);
	294	extern SCM scm_sum (SCM x, SCM y);
	295	extern SCM scm_difference (SCM x, SCM y);
	296	extern SCM scm_product (SCM x, SCM y);
	297	extern double scm_num2dbl (SCM a, const char * why);
	298	extern SCM scm_divide (SCM x, SCM y);
	299	extern double scm_asinh (double x);
	300	extern double scm_acosh (double x);
	301	extern double scm_atanh (double x);
	302	extern double scm_truncate (double x);
	303	extern double scm_round (double x);
	304	extern double scm_exact_to_inexact (double z);
	305	extern SCM scm_sys_expt (SCM z1, SCM z2);
	306	extern SCM scm_sys_atan2 (SCM z1, SCM z2);
	307	extern SCM scm_make_rectangular (SCM z1, SCM z2);
	308	extern SCM scm_make_polar (SCM z1, SCM z2);
	309	extern SCM scm_real_part (SCM z);
	310	extern SCM scm_imag_part (SCM z);
	311	extern SCM scm_magnitude (SCM z);
	312	extern SCM scm_angle (SCM z);
	313	extern SCM scm_inexact_to_exact (SCM z);
	314	extern SCM scm_trunc (SCM x);
1be6b49c ML	315	extern SCM scm_i_dbl2big (double d);
	316
	317	#if (SCM_DEBUG_DEPRECATED == 0)
7866a09b	318	extern SCM scm_dbl2big (double d);
1be6b49c ML	319	#endif
	320
	321	extern double scm_i_big2dbl (SCM b);
	322
	323	#if (SCM_DEBUG_DEPRECATED == 0)
7866a09b	324	extern double scm_big2dbl (SCM b);
1be6b49c ML	325	#endif
	326
	327	extern SCM scm_short2num (short n);
	328	extern SCM scm_ushort2num (unsigned short n);
	329	extern SCM scm_int2num (int n);
	330	extern SCM scm_uint2num (unsigned int n);
	331	extern SCM scm_long2num (long n);
	332	extern SCM scm_ulong2num (unsigned long n);
	333	extern SCM scm_bits2num (scm_bits_t n);
	334	extern SCM scm_ubits2num (scm_ubits_t n);
	335	extern SCM scm_size2num (size_t n);
	336	extern SCM scm_ptrdiff2num (ptrdiff_t n);
	337	extern short scm_num2short (SCM num, unsigned long int pos,
	338	const char *s_caller);
	339	extern unsigned short scm_num2ushort (SCM num, unsigned long int pos,
	340	const char *s_caller);
	341	extern int scm_num2int (SCM num, unsigned long int pos,
	342	const char *s_caller);
	343	extern unsigned int scm_num2uint (SCM num, unsigned long int pos,
	344	const char *s_caller);
e4b265d8 DH	345	extern long scm_num2long (SCM num, unsigned long int pos,
e4b265d8 DH	346	const char *s_caller);
1be6b49c ML	347	extern unsigned long scm_num2ulong (SCM num, unsigned long int pos,
	348	const char *s_caller);
	349	extern scm_bits_t scm_num2bits (SCM num, unsigned long int pos,
	350	const char *s_caller);
	351	extern scm_ubits_t scm_num2ubits (SCM num, unsigned long int pos,
	352	const char *s_caller);
	353	extern ptrdiff_t scm_num2ptrdiff (SCM num, unsigned long int pos,
	354	const char *s_caller);
	355	extern size_t scm_num2size (SCM num, unsigned long int pos,
	356	const char *s_caller);
9ea8cdcb	357	#ifdef HAVE_LONG_LONGS
1be6b49c ML	358	extern SCM scm_long_long2num (long long sl);
	359	extern SCM scm_ulong_long2num (unsigned long long sl);
	360	extern long long scm_num2long_long (SCM num, unsigned long int pos,
7866a09b	361	const char *s_caller);
1be6b49c	362	extern unsigned long long scm_num2ulong_long (SCM num, unsigned long int pos,
caf08e65	363	const char *s_caller);
9ea8cdcb	364	#endif
1be6b49c	365
7866a09b	366	extern void scm_init_numbers (void);
0f2d19dd JB	367
0f2d19dd JB	368	#endif /* NUMBERSH */
89e00824 ML	369
	370	/*
	371	Local Variables:
	372	c-file-style: "gnu"
	373	End:
	374	*/