mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-11 06:20:23 +02:00
Code Activity

Some dispatch sequence reordering fixes of comparisons of SCM values with

Browse source 
integer constants.
This commit is contained in:
Dirk Herrmann 2000-04-28 17:14:49 +00:00
parent 89a7e495bc
commit 09fb759974
2 changed files with 347 additions and 268 deletions
Download patch file Download diff file Expand all files Collapse all files

12
libguile/ChangeLog
View file

@ -1,3 +1,15 @@
2000-04-28 Dirk Herrmann <D.Herrmann@tu-bs.de>
* numbers.c (SCM_SWAP): Moved to the top of the file to allow for
a wider use.
* numbers.c (scm_modulo, scm_gcd, scm_lcm, scm_logand, scm_logior,
scm_logxor): Reordered dispatch sequence, thereby fixing some
comparisons of SCM values with integer constants.
* number.c (scm_logtest): Removed some redundant SCM_{N}?IMP
tests.
2000-04-28 Dirk Herrmann <D.Herrmann@tu-bs.de> 2000-04-28 Dirk Herrmann <D.Herrmann@tu-bs.de>
* numbers.c (scm_quotient, scm_remainder): Removed code that was * numbers.c (scm_quotient, scm_remainder): Removed code that was

603
libguile/numbers.c
View file

