~ chicken-core (chicken-5) 71a88794a70ec0feb9fdc2a25c424b7fbb432720
commit 71a88794a70ec0feb9fdc2a25c424b7fbb432720
Author: Peter Bex <peter@more-magic.net>
AuthorDate: Sun Mar 29 15:09:06 2015 +0200
Commit: Peter Bex <peter@more-magic.net>
CommitDate: Sun May 31 14:55:24 2015 +0200
Make C_digits_to_integer inlineable, to make the reading of numbers a little bit faster
diff --git a/chicken.h b/chicken.h
index 52e802f1..89567252 100644
--- a/chicken.h
+++ b/chicken.h
@@ -1987,7 +1987,6 @@ C_fctexport void C_ccall C_string_to_symbol(C_word c, C_word closure, C_word k,
C_fctexport void C_ccall C_build_symbol(C_word c, C_word closure, C_word k, C_word string) C_noret;
/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
C_fctexport void C_ccall C_quotient(C_word c, C_word closure, C_word k, C_word n1, C_word n2) C_noret;
-C_fctexport void C_ccall C_digits_to_integer(C_word c, C_word self, C_word k, C_word n, C_word start, C_word end, C_word radix, C_word negp) C_noret;
C_fctexport void C_ccall C_number_to_string(C_word c, C_word closure, C_word k, C_word num, ...) C_noret;
C_fctexport void C_ccall C_fixnum_to_string(C_word c, C_word closure, C_word k, C_word num, C_word radix) C_noret;
C_fctexport void C_ccall C_flonum_to_string(C_word c, C_word closure, C_word k, C_word num, C_word radix) C_noret;
@@ -2193,7 +2192,7 @@ C_fctexport C_word C_fcall C_s_a_i_bitwise_and(C_word **ptr, C_word n, C_word x,
C_fctexport C_word C_fcall C_s_a_i_bitwise_ior(C_word **ptr, C_word n, C_word x, C_word y) C_regparm;
C_fctexport C_word C_fcall C_s_a_i_bitwise_xor(C_word **ptr, C_word n, C_word x, C_word y) C_regparm;
C_fctexport C_word C_fcall C_s_a_i_bitwise_not(C_word **ptr, C_word n, C_word x) C_regparm;
-
+C_fctexport C_word C_fcall C_s_a_i_digits_to_integer(C_word **ptr, C_word n, C_word str, C_word start, C_word end, C_word radix, C_word negp) C_regparm;
C_fctexport C_word C_fcall C_i_foreign_char_argumentp(C_word x) C_regparm;
C_fctexport C_word C_fcall C_i_foreign_fixnum_argumentp(C_word x) C_regparm;
diff --git a/library.scm b/library.scm
index 3be55736..cd827125 100644
--- a/library.scm
+++ b/library.scm
@@ -1811,8 +1811,9 @@ EOF
(and all-hashes-ok? (scan-hashes start))))
(end (or hashes digits)))
(and-let* ((end)
- (num ((##core#primitive "C_digits_to_integer")
- str start (car end) radix neg?)))
+ (num (##core#inline_allocate
+ ("C_s_a_i_digits_to_integer" 3)
+ str start (car end) radix neg?)))
(when hashes ; Eeewww. Feeling dirty yet?
(set! seen-hashes? #t)
(go-inexact!))
@@ -1825,8 +1826,9 @@ EOF
(and-let* ((start (if sign (fx+ start 1) start))
(end (scan-digits start)))
(go-inexact!)
- (cons ((##core#primitive "C_digits_to_integer")
- str start (car end) radix (eq? sign 'neg))
+ (cons (##core#inline_allocate
+ ("C_s_a_i_digits_to_integer" 3)
+ str start (car end) radix (eq? sign 'neg))
(cdr end)))))))
(scan-decimal-tail ; The part after the decimal dot
(lambda (start neg? decimal-head)
diff --git a/runtime.c b/runtime.c
index b0a728b9..ede32de8 100644
--- a/runtime.c
+++ b/runtime.c
@@ -845,7 +845,7 @@ static C_PTABLE_ENTRY *create_initial_ptable()
{
/* IMPORTANT: hardcoded table size -
this must match the number of C_pte calls + 1 (NULL terminator)! */
- C_PTABLE_ENTRY *pt = (C_PTABLE_ENTRY *)C_malloc(sizeof(C_PTABLE_ENTRY) * 71);
+ C_PTABLE_ENTRY *pt = (C_PTABLE_ENTRY *)C_malloc(sizeof(C_PTABLE_ENTRY) * 70);
int i = 0;
if(pt == NULL)
@@ -907,7 +907,6 @@ static C_PTABLE_ENTRY *create_initial_ptable()
C_pte(C_copy_closure);
C_pte(C_dump_heap_state);
C_pte(C_filter_heap_objects);
- C_pte(C_digits_to_integer);
C_pte(C_fixnum_to_string);
C_pte(C_integer_to_string);
C_pte(C_flonum_to_string);
@@ -10811,22 +10810,26 @@ C_a_i_string_to_number(C_word **a, int c, C_word str, C_word radix0)
return n;
}
-void C_ccall
-C_digits_to_integer(C_word c, C_word self, C_word k, C_word str,
- C_word start, C_word end, C_word radix, C_word negp)
+C_regparm C_word C_fcall
+C_s_a_i_digits_to_integer(C_word **ptr, C_word n, C_word str, C_word start, C_word end, C_word radix, C_word negp)
{
- assert((C_unfix(radix) > 1) && C_fitsinbignumhalfdigitp(C_unfix(radix)));
-
if (start == end) {
- C_kontinue(k, C_SCHEME_FALSE);
+ return C_SCHEME_FALSE;
} else {
- C_word kab[C_SIZEOF_CLOSURE(6)], *ka = kab, k2, size;
size_t nbits;
- k2 = C_closure(&ka, 6, (C_word)digits_to_integer_2, k, str, start, end, radix);
+ char *s = C_c_string(str);
+ C_word result, size;
+ end = C_unfix(end);
+ start = C_unfix(start);
+ radix = C_unfix(radix);
- nbits = (C_unfix(end) - C_unfix(start)) * C_ilen(C_unfix(radix)-1);
+ assert((radix > 1) && C_fitsinbignumhalfdigitp(radix));
+
+ nbits = (end - start) * C_ilen(radix - 1);
size = C_fix(C_BIGNUM_BITS_TO_DIGITS(nbits));
- C_allocate_bignum(5, (C_word)NULL, k2, size, negp, C_SCHEME_FALSE);
+ result = C_allocate_scratch_bignum(ptr, size, negp, C_SCHEME_FALSE);
+
+ return str_to_bignum(result, s + start, s + end, radix);
}
}
@@ -10838,19 +10841,6 @@ C_inline int hex_char_to_digit(int ch)
else return ch - (int)'0'; /* decimal (OR INVALID; handled elsewhere) */
}
-static void
-digits_to_integer_2(C_word c, C_word self, C_word result)
-{
- C_word k = C_block_item(self, 1),
- str = C_block_item(self, 2),
- start = C_unfix(C_block_item(self, 3)),
- end = C_unfix(C_block_item(self, 4)),
- radix = C_unfix(C_block_item(self, 5));
- char *s = C_c_string(str);
-
- C_kontinue(k, str_to_bignum(result, s + start, s + end, radix));
-}
-
/* Write from digit character stream to bignum. Bignum does not need
* to be initialised. Returns the bignum, or a fixnum. Assumes the
* string contains only digits that fit within radix (checked by
Trap