summaryrefslogtreecommitdiff
path: root/libguile/numbers.c
diff options
context:
space:
mode:
Diffstat (limited to 'libguile/numbers.c')
-rw-r--r--libguile/numbers.c667
1 files changed, 293 insertions, 374 deletions
diff --git a/libguile/numbers.c b/libguile/numbers.c
index 992b3ddb7..8330b37fe 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -38,6 +38,10 @@
* 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 */
+
#include <stdio.h>
@@ -48,6 +52,7 @@
#include "feature.h"
#include "smob.h"
+#include "scm_validate.h"
#include "numbers.h"
#define DIGITS '0':case '1':case '2':case '3':case '4':\
@@ -90,11 +95,10 @@
-SCM_PROC (s_exact_p, "exact?", 1, 0, 0, scm_exact_p);
-
-SCM
-scm_exact_p (x)
- SCM x;
+GUILE_PROC (scm_exact_p, "exact?", 1, 0, 0,
+ (SCM x),
+"")
+#define FUNC_NAME s_scm_exact_p
{
if (SCM_INUMP (x))
return SCM_BOOL_T;
@@ -104,42 +108,43 @@ scm_exact_p (x)
#endif
return SCM_BOOL_F;
}
+#undef FUNC_NAME
-SCM_PROC (s_odd_p, "odd?", 1, 0, 0, scm_odd_p);
-
-SCM
-scm_odd_p (n)
- SCM n;
+GUILE_PROC (scm_odd_p, "odd?", 1, 0, 0,
+ (SCM n),
+"")
+#define FUNC_NAME s_scm_odd_p
{
#ifdef SCM_BIGDIG
if (SCM_NINUMP (n))
{
- SCM_ASSERT (SCM_NIMP (n) && SCM_BIGP (n), n, SCM_ARG1, s_odd_p);
- return (1 & SCM_BDIGITS (n)[0]) ? SCM_BOOL_T : SCM_BOOL_F;
+ SCM_VALIDATE_BIGINT(1,n);
+ return SCM_BOOL(1 & SCM_BDIGITS (n)[0]);
}
#else
- SCM_ASSERT (SCM_INUMP (n), n, SCM_ARG1, s_odd_p);
+ SCM_VALIDATE_INT(1,n);
#endif
- return (4 & (int) n) ? SCM_BOOL_T : SCM_BOOL_F;
+ return SCM_BOOL(4 & (int) n);
}
+#undef FUNC_NAME
-SCM_PROC (s_even_p, "even?", 1, 0, 0, scm_even_p);
-
-SCM
-scm_even_p (n)
- SCM n;
+GUILE_PROC (scm_even_p, "even?", 1, 0, 0,
+ (SCM n),
+"")
+#define FUNC_NAME s_scm_even_p
{
#ifdef SCM_BIGDIG
if (SCM_NINUMP (n))
{
- SCM_ASSERT (SCM_NIMP (n) && SCM_BIGP (n), n, SCM_ARG1, s_even_p);
- return (1 & SCM_BDIGITS (n)[0]) ? SCM_BOOL_F : SCM_BOOL_T;
+ SCM_VALIDATE_BIGINT(1,n);
+ return SCM_NEGATE_BOOL(1 & SCM_BDIGITS (n)[0]);
}
#else
- SCM_ASSERT (SCM_INUMP (n), n, SCM_ARG1, s_even_p);
+ SCM_VALIDATE_INT(1,n);
#endif
- return (4 & (int) n) ? SCM_BOOL_F : SCM_BOOL_T;
+ return SCM_NEGATE_BOOL(4 & (int) n);
}
+#undef FUNC_NAME
SCM_GPROC (s_abs, "abs", 1, 0, 0, scm_abs, g_abs);
@@ -516,210 +521,217 @@ scm_lcm (n1, n2)
#endif
#ifndef scm_long2num
-SCM_PROC1 (s_logand, "logand", scm_tc7_asubr, scm_logand);
-
-SCM
-scm_logand (n1, n2)
- SCM n1;
- SCM n2;
+GUILE_PROC1 (scm_logand, "logand", scm_tc7_asubr,
+ (SCM n1, SCM n2),
+"")
+#define FUNC_NAME s_scm_logand
{
+ int i1, i2;
if (SCM_UNBNDP (n2))
{
if (SCM_UNBNDP (n1))
return SCM_MAKINUM (-1);
return n1;
}
- return scm_ulong2num (scm_num2ulong (n1, (char *) SCM_ARG1, s_logand)
- & scm_num2ulong (n2, (char *) SCM_ARG2, s_logand));
+ SCM_VALIDATE_INT_COPY(1,n1,i1);
+ SCM_VALIDATE_INT_COPY(2,n2,i2);
+ return scm_ulong2num (i1 & i2);
}
+#undef FUNC_NAME
-SCM_PROC1 (s_logior, "logior", scm_tc7_asubr, scm_logior);
-
-SCM
-scm_logior (n1, n2)
- SCM n1;
- SCM n2;
+GUILE_PROC1 (scm_logior, "logior", scm_tc7_asubr,
+ (SCM n1, SCM n2),
+"")
+#define FUNC_NAME s_scm_logior
{
+ int i1, i2;
if (SCM_UNBNDP (n2))
{
if (SCM_UNBNDP (n1))
return SCM_INUM0;
return n1;
}
- return scm_ulong2num (scm_num2ulong (n1, (char *) SCM_ARG1, s_logior)
- | scm_num2ulong (n2, (char *) SCM_ARG2, s_logior));
+ SCM_VALIDATE_INT_COPY(1,n1,i1);
+ SCM_VALIDATE_INT_COPY(2,n2,i2);
+ return scm_ulong2num (i1 | i2);
}
+#undef FUNC_NAME
-SCM_PROC1 (s_logxor, "logxor", scm_tc7_asubr, scm_logxor);
-
-SCM
-scm_logxor (n1, n2)
- SCM n1;
- SCM n2;
+GUILE_PROC1 (scm_logxor, "logxor", scm_tc7_asubr,
+ (SCM n1, SCM n2),
+"")
+#define FUNC_NAME s_scm_logxor
{
+ int i1, i2;
if (SCM_UNBNDP (n2))
{
if (SCM_UNBNDP (n1))
return SCM_INUM0;
return n1;
}
- return scm_ulong2num (scm_num2ulong (n1, (char *) SCM_ARG1, s_logxor)
- ^ scm_num2ulong (n2, (char *) SCM_ARG2, s_logxor));
+ SCM_VALIDATE_INT_COPY(1,n1,i1);
+ SCM_VALIDATE_INT_COPY(2,n2,i2);
+ return scm_ulong2num (i1 ^ i2);
}
+#undef FUNC_NAME
-SCM_PROC (s_logtest, "logtest", 2, 0, 0, scm_logtest);
-
-SCM
-scm_logtest (n1, n2)
- SCM n1;
- SCM n2;
+GUILE_PROC (scm_logtest, "logtest", 2, 0, 0,
+ (SCM n1, SCM n2),
+"")
+#define FUNC_NAME s_scm_logtest
{
- return ((scm_num2ulong (n1, (char *) SCM_ARG1, s_logtest)
- & scm_num2ulong (n2, (char *) SCM_ARG2, s_logtest))
- ? SCM_BOOL_T : SCM_BOOL_F);
+ int i1, i2;
+ SCM_VALIDATE_INT_COPY(1,n1,i1);
+ SCM_VALIDATE_INT_COPY(2,n2,i2);
+ return SCM_BOOL(i1 & i2);
}
+#undef FUNC_NAME
-SCM_PROC (s_logbit_p, "logbit?", 2, 0, 0, scm_logbit_p);
-
-SCM
-scm_logbit_p (n1, n2)
- SCM n1;
- SCM n2;
+GUILE_PROC (scm_logbit_p, "logbit?", 2, 0, 0,
+ (SCM n1, SCM n2),
+"")
+#define FUNC_NAME s_scm_logbit_p
{
- return (((1 << scm_num2long (n1, (char *) SCM_ARG1, s_logtest))
- & scm_num2ulong (n2, (char *) SCM_ARG2, s_logtest))
- ? SCM_BOOL_T : SCM_BOOL_F);
+ int i1, i2;
+ SCM_VALIDATE_INT_COPY(1,n1,i1);
+ SCM_VALIDATE_INT_COPY(2,n2,i2);
+ return SCM_BOOL((1 << i1) & i2);
}
+#undef FUNC_NAME
#else
-SCM_PROC1 (s_logand, "logand", scm_tc7_asubr, scm_logand);
-
-SCM
-scm_logand (n1, n2)
- SCM n1;
- SCM n2;
+GUILE_PROC1 (scm_logand, "logand", scm_tc7_asubr,
+ (SCM n1, SCM n2),
+"")
+#define FUNC_NAME s_scm_logand
{
+ int i1, i2;
if (SCM_UNBNDP (n2))
{
if (SCM_UNBNDP (n1))
return SCM_MAKINUM (-1);
return n1;
}
- return SCM_MAKINUM (SCM_INUM (n1) & SCM_INUM (n2));
+ SCM_VALIDATE_INT_COPY(1,n1,i1);
+ SCM_VALIDATE_INT_COPY(2,n2,i2);
+ return SCM_MAKINUM (i1 & i2);
}
+#undef FUNC_NAME
-SCM_PROC1 (s_logior, "logior", scm_tc7_asubr, scm_logior);
-
-SCM
-scm_logior (n1, n2)
- SCM n1;
- SCM n2;
+GUILE_PROC1 (scm_logior, "logior", scm_tc7_asubr,
+ (SCM n1, SCM n2),
+"")
+#define FUNC_NAME s_scm_logior
{
+ int i1, i2;
if (SCM_UNBNDP (n2))
{
if (SCM_UNBNDP (n1))
return SCM_INUM0;
return n1;
}
- return SCM_MAKINUM (SCM_INUM (n1) | SCM_INUM (n2));
+ SCM_VALIDATE_INT_COPY(1,n1,i1);
+ SCM_VALIDATE_INT_COPY(2,n2,i2);
+ return SCM_MAKINUM (i1 | i2);
}
+#undef FUNC_NAME
-SCM_PROC1 (s_logxor, "logxor", scm_tc7_asubr, scm_logxor);
-
-SCM
-scm_logxor (n1, n2)
- SCM n1;
- SCM n2;
+GUILE_PROC1 (scm_logxor, "logxor", scm_tc7_asubr,
+ (SCM n1, SCM n2),
+"")
+#define FUNC_NAME s_scm_logxor
{
+ int i1, i2;
if (SCM_UNBNDP (n2))
{
if (SCM_UNBNDP (n1))
return SCM_INUM0;
return n1;
}
- return SCM_MAKINUM (SCM_INUM (n1) ^ SCM_INUM (n2));
+ SCM_VALIDATE_INT_COPY(1,n1,i1);
+ SCM_VALIDATE_INT_COPY(2,n2,i2);
+ return SCM_MAKINUM (i1 ^ i2);
}
+#undef FUNC_NAME
-SCM_PROC (s_logtest, "logtest", 2, 0, 0, scm_logtest);
-
-SCM
-scm_logtest (n1, n2)
- SCM n1;
- SCM n2;
+GUILE_PROC (scm_logtest, "logtest", 2, 0, 0,
+ (SCM n1, SCM n2),
+"")
+#define FUNC_NAME s_scm_logtest
{
- SCM_ASSERT (SCM_INUMP (n1), n1, SCM_ARG1, s_logtest);
- SCM_ASSERT (SCM_INUMP (n2), n2, SCM_ARG2, s_logtest);
- return (SCM_INUM (n1) & SCM_INUM (n2)) ? SCM_BOOL_T : SCM_BOOL_F;
+ int i1, i2;
+ SCM_VALIDATE_INT_COPY(1,n1,i1);
+ SCM_VALIDATE_INT_COPY(2,n2,i2);
+ return SCM_BOOL(i1 & i2);
}
+#undef FUNC_NAME
-SCM_PROC (s_logbit_p, "logbit?", 2, 0, 0, scm_logbit_p);
-
-SCM
-scm_logbit_p (n1, n2)
- SCM n1;
- SCM n2;
+GUILE_PROC (scm_logbit_p, "logbit?", 2, 0, 0,
+ (SCM n1, SCM n2),
+"")
+#define FUNC_NAME s_scm_logbit_p
{
- SCM_ASSERT (SCM_INUMP (n1) && SCM_INUM (n1) >= 0, n1, SCM_ARG1, s_logbit_p);
- SCM_ASSERT (SCM_INUMP (n2), n2, SCM_ARG2, s_logbit_p);
- return ((1 << SCM_INUM (n1)) & SCM_INUM (n2)) ? SCM_BOOL_T : SCM_BOOL_F;
+ int i1, i2;
+ SCM_VALIDATE_INT_MIN_COPY(1,n1,0,i1);
+ SCM_VALIDATE_INT_COPY(2,n2,i2);
+ return SCM_BOOL((1 << i1) & i2);
}
+#undef FUNC_NAME
#endif
-SCM_PROC (s_lognot, "lognot", 1, 0, 0, scm_lognot);
-
-SCM
-scm_lognot (n)
- SCM n;
+GUILE_PROC (scm_lognot, "lognot", 1, 0, 0,
+ (SCM n),
+"")
+#define FUNC_NAME s_scm_lognot
{
- SCM_ASSERT (SCM_INUMP (n), n, SCM_ARG1, s_lognot);
+ SCM_VALIDATE_INT(1,n);
return scm_difference (SCM_MAKINUM (-1L), n);
}
+#undef FUNC_NAME
-SCM_PROC (s_integer_expt, "integer-expt", 2, 0, 0, scm_integer_expt);
-
-SCM
-scm_integer_expt (z1, z2)
- SCM z1;
- SCM z2;
+GUILE_PROC (scm_integer_expt, "integer-expt", 2, 0, 0,
+ (SCM z1, SCM z2),
+"")
+#define FUNC_NAME s_scm_integer_expt
{
SCM acc = SCM_MAKINUM (1L);
+ int i2;
#ifdef SCM_BIGDIG
if (SCM_INUM0 == z1 || acc == z1)
return z1;
else if (SCM_MAKINUM (-1L) == z1)
return SCM_BOOL_F == scm_even_p (z2) ? z1 : acc;
#endif
- SCM_ASSERT (SCM_INUMP (z2), z2, SCM_ARG2, s_integer_expt);
- z2 = SCM_INUM (z2);
- if (z2 < 0)
+ SCM_VALIDATE_INT_COPY(2,z2,i2);
+ if (i2 < 0)
{
- z2 = -z2;
+ i2 = -i2;
z1 = scm_divide (z1, SCM_UNDEFINED);
}
while (1)
{
- if (0 == z2)
+ if (0 == i2)
return acc;
- if (1 == z2)
+ if (1 == i2)
return scm_product (acc, z1);
- if (z2 & 1)
+ if (i2 & 1)
acc = scm_product (acc, z1);
z1 = scm_product (z1, z1);
- z2 >>= 1;
+ i2 >>= 1;
}
}
+#undef FUNC_NAME
-SCM_PROC (s_ash, "ash", 2, 0, 0, scm_ash);
-
-SCM
-scm_ash (n, cnt)
- SCM n;
- SCM cnt;
+GUILE_PROC (scm_ash, "ash", 2, 0, 0,
+ (SCM n, SCM cnt),
+"")
+#define FUNC_NAME s_scm_ash
{
+ /* GJB:FIXME:: what is going on here? */
SCM res = SCM_INUM (n);
- SCM_ASSERT (SCM_INUMP (cnt), cnt, SCM_ARG2, s_ash);
+ SCM_VALIDATE_INT(2,cnt);
#ifdef SCM_BIGDIG
if (cnt < 0)
{
@@ -733,30 +745,30 @@ scm_ash (n, cnt)
else
return scm_product (n, scm_integer_expt (SCM_MAKINUM (2), cnt));
#else
- SCM_ASSERT (SCM_INUMP (n), n, SCM_ARG1, s_ash);
+ SCM_VALIDATE_INT(1,n)
cnt = SCM_INUM (cnt);
if (cnt < 0)
return SCM_MAKINUM (SCM_SRS (res, -cnt));
res = SCM_MAKINUM (res << cnt);
if (SCM_INUM (res) >> cnt != SCM_INUM (n))
- scm_num_overflow (s_ash);
+ scm_num_overflow (FUNC_NAME);
return res;
#endif
}
+#undef FUNC_NAME
-SCM_PROC (s_bit_extract, "bit-extract", 3, 0, 0, scm_bit_extract);
-
-SCM
-scm_bit_extract (n, start, end)
- SCM n;
- SCM start;
- SCM end;
+/* GJB:FIXME: do not use SCMs as integers! */
+GUILE_PROC (scm_bit_extract, "bit-extract", 3, 0, 0,
+ (SCM n, SCM start, SCM end),
+"")
+#define FUNC_NAME s_scm_bit_extract
{
- SCM_ASSERT (SCM_INUMP (start), start, SCM_ARG2, s_bit_extract);
- SCM_ASSERT (SCM_INUMP (end), end, SCM_ARG3, s_bit_extract);
+ SCM_VALIDATE_INT(1,n);
+ SCM_VALIDATE_INT_MIN(2,start,0);
+ SCM_VALIDATE_INT_MIN(3,end,0);
start = SCM_INUM (start);
end = SCM_INUM (end);
- SCM_ASSERT (end >= start, SCM_MAKINUM (end), SCM_OUTOFRANGE, s_bit_extract);
+ SCM_ASSERT (end >= start, SCM_MAKINUM (end), SCM_OUTOFRANGE, FUNC_NAME);
#ifdef SCM_BIGDIG
if (SCM_NINUMP (n))
return
@@ -765,19 +777,20 @@ scm_bit_extract (n, start, end)
SCM_MAKINUM (1L)),
scm_ash (n, SCM_MAKINUM (-start)));
#else
- SCM_ASSERT (SCM_INUMP (n), n, SCM_ARG1, s_bit_extract);
+ SCM_VALIDATE_INT(1,n);
#endif
return SCM_MAKINUM ((SCM_INUM (n) >> start) & ((1L << (end - start)) - 1));
}
+#undef FUNC_NAME
static const char scm_logtab[] = {
0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4
};
-SCM_PROC (s_logcount, "logcount", 1, 0, 0, scm_logcount);
-SCM
-scm_logcount (n)
- SCM n;
+GUILE_PROC (scm_logcount, "logcount", 1, 0, 0,
+ (SCM n),
+"")
+#define FUNC_NAME s_scm_logcount
{
register unsigned long c = 0;
register long nn;
@@ -786,7 +799,7 @@ scm_logcount (n)
{
scm_sizet i;
SCM_BIGDIG *ds, d;
- SCM_ASSERT (SCM_NIMP (n) && SCM_BIGP (n), n, SCM_ARG1, s_logcount);
+ SCM_VALIDATE_BIGINT(1,n);
if (SCM_BIGSIGN (n))
return scm_logcount (scm_difference (SCM_MAKINUM (-1L), n));
ds = SCM_BDIGITS (n);
@@ -796,7 +809,7 @@ scm_logcount (n)
return SCM_MAKINUM (c);
}
#else
- SCM_ASSERT (SCM_INUMP (n), n, SCM_ARG1, s_logcount);
+ SCM_VALIDATE_INT(1,n);
#endif
if ((nn = SCM_INUM (n)) < 0)
nn = -1 - nn;
@@ -804,15 +817,17 @@ scm_logcount (n)
c += scm_logtab[15 & nn];
return SCM_MAKINUM (c);
}
+#undef FUNC_NAME
+
static const char scm_ilentab[] = {
0, 1, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4
};
-SCM_PROC (s_integer_length, "integer-length", 1, 0, 0, scm_integer_length);
-SCM
-scm_integer_length (n)
- SCM n;
+GUILE_PROC (scm_integer_length, "integer-length", 1, 0, 0,
+ (SCM n),
+"")
+#define FUNC_NAME s_scm_integer_length
{
register unsigned long c = 0;
register long nn;
@@ -821,7 +836,7 @@ scm_integer_length (n)
if (SCM_NINUMP (n))
{
SCM_BIGDIG *ds, d;
- SCM_ASSERT (SCM_NIMP (n) && SCM_BIGP (n), n, SCM_ARG1, s_integer_length);
+ SCM_VALIDATE_BIGINT(1,n);
if (SCM_BIGSIGN (n))
return scm_integer_length (scm_difference (SCM_MAKINUM (-1L), n));
ds = SCM_BDIGITS (n);
@@ -834,7 +849,7 @@ scm_integer_length (n)
return SCM_MAKINUM (c - 4 + l);
}
#else
- SCM_ASSERT (SCM_INUMP (n), n, SCM_ARG1, s_integer_length);
+ SCM_VALIDATE_INT(1,n);
#endif
if ((nn = SCM_INUM (n)) < 0)
nn = -1 - nn;
@@ -845,15 +860,14 @@ scm_integer_length (n)
}
return SCM_MAKINUM (c - 4 + l);
}
+#undef FUNC_NAME
#ifdef SCM_BIGDIG
static const char s_bignum[] = "bignum";
SCM
-scm_mkbig (nlen, sign)
- scm_sizet nlen;
- int sign;
+scm_mkbig (scm_sizet nlen, int sign)
{
SCM v = nlen;
/* Cast to SCM to avoid signed/unsigned comparison warnings. */
@@ -870,9 +884,7 @@ scm_mkbig (nlen, sign)
SCM
-scm_big2inum (b, l)
- SCM b;
- scm_sizet l;
+scm_big2inum (SCM b, scm_sizet l)
{
unsigned long num = 0;
SCM_BIGDIG *tmp = SCM_BDIGITS (b);
@@ -892,9 +904,7 @@ scm_big2inum (b, l)
static const char s_adjbig[] = "scm_adjbig";
SCM
-scm_adjbig (b, nlen)
- SCM b;
- scm_sizet nlen;
+scm_adjbig (SCM b, scm_sizet nlen)
{
scm_sizet nsiz = nlen;
if (((nsiz << 16) >> 16) != nlen)
@@ -918,8 +928,7 @@ scm_adjbig (b, nlen)
SCM
-scm_normbig (b)
- SCM b;
+scm_normbig (SCM b)
{
#ifndef _UNICOS
scm_sizet nlen = SCM_NUMDIGS (b);
@@ -940,9 +949,7 @@ scm_normbig (b)
SCM
-scm_copybig (b, sign)
- SCM b;
- int sign;
+scm_copybig (SCM b, int sign)
{
scm_sizet i = SCM_NUMDIGS (b);
SCM ans = scm_mkbig (i, sign);
@@ -955,8 +962,7 @@ scm_copybig (b, sign)
SCM
-scm_long2big (n)
- long n;
+scm_long2big (long n)
{
scm_sizet i = 0;
SCM_BIGDIG *digits;
@@ -975,8 +981,7 @@ scm_long2big (n)
#ifdef HAVE_LONG_LONGS
SCM
-scm_long_long2big (n)
- long_long n;
+scm_long_long2big (long_long n)
{
scm_sizet i;
SCM_BIGDIG *digits;
@@ -1015,8 +1020,7 @@ scm_long_long2big (n)
SCM
-scm_2ulong2big (np)
- unsigned long *np;
+scm_2ulong2big (unsigned long *np)
{
unsigned long n;
scm_sizet i;
@@ -1044,8 +1048,7 @@ scm_2ulong2big (np)
SCM
-scm_ulong2big (n)
- unsigned long n;
+scm_ulong2big (unsigned long n)
{
scm_sizet i = 0;
SCM_BIGDIG *digits;
@@ -1062,9 +1065,7 @@ scm_ulong2big (n)
int
-scm_bigcomp (x, y)
- SCM x;
- SCM y;
+scm_bigcomp (SCM x, SCM y)
{
int xsign = SCM_BIGSIGN (x);
int ysign = SCM_BIGSIGN (y);
@@ -1105,8 +1106,7 @@ scm_bigcomp (x, y)
long
-scm_pseudolong (x)
- long x;
+scm_pseudolong (long x)
{
union
{
@@ -1130,9 +1130,7 @@ scm_pseudolong (x)
void
-scm_longdigs (x, digs)
- long x;
- SCM_BIGDIG digs[];
+scm_longdigs (long x, SCM_BIGDIG digs[])
{
scm_sizet i = 0;
if (x < 0)
@@ -1148,12 +1146,7 @@ scm_longdigs (x, digs)
SCM
-scm_addbig (x, nx, xsgn, bigy, sgny)
- SCM_BIGDIG *x;
- scm_sizet nx;
- int xsgn;
- SCM bigy;
- int sgny;
+scm_addbig (SCM_BIGDIG *x, scm_sizet nx, int xsgn, SCM bigy, int sgny)
{
/* Assumes nx <= SCM_NUMDIGS(bigy) */
/* Assumes xsgn and sgny scm_equal either 0 or 0x0100 */
@@ -1238,12 +1231,7 @@ scm_addbig (x, nx, xsgn, bigy, sgny)
SCM
-scm_mulbig (x, nx, y, ny, sgn)
- SCM_BIGDIG *x;
- scm_sizet nx;
- SCM_BIGDIG *y;
- scm_sizet ny;
- int sgn;
+scm_mulbig (SCM_BIGDIG *x, scm_sizet nx, SCM_BIGDIG *y, scm_sizet ny, int sgn)
{
scm_sizet i = 0, j = nx + ny;
unsigned long n = 0;
@@ -1299,11 +1287,7 @@ scm_divbigdig (SCM_BIGDIG * ds,
SCM
-scm_divbigint (x, z, sgn, mode)
- SCM x;
- long z;
- int sgn;
- int mode;
+scm_divbigint (SCM x, long z, int sgn, int mode)
{
if (z < 0)
z = -z;
@@ -1336,13 +1320,7 @@ scm_divbigint (x, z, sgn, mode)
SCM
-scm_divbigbig (x, nx, y, ny, sgn, modes)
- SCM_BIGDIG *x;
- scm_sizet nx;
- SCM_BIGDIG *y;
- scm_sizet ny;
- int sgn;
- int modes;
+scm_divbigbig (SCM_BIGDIG *x, scm_sizet nx, SCM_BIGDIG *y, scm_sizet ny, int sgn, int modes)
{
/* modes description
0 remainder
@@ -1551,12 +1529,8 @@ static const double fx[] =
-static scm_sizet idbl2str SCM_P ((double f, char *a));
-
static scm_sizet
-idbl2str (f, a)
- double f;
- char *a;
+idbl2str (double f, char *a)
{
int efmt, dpt, d, i, wp = scm_dblprec;
scm_sizet ch = 0;
@@ -1695,12 +1669,8 @@ idbl2str (f, a)
}
-static scm_sizet iflo2str SCM_P ((SCM flt, char *str));
-
static scm_sizet
-iflo2str (flt, str)
- SCM flt;
- char *str;
+iflo2str (SCM flt, char *str)
{
scm_sizet i;
#ifdef SCM_SINGLES
@@ -1721,12 +1691,11 @@ iflo2str (flt, str)
#endif /* SCM_FLOATS */
/* convert a long to a string (unterminated). returns the number of
- characters in the result. */
+ characters in the result.
+ rad is output base
+ p is destination: worst case (base 2) is SCM_INTBUFLEN */
scm_sizet
-scm_iint2str (num, rad, p)
- long num;
- int rad; /* output base. */
- char *p; /* destination: worst case (base 2) is SCM_INTBUFLEN. */
+scm_iint2str (long num, int rad, char *p)
{
scm_sizet j = 1;
scm_sizet i;
@@ -1757,12 +1726,8 @@ scm_iint2str (num, rad, p)
#ifdef SCM_BIGDIG
-static SCM big2str SCM_P ((SCM b, register unsigned int radix));
-
static SCM
-big2str (b, radix)
- SCM b;
- register unsigned int radix;
+big2str (SCM b, unsigned int radix)
{
SCM t = scm_copybig (b, 0); /* sign of temp doesn't matter */
register SCM_BIGDIG *ds = SCM_BDIGITS (t);
@@ -1810,21 +1775,13 @@ big2str (b, radix)
#endif
-SCM_PROC (s_number_to_string, "number->string", 1, 1, 0, scm_number_to_string);
-
-SCM
-scm_number_to_string (x, radix)
- SCM x;
- SCM radix;
+GUILE_PROC (scm_number_to_string, "number->string", 1, 1, 0,
+ (SCM x, SCM radix),
+"")
+#define FUNC_NAME s_scm_number_to_string
{
- if (SCM_UNBNDP (radix))
- radix = SCM_MAKINUM (10L);
- else
- {
- SCM_ASSERT (SCM_INUMP (radix), radix, SCM_ARG2, s_number_to_string);
- SCM_ASSERT (SCM_INUM (radix) >= 2, radix, SCM_OUTOFRANGE,
- s_number_to_string);
- }
+ int base;
+ SCM_VALIDATE_INT_MIN_DEF_COPY(2,radix,2,10,base);
#ifdef SCM_FLOATS
if (SCM_NINUMP (x))
{
@@ -1832,12 +1789,12 @@ scm_number_to_string (x, radix)
#ifdef SCM_BIGDIG
SCM_ASRTGO (SCM_NIMP (x), badx);
if (SCM_BIGP (x))
- return big2str (x, (unsigned int) SCM_INUM (radix));
+ return big2str (x, (unsigned int) base);
#ifndef SCM_RECKLESS
if (!(SCM_INEXP (x)))
{
badx:
- scm_wta (x, (char *) SCM_ARG1, s_number_to_string);
+ scm_wta (x, (char *) SCM_ARG1, FUNC_NAME);
}
#endif
#else
@@ -1852,7 +1809,7 @@ scm_number_to_string (x, radix)
{
SCM_ASSERT (SCM_NIMP (x) && SCM_BIGP (x),
x, SCM_ARG1, s_number_to_string);
- return big2str (x, (unsigned int) SCM_INUM (radix));
+ return big2str (x, (unsigned int) base);
}
#else
SCM_ASSERT (SCM_INUMP (x), x, SCM_ARG1, s_number_to_string);
@@ -1862,21 +1819,19 @@ scm_number_to_string (x, radix)
char num_buf[SCM_INTBUFLEN];
return scm_makfromstr (num_buf,
scm_iint2str (SCM_INUM (x),
- (int) SCM_INUM (radix),
+ base,
num_buf),
0);
}
}
+#undef FUNC_NAME
/* These print routines are stubbed here so that scm_repl.c doesn't need
SCM_FLOATS or SCM_BIGDIGs conditionals */
int
-scm_floprint (sexp, port, pstate)
- SCM sexp;
- SCM port;
- scm_print_state *pstate;
+scm_floprint (SCM sexp, SCM port, scm_print_state *pstate)
{
#ifdef SCM_FLOATS
char num_buf[SCM_FLOBUFLEN];
@@ -1890,10 +1845,7 @@ scm_floprint (sexp, port, pstate)
int
-scm_bigprint (exp, port, pstate)
- SCM exp;
- SCM port;
- scm_print_state *pstate;
+scm_bigprint (SCM exp, SCM port, scm_print_state *pstate)
{
#ifdef SCM_BIGDIG
exp = big2str (exp, (unsigned int) 10);
@@ -1907,13 +1859,8 @@ scm_bigprint (exp, port, pstate)
/*** STRINGS -> NUMBERS ***/
-static SCM scm_small_istr2int SCM_P ((char *str, long len, long radix));
-
static SCM
-scm_small_istr2int (str, len, radix)
- char *str;
- long len;
- long radix;
+scm_small_istr2int (char *str, long len, long radix)
{
register long n = 0, ln;
register int c;
@@ -1977,10 +1924,7 @@ scm_small_istr2int (str, len, radix)
SCM
-scm_istr2int (str, len, radix)
- char *str;
- long len;
- long radix;
+scm_istr2int (char *str, long len, long radix)
{
scm_sizet j;
register scm_sizet k, blen = 1;
@@ -2074,10 +2018,7 @@ scm_istr2int (str, len, radix)
#ifdef SCM_FLOATS
SCM
-scm_istr2flo (str, len, radix)
- char *str;
- long len;
- long radix;
+scm_istr2flo (char *str, long len, long radix)
{
register int c, i = 0;
double lead_sgn;
@@ -2366,10 +2307,7 @@ scm_istr2flo (str, len, radix)
SCM
-scm_istring2number (str, len, radix)
- char *str;
- long len;
- long radix;
+scm_istring2number (char *str, long len, long radix)
{
int i = 0;
char ex = 0;
@@ -2439,37 +2377,27 @@ scm_istring2number (str, len, radix)
}
-SCM_PROC (s_string_to_number, "string->number", 1, 1, 0, scm_string_to_number);
-
-SCM
-scm_string_to_number (str, radix)
- SCM str;
- SCM radix;
+GUILE_PROC (scm_string_to_number, "string->number", 1, 1, 0,
+ (SCM str, SCM radix),
+"")
+#define FUNC_NAME s_scm_string_to_number
{
SCM answer;
- if (SCM_UNBNDP (radix))
- radix = SCM_MAKINUM (10L);
- else
- {
- SCM_ASSERT (SCM_INUMP (radix), radix, SCM_ARG2, s_string_to_number);
- SCM_ASSERT (SCM_INUM (radix) >= 2, radix, SCM_OUTOFRANGE,
- s_number_to_string);
- }
- SCM_ASSERT (SCM_NIMP (str) && SCM_ROSTRINGP (str),
- str, SCM_ARG1, s_string_to_number);
+ int base;
+ SCM_VALIDATE_ROSTRING(1,str);
+ SCM_VALIDATE_INT_MIN_DEF_COPY(2,radix,2,10,base);
answer = scm_istring2number (SCM_ROCHARS (str),
SCM_ROLENGTH (str),
- SCM_INUM (radix));
+ base);
return scm_return_first (answer, str);
}
+#undef FUNC_NAME
/*** END strs->nums ***/
#ifdef SCM_FLOATS
SCM
-scm_makdbl (x, y)
- double x;
- double y;
+scm_makdbl (double x, double y)
{
SCM z;
if ((y == 0.0) && (x == 0.0))
@@ -2505,9 +2433,7 @@ scm_makdbl (x, y)
SCM
-scm_bigequal (x, y)
- SCM x;
- SCM y;
+scm_bigequal (SCM x, SCM y)
{
#ifdef SCM_BIGDIG
if (0 == scm_bigcomp (x, y))
@@ -2519,9 +2445,7 @@ scm_bigequal (x, y)
SCM
-scm_floequal (x, y)
- SCM x;
- SCM y;
+scm_floequal (SCM x, SCM y)
{
#ifdef SCM_FLOATS
if (SCM_REALPART (x) != SCM_REALPART (y))
@@ -2535,12 +2459,12 @@ scm_floequal (x, y)
-SCM_PROC (s_number_p, "number?", 1, 0, 0, scm_number_p);
-SCM_PROC (s_complex_p, "complex?", 1, 0, 0, scm_number_p);
+SCM_REGISTER_PROC (s_number_p, "number?", 1, 0, 0, scm_number_p);
-SCM
-scm_number_p (x)
- SCM x;
+GUILE_PROC (scm_number_p, "complex?", 1, 0, 0,
+ (SCM x),
+"")
+#define FUNC_NAME s_scm_number_p
{
if (SCM_INUMP (x))
return SCM_BOOL_T;
@@ -2555,16 +2479,18 @@ scm_number_p (x)
#endif
return SCM_BOOL_F;
}
+#undef FUNC_NAME
#ifdef SCM_FLOATS
-SCM_PROC (s_real_p, "real?", 1, 0, 0, scm_real_p);
-SCM_PROC (s_rational_p, "rational?", 1, 0, 0, scm_real_p);
+SCM_REGISTER_PROC (s_real_p, "real?", 1, 0, 0, scm_real_p);
-SCM
-scm_real_p (x)
- SCM x;
+
+GUILE_PROC (scm_real_p, "rational?", 1, 0, 0,
+ (SCM x),
+"")
+#define FUNC_NAME s_scm_real_p
{
if (SCM_INUMP (x))
return SCM_BOOL_T;
@@ -2578,14 +2504,14 @@ scm_real_p (x)
#endif
return SCM_BOOL_F;
}
+#undef FUNC_NAME
-SCM_PROC (s_int_p, "integer?", 1, 0, 0, scm_integer_p);
-
-SCM
-scm_integer_p (x)
- SCM x;
+GUILE_PROC (scm_integer_p, "integer?", 1, 0, 0,
+ (SCM x),
+"")
+#define FUNC_NAME s_scm_integer_p
{
double r;
if (SCM_INUMP (x))
@@ -2605,16 +2531,16 @@ scm_integer_p (x)
return SCM_BOOL_T;
return SCM_BOOL_F;
}
+#undef FUNC_NAME
#endif /* SCM_FLOATS */
-SCM_PROC (s_inexact_p, "inexact?", 1, 0, 0, scm_inexact_p);
-
-SCM
-scm_inexact_p (x)
- SCM x;
+GUILE_PROC (scm_inexact_p, "inexact?", 1, 0, 0,
+ (SCM x),
+"")
+#define FUNC_NAME s_scm_inexact_p
{
#ifdef SCM_FLOATS
if (SCM_NIMP (x) && SCM_INEXP (x))
@@ -2622,6 +2548,7 @@ scm_inexact_p (x)
#endif
return SCM_BOOL_F;
}
+#undef FUNC_NAME
@@ -2840,39 +2767,36 @@ scm_less_p (x, y)
}
-SCM_PROC1 (s_gr_p, ">", scm_tc7_rpsubr, scm_gr_p);
-
-SCM
-scm_gr_p (x, y)
- SCM x;
- SCM y;
+GUILE_PROC1 (scm_gr_p, ">", scm_tc7_rpsubr,
+ (SCM x, SCM y),
+"")
+#define FUNC_NAME s_scm_gr_p
{
return scm_less_p (y, x);
}
+#undef FUNC_NAME
-SCM_PROC1 (s_leq_p, "<=", scm_tc7_rpsubr, scm_leq_p);
-
-SCM
-scm_leq_p (x, y)
- SCM x;
- SCM y;
+GUILE_PROC1 (scm_leq_p, "<=", scm_tc7_rpsubr,
+ (SCM x, SCM y),
+"")
+#define FUNC_NAME s_scm_leq_p
{
return SCM_BOOL_NOT (scm_less_p (y, x));
}
+#undef FUNC_NAME
-SCM_PROC1 (s_geq_p, ">=", scm_tc7_rpsubr, scm_geq_p);
-
-SCM
-scm_geq_p (x, y)
- SCM x;
- SCM y;
+GUILE_PROC1 (scm_geq_p, ">=", scm_tc7_rpsubr,
+ (SCM x, SCM y),
+"")
+#define FUNC_NAME s_scm_geq_p
{
return SCM_BOOL_NOT (scm_less_p (x, y));
}
+#undef FUNC_NAME
@@ -4269,59 +4193,55 @@ scm_two_doubles (z1, z2, sstring, xy)
-SCM_PROC (s_sys_expt, "$expt", 2, 0, 0, scm_sys_expt);
-
-SCM
-scm_sys_expt (z1, z2)
- SCM z1;
- SCM z2;
+GUILE_PROC (scm_sys_expt, "$expt", 2, 0, 0,
+ (SCM z1, SCM z2),
+"")
+#define FUNC_NAME s_scm_sys_expt
{
struct dpair xy;
- scm_two_doubles (z1, z2, s_sys_expt, &xy);
+ scm_two_doubles (z1, z2, FUNC_NAME, &xy);
return scm_makdbl (pow (xy.x, xy.y), 0.0);
}
+#undef FUNC_NAME
-SCM_PROC (s_sys_atan2, "$atan2", 2, 0, 0, scm_sys_atan2);
-
-SCM
-scm_sys_atan2 (z1, z2)
- SCM z1;
- SCM z2;
+GUILE_PROC (scm_sys_atan2, "$atan2", 2, 0, 0,
+ (SCM z1, SCM z2),
+"")
+#define FUNC_NAME s_scm_sys_atan2
{
struct dpair xy;
- scm_two_doubles (z1, z2, s_sys_atan2, &xy);
+ scm_two_doubles (z1, z2, FUNC_NAME, &xy);
return scm_makdbl (atan2 (xy.x, xy.y), 0.0);
}
+#undef FUNC_NAME
-SCM_PROC (s_make_rectangular, "make-rectangular", 2, 0, 0, scm_make_rectangular);
-
-SCM
-scm_make_rectangular (z1, z2)
- SCM z1;
- SCM z2;
+GUILE_PROC (scm_make_rectangular, "make-rectangular", 2, 0, 0,
+ (SCM z1, SCM z2),
+"")
+#define FUNC_NAME s_scm_make_rectangular
{
struct dpair xy;
- scm_two_doubles (z1, z2, s_make_rectangular, &xy);
+ scm_two_doubles (z1, z2, FUNC_NAME, &xy);
return scm_makdbl (xy.x, xy.y);
}
+#undef FUNC_NAME
-SCM_PROC (s_make_polar, "make-polar", 2, 0, 0, scm_make_polar);
-
-SCM
-scm_make_polar (z1, z2)
- SCM z1;
- SCM z2;
+GUILE_PROC (scm_make_polar, "make-polar", 2, 0, 0,
+ (SCM z1, SCM z2),
+"")
+#define FUNC_NAME s_scm_make_polar
{
struct dpair xy;
- scm_two_doubles (z1, z2, s_make_polar, &xy);
+ scm_two_doubles (z1, z2, FUNC_NAME, &xy);
return scm_makdbl (xy.x * cos (xy.y), xy.x * sin (xy.y));
}
+#undef FUNC_NAME
@@ -4454,11 +4374,10 @@ scm_angle (z)
}
-SCM_PROC (s_inexact_to_exact, "inexact->exact", 1, 0, 0, scm_inexact_to_exact);
-
-SCM
-scm_inexact_to_exact (z)
- SCM z;
+GUILE_PROC (scm_inexact_to_exact, "inexact->exact", 1, 0, 0,
+ (SCM z),
+"")
+#define FUNC_NAME s_scm_inexact_to_exact
{
if (SCM_INUMP (z))
return z;
@@ -4470,11 +4389,11 @@ scm_inexact_to_exact (z)
if (!(SCM_REALP (z)))
{
badz:
- scm_wta (z, (char *) SCM_ARG1, s_inexact_to_exact);
+ scm_wta (z, (char *) SCM_ARG1, FUNC_NAME);
}
#endif
#else
- SCM_ASSERT (SCM_NIMP (z) && SCM_REALP (z), z, SCM_ARG1, s_inexact_to_exact);
+ SCM_VALIDATE_REAL(1,z);
#endif
#ifdef SCM_BIGDIG
{
@@ -4493,6 +4412,7 @@ scm_inexact_to_exact (z)
return SCM_MAKINUM ((long) floor (SCM_REALPART (z) + 0.5));
#endif
}
+#undef FUNC_NAME
@@ -4813,7 +4733,6 @@ scm_num2ulong (num, pos, s_caller)
#ifdef SCM_FLOATS
#ifndef DBL_DIG
-static void add1 SCM_P ((double f, double *fsum));
static void
add1 (f, fsum)
double f, *fsum;