~ chicken-core (chicken-5) fdae1c59fe2cca92db621daaebe14f4b25dbf29e
commit fdae1c59fe2cca92db621daaebe14f4b25dbf29e
Author: Peter Bex <peter@more-magic.net>
AuthorDate: Thu Mar 12 22:27:48 2015 +0100
Commit: Peter Bex <peter@more-magic.net>
CommitDate: Sun May 31 14:55:23 2015 +0200
Convert dyadic integer plus and integer minus to use scratch space.
diff --git a/chicken.h b/chicken.h
index 89a34e9a..f0387662 100644
--- a/chicken.h
+++ b/chicken.h
@@ -1965,11 +1965,9 @@ C_fctexport void C_ccall C_u_2_integer_times(C_word c, C_word self, C_word k, C_
/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
C_fctexport void C_ccall C_plus(C_word c, C_word closure, C_word k, ...) C_noret;
C_fctexport void C_ccall C_2_basic_plus(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_plus(C_word c, C_word self, C_word k, C_word x, C_word y) C_noret;
/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
C_fctexport void C_ccall C_minus(C_word c, C_word closure, C_word k, C_word n1, ...) C_noret;
C_fctexport void C_ccall C_2_basic_minus(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_minus(C_word c, C_word self, C_word k, C_word x, C_word y) C_noret;
/* XXX TODO OBSOLETE: This can be removed after recompiling c-platform.scm */
C_fctexport void C_ccall C_divide(C_word c, C_word closure, C_word k, C_word n1, ...) C_noret;
C_fctexport void C_ccall C_basic_quotient(C_word c, C_word self, C_word k, C_word x, C_word y) C_noret;
@@ -2192,8 +2190,11 @@ C_fctexport C_word C_fcall C_i_file_exists_p(C_word name, C_word file, C_word di
C_fctexport C_word C_fcall C_s_a_i_abs(C_word **ptr, C_word n, C_word x) C_regparm;
C_fctexport C_word C_fcall C_s_a_i_negate(C_word **ptr, C_word n, C_word x) C_regparm;
C_fctexport C_word C_fcall C_s_a_u_i_integer_negate(C_word **ptr, C_word n, C_word x) C_regparm;
+C_fctexport C_word C_fcall C_s_a_u_i_integer_minus(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_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;
C_fctexport C_word C_fcall C_i_foreign_flonum_argumentp(C_word x) C_regparm;
diff --git a/library.scm b/library.scm
index e7ef8bd6..3c6f756f 100644
--- a/library.scm
+++ b/library.scm
@@ -1208,7 +1208,9 @@ EOF
(##sys#+-2 x (##sys#slot args 0))) ) ) ) ) ) )
(define ##sys#+-2 (##core#primitive "C_2_basic_plus"))
-(define ##sys#integer-plus (##core#primitive "C_u_2_integer_plus"))
+;; OBSOLETE: Remove this (or change to define-inline)
+(define (##sys#integer-plus x y)
+ (##core#inline_allocate ("C_s_a_u_i_integer_plus" 6) x y))
(define (##sys#extended-plus x y)
(cond ((or (cplxnum? x) (cplxnum? y))
@@ -1252,7 +1254,9 @@ EOF
(##sys#--2 x (##sys#slot args 0))) ) ) ) )
(define ##sys#--2 (##core#primitive "C_2_basic_minus"))
-(define ##sys#integer-minus (##core#primitive "C_u_2_integer_minus"))
+;; OBSOLETE: Remove this (or change to define-inline)
+(define (##sys#integer-minus x y)
+ (##core#inline_allocate ("C_s_a_u_i_integer_minus" 6) x y))
(define (##sys#extended-minus x y)
(cond ((or (cplxnum? x) (cplxnum? y))
diff --git a/runtime.c b/runtime.c
index 63d66f92..5de43743 100644
--- a/runtime.c
+++ b/runtime.c
@@ -518,10 +518,8 @@ static void bignum_actual_shift(C_word c, C_word self, C_word result) C_noret;
static void bignum_times_bignum_unsigned(C_word k, C_word x, C_word y, C_word negp) C_noret;
static void bignum_times_bignum_unsigned_2(C_word c, C_word self, C_word result) C_noret;
static void integer_times_2(C_word c, C_word self, C_word new_big) C_noret;
-static void bignum_plus_unsigned(C_word k, C_word x, C_word y, C_word negp) C_noret;
-static void bignum_plus_unsigned_2(C_word c, C_word self, C_word result) C_noret;
-static void bignum_minus_unsigned(C_word k, C_word x, C_word y) C_noret;
-static void bignum_minus_unsigned_2(C_word c, C_word self, C_word result) C_noret;
+static C_word bignum_plus_unsigned(C_word **ptr, C_word x, C_word y, C_word negp);
+static C_word bignum_minus_unsigned(C_word **ptr, C_word x, C_word y);
static C_regparm void basic_divrem(C_word c, C_word self, C_word k, C_word x, C_word y, C_word return_r, C_word return_q) C_noret;
static C_regparm void integer_divrem(C_word c, C_word self, C_word k, C_word x, C_word y, C_word return_q, C_word return_r) C_noret;
static C_word bignum_remainder_unsigned_halfdigit(C_word num, C_word den);
@@ -846,7 +844,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) * 76);
+ C_PTABLE_ENTRY *pt = (C_PTABLE_ENTRY *)C_malloc(sizeof(C_PTABLE_ENTRY) * 74);
int i = 0;
if(pt == NULL)
@@ -923,8 +921,6 @@ static C_PTABLE_ENTRY *create_initial_ptable()
C_pte(C_basic_quotient);
C_pte(C_basic_remainder);
C_pte(C_basic_divrem);
- C_pte(C_u_2_integer_plus);
- C_pte(C_u_2_integer_minus);
C_pte(C_u_2_integer_times);
C_pte(C_u_integer_quotient);
C_pte(C_u_integer_remainder);
@@ -7549,9 +7545,11 @@ C_regparm C_word C_fcall C_2_times(C_word **ptr, C_word x, C_word y)
return C_flonum(ptr, 0.0/0.0);
}
-static void bignum_plus_unsigned(C_word k, C_word x, C_word y, C_word negp)
+static C_word bignum_plus_unsigned(C_word **ptr, C_word x, C_word y, C_word negp)
{
- C_word kab[C_SIZEOF_CLOSURE(4)], *ka = kab, k2, size;
+ C_word size, result;
+ C_uword sum, digit, *scan_y, *end_y, *scan_r, *end_r;
+ int carry = 0;
if (C_bignum_size(y) > C_bignum_size(x)) { /* Ensure size(y) <= size(x) */
C_word z = x;
@@ -7559,23 +7557,13 @@ static void bignum_plus_unsigned(C_word k, C_word x, C_word y, C_word negp)
y = z;
}
- k2 = C_closure(&ka, 4, (C_word)bignum_plus_unsigned_2, k, x, y);
-
size = C_fix(C_bignum_size(x) + 1); /* One more digit, for possible carry. */
- C_allocate_bignum(5, (C_word)NULL, k2, size, negp, C_SCHEME_FALSE);
-}
+ result = C_allocate_scratch_bignum(ptr, size, negp, C_SCHEME_FALSE);
-static void bignum_plus_unsigned_2(C_word c, C_word self, C_word result)
-{
- C_word k = C_block_item(self, 1),
- x = C_block_item(self, 2),
- y = C_block_item(self, 3);
- C_uword *scan_y = C_bignum_digits(y),
- *end_y = scan_y + C_bignum_size(y),
- *scan_r = C_bignum_digits(result),
- *end_r = scan_r + C_bignum_size(result),
- sum, digit;
- int carry = 0;
+ scan_y = C_bignum_digits(y);
+ end_y = scan_y + C_bignum_size(y);
+ scan_r = C_bignum_digits(result);
+ end_r = scan_r + C_bignum_size(result);
/* Copy x into r so we can operate on two pointers, which is faster
* than three, and we can stop earlier after adding y. It's slower
@@ -7605,7 +7593,7 @@ static void bignum_plus_unsigned_2(C_word c, C_word self, C_word result)
}
assert(scan_r <= end_r);
- C_kontinue(k, C_bignum_simplify(result));
+ return C_bignum_simplify(result);
}
void C_ccall
@@ -7621,7 +7609,8 @@ C_2_basic_plus(C_word c, C_word self, C_word k, C_word x, C_word y)
C_word *a = C_alloc(C_SIZEOF_FLONUM);
C_kontinue(k, C_flonum(&a, (double)C_unfix(x) + C_flonum_magnitude(y)));
} else if (C_truep(C_bignump(y))) {
- C_u_2_integer_plus(4, (C_word)NULL, k, x, y);
+ C_word ab[C_SIZEOF_BIGNUM_WRAPPER], *a = ab;
+ C_kontinue(k, C_s_a_u_i_integer_plus(&a, 2, x, y));
} else {
try_extended_number("\003sysextended-plus", 3, k, x, y);
}
@@ -7642,14 +7631,16 @@ C_2_basic_plus(C_word c, C_word self, C_word k, C_word x, C_word y)
}
} else if (C_truep(C_bignump(x))) {
if (y & C_FIXNUM_BIT) {
- C_u_2_integer_plus(4, (C_word)NULL, k, x, y);
+ C_word ab[C_SIZEOF_BIGNUM_WRAPPER], *a = ab;
+ C_kontinue(k, C_s_a_u_i_integer_plus(&a, 2, x, y));
} else if (C_immediatep(y)) {
barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "+", y);
} else if (C_block_header(y) == C_FLONUM_TAG) {
C_word *a = C_alloc(C_SIZEOF_FLONUM);
C_kontinue(k, C_flonum(&a, C_bignum_to_double(x)+C_flonum_magnitude(y)));
} else if (C_truep(C_bignump(y))) {
- C_u_2_integer_plus(4, (C_word)NULL, k, x, y);
+ C_word ab[C_SIZEOF_BIGNUM_WRAPPER], *a = ab;
+ C_kontinue(k, C_s_a_u_i_integer_plus(&a, 2, x, y));
} else {
try_extended_number("\003sysextended-plus", 3, k, x, y);
}
@@ -7658,23 +7649,28 @@ C_2_basic_plus(C_word c, C_word self, C_word k, C_word x, C_word y)
}
}
-void C_ccall
-C_u_2_integer_plus(C_word c, C_word self, C_word k, C_word x, C_word y)
+C_regparm C_word C_fcall
+C_s_a_u_i_integer_plus(C_word **ptr, C_word n, C_word x, C_word y)
{
if ((x & y) & C_FIXNUM_BIT) {
- C_word ab[C_SIZEOF_FIX_BIGNUM], *a = ab;
- C_kontinue(k, C_a_i_fixnum_plus(&a, 2, x, y));
+ return C_a_i_fixnum_plus(ptr, 2, x, y);
} else {
- C_word ab[C_SIZEOF_FIX_BIGNUM * 2], *a = ab;
+ C_word ab[C_SIZEOF_FIX_BIGNUM * 2 + C_SIZEOF_BIGNUM_WRAPPER], *a = ab;
if (x & C_FIXNUM_BIT) x = C_a_u_i_fix_to_big(&a, x);
if (y & C_FIXNUM_BIT) y = C_a_u_i_fix_to_big(&a, y);
if (C_bignum_negativep(x)) {
- if (C_bignum_negativep(y)) bignum_plus_unsigned(k, x, y, C_SCHEME_TRUE);
- else bignum_minus_unsigned(k, y, x);
+ if (C_bignum_negativep(y)) {
+ return bignum_plus_unsigned(ptr, x, y, C_SCHEME_TRUE);
+ } else {
+ return bignum_minus_unsigned(ptr, y, x);
+ }
} else {
- if (C_bignum_negativep(y)) bignum_minus_unsigned(k, x, y);
- else bignum_plus_unsigned(k, x, y, C_SCHEME_FALSE);
+ if (C_bignum_negativep(y)) {
+ return bignum_minus_unsigned(ptr, x, y);
+ } else {
+ return bignum_plus_unsigned(ptr, x, y, C_SCHEME_FALSE);
+ }
}
}
}
@@ -7758,41 +7754,35 @@ C_regparm C_word C_fcall C_2_plus(C_word **ptr, C_word x, C_word y)
return C_flonum(ptr, 0.0/0.0);
}
-static void bignum_minus_unsigned(C_word k, C_word x, C_word y)
+static C_word bignum_minus_unsigned(C_word **ptr, C_word x, C_word y)
{
- C_word kab[C_SIZEOF_CLOSURE(4)], *ka = kab, k2, size;
+ C_word res, size;
+ C_uword *scan_r, *end_r, *scan_y, *end_y, difference, digit;
+ int borrow = 0;
switch(bignum_cmp_unsigned(x, y)) {
case 0: /* x = y, return 0 */
- C_kontinue(k, C_fix(0));
+ return C_fix(0);
case -1: /* abs(x) < abs(y), return -(abs(y) - abs(x)) */
- k2 = C_closure(&ka, 4, (C_word)bignum_minus_unsigned_2, k, y, x);
-
size = C_fix(C_bignum_size(y)); /* Maximum size of result is length of y. */
- C_allocate_bignum(5, (C_word)NULL, k2, size, C_SCHEME_TRUE, C_SCHEME_FALSE);
+ res = C_allocate_scratch_bignum(ptr, size, C_SCHEME_TRUE, C_SCHEME_FALSE);
+ size = y;
+ y = x;
+ x = size;
+ break;
case 1: /* abs(x) > abs(y), return abs(x) - abs(y) */
default:
- k2 = C_closure(&ka, 4, (C_word)bignum_minus_unsigned_2, k, x, y);
-
size = C_fix(C_bignum_size(x)); /* Maximum size of result is length of x. */
- C_allocate_bignum(5, (C_word)NULL, k2, size, C_SCHEME_FALSE, C_SCHEME_FALSE);
+ res = C_allocate_scratch_bignum(ptr, size, C_SCHEME_FALSE, C_SCHEME_FALSE);
break;
}
-}
-static void bignum_minus_unsigned_2(C_word c, C_word self, C_word result)
-{
- C_word k = C_block_item(self, 1),
- x = C_block_item(self, 2),
- y = C_block_item(self, 3);
- C_uword *scan_r = C_bignum_digits(result),
- *end_r = scan_r + C_bignum_size(result),
- *scan_y = C_bignum_digits(y),
- *end_y = scan_y + C_bignum_size(y),
- difference, digit;
- int borrow = 0;
+ scan_r = C_bignum_digits(res);
+ end_r = scan_r + C_bignum_size(res);
+ scan_y = C_bignum_digits(y);
+ end_y = scan_y + C_bignum_size(y);
- bignum_digits_destructive_copy(result, x); /* See bignum_plus_unsigned_2 */
+ bignum_digits_destructive_copy(res, x); /* See bignum_plus_unsigned */
/* Destructively subtract y's digits w/ borrow from and back into r. */
while (scan_y < end_y) {
@@ -7817,7 +7807,7 @@ static void bignum_minus_unsigned_2(C_word c, C_word self, C_word result)
assert(scan_r <= end_r);
- C_kontinue(k, C_bignum_simplify(result));
+ return C_bignum_simplify(res);
}
void C_ccall
@@ -7833,7 +7823,8 @@ C_2_basic_minus(C_word c, C_word self, C_word k, C_word x, C_word y)
C_word *a = C_alloc(C_SIZEOF_FLONUM);
C_kontinue(k, C_flonum(&a, (double)C_unfix(x) - C_flonum_magnitude(y)));
} else if (C_truep(C_bignump(y))) {
- C_u_2_integer_minus(4, (C_word)NULL, k, x, y);
+ C_word ab[C_SIZEOF_BIGNUM_WRAPPER], *a = ab;
+ C_kontinue(k, C_s_a_u_i_integer_minus(&a, 2, x, y));
} else {
try_extended_number("\003sysextended-minus", 3, k, x, y);
}
@@ -7854,14 +7845,16 @@ C_2_basic_minus(C_word c, C_word self, C_word k, C_word x, C_word y)
}
} else if (C_truep(C_bignump(x))) {
if (y & C_FIXNUM_BIT) {
- C_u_2_integer_minus(4, (C_word)NULL, k, x, y);
+ C_word ab[C_SIZEOF_BIGNUM_WRAPPER], *a = ab;
+ C_kontinue(k, C_s_a_u_i_integer_minus(&a, 2, x, y));
} else if (C_immediatep(y)) {
barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "-", y);
} else if (C_block_header(y) == C_FLONUM_TAG) {
C_word *a = C_alloc(C_SIZEOF_FLONUM);
C_kontinue(k, C_flonum(&a, C_bignum_to_double(x)-C_flonum_magnitude(y)));
} else if (C_truep(C_bignump(y))) {
- C_u_2_integer_minus(4, (C_word)NULL, k, x, y);
+ C_word ab[C_SIZEOF_BIGNUM_WRAPPER], *a = ab;
+ C_kontinue(k, C_s_a_u_i_integer_minus(&a, 2, x, y));
} else {
try_extended_number("\003sysextended-minus", 3, k, x, y);
}
@@ -7870,23 +7863,28 @@ C_2_basic_minus(C_word c, C_word self, C_word k, C_word x, C_word y)
}
}
-void C_ccall
-C_u_2_integer_minus(C_word c, C_word self, C_word k, C_word x, C_word y)
+C_regparm C_word C_fcall
+C_s_a_u_i_integer_minus(C_word **ptr, C_word n, C_word x, C_word y)
{
if ((x & y) & C_FIXNUM_BIT) {
- C_word ab[C_SIZEOF_FIX_BIGNUM], *a = ab;
- C_kontinue(k, C_a_i_fixnum_difference(&a, 2, x, y));
+ return C_a_i_fixnum_difference(ptr, 2, x, y);
} else {
- C_word ab[C_SIZEOF_FIX_BIGNUM * 2], *a = ab;
+ C_word ab[C_SIZEOF_FIX_BIGNUM * 2 + C_SIZEOF_BIGNUM_WRAPPER], *a = ab;
if (x & C_FIXNUM_BIT) x = C_a_u_i_fix_to_big(&a, x);
if (y & C_FIXNUM_BIT) y = C_a_u_i_fix_to_big(&a, y);
if (C_bignum_negativep(x)) {
- if (C_bignum_negativep(y)) bignum_minus_unsigned(k, y, x);
- else bignum_plus_unsigned(k, x, y, C_SCHEME_TRUE);
+ if (C_bignum_negativep(y)) {
+ return bignum_minus_unsigned(ptr, y, x);
+ } else {
+ return bignum_plus_unsigned(ptr, x, y, C_SCHEME_TRUE);
+ }
} else {
- if (C_bignum_negativep(y)) bignum_plus_unsigned(k, x, y, C_SCHEME_FALSE);
- else bignum_minus_unsigned(k, x, y);
+ if (C_bignum_negativep(y)) {
+ return bignum_plus_unsigned(ptr, x, y, C_SCHEME_FALSE);
+ } else {
+ return bignum_minus_unsigned(ptr, x, y);
+ }
}
}
}
diff --git a/types.db b/types.db
index ca8ca2ca..dbe39e66 100644
--- a/types.db
+++ b/types.db
@@ -319,7 +319,7 @@
((fixnum fixnum) (integer)
(##core#inline_allocate ("C_a_i_fixnum_plus" 6) #(1) #(2)))
((integer integer) (integer)
- (##sys#integer-plus #(1) #(2)))
+ (##core#inline_allocate ("C_s_a_u_i_integer_plus" 6) #(1) #(2)))
((* *) (number)
(##sys#+-2 #(1) #(2))))
@@ -344,7 +344,7 @@
((fixnum fixnum) (integer)
(##core#inline_allocate ("C_a_i_fixnum_difference" 6) #(1) #(2)))
((integer integer) (integer)
- (##sys#integer-minus #(1) #(2)))
+ (##core#inline_allocate ("C_s_a_u_i_integer_minus" 6) #(1) #(2)))
((* *) (number)
(##sys#--2 #(1) #(2))))
Trap