summaryrefslogtreecommitdiff
path: root/libguile/num2integral.i.c
diff options
context:
space:
mode:
Diffstat (limited to 'libguile/num2integral.i.c')
-rw-r--r--libguile/num2integral.i.c165
1 files changed, 165 insertions, 0 deletions
diff --git a/libguile/num2integral.i.c b/libguile/num2integral.i.c
new file mode 100644
index 000000000..3e5d65389
--- /dev/null
+++ b/libguile/num2integral.i.c
@@ -0,0 +1,165 @@
+/* this file is #include'd (many times) by numbers.c */
+
+ITYPE
+NUM2INTEGRAL (SCM num, unsigned long int pos, const char *s_caller)
+{
+ if (SCM_INUMP (num))
+ { /* immediate */
+
+ scm_bits_t n = SCM_INUM (num);
+
+#ifdef UNSIGNED
+ if (n < 0)
+ scm_out_of_range (s_caller, num);
+#endif
+
+ if (sizeof (ITYPE) >= sizeof (scm_bits_t))
+ /* can't fit anything too big for this type in an inum
+ anyway */
+ return (ITYPE) n;
+ else
+ { /* an inum can be out of range, so check */
+ if (n > (scm_bits_t)MAX_VALUE
+#ifndef UNSIGNED
+ || n < (scm_bits_t)MIN_VALUE
+#endif
+ )
+ scm_out_of_range (s_caller, num);
+ else
+ return (ITYPE) n;
+ }
+ }
+ else if (SCM_BIGP (num))
+ { /* bignum */
+
+ ITYPE res = 0;
+ size_t l;
+
+ for (l = SCM_NUMDIGS (num); l--;)
+ {
+ ITYPE new = SCM_I_BIGUP (ITYPE, res) + SCM_BDIGITS (num)[l];
+ if (new < res
+#ifndef UNSIGNED
+ && !(new == MIN_VALUE && l == 0)
+#endif
+ )
+ scm_out_of_range (s_caller, num);
+ res = new;
+ }
+
+#ifndef UNSIGNED
+ if (SCM_BIGSIGN (num))
+ {
+ res = -res;
+ if (res <= 0)
+ return res;
+ else
+ scm_out_of_range (s_caller, num);
+ }
+ else
+ {
+ if (res >= 0)
+ return res;
+ else
+ scm_out_of_range (s_caller, num);
+ }
+#endif
+
+ return res;
+ }
+ else if (SCM_REALP (num))
+ { /* inexact */
+
+ double u = SCM_REAL_VALUE (num);
+ ITYPE res = u;
+ if ((double) res == u)
+ return res;
+ else
+ scm_out_of_range (s_caller, num);
+ }
+ else
+ scm_wrong_type_arg (s_caller, pos, num);
+}
+
+SCM
+INTEGRAL2NUM (ITYPE n)
+{
+ if (sizeof (ITYPE) < sizeof (scm_bits_t)
+ ||
+#ifndef UNSIGNED
+ SCM_FIXABLE (n)
+#else
+ SCM_POSFIXABLE (n)
+#endif
+ )
+ return SCM_MAKINUM (n);
+
+#ifdef SCM_BIGDIG
+ return INTEGRAL2BIG (n);
+#else
+ return scm_make_real ((double) n);
+#endif
+}
+
+#ifdef SCM_BIGDIG
+
+SCM
+INTEGRAL2BIG (ITYPE n)
+{
+ SCM res;
+ int neg_p;
+ int n_digits;
+ size_t i;
+ SCM_BIGDIG *digits;
+
+#ifndef UNSIGNED
+ neg_p = (n < 0);
+ if (neg_p) n = -n;
+#else
+ neg_p = 0;
+#endif
+
+#ifndef UNSIGNED
+ if (n == MIN_VALUE)
+ /* special case */
+ n_digits =
+ (sizeof (ITYPE) + sizeof (SCM_BIGDIG) - 1) / sizeof (SCM_BIGDIG);
+ else
+#endif
+ {
+ ITYPE tn;
+ for (tn = n, n_digits = 0;
+ tn;
+ ++n_digits, tn = SCM_BIGDN (tn))
+ ;
+ }
+
+ i = 0;
+ res = scm_i_mkbig (n_digits, neg_p);
+ digits = SCM_BDIGITS (res);
+
+ while (i < n_digits)
+ {
+ digits[i++] = SCM_BIGLO (n);
+ n = SCM_BIGDN (n);
+ }
+
+ return res;
+}
+
+#endif
+
+/* clean up */
+#undef INTEGRAL2NUM
+#undef INTEGRAL2BIG
+#undef NUM2INTEGRAL
+#undef UNSIGNED
+#undef ITYPE
+#undef MIN_VALUE
+#undef MAX_VALUE
+
+/*
+ Local Variables:
+ c-file-style: "gnu"
+ End:
+*/