~ chicken-core (chicken-5) 6140fe4d060fa56fa27b8d5781c762ab6eea87c7
commit 6140fe4d060fa56fa27b8d5781c762ab6eea87c7
Author: Peter Bex <peter@more-magic.net>
AuthorDate: Sun Mar 22 14:47:02 2015 +0100
Commit: Peter Bex <peter@more-magic.net>
CommitDate: Sun May 31 14:55:24 2015 +0200
Make bignum-extract-digits inlineable, to improve Karatsuba and Burnikel-Ziegler perf.
diff --git a/chicken.h b/chicken.h
index d89f88e4..4f6c6ab8 100644
--- a/chicken.h
+++ b/chicken.h
@@ -1974,7 +1974,6 @@ C_fctexport void C_ccall C_basic_divrem(C_word c, C_word self, C_word k, C_word
C_fctexport void C_ccall C_u_integer_divrem(C_word c, C_word self, C_word k, C_word x, C_word y) C_noret;
C_fctexport void C_ccall C_u_flo_to_int(C_word c, C_word self, C_word k, C_word x) C_noret;
C_fctexport void C_ccall C_u_integer_shift(C_word c, C_word self, C_word k, C_word x, C_word y) C_noret;
-C_fctexport void C_ccall C_u_bignum_extract_digits(C_word c, C_word self, C_word k, C_word x, C_word start, C_word end) C_noret;
C_fctexport void C_ccall C_u_2_integer_bitwise_and(C_word c, C_word self, C_word k, C_word x, C_word y) C_noret;
C_fctexport void C_ccall C_u_2_integer_bitwise_ior(C_word c, C_word self, C_word k, C_word x, C_word y) C_noret;
C_fctexport void C_ccall C_u_2_integer_bitwise_xor(C_word c, C_word self, C_word k, C_word x, C_word y) C_noret;
@@ -2190,6 +2189,7 @@ C_fctexport C_word C_fcall C_s_a_u_i_integer_minus(C_word **ptr, C_word n, C_wor
C_fctexport C_word C_fcall C_s_a_i_plus(C_word **ptr, C_word n, C_word x, C_word y) C_regparm;
C_fctexport C_word C_fcall C_s_a_u_i_integer_plus(C_word **ptr, C_word n, C_word x, C_word y) C_regparm;
C_fctexport C_word C_fcall C_s_a_u_i_integer_gcd(C_word **ptr, C_word n, C_word x, C_word y) C_regparm;
+C_fctexport C_word C_fcall C_s_a_u_i_bignum_extract_digits(C_word **ptr, C_word n, C_word x, C_word start, C_word end) C_regparm;
C_fctexport C_word C_fcall C_i_foreign_char_argumentp(C_word x) C_regparm;
diff --git a/library.scm b/library.scm
index 3651ebdb..4bdbde1c 100644
--- a/library.scm
+++ b/library.scm
@@ -38,7 +38,7 @@
maximal-string-length find-ratio-between find-ratio
make-complex flonum->ratnum ratnum rat+/-
+maximum-allowed-exponent+ mantexp->dbl ldexp round-quotient
- ##sys#string->compnum ##sys#bignum-extract-digits ##sys#internal-gcd)
+ ##sys#string->compnum ##sys#internal-gcd)
(not inline ##sys#user-read-hook ##sys#error-hook ##sys#signal-hook ##sys#schedule
##sys#default-read-info-hook ##sys#infix-list-hook ##sys#sharp-number-hook
##sys#user-print-hook ##sys#user-interrupt-hook ##sys#step-hook)
@@ -1129,8 +1129,8 @@ EOF
(##sys#*-2 x (##sys#slot args 0))) ) ) ) ) ) )
(define-inline (%bignum-digit-count b) (##core#inline "C_u_i_bignum_size" b))
-(define ##sys#bignum-extract-digits
- (##core#primitive "C_u_bignum_extract_digits"))
+(define-inline (##sys#bignum-extract-digits big start end)
+ (##core#inline_allocate ("C_s_a_u_i_bignum_extract_digits" 6) big start end))
;; Karatsuba multiplication: invoked from C when the two numbers are
;; large enough to make it worthwhile. Complexity is O(n^log2(3)),
diff --git a/runtime.c b/runtime.c
index 614ded56..3068a64d 100644
--- a/runtime.c
+++ b/runtime.c
@@ -512,7 +512,6 @@ static WEAK_TABLE_ENTRY *C_fcall lookup_weak_table_entry(C_word item, C_word con
static C_ccall void values_continuation(C_word c, C_word closure, C_word dummy, ...) C_noret;
static C_word add_symbol(C_word **ptr, C_word key, C_word string, C_SYMBOL_TABLE *stable);
static C_regparm int C_fcall C_in_new_heapp(C_word x);
-static void bignum_actual_extraction(C_word c, C_word self, C_word result) C_noret;
static void bignum_bitwise_and_2(C_word c, C_word self, C_word result) C_noret;
static void bignum_bitwise_ior_2(C_word c, C_word self, C_word result) C_noret;
static void bignum_bitwise_xor_2(C_word c, C_word self, C_word result) C_noret;
@@ -5916,14 +5915,14 @@ C_regparm C_word C_fcall C_i_integer_length(C_word x)
/* This is currently only used by Karatsuba multiplication and
* Burnikel-Ziegler division. It is not intended as a public API!
*/
-void C_ccall
-C_u_bignum_extract_digits(C_word c, C_word self, C_word k, C_word x, C_word start, C_word end)
+C_regparm C_word C_fcall
+C_s_a_u_i_bignum_extract_digits(C_word **ptr, C_word n, C_word x, C_word start, C_word end)
{
if (x & C_FIXNUM_BIT) { /* Needed? */
if (C_unfix(start) == 0 && (end == C_SCHEME_FALSE || C_unfix(end) > 0))
- C_kontinue(k, x);
+ return x;
else
- C_kontinue(k, C_fix(0));
+ return C_fix(0);
} else {
C_word negp, size;
@@ -5938,32 +5937,21 @@ C_u_bignum_extract_digits(C_word c, C_word self, C_word k, C_word x, C_word star
size = end - start;
if (size == 0 || start >= C_bignum_size(x)) {
- C_kontinue(k, C_fix(0));
+ return C_fix(0);
} else {
- C_word k2, kab[C_SIZEOF_CLOSURE(5)], *ka = kab;
- k2 = C_closure(&ka, 5, (C_word)bignum_actual_extraction,
- k, x, C_fix(start), C_fix(end));
- C_allocate_bignum(5, (C_word)NULL, k2, C_fix(size), negp, C_SCHEME_FALSE);
+ C_uword res, *res_digits, *x_digits;
+ res = C_allocate_scratch_bignum(ptr, C_fix(size), negp, C_SCHEME_FALSE);
+ res_digits = C_bignum_digits(res);
+ x_digits = C_bignum_digits(x);
+ /* Can't use bignum_digits_destructive_copy because that assumes
+ * target is at least as big as source.
+ */
+ C_memcpy(res_digits, x_digits + start, C_wordstobytes(end - start));
+ return C_bignum_simplify(res);
}
}
}
-static void bignum_actual_extraction(C_word c, C_word self, C_word result)
-{
- C_word k = C_block_item(self, 1),
- x = C_block_item(self, 2),
- start = C_unfix(C_block_item(self, 3)),
- end = C_unfix(C_block_item(self, 4));
- C_uword *result_digits = C_bignum_digits(result),
- *x_digits = C_bignum_digits(x);
-
- /* Can't use bignum_digits_destructive_copy because that assumes
- * target is at least as big as source.
- */
- C_memcpy(result_digits, x_digits + start, C_wordstobytes(end-start));
- C_kontinue(k, C_bignum_simplify(result));
-}
-
/* This returns a tmp bignum negated copy of X (must be freed!) when
* the number is negative, or #f if it doesn't need to be negated.
* The size can be larger or smaller than X (it may be 1-padded).
Trap