@ -62,6 +62,9 @@
case '5':case '6':case '7':case '8':case '9' case '5':case '6':case '7':case '8':case '9'
#define SCM_SWAP(x,y) do { SCM __t = x; x = y; y = __t; } while (0)
/* IS_INF tests its floating point number for infiniteness /* IS_INF tests its floating point number for infiniteness
*/ */
#ifndef IS_INF #ifndef IS_INF
@ -304,30 +307,16 @@ scm_modulo (SCM x, SCM y)
#endif #endif
return SCM_MAKINUM (((yy < 0) ? (z > 0) : (z < 0)) ? z + yy : z); return SCM_MAKINUM (((yy < 0) ? (z > 0) : (z < 0)) ? z + yy : z);
} }
} else {
#ifdef SCM_BIGDIG #ifdef SCM_BIGDIG
if (!SCM_BIGP (y)) { } else if (SCM_BIGP (y)) {
SCM_WTA_DISPATCH_2 (g_modulo, x, y, SCM_ARG2, s_modulo); return (SCM_BIGSIGN (y) ? (xx > 0) : (xx < 0)) ? scm_sum (x, y) : x;
} else {
return (SCM_BIGSIGN (y) ? (xx > 0) : (xx < 0)) ? scm_sum (x, y) : x;
}
#else
SCM_WTA_DISPATCH_2 (g_modulo, x, y, SCM_ARG2, s_modulo);
#endif #endif
}
} else {
#ifdef SCM_BIGDIG
SCM_GASSERT2 (SCM_BIGP (x), g_modulo, x, y, SCM_ARG1, s_modulo);
if (SCM_NINUMP (y)) {
if (!SCM_BIGP (y)) {
SCM_WTA_DISPATCH_2 (g_modulo, x, y, SCM_ARG2, s_modulo);
} else {
return scm_divbigbig (SCM_BDIGITS (x), SCM_NUMDIGS (x),
SCM_BDIGITS (y), SCM_NUMDIGS (y),
SCM_BIGSIGN (y),
(SCM_BIGSIGN (x) ^ SCM_BIGSIGN (y)) ? 1 : 0);
}
} else { } else {
SCM_WTA_DISPATCH_2 (g_modulo, x, y, SCM_ARG2, s_modulo);
}
#ifdef SCM_BIGDIG
} else if (SCM_BIGP (x)) {
if (SCM_INUMP (y)) {
long yy = SCM_INUM (y); long yy = SCM_INUM (y);
if (yy == 0) { if (yy == 0) {
scm_num_overflow (s_modulo); scm_num_overflow (s_modulo);
@ -335,146 +324,171 @@ scm_modulo (SCM x, SCM y)
return scm_divbigint (x, yy, yy < 0, return scm_divbigint (x, yy, yy < 0,
(SCM_BIGSIGN (x) ? (yy > 0) : (yy < 0)) ? 1 : 0); (SCM_BIGSIGN (x) ? (yy > 0) : (yy < 0)) ? 1 : 0);
} }
} else if (SCM_BIGP (y)) {
return scm_divbigbig (SCM_BDIGITS (x), SCM_NUMDIGS (x),
SCM_BDIGITS (y), SCM_NUMDIGS (y),
SCM_BIGSIGN (y),
(SCM_BIGSIGN (x) ^ SCM_BIGSIGN (y)) ? 1 : 0);
} else {
SCM_WTA_DISPATCH_2 (g_modulo, x, y, SCM_ARG2, s_modulo);
} }
#else
SCM_WTA_DISPATCH_2 (g_modulo, x, y, SCM_ARG2, s_modulo);
#endif #endif
} else {
SCM_WTA_DISPATCH_2 (g_modulo, x, y, SCM_ARG1, s_modulo);
} }
} }
SCM_GPROC1 (s_gcd, "gcd", scm_tc7_asubr, scm_gcd, g_gcd); SCM_GPROC1 (s_gcd, "gcd", scm_tc7_asubr, scm_gcd, g_gcd);
SCM SCM
scm_gcd (SCM x, SCM y) scm_gcd (SCM x, SCM y)
{ {
long u, v, k, t; if (SCM_UNBNDP (y)) {
if (SCM_UNBNDP (y)) if (SCM_UNBNDP (x)) {
return SCM_UNBNDP (x) ? SCM_INUM0 : x; return SCM_INUM0;
} else {
return x;
}
}
tailrec: tailrec:
#ifdef SCM_BIGDIG if (SCM_INUMP (x)) {
if (SCM_NINUMP (x)) if (SCM_INUMP (y)) {
{ long xx = SCM_INUM (x);
big_gcd: long yy = SCM_INUM (y);
SCM_GASSERT2 (SCM_BIGP (x), long u = xx < 0 ? -xx : xx;
g_gcd, x, y, SCM_ARG1, s_gcd); long v = yy < 0 ? -yy : yy;
if (SCM_BIGSIGN (x)) long result;
x = scm_copybig (x, 0);
newy: if (xx == 0) {
if (SCM_NINUMP (y)) result = v;
{ } else if (yy == 0) {
SCM_GASSERT2 (SCM_BIGP (y), result = u;
g_gcd, x, y, SCM_ARGn, s_gcd); } else {
if (SCM_BIGSIGN (y)) int k = 1;
y = scm_copybig (y, 0); long t;
switch (scm_bigcomp (x, y))
{ /* Determine a common factor 2^k */
case -1: while (!(1 & (u | v))) {
swaprec: k <<= 1;
{ u >>= 1;
SCM t = scm_remainder (x, y); v >>= 1;
x = y;
y = t;
}
goto tailrec;
case 0:
return x;
case 1:
y = scm_remainder (y, x);
goto newy;
}
/* instead of the switch, we could just
return scm_gcd (y, scm_modulo (x, y)); */
} }
if (SCM_EQ_P (y, SCM_INUM0))
return x; /* Now, any factor 2^n can be eliminated */
goto swaprec; if (u & 1) {
} t = -v;
if (SCM_NINUMP (y)) } else {
{ t = u;
SCM t = x; b3:
x = y; t = SCM_SRS (t, 1);
y = t; }
goto big_gcd; if (!(1 & t))
} goto b3;
#else if (t > 0)
SCM_GASSERT2 (SCM_INUMP (x), g_gcd, x, y, SCM_ARG1, s_gcd); u = t;
SCM_GASSERT2 (SCM_INUMP (y), g_gcd, x, y, SCM_ARGn, s_gcd); else
#endif v = -t;
u = SCM_INUM (x); t = u - v;
if (u < 0) if (t != 0)
u = -u; goto b3;
v = SCM_INUM (y);
if (v < 0) result = u * k;
v = -v; }
else if (0 == v) if (SCM_POSFIXABLE (result)) {
goto getout; return SCM_MAKINUM (result);
if (0 == u) } else {
{
u = v;
goto getout;
}
for (k = 1; !(1 & ((int) u | (int) v)); k <<= 1, u >>= 1, v >>= 1);
if (1 & (int) u)
t = -v;
else
{
t = u;
b3:
t = SCM_SRS (t, 1);
}
if (!(1 & (int) t))
goto b3;
if (t > 0)
u = t;
else
v = -t;
if ((t = u - v))
goto b3;
u = u * k;
getout:
if (!SCM_POSFIXABLE (u))
#ifdef SCM_BIGDIG #ifdef SCM_BIGDIG
return scm_long2big (u); return scm_long2big (result);
#else #else
scm_num_overflow (s_gcd); scm_num_overflow (s_gcd);
#endif #endif
return SCM_MAKINUM (u); }
#ifdef SCM_BIGDIG
} else if (SCM_BIGP (y)) {
SCM_SWAP (x, y);
goto big_gcd;
#endif
} else {
SCM_WTA_DISPATCH_2 (g_gcd, x, y, SCM_ARG2, s_gcd);
}
#ifdef SCM_BIGDIG
} else if (SCM_BIGP (x)) {
big_gcd:
if (SCM_BIGSIGN (x))
x = scm_copybig (x, 0);
newy:
if (SCM_INUMP (y)) {
if (SCM_EQ_P (y, SCM_INUM0)) {
return x;
} else {
goto swaprec;
}
} else if (SCM_BIGP (y)) {
if (SCM_BIGSIGN (y))
y = scm_copybig (y, 0);
switch (scm_bigcomp (x, y))
{
case -1: /* x > y */
swaprec:
{
SCM t = scm_remainder (x, y);
x = y;
y = t;
}
goto tailrec;
case 1: /* x < y */
y = scm_remainder (y, x);
goto newy;
default: /* x == y */
return x;
}
/* instead of the switch, we could just
return scm_gcd (y, scm_modulo (x, y)); */
} else {
SCM_WTA_DISPATCH_2 (g_gcd, x, y, SCM_ARG2, s_gcd);
}
#endif
} else {
SCM_WTA_DISPATCH_2 (g_gcd, x, y, SCM_ARG1, s_gcd);
}
} }
SCM_GPROC1 (s_lcm, "lcm", scm_tc7_asubr, scm_lcm, g_lcm); SCM_GPROC1 (s_lcm, "lcm", scm_tc7_asubr, scm_lcm, g_lcm);
SCM SCM
scm_lcm (SCM n1, SCM n2) scm_lcm (SCM n1, SCM n2)
{ {
SCM d; if (SCM_UNBNDP (n2)) {
if (SCM_UNBNDP (n1)) {
return SCM_MAKINUM (1L);
} else {
n2 = SCM_MAKINUM (1L);
}
};
#ifndef SCM_BIGDIG #ifndef SCM_BIGDIG
SCM_GASSERT2 (SCM_INUMP (n1) || SCM_UNBNDP (n1), SCM_GASSERT2 (SCM_INUMP (n1), g_lcm, n1, n2, SCM_ARG1, s_lcm);
g_lcm, n1, n2, SCM_ARG1, s_lcm); SCM_GASSERT2 (SCM_INUMP (n2), g_lcm, n1, n2, SCM_ARGn, s_lcm);
SCM_GASSERT2 (SCM_INUMP (n2) || SCM_UNBNDP (n2),
g_lcm, n1, n2, SCM_ARGn, s_lcm);
#else #else
SCM_GASSERT2 (SCM_INUMP (n1) SCM_GASSERT2 (SCM_INUMP (n1) || SCM_BIGP (n1),
|| SCM_UNBNDP (n1)
|| (SCM_BIGP (n1)),
g_lcm, n1, n2, SCM_ARG1, s_lcm); g_lcm, n1, n2, SCM_ARG1, s_lcm);
SCM_GASSERT2 (SCM_INUMP (n2) SCM_GASSERT2 (SCM_INUMP (n2) || SCM_BIGP (n2),
|| SCM_UNBNDP (n2)
|| (SCM_BIGP (n2)),
g_lcm, n1, n2, SCM_ARGn, s_lcm); g_lcm, n1, n2, SCM_ARGn, s_lcm);
#endif #endif
if (SCM_UNBNDP (n2))
{ {
n2 = SCM_MAKINUM (1L); SCM d = scm_gcd (n1, n2);
if (SCM_UNBNDP (n1)) if (SCM_EQ_P (d, SCM_INUM0)) {
return n2; return d;
} else {
return scm_abs (scm_product (n1, scm_quotient (n2, d)));
} }
}
d = scm_gcd (n1, n2);
if (SCM_EQ_P (d, SCM_INUM0))
return d;
return scm_abs (scm_product (n1, scm_quotient (n2, d)));
} }
#ifndef scm_long2num #ifndef scm_long2num
#define SCM_LOGOP_RETURN(x) scm_ulong2num(x) #define SCM_LOGOP_RETURN(x) scm_ulong2num(x)
#else #else
@ -703,6 +717,7 @@ SCM scm_big_test(SCM_BIGDIG *x, scm_sizet nx, int xsgn, SCM bigy)
#endif #endif
SCM_DEFINE1 (scm_logand, "logand", scm_tc7_asubr, SCM_DEFINE1 (scm_logand, "logand", scm_tc7_asubr,
(SCM n1, SCM n2), (SCM n1, SCM n2),
"Returns the integer which is the bit-wise AND of the two integer\n" "Returns the integer which is the bit-wise AND of the two integer\n"
@ -713,61 +728,83 @@ SCM_DEFINE1 (scm_logand, "logand", scm_tc7_asubr,
" @result{} \"1000\"") " @result{} \"1000\"")
#define FUNC_NAME s_scm_logand #define FUNC_NAME s_scm_logand
{ {
if (SCM_UNBNDP (n2)) if (SCM_UNBNDP (n2)) {
{ if (SCM_UNBNDP (n1)) {
if (SCM_UNBNDP (n1)) return SCM_MAKINUM (-1);
return SCM_MAKINUM (-1); } else if (!SCM_NUMBERP (n1)) {
SCM_WRONG_TYPE_ARG (SCM_ARG1, n1);
#ifndef SCM_RECKLESS #ifndef SCM_RECKLESS
if (!(SCM_NUMBERP (n1))) } else if (SCM_NUMBERP (n1)) {
badx: SCM_WTA (SCM_ARG1, n1);
#endif
return n1; return n1;
} else {
SCM_WRONG_TYPE_ARG (SCM_ARG1, n1);
#else
} else {
return n1;
#endif
}
}
if (SCM_INUMP (n1)) {
long nn1 = SCM_INUM (n1);
if (SCM_INUMP (n2)) {
long nn2 = SCM_INUM (n2);
return SCM_MAKINUM (nn1 & nn2);
#ifdef SCM_BIGDIG
} else if SCM_BIGP (n2) {
intbig:
{
# ifndef SCM_DIGSTOOBIG
long z = scm_pseudolong (nn1);
if ((nn1 < 0) && SCM_BIGSIGN (n2)) {
return scm_big_ior ((SCM_BIGDIG *) & z, SCM_DIGSPERLONG,
SCM_BIGSIGNFLAG, n2);
} else {
return scm_big_and ((SCM_BIGDIG *) & z, SCM_DIGSPERLONG,
(nn1 < 0) ? SCM_BIGSIGNFLAG : 0, n2, 0);
}
# else
SCM_BIGDIG zdigs [SCM_DIGSPERLONG];
scm_longdigs (nn1, zdigs);
if ((nn1 < 0) && SCM_BIGSIGN (n2)) {
return scm_big_ior (zdigs, SCM_DIGSPERLONG, SCM_BIGSIGNFLAG, n2);
} else {
return scm_big_and (zdigs, SCM_DIGSPERLONG,
(nn1 < 0) ? SCM_BIGSIGNFLAG : 0, n2, 0);
}
# endif
}
# endif
} else {
SCM_WRONG_TYPE_ARG (SCM_ARG2, n2);
} }
#ifdef SCM_BIGDIG #ifdef SCM_BIGDIG
if SCM_NINUMP(n1) { } else if (SCM_BIGP (n1)) {
SCM t; if (SCM_INUMP (n2)) {
SCM_ASRTGO(SCM_NIMP(n1) && SCM_BIGP(n1), badx); SCM_SWAP (n1, n2);
if SCM_INUMP(n2) {t = n1; n1 = n2; n2 = t; goto intbig;} goto intbig;
SCM_ASRTGO(SCM_NIMP(n2) && SCM_BIGP(n2), bady); } else if (SCM_BIGP (n2)) {
if (SCM_NUMDIGS(n1) > SCM_NUMDIGS(n2)) {t = n1; n1 = n2; n2 = t;} if (SCM_NUMDIGS (n1) > SCM_NUMDIGS (n2)) {
if ((SCM_BIGSIGN(n1)) && SCM_BIGSIGN(n2)) SCM_SWAP (n1, n2);
return scm_big_ior (SCM_BDIGITS(n1), };
SCM_NUMDIGS(n1), if ((SCM_BIGSIGN (n1)) && SCM_BIGSIGN (n2)) {
SCM_BIGSIGNFLAG, return scm_big_ior (SCM_BDIGITS (n1), SCM_NUMDIGS (n1),
n2); SCM_BIGSIGNFLAG, n2);
return scm_big_and (SCM_BDIGITS(n1), } else {
SCM_NUMDIGS(n1), return scm_big_and (SCM_BDIGITS (n1), SCM_NUMDIGS (n1),
SCM_BIGSIGN(n1), SCM_BIGSIGN (n1), n2, 0);
n2, }
0); } else {
SCM_WRONG_TYPE_ARG (SCM_ARG2, n2);
}
# endif
} else {
SCM_WRONG_TYPE_ARG (SCM_ARG1, n1);
} }
if SCM_NINUMP(n2) {
# ifndef SCM_RECKLESS
if (!(SCM_NIMP(n2) && SCM_BIGP(n2)))
bady: SCM_WTA (SCM_ARG2, n2);
# endif
intbig: {
# ifndef SCM_DIGSTOOBIG
long z = scm_pseudolong(SCM_INUM(n1));
if ((n1 < 0) && SCM_BIGSIGN(n2))
return scm_big_ior((SCM_BIGDIG *)&z, SCM_DIGSPERLONG, SCM_BIGSIGNFLAG, n2);
return scm_big_and((SCM_BIGDIG *)&z, SCM_DIGSPERLONG, (n1 < 0) ? SCM_BIGSIGNFLAG : 0, n2, 0);
# else
SCM_BIGDIG zdigs[SCM_DIGSPERLONG];
scm_longdigs(SCM_INUM(n1), zdigs);
if ((n1 < 0) && SCM_BIGSIGN(n2))
return scm_big_ior(zdigs, SCM_DIGSPERLONG, SCM_BIGSIGNFLAG, n2);
return scm_big_and(zdigs, SCM_DIGSPERLONG, (n1 < 0) ? SCM_BIGSIGNFLAG : 0, n2, 0);
# endif
}}
#else
SCM_ASRTGO(SCM_INUMP(n1), badx);
SCM_ASSERT(SCM_INUMP(n2), n2, SCM_ARG2, FUNC_NAME);
#endif
return SCM_MAKINUM(SCM_INUM(n1) & SCM_INUM(n2));
} }
#undef FUNC_NAME #undef FUNC_NAME
SCM_DEFINE1 (scm_logior, "logior", scm_tc7_asubr, SCM_DEFINE1 (scm_logior, "logior", scm_tc7_asubr,
(SCM n1, SCM n2), (SCM n1, SCM n2),
"Returns the integer which is the bit-wise OR of the two integer\n" "Returns the integer which is the bit-wise OR of the two integer\n"
@ -779,54 +816,82 @@ SCM_DEFINE1 (scm_logior, "logior", scm_tc7_asubr,
"@end lisp") "@end lisp")
#define FUNC_NAME s_scm_logior #define FUNC_NAME s_scm_logior
{ {
if (SCM_UNBNDP (n2)) if (SCM_UNBNDP (n2)) {
{ if (SCM_UNBNDP (n1)) {
if (SCM_UNBNDP (n1)) return SCM_INUM0;
return SCM_INUM0;
#ifndef SCM_RECKLESS #ifndef SCM_RECKLESS
if (!(SCM_NUMBERP(n1))) } else if (SCM_NUMBERP (n1)) {
badx: SCM_WTA(SCM_ARG1, n1);
#endif
return n1; return n1;
} else {
SCM_WRONG_TYPE_ARG (SCM_ARG1, n1);
#else
} else {
return n1;
#endif
}
}
if (SCM_INUMP (n1)) {
long nn1 = SCM_INUM (n1);
if (SCM_INUMP (n2)) {
long nn2 = SCM_INUM (n2);
return SCM_MAKINUM (nn1 | nn2);
#ifdef SCM_BIGDIG
} else if (SCM_BIGP (n2)) {
intbig:
{
# ifndef SCM_DIGSTOOBIG
long z = scm_pseudolong (nn1);
if ((!(nn1 < 0)) && !SCM_BIGSIGN (n2)) {
return scm_big_ior ((SCM_BIGDIG *) & z, SCM_DIGSPERLONG,
(nn1 < 0) ? SCM_BIGSIGNFLAG : 0, n2);
} else {
return scm_big_and ((SCM_BIGDIG *) & z, SCM_DIGSPERLONG,
(nn1 < 0) ? SCM_BIGSIGNFLAG : 0, n2, SCM_BIGSIGNFLAG);
}
# else
BIGDIG zdigs [DIGSPERLONG];
scm_longdigs (nn1, zdigs);
if ((!(nn1 < 0)) && !SCM_BIGSIGN (n2)) {
return scm_big_ior (zdigs, SCM_DIGSPERLONG,
(nn1 < 0) ? SCM_BIGSIGNFLAG : 0, n2);
} else {
return scm_big_and (zdigs, SCM_DIGSPERLONG,
(nn1 < 0) ? SCM_BIGSIGNFLAG : 0, n2, SCM_BIGSIGNFLAG);
}
# endif
}
#endif
} else {
SCM_WRONG_TYPE_ARG (SCM_ARG2, n2);
} }
#ifdef SCM_BIGDIG #ifdef SCM_BIGDIG
if SCM_NINUMP(n1) { } else if (SCM_BIGP (n1)) {
SCM t; if (SCM_INUMP (n2)) {
SCM_ASRTGO(SCM_NIMP(n1) && SCM_BIGP(n1), badx); SCM_SWAP (n1, n2);
if SCM_INUMP(n2) {t = n1; n1 = n2; n2 = t; goto intbig;} goto intbig;
SCM_ASRTGO(SCM_NIMP(n2) && SCM_BIGP(n2), bady); } else if (SCM_BIGP (n2)) {
if (SCM_NUMDIGS(n1) > SCM_NUMDIGS(n2)) {t = n1; n1 = n2; n2 = t;} if (SCM_NUMDIGS (n1) > SCM_NUMDIGS (n2)) {
if ((!SCM_BIGSIGN(n1)) && !SCM_BIGSIGN(n2)) SCM_SWAP (n1, n2);
return scm_big_ior(SCM_BDIGITS(n1), SCM_NUMDIGS(n1), SCM_BIGSIGN(n1), n2); };
return scm_big_and(SCM_BDIGITS(n1), SCM_NUMDIGS(n1), SCM_BIGSIGN(n1), n2, SCM_BIGSIGNFLAG); if ((!SCM_BIGSIGN (n1)) && !SCM_BIGSIGN (n2)) {
} return scm_big_ior (SCM_BDIGITS (n1), SCM_NUMDIGS (n1),
if SCM_NINUMP(n2) { SCM_BIGSIGN (n1), n2);
# ifndef SCM_RECKLESS } else {
if (!(SCM_NIMP(n2) && SCM_BIGP(n2))) return scm_big_and (SCM_BDIGITS (n1), SCM_NUMDIGS (n1),
bady: SCM_WTA(SCM_ARG2, n2); SCM_BIGSIGN (n1), n2, SCM_BIGSIGNFLAG);
# endif }
intbig: { } else {
# ifndef SCM_DIGSTOOBIG SCM_WRONG_TYPE_ARG (SCM_ARG2, n2);
long z = scm_pseudolong(SCM_INUM(n1)); }
if ((!(n1 < 0)) && !SCM_BIGSIGN(n2))
return scm_big_ior((SCM_BIGDIG *)&z, SCM_DIGSPERLONG, (n1 < 0) ? SCM_BIGSIGNFLAG : 0, n2);
return scm_big_and((SCM_BIGDIG *)&z, SCM_DIGSPERLONG, (n1 < 0) ? SCM_BIGSIGNFLAG : 0, n2, SCM_BIGSIGNFLAG);
# else
BIGDIG zdigs[DIGSPERLONG];
scm_longdigs(SCM_INUM(n1), zdigs);
if ((!(n1 < 0)) && !SCM_BIGSIGN(n2))
return scm_big_ior(zdigs, SCM_DIGSPERLONG, (n1 < 0) ? SCM_BIGSIGNFLAG : 0, n2);
return scm_big_and(zdigs, SCM_DIGSPERLONG, (n1 < 0) ? SCM_BIGSIGNFLAG : 0, n2, SCM_BIGSIGNFLAG);
# endif
}}
#else
SCM_ASRTGO(SCM_INUMP(n1), badx);
SCM_ASSERT(SCM_INUMP(n2), n2, SCM_ARG2, FUNC_NAME);
#endif #endif
return SCM_MAKINUM(SCM_INUM(n1) | SCM_INUM(n2)); } else {
SCM_WRONG_TYPE_ARG (SCM_ARG1, n1);
}
} }
#undef FUNC_NAME #undef FUNC_NAME
SCM_DEFINE1 (scm_logxor, "logxor", scm_tc7_asubr, SCM_DEFINE1 (scm_logxor, "logxor", scm_tc7_asubr,
(SCM n1, SCM n2), (SCM n1, SCM n2),
"Returns the integer which is the bit-wise XOR of the two integer\n" "Returns the integer which is the bit-wise XOR of the two integer\n"
@ -838,61 +903,67 @@ SCM_DEFINE1 (scm_logxor, "logxor", scm_tc7_asubr,
"@end lisp") "@end lisp")
#define FUNC_NAME s_scm_logxor #define FUNC_NAME s_scm_logxor
{ {
if (SCM_UNBNDP (n2)) if (SCM_UNBNDP (n2)) {
{ if (SCM_UNBNDP (n1)) {
if (SCM_UNBNDP (n1)) return SCM_INUM0;
return SCM_INUM0;
#ifndef SCM_RECKLESS #ifndef SCM_RECKLESS
if (!(SCM_NUMBERP(n1))) } else if (SCM_NUMBERP (n1)) {
badx: SCM_WTA(SCM_ARG1, n1);
#endif
return n1; return n1;
} else {
SCM_WRONG_TYPE_ARG (SCM_ARG1, n1);
#else
} else {
return n1;
#endif
} }
#ifdef SCM_BIGDIG
if SCM_NINUMP(n1) {
SCM t;
SCM_ASRTGO(SCM_NIMP(n1) && SCM_BIGP(n1), badx);
if SCM_INUMP(n2)
{
t = n1;
n1 = n2;
n2 = t;
goto intbig;
}
SCM_ASRTGO(SCM_NIMP(n2) && SCM_BIGP(n2), bady);
if (SCM_NUMDIGS(n1) > SCM_NUMDIGS(n2))
{
t = n1;
n1 = n2;
n2 = t;
}
return scm_big_xor(SCM_BDIGITS(n1), SCM_NUMDIGS(n1), SCM_BIGSIGN(n1), n2);
} }
if SCM_NINUMP(n2) {
# ifndef SCM_RECKLESS if (SCM_INUMP (n1)) {
if (!(SCM_NIMP(n2) && SCM_BIGP(n2))) long nn1 = SCM_INUM (n1);
bady: SCM_WTA (SCM_ARG2, n2); if (SCM_INUMP (n2)) {
# endif long nn2 = SCM_INUM (n2);
intbig: return SCM_MAKINUM (nn1 ^ nn2);
#ifdef SCM_BIGDIG
} else if (SCM_BIGP (n2)) {
intbig:
{ {
# ifndef SCM_DIGSTOOBIG # ifndef SCM_DIGSTOOBIG
long z = scm_pseudolong(SCM_INUM(n1)); long z = scm_pseudolong (nn1);
return scm_big_xor((SCM_BIGDIG *)&z, SCM_DIGSPERLONG, (n1 < 0) ? SCM_BIGSIGNFLAG : 0, n2); return scm_big_xor ((SCM_BIGDIG *) & z, SCM_DIGSPERLONG,
(nn1 < 0) ? SCM_BIGSIGNFLAG : 0, n2);
# else # else
SCM_BIGDIG zdigs[SCM_DIGSPERLONG]; SCM_BIGDIG zdigs [SCM_DIGSPERLONG];
scm_longdigs(SCM_INUM(n1), zdigs); scm_longdigs (nn1, zdigs);
return scm_big_xor(zdigs, SCM_DIGSPERLONG, (n1 < 0) ? SCM_BIGSIGNFLAG : 0, n2); return scm_big_xor (zdigs, SCM_DIGSPERLONG,
(nn1 < 0) ? SCM_BIGSIGNFLAG : 0, n2);
# endif # endif
} }
}
#else
SCM_ASRTGO(INUMP(n1), badx);
SCM_ASSERT(INUMP(n2), n2, SCM_ARG2, FUNC_NAME);
#endif #endif
return SCM_MAKINUM(SCM_INUM(n1) ^ SCM_INUM(n2)); } else {
SCM_WRONG_TYPE_ARG (SCM_ARG2, n2);
}
#ifdef SCM_BIGDIG
} else if (SCM_BIGP (n1)) {
if (SCM_INUMP (n2)) {
SCM_SWAP (n1, n2);
goto intbig;
} else if (SCM_BIGP (n2)) {
if (SCM_NUMDIGS(n1) > SCM_NUMDIGS(n2)) {
SCM_SWAP (n1, n2);
}
return scm_big_xor (SCM_BDIGITS (n1), SCM_NUMDIGS (n1),
SCM_BIGSIGN (n1), n2);
} else {
SCM_WRONG_TYPE_ARG (SCM_ARG2, n2);
}
# endif
} else {
SCM_WRONG_TYPE_ARG (SCM_ARG1, n1);
}
} }
#undef FUNC_NAME #undef FUNC_NAME
SCM_DEFINE (scm_logtest, "logtest", 2, 0, 0, SCM_DEFINE (scm_logtest, "logtest", 2, 0, 0,
(SCM n1, SCM n2), (SCM n1, SCM n2),
"@example\n" "@example\n"
@ -909,15 +980,15 @@ SCM_DEFINE (scm_logtest, "logtest", 2, 0, 0,
#ifdef SCM_BIGDIG #ifdef SCM_BIGDIG
if SCM_NINUMP(n1) { if SCM_NINUMP(n1) {
SCM t; SCM t;
SCM_ASRTGO(SCM_NIMP(n1) && SCM_BIGP(n1), badx); SCM_ASRTGO(SCM_BIGP (n1), badx);
if SCM_INUMP(n2) {t = n1; n1 = n2; n2 = t; goto intbig;} if SCM_INUMP(n2) {t = n1; n1 = n2; n2 = t; goto intbig;}
SCM_ASRTGO(SCM_NIMP(n2) && SCM_BIGP(n2), bady); SCM_ASRTGO(SCM_BIGP (n2), bady);
if (SCM_NUMDIGS(n1) > SCM_NUMDIGS(n2)) {t = n1; n1 = n2; n2 = t;} if (SCM_NUMDIGS(n1) > SCM_NUMDIGS(n2)) {t = n1; n1 = n2; n2 = t;}
return scm_big_test(SCM_BDIGITS(n1), SCM_NUMDIGS(n1), SCM_BIGSIGN(n1), n2); return scm_big_test(SCM_BDIGITS(n1), SCM_NUMDIGS(n1), SCM_BIGSIGN(n1), n2);
} }
if SCM_NINUMP(n2) { if SCM_NINUMP(n2) {
# ifndef SCM_RECKLESS # ifndef SCM_RECKLESS
if (!(SCM_NIMP(n2) && SCM_BIGP(n2))) if (!SCM_BIGP (n2))
bady: SCM_WTA(SCM_ARG2, n2); bady: SCM_WTA(SCM_ARG2, n2);
# endif # endif
intbig: { intbig: {
@ -954,7 +1025,7 @@ SCM_DEFINE (scm_logbit_p, "logbit?", 2, 0, 0,
SCM_ASSERT(SCM_INUMP(index) && SCM_INUM(index) >= 0, index, SCM_ARG1, FUNC_NAME); SCM_ASSERT(SCM_INUMP(index) && SCM_INUM(index) >= 0, index, SCM_ARG1, FUNC_NAME);
#ifdef SCM_BIGDIG #ifdef SCM_BIGDIG
if SCM_NINUMP(j) { if SCM_NINUMP(j) {
SCM_ASSERT(SCM_NIMP(j) && SCM_BIGP(j), j, SCM_ARG2, FUNC_NAME); SCM_ASSERT(SCM_BIGP (j), j, SCM_ARG2, FUNC_NAME);
if (SCM_NUMDIGS(j) * SCM_BITSPERDIG < SCM_INUM(index)) return SCM_BOOL_F; if (SCM_NUMDIGS(j) * SCM_BITSPERDIG < SCM_INUM(index)) return SCM_BOOL_F;
else if SCM_BIGSIGN(j) { else if SCM_BIGSIGN(j) {
long num = -1; long num = -1;
@ -3232,10 +3303,6 @@ scm_max (SCM x, SCM y)
} }
#define SCM_SWAP(x,y) do { SCM t = x; x = y; y = t; } while (0)
SCM_GPROC1 (s_min, "min", scm_tc7_asubr, scm_min, g_min); SCM_GPROC1 (s_min, "min", scm_tc7_asubr, scm_min, g_min);
SCM SCM