SCM_FRACTION_DENOMINATOR (z));
}
- static int
- double_is_non_negative_zero (double x)
+ static SCM
+ scm_i_from_double (double val)
{
- static double zero = 0.0;
+ SCM z;
+
- z = PTR2SCM (scm_gc_malloc_pointerless (sizeof (scm_t_double), "real"));
++ z = SCM_PACK_POINTER (scm_gc_malloc_pointerless (sizeof (scm_t_double), "real"));
+
+ SCM_SET_CELL_TYPE (z, scm_tc16_real);
+ SCM_REAL_VALUE (z) = val;
- return !memcmp (&x, &zero, sizeof(double));
+ return z;
}
SCM_PRIMITIVE_GENERIC (scm_exact_p, "exact?", 1, 0, 0,
{
double yy = scm_i_fraction2double (y);
double xx = SCM_REAL_VALUE (x);
- return (xx < yy) ? scm_from_double (yy) : x;
+ return (xx < yy) ? scm_i_from_double (yy) : x;
}
else
- SCM_WTA_DISPATCH_2 (g_max, x, y, SCM_ARGn, s_max);
+ return scm_wta_dispatch_2 (g_max, x, y, SCM_ARGn, s_max);
}
else if (SCM_FRACTIONP (x))
{
{
double yy = scm_i_fraction2double (y);
double xx = SCM_REAL_VALUE (x);
- return (yy < xx) ? scm_from_double (yy) : x;
+ return (yy < xx) ? scm_i_from_double (yy) : x;
}
else
- SCM_WTA_DISPATCH_2 (g_min, x, y, SCM_ARGn, s_min);
+ return scm_wta_dispatch_2 (g_min, x, y, SCM_ARGn, s_min);
}
else if (SCM_FRACTIONP (x))
{
return scm_c_make_rectangular (SCM_REAL_VALUE (x) + SCM_COMPLEX_REAL (y),
SCM_COMPLEX_IMAG (y));
else if (SCM_FRACTIONP (y))
- return scm_from_double (SCM_REAL_VALUE (x) + scm_i_fraction2double (y));
+ return scm_i_from_double (SCM_REAL_VALUE (x) + scm_i_fraction2double (y));
else
- SCM_WTA_DISPATCH_2 (g_sum, x, y, SCM_ARGn, s_sum);
+ return scm_wta_dispatch_2 (g_sum, x, y, SCM_ARGn, s_sum);
}
else if (SCM_COMPLEXP (x))
{
return scm_c_make_rectangular (SCM_REAL_VALUE (x) - SCM_COMPLEX_REAL (y),
-SCM_COMPLEX_IMAG (y));
else if (SCM_FRACTIONP (y))
- return scm_from_double (SCM_REAL_VALUE (x) - scm_i_fraction2double (y));
+ return scm_i_from_double (SCM_REAL_VALUE (x) - scm_i_fraction2double (y));
else
- SCM_WTA_DISPATCH_2 (g_difference, x, y, SCM_ARGn, s_difference);
+ return scm_wta_dispatch_2 (g_difference, x, y, SCM_ARGn, s_difference);
}
else if (SCM_COMPLEXP (x))
{
return scm_c_make_rectangular (SCM_REAL_VALUE (x) * SCM_COMPLEX_REAL (y),
SCM_REAL_VALUE (x) * SCM_COMPLEX_IMAG (y));
else if (SCM_FRACTIONP (y))
- return scm_from_double (SCM_REAL_VALUE (x) * scm_i_fraction2double (y));
+ return scm_i_from_double (SCM_REAL_VALUE (x) * scm_i_fraction2double (y));
else
- SCM_WTA_DISPATCH_2 (g_product, x, y, SCM_ARGn, s_product);
+ return scm_wta_dispatch_2 (g_product, x, y, SCM_ARGn, s_product);
}
else if (SCM_COMPLEXP (x))
{
goto complex_div;
}
else if (SCM_FRACTIONP (y))
- return scm_from_double (rx / scm_i_fraction2double (y));
+ return scm_i_from_double (rx / scm_i_fraction2double (y));
else
- SCM_WTA_DISPATCH_2 (g_divide, x, y, SCM_ARGn, s_divide);
+ return scm_wta_dispatch_2 (g_divide, x, y, SCM_ARGn, s_divide);
}
else if (SCM_COMPLEXP (x))
{
else if (scm_is_real (z))
{
if (scm_is_real (y))
- return scm_from_double (atan2 (scm_to_double (z), scm_to_double (y)));
+ return scm_i_from_double (atan2 (scm_to_double (z), scm_to_double (y)));
else
- SCM_WTA_DISPATCH_2 (g_scm_atan, z, y, SCM_ARG2, s_scm_atan);
+ return scm_wta_dispatch_2 (g_scm_atan, z, y, SCM_ARG2, s_scm_atan);
}
else
- SCM_WTA_DISPATCH_2 (g_scm_atan, z, y, SCM_ARG1, s_scm_atan);
+ return scm_wta_dispatch_2 (g_scm_atan, z, y, SCM_ARG1, s_scm_atan);
}
#undef FUNC_NAME
{
if (scm_is_false (scm_negative_p (SCM_FRACTION_NUMERATOR (z))))
return flo0;
- else return scm_from_double (atan2 (0.0, -1.0));
+ else return scm_i_from_double (atan2 (0.0, -1.0));
}
else
- SCM_WTA_DISPATCH_1 (g_scm_angle, z, SCM_ARG1, s_scm_angle);
+ return scm_wta_dispatch_1 (g_scm_angle, z, SCM_ARG1, s_scm_angle);
}
#undef FUNC_NAME
else if (SCM_COMPLEXP (z) && SCM_COMPLEX_IMAG (z) == 0.0)
val = SCM_COMPLEX_REAL (z);
else
- SCM_WTA_DISPATCH_1 (g_scm_inexact_to_exact, z, 1, s_scm_inexact_to_exact);
+ return scm_wta_dispatch_1 (g_scm_inexact_to_exact, z, 1,
+ s_scm_inexact_to_exact);
- if (!SCM_LIKELY (DOUBLE_IS_FINITE (val)))
+ if (!SCM_LIKELY (isfinite (val)))
SCM_OUT_OF_RANGE (1, z);
else if (val == 0.0)
return SCM_INUM0;
SCM
scm_from_double (double val)
{
- SCM z;
-
- z = SCM_PACK_POINTER (scm_gc_malloc_pointerless (sizeof (scm_t_double), "real"));
-
- SCM_SET_CELL_TYPE (z, scm_tc16_real);
- SCM_REAL_VALUE (z) = val;
-
- return z;
+ return scm_i_from_double (val);
}
-#if SCM_ENABLE_DEPRECATED == 1
-
-float
-scm_num2float (SCM num, unsigned long pos, const char *s_caller)
-{
- scm_c_issue_deprecation_warning
- ("`scm_num2float' is deprecated. Use scm_to_double instead.");
-
- if (SCM_BIGP (num))
- {
- float res = mpz_get_d (SCM_I_BIG_MPZ (num));
- if (!isinf (res))
- return res;
- else
- scm_out_of_range (NULL, num);
- }
- else
- return scm_to_double (num);
-}
-
-double
-scm_num2double (SCM num, unsigned long pos, const char *s_caller)
-{
- scm_c_issue_deprecation_warning
- ("`scm_num2double' is deprecated. Use scm_to_double instead.");
-
- if (SCM_BIGP (num))
- {
- double res = mpz_get_d (SCM_I_BIG_MPZ (num));
- if (!isinf (res))
- return res;
- else
- scm_out_of_range (NULL, num);
- }
- else
- return scm_to_double (num);
-}
-
-#endif
-
int
scm_is_complex (SCM val)
{
{
/* When z is a negative bignum the conversion to double overflows,
giving -infinity, but that's ok, the exp is still 0.0. */
- return scm_from_double (exp (scm_to_double (z)));
+ return scm_i_from_double (exp (scm_to_double (z)));
}
else
- SCM_WTA_DISPATCH_1 (g_scm_exp, z, 1, s_scm_exp);
+ return scm_wta_dispatch_1 (g_scm_exp, z, 1, s_scm_exp);
}
#undef FUNC_NAME
*/
/* The maximum/minimum tagged integers. */
- #define INUM_MAX (INTPTR_MAX - 1)
- #define INUM_MIN (INTPTR_MIN + scm_tc2_int)
-#undef INUM_MAX
-#undef INUM_MIN
-#undef INUM_STEP
+ #define INUM_MAX \
+ ((scm_t_signed_bits) SCM_UNPACK (SCM_I_MAKINUM (SCM_MOST_POSITIVE_FIXNUM)))
+ #define INUM_MIN \
+ ((scm_t_signed_bits) SCM_UNPACK (SCM_I_MAKINUM (SCM_MOST_NEGATIVE_FIXNUM)))
+ #define INUM_STEP \
+ ((scm_t_signed_bits) SCM_UNPACK (SCM_INUM1) \
+ - (scm_t_signed_bits) SCM_UNPACK (SCM_INUM0))
-#undef FUNC2
#define FUNC2(CFUNC,SFUNC) \
{ \
ARGS2 (x, y); \
slow_sub: \
do { } while (0)
+ # define ASM_MUL(x, y) \
+ { \
+ scm_t_signed_bits xx = SCM_I_INUM (x); \
+ asm volatile goto ("mov %1, %%"_CX"; " \
+ "test %[tag], %%cl; je %l[slow_mul]; " \
+ "sub %[tag], %%"_CX"; " \
+ "test %[tag], %0; je %l[slow_mul]; " \
+ "imul %2, %%"_CX"; jo %l[slow_mul]; " \
+ "add %[tag], %%"_CX"; " \
+ "mov %%"_CX", (%[vsp])\n" \
+ : /* no outputs */ \
+ : "r" (x), "r" (y), "r" (xx), \
+ [vsp] "r" (sp), [tag] "i" (scm_tc2_int) \
+ : _CX, "memory", "cc" \
+ : slow_mul); \
+ NEXT; \
+ } \
+ slow_mul: \
+ do { } while (0)
+
#endif
+ #if SCM_GNUC_PREREQ (4, 5) && defined __arm__
+
+ # define ASM_ADD(x, y) \
+ if (SCM_LIKELY (SCM_I_INUMP (x) && SCM_I_INUMP (y))) \
+ { \
+ asm volatile goto ("adds r0, %0, %1; bvs %l[slow_add]; " \
+ "str r0, [%[vsp]]\n" \
+ : /* no outputs */ \
+ : "r" (x), "r" (y - scm_tc2_int), \
+ [vsp] "r" (sp) \
+ : "r0", "memory", "cc" \
+ : slow_add); \
+ NEXT; \
+ } \
+ slow_add: \
+ do { } while (0)
+
+ # define ASM_SUB(x, y) \
+ if (SCM_LIKELY (SCM_I_INUMP (x) && SCM_I_INUMP (y))) \
+ { \
+ asm volatile goto ("subs r0, %0, %1; bvs %l[slow_sub]; " \
+ "str r0, [%[vsp]]\n" \
+ : /* no outputs */ \
+ : "r" (x), "r" (y - scm_tc2_int), \
+ [vsp] "r" (sp) \
+ : "r0", "memory", "cc" \
+ : slow_sub); \
+ NEXT; \
+ } \
+ slow_sub: \
+ do { } while (0)
+
+ # if defined (__ARM_ARCH_3M__) || defined (__ARM_ARCH_4__) \
+ || defined (__ARM_ARCH_4T__) || defined (__ARM_ARCH_5__) \
+ || defined (__ARM_ARCH_5T__) || defined (__ARM_ARCH_5E__) \
+ || defined (__ARM_ARCH_5TE__) || defined (__ARM_ARCH_5TEJ__) \
+ || defined (__ARM_ARCH_6__) || defined (__ARM_ARCH_6J__) \
+ || defined (__ARM_ARCH_6K__) || defined (__ARM_ARCH_6Z__) \
+ || defined (__ARM_ARCH_6ZK__) || defined (__ARM_ARCH_6T2__) \
+ || defined (__ARM_ARCH_6M__) || defined (__ARM_ARCH_7__) \
+ || defined (__ARM_ARCH_7A__) || defined (__ARM_ARCH_7R__) \
+ || defined (__ARM_ARCH_7M__) || defined (__ARM_ARCH_7EM__) \
+ || defined (__ARM_ARCH_8A__)
+
+ /* The ARM architectures listed above support the SMULL instruction */
+
+ # define ASM_MUL(x, y) \
+ if (SCM_LIKELY (SCM_I_INUMP (x) && SCM_I_INUMP (y))) \
+ { \
+ scm_t_signed_bits rlo, rhi; \
+ asm ("smull %0, %1, %2, %3\n" \
+ : "=r" (rlo), "=r" (rhi) \
+ : "r" (SCM_UNPACK (x) - scm_tc2_int), \
+ "r" (SCM_I_INUM (y))); \
+ if (SCM_LIKELY (SCM_SRS (rlo, 31) == rhi)) \
+ RETURN (SCM_PACK (rlo + scm_tc2_int)); \
+ } \
+ do { } while (0)
+
+ # endif
+
+ #endif
-VM_DEFINE_FUNCTION (150, add, "add", 2)
+VM_DEFINE_FUNCTION (152, add, "add", 2)
{
#ifndef ASM_ADD
FUNC2 (+, scm_sum);
RETURN (scm_difference (x, SCM_I_MAKINUM (1)));
}
- #undef ASM_ADD
- #undef ASM_SUB
- #undef FUNC2
- #undef INUM_MAX
- #undef INUM_MIN
-
-VM_DEFINE_FUNCTION (154, mul, "mul", 2)
+VM_DEFINE_FUNCTION (156, mul, "mul", 2)
{
ARGS2 (x, y);
+ #ifdef ASM_MUL
+ ASM_MUL (x, y);
+ #endif
SYNC_REGISTER ();
RETURN (scm_product (x, y));
}
-# undef ASM_ADD
-# undef ASM_SUB
-# undef ASM_MUL
++#undef ASM_ADD
++#undef ASM_SUB
++#undef ASM_MUL
++#undef FUNC2
++#undef INUM_MAX
++#undef INUM_MIN
++#undef INUM_STEP
+
-VM_DEFINE_FUNCTION (155, div, "div", 2)
+VM_DEFINE_FUNCTION (157, div, "div", 2)
{
ARGS2 (x, y);
SYNC_REGISTER ();
HCoop / bpt / guile.git / commitdiff