Hello hackers, I'm currently busy with a writeup of some of the stuff that went into the numbers integration (it will take a long while until it's finished, so don't hold your breath for it!), and I realised that it's a bit silly to wrap all our extended numbers in a struct. This just eats up precious machine words (the struct-type takes up an extra machine word which we can drop).
This memory usage should in general not be a huge problem, but unfortunately our inline functions all need to pre-allocate enough memory for the *worst* case, which is usually a cplxnum that consists of ratnums in both its real and imaginary parts, and those ratnums in turn consisting of 2 bignums each. The actual bignum digit data will be allocated on-demand in the scratch buffer, but the bignum wrapper, the ratnums, and the cplxnum "shell" all need to be pre-allocated on the stack. This is especially noticeable in C_s_a_i_times(), which needs a whopping 40 words pre-allocated. The attached patches add a custom type for bignums (first patch) and custom types for ratnums/cplxnums (second patch). This reduces the aforementioned C_s_a_i_times() pre-allocation from 40 to 29 words. Theoretically, this should slow down nursery growth by a quarter(!) Unfortunately, the benchmark results are not showing any noticeable difference in run time, though it does show that the number of GCs and time spent in GC has noticeably diminished; in some benchmarks the GC time is 5 times faster, but that may just be a fluke... All in all, I think these changes are worthwhile but for the caveat that it results in us having NO MORE reserved type tags left! In fact, the complete change is only possible because we dropped the SWIG pointer type; before that we only had two reserved types left. I don't see an easy way to reclaim type tags elsewhere; we don't have that many. Maybe (but only MAYBE) we could get rid of lambda info as a separate core type. Now, I also think the original representation of the ratnums and cplxnums as record types is kind of elegant (making them "not exist" at the C level, more or less), so I'm a bit on the fence regarding the second patch. However, I do think the abstraction of the accessors as a C macro is a must; I'd be willing to re-do that part as a separate patch if the whole thing isn't applied. Making bignums more "core" (first patch) is a great move overall, I think, so I'd urge you to certainly consider that one. It also results in a gain in pre-allocation savings that's as big as the combined change of ratnums & cplxnums. Please, discuss! Cheers, Peter
From b055baf4d28a109188a43adde977477e4369ac67 Mon Sep 17 00:00:00 2001
From: Peter Bex <pe...@more-magic.net>
Date: Sun, 7 Aug 2016 21:32:59 +0200
Subject: [PATCH 1/2] Change bignum representation to use a custom type.
Instead of using a generic record type with a "bignum_type_tag" symbol
slot, we use a custom object containing only a pointer to the actual
bignum data.
This saves at least one slot when pre-allocating for a call to an
arithmetic operator. In case of the generic operators, this can save up
to four slots (maximum size is allotted for a complex number consisting
of two ratnums, each containing two bignums; so four bignums in total).
Less allocation results in slower nursery growth, which in turn means
minor garbage collections will happen less frequently.
The change in object type also means we need to do one less check in
the bignum? predicate.
---
c-backend.scm | 4 ++--
c-platform.scm | 22 ++++++++---------
chicken.h | 42 ++++++++++++++++++--------------
library.scm | 24 +++++++++----------
runtime.c | 22 +++++++----------
types.db | 76 +++++++++++++++++++++++++++++-----------------------------
6 files changed, 96 insertions(+), 94 deletions(-)
diff --git a/c-backend.scm b/c-backend.scm
index e3958c2..6ed1f09 100644
--- a/c-backend.scm
+++ b/c-backend.scm
@@ -671,9 +671,9 @@
(define (literal-size lit)
(cond ((immediate? lit) 0)
- ((big-fixnum? lit) 3) ; immediate if fixnum, bignum see below
+ ((big-fixnum? lit) 2) ; immediate if fixnum, bignum see below
((string? lit) 0) ; statically allocated
- ((bignum? lit) 3) ; internal vector statically allocated
+ ((bignum? lit) 2) ; internal vector statically allocated
((flonum? lit) words-per-flonum)
((symbol? lit) 7) ; size of symbol, and possibly a bucket
((pair? lit) (+ 3 (literal-size (car lit)) (literal-size (cdr lit))))
diff --git a/c-platform.scm b/c-platform.scm
index acd0b53..e4ca050 100644
--- a/c-platform.scm
+++ b/c-platform.scm
@@ -584,11 +584,11 @@
(rewrite 'abs 14 'fixnum 1 "C_fixnum_abs" "C_fixnum_abs")
-(rewrite 'chicken.bitwise#bitwise-and 21 -1 "C_fixnum_and" "C_u_fixnum_and" "C_s_a_i_bitwise_and" 6)
-(rewrite 'chicken.bitwise#bitwise-xor 21 0 "C_fixnum_xor" "C_fixnum_xor" "C_s_a_i_bitwise_xor" 6)
-(rewrite 'chicken.bitwise#bitwise-ior 21 0 "C_fixnum_or" "C_u_fixnum_or" "C_s_a_i_bitwise_ior" 6)
+(rewrite 'chicken.bitwise#bitwise-and 21 -1 "C_fixnum_and" "C_u_fixnum_and" "C_s_a_i_bitwise_and" 5)
+(rewrite 'chicken.bitwise#bitwise-xor 21 0 "C_fixnum_xor" "C_fixnum_xor" "C_s_a_i_bitwise_xor" 5)
+(rewrite 'chicken.bitwise#bitwise-ior 21 0 "C_fixnum_or" "C_u_fixnum_or" "C_s_a_i_bitwise_ior" 5)
-(rewrite 'chicken.bitwise#bitwise-not 22 1 "C_s_a_i_bitwise_not" #t 6 "C_fixnum_not")
+(rewrite 'chicken.bitwise#bitwise-not 22 1 "C_s_a_i_bitwise_not" #t 5 "C_fixnum_not")
(rewrite 'chicken.flonum#fp+ 16 2 "C_a_i_flonum_plus" #f words-per-flonum)
(rewrite 'chicken.flonum#fp- 16 2 "C_a_i_flonum_difference" #f words-per-flonum)
@@ -674,12 +674,12 @@
(rewrite 'lcm 18 1)
(rewrite 'list 18 '())
-(rewrite '+ 16 2 "C_s_a_i_plus" #t 36)
-(rewrite '- 16 2 "C_s_a_i_minus" #t 36)
-(rewrite '* 16 2 "C_s_a_i_times" #t 40)
-(rewrite 'quotient 16 2 "C_s_a_i_quotient" #t 6)
-(rewrite 'remainder 16 2 "C_s_a_i_remainder" #t 6)
-(rewrite 'modulo 16 2 "C_s_a_i_modulo" #t 6)
+(rewrite '+ 16 2 "C_s_a_i_plus" #t 32)
+(rewrite '- 16 2 "C_s_a_i_minus" #t 32)
+(rewrite '* 16 2 "C_s_a_i_times" #t 36)
+(rewrite 'quotient 16 2 "C_s_a_i_quotient" #t 5)
+(rewrite 'remainder 16 2 "C_s_a_i_remainder" #t 5)
+(rewrite 'modulo 16 2 "C_s_a_i_modulo" #t 5)
(rewrite '= 17 2 "C_i_nequalp")
(rewrite '> 17 2 "C_i_greaterp")
@@ -829,7 +829,7 @@
(make-node '##core#inline
'("C_i_fixnum_arithmetic_shift") callargs)
(make-node '##core#inline_allocate
- (list "C_s_a_i_arithmetic_shift" 6)
+ (list "C_s_a_i_arithmetic_shift" 5)
callargs) ) ) ) ) ) ) ) )
(rewrite '##sys#byte 17 2 "C_subbyte")
diff --git a/chicken.h b/chicken.h
index 3ecdd39..1bbce14 100644
--- a/chicken.h
+++ b/chicken.h
@@ -464,7 +464,7 @@ static inline int isinf_ld (long double x)
# define C_PAIR_TYPE (0x0300000000000000L)
# define C_CLOSURE_TYPE (0x0400000000000000L | C_SPECIALBLOCK_BIT)
# define C_FLONUM_TYPE (0x0500000000000000L | C_BYTEBLOCK_BIT | C_8ALIGN_BIT)
-/* unused (0x0600000000000000L ...) */
+# define C_BIGNUM_TYPE (0x0600000000000000L) /* Just the wrapper */
# define C_PORT_TYPE (0x0700000000000000L | C_SPECIALBLOCK_BIT)
# define C_STRUCTURE_TYPE (0x0800000000000000L)
# define C_POINTER_TYPE (0x0900000000000000L | C_SPECIALBLOCK_BIT)
@@ -494,7 +494,7 @@ static inline int isinf_ld (long double x)
# else
# define C_FLONUM_TYPE (0x05000000 | C_BYTEBLOCK_BIT | C_8ALIGN_BIT)
# endif
-/* unused (0x06000000 ...) */
+# define C_BIGNUM_TYPE (0x06000000) /* Just the wrapper */
# define C_PORT_TYPE (0x07000000 | C_SPECIALBLOCK_BIT)
# define C_STRUCTURE_TYPE (0x08000000)
# define C_POINTER_TYPE (0x09000000 | C_SPECIALBLOCK_BIT)
@@ -527,11 +527,11 @@ static inline int isinf_ld (long double x)
#define C_SIZEOF_STRUCTURE(n) ((n)+1)
#define C_SIZEOF_CLOSURE(n) ((n)+1)
#define C_SIZEOF_INTERNAL_BIGNUM_VECTOR(n) (C_SIZEOF_VECTOR((n)+1))
-#define C_internal_bignum_vector(b) (C_block_item(b,1))
+#define C_internal_bignum_vector(b) (C_block_item(b,0))
/* This is for convenience and allows flexibility in representation */
#define C_SIZEOF_FIX_BIGNUM C_SIZEOF_BIGNUM(1)
-#define C_SIZEOF_BIGNUM_WRAPPER C_SIZEOF_STRUCTURE(2)
+#define C_SIZEOF_BIGNUM_WRAPPER 2
#define C_SIZEOF_BIGNUM(n) (C_SIZEOF_INTERNAL_BIGNUM_VECTOR(n)+C_SIZEOF_BIGNUM_WRAPPER)
/* Fixed size types have pre-computed header tags */
@@ -541,6 +541,7 @@ static inline int isinf_ld (long double x)
#define C_TAGGED_POINTER_TAG (C_TAGGED_POINTER_TYPE | (C_SIZEOF_TAGGED_POINTER - 1))
#define C_SYMBOL_TAG (C_SYMBOL_TYPE | (C_SIZEOF_SYMBOL - 1))
#define C_FLONUM_TAG (C_FLONUM_TYPE | sizeof(double))
+#define C_BIGNUM_TAG (C_BIGNUM_TYPE | 1)
#define C_STRUCTURE3_TAG (C_STRUCTURE_TYPE | 3)
#define C_STRUCTURE2_TAG (C_STRUCTURE_TYPE | 2)
@@ -1173,7 +1174,7 @@ typedef void (C_ccall *C_proc)(C_word, C_word *) C_noret;
#define C_forwardedp(x) C_mk_bool((C_block_header(x) & C_GC_FORWARDING_BIT) != 0)
#define C_immp(x) C_mk_bool(C_immediatep(x))
#define C_flonump(x) C_mk_bool(C_block_header(x) == C_FLONUM_TAG)
-#define C_bignump(x) C_mk_bool(C_block_header(x) == C_STRUCTURE2_TAG && C_block_item(x, 0) == C_bignum_type_tag)
+#define C_bignump(x) C_mk_bool(C_block_header(x) == C_BIGNUM_TAG)
#define C_stringp(x) C_mk_bool(C_header_bits(x) == C_STRING_TYPE)
#define C_symbolp(x) C_mk_bool(C_block_header(x) == C_SYMBOL_TAG)
#define C_pairp(x) C_mk_bool(C_block_header(x) == C_PAIR_TAG)
@@ -1734,7 +1735,6 @@ C_varextern C_TLS C_word
*C_scratchspace_top,
*C_scratchspace_limit,
C_scratch_usage,
- C_bignum_type_tag,
C_ratnum_type_tag,
C_cplxnum_type_tag;
C_varextern C_TLS C_long
@@ -2437,6 +2437,15 @@ C_inline C_word C_ratnum(C_word **ptr, C_word x, C_word y)
return C_a_i_record3(ptr, 2, C_ratnum_type_tag, x, y);
}
+C_inline C_word C_a_i_bignum_wrapper(C_word **ptr, C_word vec)
+{
+ C_word *p = *ptr, *p0 = p;
+
+ *(p++) = C_BIGNUM_TAG;
+ *(p++) = vec;
+ *ptr = p;
+ return (C_word)p0;
+}
/* Silly (this is not normalized) but in some cases needed internally */
C_inline C_word C_bignum0(C_word **ptr)
@@ -2447,7 +2456,7 @@ C_inline C_word C_bignum0(C_word **ptr)
*(p++) = 0; /* zero is always positive */
*ptr = p;
- return C_a_i_record2(ptr, 2, C_bignum_type_tag, p0);
+ return C_a_i_bignum_wrapper(ptr, p0);
}
C_inline C_word C_bignum1(C_word **ptr, int negp, C_uword d1)
@@ -2459,7 +2468,7 @@ C_inline C_word C_bignum1(C_word **ptr, int negp, C_uword d1)
*(p++) = d1;
*ptr = p;
- return C_a_i_record2(ptr, 2, C_bignum_type_tag, p0);
+ return C_a_i_bignum_wrapper(ptr, p0);
}
/* Here d1, d2, ... are low to high (ie, little endian)! */
@@ -2473,14 +2482,12 @@ C_inline C_word C_bignum2(C_word **ptr, int negp, C_uword d1, C_uword d2)
*(p++) = d2;
*ptr = p;
- return C_a_i_record2(ptr, 2, C_bignum_type_tag, p0);
+ return C_a_i_bignum_wrapper(ptr, p0);
}
C_inline C_word C_i_bignump(C_word x)
{
- return C_mk_bool(!C_immediatep(x) &&
- C_block_header(x) == C_STRUCTURE2_TAG &&
- C_block_item(x, 0) == C_bignum_type_tag);
+ return C_mk_bool(!C_immediatep(x) && C_block_header(x) == C_BIGNUM_TAG);
}
@@ -2748,9 +2755,8 @@ C_inline C_word basic_eqvp(C_word x, C_word y)
((C_block_header(x) == C_FLONUM_TAG &&
C_flonum_magnitude(x) == C_flonum_magnitude(y)) ||
- (C_block_header(x) == C_STRUCTURE2_TAG &&
- C_block_item(x, 0) == C_bignum_type_tag &&
- C_block_item(y, 0) == C_bignum_type_tag &&
+ (C_block_header(x) == C_BIGNUM_TAG &&
+ C_block_header(y) == C_BIGNUM_TAG &&
C_i_bignum_cmp(x, y) == C_fix(0)))));
}
@@ -2813,7 +2819,7 @@ C_inline C_word C_i_numberp(C_word x)
return C_mk_bool((x & C_FIXNUM_BIT) ||
(!C_immediatep(x) &&
(C_block_header(x) == C_FLONUM_TAG ||
- C_truep(C_bignump(x)) ||
+ C_block_header(x) == C_BIGNUM_TAG ||
(C_block_header(x) == C_STRUCTURE3_TAG &&
(C_block_item(x, 0) == C_ratnum_type_tag ||
C_block_item(x, 0) == C_cplxnum_type_tag)))));
@@ -2825,7 +2831,7 @@ C_inline C_word C_i_realp(C_word x)
return C_mk_bool((x & C_FIXNUM_BIT) ||
(!C_immediatep(x) &&
(C_block_header(x) == C_FLONUM_TAG ||
- C_truep(C_bignump(x)) ||
+ C_block_header(x) == C_BIGNUM_TAG ||
(C_block_header(x) == C_STRUCTURE3_TAG &&
C_block_item(x, 0) == C_ratnum_type_tag))));
}
@@ -2841,7 +2847,7 @@ C_inline C_word C_i_rationalp(C_word x)
double n = C_flonum_magnitude(x);
return C_mk_bool(!C_isinf(n) && !C_isnan(n));
} else {
- return C_mk_bool(C_truep(C_bignump(x)) ||
+ return C_mk_bool(C_block_header(x) == C_BIGNUM_TAG ||
(C_block_header(x) == C_STRUCTURE3_TAG &&
C_block_item(x, 0) == C_ratnum_type_tag));
}
diff --git a/library.scm b/library.scm
index 246f70f..d27c063 100644
--- a/library.scm
+++ b/library.scm
@@ -983,7 +983,7 @@ EOF
(import chicken.flonum)
(define-inline (integer-negate x)
- (##core#inline_allocate ("C_s_a_u_i_integer_negate" 6) x))
+ (##core#inline_allocate ("C_s_a_u_i_integer_negate" 5) x))
(define = (##core#primitive "C_nequalp"))
(define > (##core#primitive "C_greaterp"))
@@ -1108,7 +1108,7 @@ EOF
(define signum (##core#primitive "C_signum"))
(define-inline (%flo->int x)
- (##core#inline_allocate ("C_s_a_u_i_flo_to_int" 6) x))
+ (##core#inline_allocate ("C_s_a_u_i_flo_to_int" 5) x))
(define (flonum->ratnum x)
;; Try to multiply by two until we reach an integer
@@ -1159,20 +1159,20 @@ EOF
(define bitwise-and (##core#primitive "C_bitwise_and"))
(define bitwise-ior (##core#primitive "C_bitwise_ior"))
(define bitwise-xor (##core#primitive "C_bitwise_xor"))
-(define (bitwise-not n) (##core#inline_allocate ("C_s_a_i_bitwise_not" 6) n))
+(define (bitwise-not n) (##core#inline_allocate ("C_s_a_i_bitwise_not" 5) n))
(define (bit-set? n i) (##core#inline "C_i_bit_setp" n i))
(define (integer-length x) (##core#inline "C_i_integer_length" x))
(define (arithmetic-shift n m)
- (##core#inline_allocate ("C_s_a_i_arithmetic_shift" 6) n m)))
+ (##core#inline_allocate ("C_s_a_i_arithmetic_shift" 5) n m)))
(import chicken.bitwise)
;;; Basic arithmetic:
(define-inline (%integer-gcd a b)
- (##core#inline_allocate ("C_s_a_u_i_integer_gcd" 6) a b))
+ (##core#inline_allocate ("C_s_a_u_i_integer_gcd" 5) a b))
-(define (abs x) (##core#inline_allocate ("C_s_a_i_abs" 10) x))
+(define (abs x) (##core#inline_allocate ("C_s_a_i_abs" 9) x))
(define (/ arg1 . args)
(if (null? args)
@@ -1185,7 +1185,7 @@ EOF
(##sys#/-2 x (##sys#slot args 0))) ) ) ) )
(define-inline (%integer-quotient a b)
- (##core#inline_allocate ("C_s_a_u_i_integer_quotient" 6) a b))
+ (##core#inline_allocate ("C_s_a_u_i_integer_quotient" 5) a b))
(define (##sys#/-2 x y)
(when (eq? y 0)
@@ -1301,9 +1301,9 @@ EOF
(exact->inexact result)
result)))
-(define (quotient a b) (##core#inline_allocate ("C_s_a_i_quotient" 6) a b))
-(define (remainder a b) (##core#inline_allocate ("C_s_a_i_remainder" 6) a b))
-(define (modulo a b) (##core#inline_allocate ("C_s_a_i_modulo" 6) a b))
+(define (quotient a b) (##core#inline_allocate ("C_s_a_i_quotient" 5) a b))
+(define (remainder a b) (##core#inline_allocate ("C_s_a_i_remainder" 5) a b))
+(define (modulo a b) (##core#inline_allocate ("C_s_a_i_modulo" 5) a b))
(define quotient&remainder (##core#primitive "C_quotient_and_remainder"))
;; Modulo's sign follows y (whereas remainder's sign follows x)
@@ -1769,7 +1769,7 @@ EOF
(end (or hashes digits)))
(and-let* ((end)
(num (##core#inline_allocate
- ("C_s_a_i_digits_to_integer" 3)
+ ("C_s_a_i_digits_to_integer" 2)
str start (car end) radix neg?)))
(when hashes ; Eeewww. Feeling dirty yet?
(set! seen-hashes? #t)
@@ -1784,7 +1784,7 @@ EOF
(end (scan-digits start)))
(go-inexact!)
(cons (##core#inline_allocate
- ("C_s_a_i_digits_to_integer" 3)
+ ("C_s_a_i_digits_to_integer" 2)
str start (car end) radix (eq? sign 'neg))
(cdr end)))))))
(scan-decimal-tail ; The part after the decimal dot
diff --git a/runtime.c b/runtime.c
index 5c542d3..ab23b1d 100644
--- a/runtime.c
+++ b/runtime.c
@@ -352,7 +352,6 @@ C_TLS C_word
*C_scratchspace_top,
*C_scratchspace_limit,
C_scratch_usage,
- C_bignum_type_tag,
C_ratnum_type_tag,
C_cplxnum_type_tag;
C_TLS C_long
@@ -1148,7 +1147,6 @@ void initialize_symbol_table(void)
for(i = 0; i < symbol_table->size; symbol_table->table[ i++ ] = C_SCHEME_END_OF_LIST);
/* Obtain reference to hooks for later: */
- C_bignum_type_tag = C_intern2(C_heaptop, C_text("\003sysbignum"));
C_ratnum_type_tag = C_intern2(C_heaptop, C_text("\003sysratnum"));
C_cplxnum_type_tag = C_intern2(C_heaptop, C_text("\003syscplxnum"));
core_provided_symbol = C_intern2(C_heaptop, C_text("\004coreprovided"));
@@ -2674,7 +2672,7 @@ C_regparm C_word C_fcall C_static_bignum(C_word **ptr, int len, C_char *str)
C_block_header_init(bigvec, C_STRING_TYPE | C_wordstobytes(size + 1));
C_set_block_item(bigvec, 0, negp);
/* This needs to be allocated at ptr, not dptr, because GC moves type tag */
- bignum = C_a_i_record2(ptr, 2, C_bignum_type_tag, bigvec);
+ bignum = C_a_i_bignum_wrapper(ptr, bigvec);
retval = str_to_bignum(bignum, str, str + len, 16);
if (retval & C_FIXNUM_BIT)
@@ -3608,7 +3606,6 @@ C_regparm void C_fcall C_reclaim(void *trampoline, C_word c)
C_regparm void C_fcall mark_system_globals(void)
{
- mark(&C_bignum_type_tag);
mark(&C_ratnum_type_tag);
mark(&C_cplxnum_type_tag);
mark(&core_provided_symbol);
@@ -3968,7 +3965,6 @@ C_regparm void C_fcall C_rereclaim2(C_uword size, int relative_resize)
C_regparm void C_fcall remark_system_globals(void)
{
- remark(&C_bignum_type_tag);
remark(&C_ratnum_type_tag);
remark(&C_cplxnum_type_tag);
remark(&core_provided_symbol);
@@ -5987,7 +5983,7 @@ C_regparm C_word C_fcall C_i_vector_set(C_word v, C_word i, C_word x)
return C_SCHEME_UNDEFINED;
}
-/* This needs at most C_SIZEOF_FIX_BIGNUM + C_SIZEOF_STRUCTURE(3) so 10 words */
+/* This needs at most C_SIZEOF_FIX_BIGNUM + C_SIZEOF_STRUCTURE(3) so 9 words */
C_regparm C_word C_fcall
C_s_a_i_abs(C_word **ptr, C_word n, C_word x)
{
@@ -6048,7 +6044,7 @@ C_regparm C_word C_fcall C_a_i_abs(C_word **a, int c, C_word x)
/* The maximum this can allocate is a cplxnum which consists of two
* ratnums that consist of 2 fix bignums each. So that's
- * C_SIZEOF_STRUCTURE(3) * 3 + C_SIZEOF_FIX_BIGNUM * 4 = 36 words!
+ * C_SIZEOF_STRUCTURE(3) * 3 + C_SIZEOF_FIX_BIGNUM * 4 = 32 words!
*/
C_regparm C_word C_fcall
C_s_a_i_negate(C_word **ptr, C_word n, C_word x)
@@ -7762,7 +7758,7 @@ cplx_times(C_word **ptr, C_word rx, C_word ix, C_word ry, C_word iy)
{
/* Allocation here is kind of tricky: Each intermediate result can
* be at most a ratnum consisting of two bignums (2 digits), so
- * C_SIZEOF_STRUCTURE(3) + C_SIZEOF_BIGNUM(2) = 11 words
+ * C_SIZEOF_STRUCTURE(3) + C_SIZEOF_BIGNUM(2) = 10 words
*/
C_word ab[(C_SIZEOF_STRUCTURE(3) + C_SIZEOF_BIGNUM(2))*6], *a = ab,
r1, r2, i1, i2, r, i;
@@ -7793,7 +7789,7 @@ cplx_times(C_word **ptr, C_word rx, C_word ix, C_word ry, C_word iy)
* number result, where both real and imag parts consist of ratnums.
* The maximum size of those ratnums is if they consist of two bignums
* from a fixnum multiplication (2 digits each), so we're looking at
- * C_SIZEOF_STRUCTURE(3) * 3 + C_SIZEOF_BIGNUM(2) * 4 = 40 words!
+ * C_SIZEOF_STRUCTURE(3) * 3 + C_SIZEOF_BIGNUM(2) * 4 = 36 words!
*/
C_regparm C_word C_fcall
C_s_a_i_times(C_word **ptr, C_word n, C_word x, C_word y)
@@ -8238,7 +8234,7 @@ static C_word rat_plusmin_rat(C_word **ptr, C_word x, C_word y, integer_plusmin_
* number result, where both real and imag parts consist of ratnums.
* The maximum size of those ratnums is if they consist of two "fix
* bignums", so we're looking at C_SIZEOF_STRUCTURE(3) * 3 +
- * C_SIZEOF_FIX_BIGNUM * 4 = 36 words!
+ * C_SIZEOF_FIX_BIGNUM * 4 = 32 words!
*/
C_regparm C_word C_fcall
C_s_a_i_plus(C_word **ptr, C_word n, C_word x, C_word y)
@@ -8500,7 +8496,7 @@ static C_word bignum_minus_unsigned(C_word **ptr, C_word x, C_word y)
return C_bignum_simplify(res);
}
-/* Like C_s_a_i_plus, this needs at most 36 words */
+/* Like C_s_a_i_plus, this needs at most 32 words */
C_regparm C_word C_fcall
C_s_a_i_minus(C_word **ptr, C_word n, C_word x, C_word y)
{
@@ -10306,7 +10302,7 @@ static C_word allocate_tmp_bignum(C_word size, C_word negp, C_word initp)
0, C_wordstobytes(C_unfix(size)));
}
- return C_a_i_record2(&mem, 2, C_bignum_type_tag, bigvec);
+ return C_a_i_bignum_wrapper(&mem, bigvec);
}
C_regparm C_word C_fcall
@@ -10322,7 +10318,7 @@ C_allocate_scratch_bignum(C_word **ptr, C_word size, C_word negp, C_word initp)
0, C_wordstobytes(C_unfix(size)));
}
- big = C_a_i_record2(ptr, 2, C_bignum_type_tag, bigvec);
+ big = C_a_i_bignum_wrapper(ptr, bigvec);
C_mutate_scratch_slot(&C_internal_bignum_vector(big), bigvec);
return big;
}
diff --git a/types.db b/types.db
index c9640d9..bf1bcb6 100644
--- a/types.db
+++ b/types.db
@@ -317,18 +317,18 @@
((float float) (float)
(##core#inline_allocate ("C_a_i_flonum_plus" 4) #(1) #(2)))
((fixnum fixnum) (integer)
- (##core#inline_allocate ("C_a_i_fixnum_plus" 6) #(1) #(2)))
+ (##core#inline_allocate ("C_a_i_fixnum_plus" 5) #(1) #(2)))
((integer integer) (integer)
- (##core#inline_allocate ("C_s_a_u_i_integer_plus" 6) #(1) #(2)))
+ (##core#inline_allocate ("C_s_a_u_i_integer_plus" 5) #(1) #(2)))
((* *) (number)
- (##core#inline_allocate ("C_s_a_i_plus" 36) #(1) #(2))))
+ (##core#inline_allocate ("C_s_a_i_plus" 32) #(1) #(2))))
(- (#(procedure #:clean #:enforce #:foldable) - (number #!rest number) number)
- ((fixnum) (integer) (##core#inline_allocate ("C_a_i_fixnum_negate" 6) #(1)))
+ ((fixnum) (integer) (##core#inline_allocate ("C_a_i_fixnum_negate" 5) #(1)))
((integer) (integer)
- (##core#inline_allocate ("C_s_a_u_i_integer_negate" 6) #(1)))
+ (##core#inline_allocate ("C_s_a_u_i_integer_negate" 5) #(1)))
((float) (float) (##core#inline_allocate ("C_a_i_flonum_negate" 4) #(1)))
- ((*) (*) (##core#inline_allocate ("C_s_a_i_negate" 36) #(1)))
+ ((*) (*) (##core#inline_allocate ("C_s_a_i_negate" 32) #(1)))
((float fixnum) (float)
(##core#inline_allocate
("C_a_i_flonum_difference" 4)
@@ -342,11 +342,11 @@
((float float) (float)
(##core#inline_allocate ("C_a_i_flonum_difference" 4) #(1) #(2)))
((fixnum fixnum) (integer)
- (##core#inline_allocate ("C_a_i_fixnum_difference" 6) #(1) #(2)))
+ (##core#inline_allocate ("C_a_i_fixnum_difference" 5) #(1) #(2)))
((integer integer) (integer)
- (##core#inline_allocate ("C_s_a_u_i_integer_minus" 6) #(1) #(2)))
+ (##core#inline_allocate ("C_s_a_u_i_integer_minus" 5) #(1) #(2)))
((* *) (number)
- (##core#inline_allocate ("C_s_a_i_minus" 36) #(1) #(2))))
+ (##core#inline_allocate ("C_s_a_i_minus" 32) #(1) #(2))))
(* (#(procedure #:clean #:enforce #:foldable) * (#!rest number) number)
(() (fixnum) '1)
@@ -370,11 +370,11 @@
((float float) (float)
(##core#inline_allocate ("C_a_i_flonum_times" 4) #(1) #(2)))
((fixnum fixnum) (integer)
- (##core#inline_allocate ("C_a_i_fixnum_times" 7) #(1) #(2)))
+ (##core#inline_allocate ("C_a_i_fixnum_times" 5) #(1) #(2)))
((integer integer) (integer)
- (##core#inline_allocate ("C_s_a_u_i_integer_times" 7) #(1) #(2)))
+ (##core#inline_allocate ("C_s_a_u_i_integer_times" 5) #(1) #(2)))
((* *) (number)
- (##core#inline_allocate ("C_s_a_i_times" 40) #(1) #(2))))
+ (##core#inline_allocate ("C_s_a_i_times" 36) #(1) #(2))))
(/ (#(procedure #:clean #:enforce #:foldable) / (number #!rest number) number)
((float fixnum) (float)
@@ -441,11 +441,11 @@
(##core#inline_allocate
("C_a_i_flonum_actual_quotient_checked" 4) #(1) #(2)))
((fixnum fixnum) (integer)
- (##core#inline_allocate ("C_a_i_fixnum_quotient_checked" 6)
+ (##core#inline_allocate ("C_a_i_fixnum_quotient_checked" 5)
#(1) #(2)))
((integer integer) (integer)
- (##core#inline_allocate ("C_s_a_u_i_integer_quotient" 6) #(1) #(2)))
- ((* *) (##core#inline_allocate ("C_s_a_i_quotient" 6) #(1) #(2))))
+ (##core#inline_allocate ("C_s_a_u_i_integer_quotient" 5) #(1) #(2)))
+ ((* *) (##core#inline_allocate ("C_s_a_i_quotient" 5) #(1) #(2))))
(remainder (#(procedure #:clean #:enforce #:foldable) remainder ((or integer float) (or integer float)) (or integer float))
((float float) (float)
@@ -455,8 +455,8 @@
((fixnum fixnum) (fixnum)
(##core#inline "C_i_fixnum_remainder_checked" #(1) #(2)))
((integer integer) (integer)
- (##core#inline_allocate ("C_s_a_u_i_integer_remainder" 6) #(1) #(2)))
- ((* *) (##core#inline_allocate ("C_s_a_i_remainder" 6) #(1) #(2))))
+ (##core#inline_allocate ("C_s_a_u_i_integer_remainder" 5) #(1) #(2)))
+ ((* *) (##core#inline_allocate ("C_s_a_i_remainder" 5) #(1) #(2))))
(quotient&remainder (#(procedure #:clean #:enforce #:foldable) quotient&remainder ((or integer float) (or integer float)) (or integer float) (or integer float))
((float float) (float float)
@@ -472,7 +472,7 @@
(let ((#(tmp1) #(1)))
(let ((#(tmp2) #(2)))
(##sys#values
- (##core#inline_allocate ("C_a_i_fixnum_quotient_checked" 6)
+ (##core#inline_allocate ("C_a_i_fixnum_quotient_checked" 5)
#(tmp1) #(tmp2))
(##core#inline
"C_i_fixnum_remainder_checked" #(tmp1) #(tmp2))))))
@@ -490,15 +490,15 @@
((fixnum fixnum) (fixnum)
(##core#inline "C_fixnum_modulo" #(1) #(2)))
((integer integer) (integer)
- (##core#inline_allocate ("C_s_a_u_i_integer_modulo" 6) #(1) #(2)))
- ((* *) (##core#inline_allocate ("C_s_a_i_modulo" 6) #(1) #(2))))
+ (##core#inline_allocate ("C_s_a_u_i_integer_modulo" 5) #(1) #(2)))
+ ((* *) (##core#inline_allocate ("C_s_a_i_modulo" 5) #(1) #(2))))
(gcd (#(procedure #:clean #:enforce #:foldable) gcd (#!rest (or integer float)) (or integer float))
(() '0)
((fixnum fixnum) (fixnum) (chicken.fixnum#fxgcd #(1) #(2)))
((float float) (float) (chicken.flonum#fpgcd #(1) #(2)))
((integer integer) (integer)
- (##core#inline_allocate ("C_s_a_u_i_integer_gcd" 6) #(1) #(2)))
+ (##core#inline_allocate ("C_s_a_u_i_integer_gcd" 5) #(1) #(2)))
((* *) (##sys#gcd #(1) #(2))))
(##sys#gcd (#(procedure #:clean #:enforce #:foldable) ##sys#gcd (number number) number))
@@ -510,12 +510,12 @@
(##sys#lcm (#(procedure #:clean #:enforce #:foldable) ##sys#lcm (number number) number))
(abs (#(procedure #:clean #:enforce #:foldable) abs (number) number)
- ((fixnum) (integer) (##core#inline_allocate ("C_a_i_fixnum_abs" 6) #(1)))
+ ((fixnum) (integer) (##core#inline_allocate ("C_a_i_fixnum_abs" 5) #(1)))
((float) (float) (##core#inline_allocate ("C_a_i_flonum_abs" 4) #(1)))
((integer) (integer)
- (##core#inline_allocate ("C_s_a_u_i_integer_abs" 6) #(1)))
+ (##core#inline_allocate ("C_s_a_u_i_integer_abs" 5) #(1)))
((*) (*)
- (##core#inline_allocate ("C_s_a_i_abs" 10) #(1))))
+ (##core#inline_allocate ("C_s_a_i_abs" 9) #(1))))
(floor (#(procedure #:clean #:enforce #:foldable) floor ((or integer ratnum float)) (or integer ratnum float))
((fixnum) (fixnum) #(1))
@@ -818,11 +818,11 @@
((cplxnum) (##sys#slot #(1) '2)))
(magnitude (#(procedure #:clean #:enforce #:foldable) magnitude (number) number)
- ((fixnum) (integer) (##core#inline_allocate ("C_a_i_fixnum_abs" 6) #(1)))
- ((integer) (##core#inline_allocate ("C_s_a_u_i_integer_abs" 6) #(1)))
+ ((fixnum) (integer) (##core#inline_allocate ("C_a_i_fixnum_abs" 5) #(1)))
+ ((integer) (##core#inline_allocate ("C_s_a_u_i_integer_abs" 5) #(1)))
((float) (float) (##core#inline_allocate ("C_a_i_flonum_abs" 4) #(1)))
(((or fixnum float bignum ratnum))
- (##core#inline_allocate ("C_s_a_i_abs" 10) #(1))))
+ (##core#inline_allocate ("C_s_a_i_abs" 9) #(1))))
(angle (#(procedure #:clean #:enforce #:foldable) angle (number) float)
((float) (##core#inline_allocate ("C_a_i_flonum_atan2" 4) '0.0 #(1)))
@@ -879,13 +879,13 @@
(add1 (#(procedure #:clean #:enforce #:foldable) add1 (number) number)
((fixnum) (integer)
- (##core#inline_allocate ("C_a_i_fixnum_plus" 6) #(1) '1))
+ (##core#inline_allocate ("C_a_i_fixnum_plus" 5) #(1) '1))
((integer) (integer)
- (##core#inline_allocate ("C_s_a_u_i_integer_plus" 6) #(1) '1))
+ (##core#inline_allocate ("C_s_a_u_i_integer_plus" 5) #(1) '1))
((float) (float)
(##core#inline_allocate ("C_a_i_flonum_plus" 4) #(1) '1.0))
((*) (number)
- (##core#inline_allocate ("C_s_a_i_plus" 36) #(1) '1)))
+ (##core#inline_allocate ("C_s_a_i_plus" 32) #(1) '1)))
(argc+argv (#(procedure #:clean) argc+argv () fixnum pointer))
(argv (#(procedure #:clean) argv () (list-of string)))
@@ -897,7 +897,7 @@
(chicken-bitwise#arithmetic-shift
(#(procedure #:clean #:enforce #:foldable) chicken.bitwise#arithmetic-shift (integer fixnum) integer)
- ((* *) (##core#inline_allocate ("C_s_a_i_arithmetic_shift" 6) #(1) #(2))))
+ ((* *) (##core#inline_allocate ("C_s_a_i_arithmetic_shift" 5) #(1) #(2))))
(exact-integer-nth-root (#(procedure #:clean #:enforce #:foldable) exact-integer-nth-root (integer integer) integer integer)
((integer integer) (##sys#exact-integer-nth-root/loc 'exact-integer-nth-root #(1) #(2))))
@@ -922,7 +922,7 @@
((fixnum) (fixnum) #(1))
((integer) #(1))
((fixnum fixnum) (fixnum) (##core#inline "C_u_fixnum_and" #(1) #(2)))
- ((* *) (##core#inline_allocate ("C_s_a_i_bitwise_and" 6) #(1) #(2))))
+ ((* *) (##core#inline_allocate ("C_s_a_i_bitwise_and" 5) #(1) #(2))))
(chicken.bitwise#bitwise-ior
(#(procedure #:clean #:enforce #:foldable) chicken.bitwise#bitwise-ior (#!rest integer) integer)
@@ -930,7 +930,7 @@
((fixnum) (fixnum) #(1))
((integer) #(1))
((fixnum fixnum) (fixnum) (##core#inline "C_u_fixnum_or" #(1) #(2)))
- ((* *) (##core#inline_allocate ("C_s_a_i_bitwise_ior" 6) #(1) #(2))))
+ ((* *) (##core#inline_allocate ("C_s_a_i_bitwise_ior" 5) #(1) #(2))))
(chicken.bitwise#bitwise-xor
(#(procedure #:clean #:enforce #:foldable) chicken.bitwise#bitwise-xor (#!rest integer) integer)
@@ -938,11 +938,11 @@
((fixnum) (fixnum) #(1))
((integer) #(1))
((fixnum fixnum) (fixnum) (##core#inline "C_fixnum_xor" #(1) #(2)))
- ((* *) (##core#inline_allocate ("C_s_a_i_bitwise_xor" 6) #(1) #(2))))
+ ((* *) (##core#inline_allocate ("C_s_a_i_bitwise_xor" 5) #(1) #(2))))
(chicken.bitwise#bitwise-not
(#(procedure #:clean #:enforce #:foldable) chicken.bitwise#bitwise-not (integer) integer)
- ((* *) (##core#inline_allocate ("C_s_a_i_bitwise_not" 6) #(1))))
+ ((* *) (##core#inline_allocate ("C_s_a_i_bitwise_not" 5) #(1))))
(blob->string (#(procedure #:clean #:enforce) blob->string (blob) string))
@@ -1320,13 +1320,13 @@
(sub1 (#(procedure #:clean #:enforce #:foldable) sub1 (number) number)
((fixnum) (integer)
- (##core#inline_allocate ("C_a_i_fixnum_difference" 6) #(1) '1))
+ (##core#inline_allocate ("C_a_i_fixnum_difference" 5) #(1) '1))
((integer) (integer)
- (##core#inline_allocate ("C_s_a_u_i_integer_minus" 6) #(1) '1))
+ (##core#inline_allocate ("C_s_a_u_i_integer_minus" 5) #(1) '1))
((float) (float)
(##core#inline_allocate ("C_a_i_flonum_difference" 4) #(1) '1.0))
((*) (number)
- (##core#inline_allocate ("C_s_a_i_minus" 36) #(1) '1)))
+ (##core#inline_allocate ("C_s_a_i_minus" 32) #(1) '1)))
(subvector (forall (a) (#(procedure #:clean #:enforce) subvector ((vector-of a) fixnum #!optional fixnum) (vector-of a))))
(symbol-escape (#(procedure #:clean) symbol-escape (#!optional *) *))
--
2.1.4
From 012c8c1ed2457e66a6e40c81f3fda300cd4c0504 Mon Sep 17 00:00:00 2001
From: Peter Bex <pe...@more-magic.net>
Date: Mon, 8 Aug 2016 22:33:41 +0200
Subject: [PATCH 2/2] Change ratnum and cplxnum representation to also use
custom types.
Same change as bignums. This eats up two more reserved type tags,
resulting in more pre-allocation savings, about as much as with the
bignum change.
The performance gains on code that *doesn't* use these numeric types
are minimal, but it really cleans up the code; the numeric ops are now
much less branchy, and it changes 2 checks to 1 check for every case
where a ratnum or a cplxnum is involved. In total, this is a net
removal of 100 lines of code.
While at it, this also replaces direct C_block_item(x, n) calls with
more opaque/abstract C_u_i_ratnum_{num,denom} and C_u_i_cplxnum_{real,imag}
helper macros. This would make it easier to change the representation in
the future. Currently only the eqv? implementation directly accesses the
slots to keep the code simpler.
---
c-backend.scm | 7 +
c-platform.scm | 6 +-
chicken.h | 96 +++++----
library.scm | 18 +-
runtime.c | 649 ++++++++++++++++++++++++---------------------------------
types.db | 45 ++--
6 files changed, 361 insertions(+), 460 deletions(-)
diff --git a/c-backend.scm b/c-backend.scm
index 6ed1f09..ccb83ad 100644
--- a/c-backend.scm
+++ b/c-backend.scm
@@ -690,6 +690,13 @@
(if (>= i n)
s
(loop (add1 i) (+ s (literal-size (##sys#slot lit i)))) ) ) ) )
+ ;; We could access rat/cplx slots directly, but let's not.
+ ((ratnum? lit) (+ (##sys#size lit)
+ (literal-size (numerator lit))
+ (literal-size (denominator lit))))
+ ((cplxnum? lit) (+ (##sys#size lit)
+ (literal-size (real-part lit))
+ (literal-size (imag-part lit))))
(else (bad-literal lit))) )
(define (gen-lit lit to)
diff --git a/c-platform.scm b/c-platform.scm
index e4ca050..c1e0a8d 100644
--- a/c-platform.scm
+++ b/c-platform.scm
@@ -674,9 +674,9 @@
(rewrite 'lcm 18 1)
(rewrite 'list 18 '())
-(rewrite '+ 16 2 "C_s_a_i_plus" #t 32)
-(rewrite '- 16 2 "C_s_a_i_minus" #t 32)
-(rewrite '* 16 2 "C_s_a_i_times" #t 36)
+(rewrite '+ 16 2 "C_s_a_i_plus" #t 29)
+(rewrite '- 16 2 "C_s_a_i_minus" #t 29)
+(rewrite '* 16 2 "C_s_a_i_times" #t 33)
(rewrite 'quotient 16 2 "C_s_a_i_quotient" #t 5)
(rewrite 'remainder 16 2 "C_s_a_i_remainder" #t 5)
(rewrite 'modulo 16 2 "C_s_a_i_modulo" #t 5)
diff --git a/chicken.h b/chicken.h
index 1bbce14..30dc2e8 100644
--- a/chicken.h
+++ b/chicken.h
@@ -470,9 +470,9 @@ static inline int isinf_ld (long double x)
# define C_POINTER_TYPE (0x0900000000000000L | C_SPECIALBLOCK_BIT)
# define C_LOCATIVE_TYPE (0x0a00000000000000L | C_SPECIALBLOCK_BIT)
# define C_TAGGED_POINTER_TYPE (0x0b00000000000000L | C_SPECIALBLOCK_BIT)
-/* unused (0x0c00000000000000L ...) */
+# define C_RATNUM_TYPE (0x0c00000000000000L)
# define C_LAMBDA_INFO_TYPE (0x0d00000000000000L | C_BYTEBLOCK_BIT)
-/* unused (0x0e00000000000000L ...) */
+# define C_CPLXNUM_TYPE (0x0e00000000000000L)
# define C_BUCKET_TYPE (0x0f00000000000000L)
#else
# define C_INT_SIGN_BIT 0x80000000
@@ -500,9 +500,9 @@ static inline int isinf_ld (long double x)
# define C_POINTER_TYPE (0x09000000 | C_SPECIALBLOCK_BIT)
# define C_LOCATIVE_TYPE (0x0a000000 | C_SPECIALBLOCK_BIT)
# define C_TAGGED_POINTER_TYPE (0x0b000000 | C_SPECIALBLOCK_BIT)
-/* unused (0x0c000000 ...) */
+# define C_RATNUM_TYPE (0x0c000000)
# define C_LAMBDA_INFO_TYPE (0x0d000000 | C_BYTEBLOCK_BIT)
-/* unused (0x0e000000 ...) */
+# define C_CPLXNUM_TYPE (0x0e000000)
# define C_BUCKET_TYPE (0x0f000000)
#endif
#define C_VECTOR_TYPE 0x00000000
@@ -524,6 +524,8 @@ static inline int isinf_ld (long double x)
#define C_SIZEOF_BUCKET 3
#define C_SIZEOF_LOCATIVE 5
#define C_SIZEOF_PORT 16
+#define C_SIZEOF_RATNUM 3
+#define C_SIZEOF_CPLXNUM 3
#define C_SIZEOF_STRUCTURE(n) ((n)+1)
#define C_SIZEOF_CLOSURE(n) ((n)+1)
#define C_SIZEOF_INTERNAL_BIGNUM_VECTOR(n) (C_SIZEOF_VECTOR((n)+1))
@@ -542,8 +544,8 @@ static inline int isinf_ld (long double x)
#define C_SYMBOL_TAG (C_SYMBOL_TYPE | (C_SIZEOF_SYMBOL - 1))
#define C_FLONUM_TAG (C_FLONUM_TYPE | sizeof(double))
#define C_BIGNUM_TAG (C_BIGNUM_TYPE | 1)
-#define C_STRUCTURE3_TAG (C_STRUCTURE_TYPE | 3)
-#define C_STRUCTURE2_TAG (C_STRUCTURE_TYPE | 2)
+#define C_RATNUM_TAG (C_RATNUM_TYPE | 2)
+#define C_CPLXNUM_TAG (C_CPLXNUM_TYPE | 2)
/* Locative subtypes */
#define C_SLOT_LOCATIVE 0
@@ -1306,6 +1308,10 @@ typedef void (C_ccall *C_proc)(C_word, C_word *) C_noret;
#define C_block_size(x) C_fix(C_header_size(x))
#define C_u_i_bignum_size(b) C_fix(C_bignum_size(b))
#define C_a_u_i_big_to_flo(p, n, b) C_flonum(p, C_bignum_to_double(b))
+#define C_u_i_ratnum_num(r) C_block_item((r), 0)
+#define C_u_i_ratnum_denom(r) C_block_item((r), 1)
+#define C_u_i_cplxnum_real(c) C_block_item((c), 0)
+#define C_u_i_cplxnum_imag(c) C_block_item((c), 1)
#define C_pointer_address(x) ((C_byte *)C_block_item((x), 0))
#define C_block_address(ptr, n, x) C_a_unsigned_int_to_num(ptr, n, x)
#define C_offset_pointer(x, y) (C_pointer_address(x) + (y))
@@ -1377,7 +1383,9 @@ typedef void (C_ccall *C_proc)(C_word, C_word *) C_noret;
# define C_a_i_cons(a, n, car, cdr) C_a_pair(a, car, cdr)
#endif /* HAVE_STATEMENT_EXPRESSIONS */
-#define C_a_i_flonum(ptr, i, n) C_flonum(ptr, n)
+#define C_a_i_flonum(ptr, c, n) C_flonum(ptr, n)
+#define C_a_i_ratnum(ptr, c, n, d) C_ratnum(ptr, n, d)
+#define C_a_i_cplxnum(ptr, c, r, i) C_cplxnum(ptr, r, i)
#define C_a_i_data_mpointer(ptr, n, x) C_mpointer(ptr, C_data_pointer(x))
#define C_a_i_fix_to_flo(p, n, f) C_flonum(p, C_unfix(f))
#define C_cast_to_flonum(n) ((double)(n))
@@ -1734,9 +1742,7 @@ C_varextern C_TLS C_word
*C_scratchspace_start,
*C_scratchspace_top,
*C_scratchspace_limit,
- C_scratch_usage,
- C_ratnum_type_tag,
- C_cplxnum_type_tag;
+ C_scratch_usage;
C_varextern C_TLS C_long
C_timer_interrupt_counter,
C_initial_timer_interrupt_period;
@@ -2427,14 +2433,26 @@ C_inline C_word C_a_i_record8(C_word **ptr, int n, C_word x1, C_word x2, C_word
return (C_word)p0;
}
-C_inline C_word C_cplxnum(C_word **ptr, C_word x, C_word y)
+C_inline C_word C_cplxnum(C_word **ptr, C_word r, C_word i)
{
- return C_a_i_record3(ptr, 2, C_cplxnum_type_tag, x, y);
+ C_word *p = *ptr, *p0 = p;
+
+ *(p++) = C_CPLXNUM_TAG;
+ *(p++) = r;
+ *(p++) = i;
+ *ptr = p;
+ return (C_word)p0;
}
-C_inline C_word C_ratnum(C_word **ptr, C_word x, C_word y)
+C_inline C_word C_ratnum(C_word **ptr, C_word n, C_word d)
{
- return C_a_i_record3(ptr, 2, C_ratnum_type_tag, x, y);
+ C_word *p = *ptr, *p0 = p;
+
+ *(p++) = C_RATNUM_TAG;
+ *(p++) = n;
+ *(p++) = d;
+ *ptr = p;
+ return (C_word)p0;
}
C_inline C_word C_a_i_bignum_wrapper(C_word **ptr, C_word vec)
@@ -2765,12 +2783,10 @@ C_inline C_word C_i_eqvp(C_word x, C_word y)
return C_mk_bool(basic_eqvp(x, y) ||
(!C_immediatep(x) && !C_immediatep(y) &&
C_block_header(x) == C_block_header(y) &&
- C_block_header(x) == C_STRUCTURE3_TAG &&
- (C_block_item(x, 0) == C_ratnum_type_tag ||
- C_block_item(x, 0) == C_cplxnum_type_tag) &&
- C_block_item(x, 0) == C_block_item(y, 0) &&
- basic_eqvp(C_block_item(x, 1), C_block_item(y, 1)) &&
- basic_eqvp(C_block_item(x, 2), C_block_item(y, 2))));
+ (C_block_header(x) == C_RATNUM_TAG ||
+ C_block_header(x) == C_CPLXNUM_TAG) &&
+ basic_eqvp(C_block_item(x, 0), C_block_item(y, 0)) &&
+ basic_eqvp(C_block_item(x, 1), C_block_item(y, 1))));
}
C_inline C_word C_i_symbolp(C_word x)
@@ -2820,9 +2836,8 @@ C_inline C_word C_i_numberp(C_word x)
(!C_immediatep(x) &&
(C_block_header(x) == C_FLONUM_TAG ||
C_block_header(x) == C_BIGNUM_TAG ||
- (C_block_header(x) == C_STRUCTURE3_TAG &&
- (C_block_item(x, 0) == C_ratnum_type_tag ||
- C_block_item(x, 0) == C_cplxnum_type_tag)))));
+ C_block_header(x) == C_RATNUM_TAG ||
+ C_block_header(x) == C_CPLXNUM_TAG)));
}
/* All numbers are real, except for cplxnums */
@@ -2832,8 +2847,7 @@ C_inline C_word C_i_realp(C_word x)
(!C_immediatep(x) &&
(C_block_header(x) == C_FLONUM_TAG ||
C_block_header(x) == C_BIGNUM_TAG ||
- (C_block_header(x) == C_STRUCTURE3_TAG &&
- C_block_item(x, 0) == C_ratnum_type_tag))));
+ C_block_header(x) == C_RATNUM_TAG)));
}
/* All finite real numbers are rational */
@@ -2848,8 +2862,7 @@ C_inline C_word C_i_rationalp(C_word x)
return C_mk_bool(!C_isinf(n) && !C_isnan(n));
} else {
return C_mk_bool(C_block_header(x) == C_BIGNUM_TAG ||
- (C_block_header(x) == C_STRUCTURE3_TAG &&
- C_block_item(x, 0) == C_ratnum_type_tag));
+ C_block_header(x) == C_RATNUM_TAG);
}
}
@@ -2884,18 +2897,16 @@ C_inline C_word C_u_i_exactp(C_word x)
return C_SCHEME_TRUE;
} else if (C_block_header(x) == C_FLONUM_TAG) {
return C_SCHEME_FALSE;
- } else if (C_block_header(x) != C_STRUCTURE3_TAG) {
- return C_SCHEME_FALSE;
- } else if (C_block_item(x, 0) == C_ratnum_type_tag) {
+ } else if (C_block_header(x) == C_RATNUM_TAG) {
return C_SCHEME_TRUE;
- } else if (C_block_item(x, 0) != C_cplxnum_type_tag) {
- return C_SCHEME_FALSE;
- } else {
- x = C_block_item(x, 1);
+ } else if (C_block_header(x) == C_CPLXNUM_TAG) {
+ x = C_u_i_cplxnum_real(x);
/* r and i are always the same exactness, and we assume they
* always store a number.
*/
return C_mk_bool(C_immediatep(x) || (C_block_header(x) != C_FLONUM_TAG));
+ } else {
+ return C_SCHEME_FALSE;
}
}
@@ -2905,12 +2916,11 @@ C_inline C_word C_u_i_inexactp(C_word x)
return C_SCHEME_FALSE;
} else if (C_block_header(x) == C_FLONUM_TAG) {
return C_SCHEME_TRUE;
- } else if (C_block_header(x) != C_STRUCTURE3_TAG ||
- C_block_item(x, 0) != C_cplxnum_type_tag) {
- return C_SCHEME_FALSE;
- } else {
- x = C_block_item(x, 1); /* r and i are always the same exactness */
+ } else if (C_block_header(x) == C_CPLXNUM_TAG) {
+ x = C_u_i_cplxnum_real(x); /* r and i are always the same exactness */
return C_mk_bool(!C_immediatep(x) && (C_block_header(x) == C_FLONUM_TAG));
+ } else {
+ return C_SCHEME_FALSE;
}
}
@@ -2937,16 +2947,12 @@ C_inline C_word C_i_flonump(C_word x)
C_inline C_word C_i_cplxnump(C_word x)
{
- return C_mk_bool(!C_immediatep(x) &&
- C_block_header(x) == C_STRUCTURE3_TAG &&
- C_block_item(x, 0) == C_cplxnum_type_tag);
+ return C_mk_bool(!C_immediatep(x) && C_block_header(x) == C_CPLXNUM_TAG);
}
C_inline C_word C_i_ratnump(C_word x)
{
- return C_mk_bool(!C_immediatep(x) &&
- C_block_header(x) == C_STRUCTURE3_TAG &&
- C_block_item(x, 0) == C_ratnum_type_tag);
+ return C_mk_bool(!C_immediatep(x) && C_block_header(x) == C_RATNUM_TAG);
}
/* TODO: Is this correctly named? Shouldn't it accept an argcount? */
diff --git a/library.scm b/library.scm
index d27c063..dde4473 100644
--- a/library.scm
+++ b/library.scm
@@ -1015,15 +1015,15 @@ EOF
;;; Complex numbers
-(define-inline (%cplxnum-real c) (##sys#slot c 1))
-(define-inline (%cplxnum-imag c) (##sys#slot c 2))
+(define-inline (%cplxnum-real c) (##core#inline "C_u_i_cplxnum_real" c))
+(define-inline (%cplxnum-imag c) (##core#inline "C_u_i_cplxnum_imag" c))
(define (make-complex r i)
(if (or (eq? i 0) (and (##core#inline "C_i_flonump" i) (fp= i 0.0)))
r
- (##sys#make-structure '##sys#cplxnum
- (if (inexact? i) (exact->inexact r) r)
- (if (inexact? r) (exact->inexact i) i)) ) )
+ (##core#inline_allocate ("C_a_i_cplxnum" 3)
+ (if (inexact? i) (exact->inexact r) r)
+ (if (inexact? r) (exact->inexact i) i)) ) )
(define (make-rectangular r i)
(##sys#check-real r 'make-rectangular)
@@ -1065,9 +1065,9 @@ EOF
;;; Rational numbers
-(define-inline (%ratnum-numerator c) (##sys#slot c 1))
-(define-inline (%ratnum-denominator c) (##sys#slot c 2))
-(define-inline (%make-ratnum r i) (##sys#make-structure '##sys#ratnum r i))
+(define-inline (%ratnum-numerator r) (##core#inline "C_u_i_ratnum_num" r))
+(define-inline (%ratnum-denominator r) (##core#inline "C_u_i_ratnum_denom" r))
+(define-inline (%make-ratnum n d) (##core#inline_allocate ("C_a_i_ratnum" 3) n d))
(define (ratnum m n)
(cond
@@ -1172,7 +1172,7 @@ EOF
(define-inline (%integer-gcd a b)
(##core#inline_allocate ("C_s_a_u_i_integer_gcd" 5) a b))
-(define (abs x) (##core#inline_allocate ("C_s_a_i_abs" 9) x))
+(define (abs x) (##core#inline_allocate ("C_s_a_i_abs" 7) x))
(define (/ arg1 . args)
(if (null? args)
diff --git a/runtime.c b/runtime.c
index ab23b1d..d9ecc05 100644
--- a/runtime.c
+++ b/runtime.c
@@ -351,9 +351,7 @@ C_TLS C_word
*C_scratchspace_start,
*C_scratchspace_top,
*C_scratchspace_limit,
- C_scratch_usage,
- C_ratnum_type_tag,
- C_cplxnum_type_tag;
+ C_scratch_usage;
C_TLS C_long
C_timer_interrupt_counter,
C_initial_timer_interrupt_period;
@@ -1147,8 +1145,6 @@ void initialize_symbol_table(void)
for(i = 0; i < symbol_table->size; symbol_table->table[ i++ ] = C_SCHEME_END_OF_LIST);
/* Obtain reference to hooks for later: */
- C_ratnum_type_tag = C_intern2(C_heaptop, C_text("\003sysratnum"));
- C_cplxnum_type_tag = C_intern2(C_heaptop, C_text("\003syscplxnum"));
core_provided_symbol = C_intern2(C_heaptop, C_text("\004coreprovided"));
interrupt_hook_symbol = C_intern2(C_heaptop, C_text("\003sysinterrupt-hook"));
error_hook_symbol = C_intern2(C_heaptop, C_text("\003syserror-hook"));
@@ -3606,8 +3602,6 @@ C_regparm void C_fcall C_reclaim(void *trampoline, C_word c)
C_regparm void C_fcall mark_system_globals(void)
{
- mark(&C_ratnum_type_tag);
- mark(&C_cplxnum_type_tag);
mark(&core_provided_symbol);
mark(&interrupt_hook_symbol);
mark(&error_hook_symbol);
@@ -3965,8 +3959,6 @@ C_regparm void C_fcall C_rereclaim2(C_uword size, int relative_resize)
C_regparm void C_fcall remark_system_globals(void)
{
- remark(&C_ratnum_type_tag);
- remark(&C_cplxnum_type_tag);
remark(&core_provided_symbol);
remark(&interrupt_hook_symbol);
remark(&error_hook_symbol);
@@ -5331,14 +5323,11 @@ C_regparm C_word C_fcall C_i_nanp(C_word x)
return C_u_i_flonum_nanp(x);
} else if (C_truep(C_bignump(x))) {
return C_SCHEME_FALSE;
- } else if (C_block_header(x) == C_STRUCTURE3_TAG) {
- if (C_block_item(x, 0) == C_ratnum_type_tag)
- return C_SCHEME_FALSE;
- else if (C_block_item(x, 0) == C_cplxnum_type_tag)
- return C_mk_bool(C_truep(C_i_nanp(C_block_item(x, 1))) ||
- C_truep(C_i_nanp(C_block_item(x, 2))));
- else
- barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "nan?", x);
+ } else if (C_block_header(x) == C_RATNUM_TAG) {
+ return C_SCHEME_FALSE;
+ } else if (C_block_header(x) == C_CPLXNUM_TAG) {
+ return C_mk_bool(C_truep(C_i_nanp(C_u_i_cplxnum_real(x))) ||
+ C_truep(C_i_nanp(C_u_i_cplxnum_imag(x))));
} else {
barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "nan?", x);
}
@@ -5354,14 +5343,11 @@ C_regparm C_word C_fcall C_i_finitep(C_word x)
return C_u_i_flonum_finitep(x);
} else if (C_truep(C_bignump(x))) {
return C_SCHEME_TRUE;
- } else if (C_block_header(x) == C_STRUCTURE3_TAG) {
- if (C_block_item(x, 0) == C_ratnum_type_tag)
- return C_SCHEME_TRUE;
- else if (C_block_item(x, 0) == C_cplxnum_type_tag)
- return C_and(C_i_finitep(C_block_item(x, 1)),
- C_i_finitep(C_block_item(x, 2)));
- else
- barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "finite?", x);
+ } else if (C_block_header(x) == C_RATNUM_TAG) {
+ return C_SCHEME_TRUE;
+ } else if (C_block_header(x) == C_CPLXNUM_TAG) {
+ return C_and(C_i_finitep(C_u_i_cplxnum_real(x)),
+ C_i_finitep(C_u_i_cplxnum_imag(x)));
} else {
barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "finite?", x);
}
@@ -5377,14 +5363,11 @@ C_regparm C_word C_fcall C_i_infinitep(C_word x)
return C_u_i_flonum_infinitep(x);
} else if (C_truep(C_bignump(x))) {
return C_SCHEME_FALSE;
- } else if (C_block_header(x) == C_STRUCTURE3_TAG) {
- if (C_block_item(x, 0) == C_ratnum_type_tag)
- return C_SCHEME_FALSE;
- else if (C_block_item(x, 0) == C_cplxnum_type_tag)
- return C_mk_bool(C_truep(C_i_infinitep(C_block_item(x, 1))) ||
- C_truep(C_i_infinitep(C_block_item(x, 2))));
- else
- barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "infinite?", x);
+ } else if (C_block_header(x) == C_RATNUM_TAG) {
+ return C_SCHEME_FALSE;
+ } else if (C_block_header(x) == C_CPLXNUM_TAG) {
+ return C_mk_bool(C_truep(C_i_infinitep(C_u_i_cplxnum_real(x))) ||
+ C_truep(C_i_infinitep(C_u_i_cplxnum_imag(x))));
} else {
barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "infinite?", x);
}
@@ -5400,13 +5383,10 @@ C_regparm C_word C_fcall C_i_exactp(C_word x)
return C_SCHEME_FALSE;
} else if (C_truep(C_bignump(x))) {
return C_SCHEME_TRUE;
- } else if (C_block_header(x) == C_STRUCTURE3_TAG) {
- if (C_block_item(x, 0) == C_ratnum_type_tag)
- return C_SCHEME_TRUE;
- else if (C_block_item(x, 0) == C_cplxnum_type_tag)
- return C_i_exactp(C_block_item(x, 1)); /* Exactness of i and r matches */
- else
- barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "exact?", x);
+ } else if (C_block_header(x) == C_RATNUM_TAG) {
+ return C_SCHEME_TRUE;
+ } else if (C_block_header(x) == C_CPLXNUM_TAG) {
+ return C_i_exactp(C_u_i_cplxnum_real(x)); /* Exactness of i and r matches */
} else {
barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "exact?", x);
}
@@ -5423,13 +5403,10 @@ C_regparm C_word C_fcall C_i_inexactp(C_word x)
return C_SCHEME_TRUE;
} else if (C_truep(C_bignump(x))) {
return C_SCHEME_FALSE;
- } else if (C_block_header(x) == C_STRUCTURE3_TAG) {
- if (C_block_item(x, 0) == C_ratnum_type_tag)
- return C_SCHEME_FALSE;
- else if (C_block_item(x, 0) == C_cplxnum_type_tag)
- return C_i_inexactp(C_block_item(x, 1)); /* Exactness of i and r matches */
- else
- barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "inexact?", x);
+ } else if (C_block_header(x) == C_RATNUM_TAG) {
+ return C_SCHEME_FALSE;
+ } else if (C_block_header(x) == C_CPLXNUM_TAG) {
+ return C_i_inexactp(C_u_i_cplxnum_real(x)); /* Exactness of i and r matches */
} else {
barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "inexact?", x);
}
@@ -5444,10 +5421,9 @@ C_regparm C_word C_fcall C_i_zerop(C_word x)
barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "zero?", x);
} else if (C_block_header(x) == C_FLONUM_TAG) {
return C_mk_bool(C_flonum_magnitude(x) == 0.0);
- } else if (C_truep(C_bignump(x)) ||
- (C_block_header(x) == C_STRUCTURE3_TAG &&
- (C_block_item(x, 0) == C_ratnum_type_tag ||
- C_block_item(x, 0) == C_cplxnum_type_tag))) {
+ } else if (C_block_header(x) == C_BIGNUM_TAG ||
+ C_block_header(x) == C_RATNUM_TAG ||
+ C_block_header(x) == C_CPLXNUM_TAG) {
return C_SCHEME_FALSE;
} else {
barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "zero?", x);
@@ -5474,11 +5450,9 @@ C_regparm C_word C_fcall C_i_positivep(C_word x)
return C_mk_bool(C_flonum_magnitude(x) > 0.0);
else if (C_truep(C_bignump(x)))
return C_mk_nbool(C_bignum_negativep(x));
- else if (C_block_header(x) == C_STRUCTURE3_TAG &&
- (C_block_item(x, 0) == C_ratnum_type_tag))
- return C_i_integer_positivep(C_block_item(x, 1));
- else if (C_block_header(x) == C_STRUCTURE3_TAG &&
- (C_block_item(x, 0) == C_cplxnum_type_tag))
+ else if (C_block_header(x) == C_RATNUM_TAG)
+ return C_i_integer_positivep(C_u_i_ratnum_num(x));
+ else if (C_block_header(x) == C_CPLXNUM_TAG)
barf(C_BAD_ARGUMENT_TYPE_NO_REAL_ERROR, "positive?", x);
else
barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "positive?", x);
@@ -5507,11 +5481,9 @@ C_regparm C_word C_fcall C_i_negativep(C_word x)
return C_mk_bool(C_flonum_magnitude(x) < 0.0);
else if (C_truep(C_bignump(x)))
return C_mk_bool(C_bignum_negativep(x));
- else if (C_block_header(x) == C_STRUCTURE3_TAG &&
- (C_block_item(x, 0) == C_ratnum_type_tag))
- return C_i_integer_negativep(C_block_item(x, 1));
- else if (C_block_header(x) == C_STRUCTURE3_TAG &&
- (C_block_item(x, 0) == C_cplxnum_type_tag))
+ else if (C_block_header(x) == C_RATNUM_TAG)
+ return C_i_integer_negativep(C_u_i_ratnum_num(x));
+ else if (C_block_header(x) == C_CPLXNUM_TAG)
barf(C_BAD_ARGUMENT_TYPE_NO_REAL_ERROR, "negative?", x);
else
barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "negative?", x);
@@ -5983,7 +5955,7 @@ C_regparm C_word C_fcall C_i_vector_set(C_word v, C_word i, C_word x)
return C_SCHEME_UNDEFINED;
}
-/* This needs at most C_SIZEOF_FIX_BIGNUM + C_SIZEOF_STRUCTURE(3) so 9 words */
+/* This needs at most C_SIZEOF_FIX_BIGNUM + max(C_SIZEOF_RATNUM, C_SIZEOF_CPLXNUM) so 7 words */
C_regparm C_word C_fcall
C_s_a_i_abs(C_word **ptr, C_word n, C_word x)
{
@@ -5995,12 +5967,10 @@ C_s_a_i_abs(C_word **ptr, C_word n, C_word x)
return C_a_i_flonum_abs(ptr, 1, x);
} else if (C_truep(C_bignump(x))) {
return C_s_a_u_i_integer_abs(ptr, 1, x);
- } else if (C_block_header(x) == C_STRUCTURE3_TAG &&
- (C_block_item(x, 0) == C_ratnum_type_tag)) {
- return C_ratnum(ptr, C_s_a_u_i_integer_abs(ptr, 1, C_block_item(x, 1)),
- C_block_item(x, 2));
- } else if (C_block_header(x) == C_STRUCTURE3_TAG &&
- (C_block_item(x, 0) == C_cplxnum_type_tag)) {
+ } else if (C_block_header(x) == C_RATNUM_TAG) {
+ return C_ratnum(ptr, C_s_a_u_i_integer_abs(ptr, 1, C_u_i_ratnum_num(x)),
+ C_u_i_ratnum_denom(x));
+ } else if (C_block_header(x) == C_CPLXNUM_TAG) {
barf(C_BAD_ARGUMENT_TYPE_COMPLEX_ABS, "abs", x);
} else {
barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "abs", x);
@@ -6044,7 +6014,7 @@ C_regparm C_word C_fcall C_a_i_abs(C_word **a, int c, C_word x)
/* The maximum this can allocate is a cplxnum which consists of two
* ratnums that consist of 2 fix bignums each. So that's
- * C_SIZEOF_STRUCTURE(3) * 3 + C_SIZEOF_FIX_BIGNUM * 4 = 32 words!
+ * C_SIZEOF_CPLXNUM + C_SIZEOF_RATNUM * 2 + C_SIZEOF_FIX_BIGNUM * 4 = 29 words!
*/
C_regparm C_word C_fcall
C_s_a_i_negate(C_word **ptr, C_word n, C_word x)
@@ -6057,14 +6027,12 @@ C_s_a_i_negate(C_word **ptr, C_word n, C_word x)
return C_a_i_flonum_negate(ptr, 1, x);
} else if (C_truep(C_bignump(x))) {
return C_s_a_u_i_integer_negate(ptr, 1, x);
- } else if (C_block_header(x) == C_STRUCTURE3_TAG &&
- (C_block_item(x, 0) == C_ratnum_type_tag)) {
- return C_ratnum(ptr, C_s_a_u_i_integer_negate(ptr, 1, C_block_item(x, 1)),
- C_block_item(x, 2));
- } else if (C_block_header(x) == C_STRUCTURE3_TAG &&
- (C_block_item(x, 0) == C_cplxnum_type_tag)) {
- return C_cplxnum(ptr, C_s_a_i_negate(ptr, 1, C_block_item(x, 1)),
- C_s_a_i_negate(ptr, 1, C_block_item(x, 2)));
+ } else if (C_block_header(x) == C_RATNUM_TAG) {
+ return C_ratnum(ptr, C_s_a_u_i_integer_negate(ptr, 1, C_u_i_ratnum_num(x)),
+ C_u_i_ratnum_denom(x));
+ } else if (C_block_header(x) == C_CPLXNUM_TAG) {
+ return C_cplxnum(ptr, C_s_a_i_negate(ptr, 1, C_u_i_cplxnum_real(x)),
+ C_s_a_i_negate(ptr, 1, C_u_i_cplxnum_imag(x)));
} else {
barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "-", x);
}
@@ -7666,13 +7634,13 @@ static C_word rat_times_integer(C_word **ptr, C_word rat, C_word i)
case C_fix(0): return C_fix(0);
case C_fix(1): return rat;
case C_fix(-1):
- num = C_s_a_u_i_integer_negate(ptr, 1, C_block_item(rat, 1));
- return C_ratnum(ptr, num , C_block_item(rat, 2));
+ num = C_s_a_u_i_integer_negate(ptr, 1, C_u_i_ratnum_num(rat));
+ return C_ratnum(ptr, num , C_u_i_ratnum_denom(rat));
/* default: CONTINUE BELOW */
}
- num = C_block_item(rat, 1);
- denom = C_block_item(rat, 2);
+ num = C_u_i_ratnum_num(rat);
+ denom = C_u_i_ratnum_denom(rat);
/* a/b * c/d = a*c / b*d [with b = 1] */
/* = ((a / g) * c) / (d / g) */
@@ -7708,10 +7676,10 @@ static C_word rat_times_rat(C_word **ptr, C_word x, C_word y)
num, denom, xnum, xdenom, ynum, ydenom,
g1, g2, a_div_g1, b_div_g2, c_div_g2, d_div_g1;
- xnum = C_block_item(x, 1);
- xdenom = C_block_item(x, 2);
- ynum = C_block_item(y, 1);
- ydenom = C_block_item(y, 2);
+ xnum = C_u_i_ratnum_num(x);
+ xdenom = C_u_i_ratnum_denom(x);
+ ynum = C_u_i_ratnum_num(y);
+ ydenom = C_u_i_ratnum_denom(y);
/* a/b * c/d = a*c / b*d [generic] */
/* = ((a / g1) * (c / g2)) / ((b / g2) * (d / g1)) */
@@ -7758,9 +7726,9 @@ cplx_times(C_word **ptr, C_word rx, C_word ix, C_word ry, C_word iy)
{
/* Allocation here is kind of tricky: Each intermediate result can
* be at most a ratnum consisting of two bignums (2 digits), so
- * C_SIZEOF_STRUCTURE(3) + C_SIZEOF_BIGNUM(2) = 10 words
+ * C_SIZEOF_RATNUM + C_SIZEOF_BIGNUM(2) = 9 words
*/
- C_word ab[(C_SIZEOF_STRUCTURE(3) + C_SIZEOF_BIGNUM(2))*6], *a = ab,
+ C_word ab[(C_SIZEOF_RATNUM + C_SIZEOF_BIGNUM(2))*6], *a = ab,
r1, r2, i1, i2, r, i;
/* a+bi * c+di = (a*c - b*d) + (a*d + b*c)i */
@@ -7789,7 +7757,7 @@ cplx_times(C_word **ptr, C_word rx, C_word ix, C_word ry, C_word iy)
* number result, where both real and imag parts consist of ratnums.
* The maximum size of those ratnums is if they consist of two bignums
* from a fixnum multiplication (2 digits each), so we're looking at
- * C_SIZEOF_STRUCTURE(3) * 3 + C_SIZEOF_BIGNUM(2) * 4 = 36 words!
+ * C_SIZEOF_RATNUM * 3 + C_SIZEOF_BIGNUM(2) * 4 = 33 words!
*/
C_regparm C_word C_fcall
C_s_a_i_times(C_word **ptr, C_word n, C_word x, C_word y)
@@ -7803,15 +7771,11 @@ C_s_a_i_times(C_word **ptr, C_word n, C_word x, C_word y)
return C_flonum(ptr, (double)C_unfix(x) * C_flonum_magnitude(y));
} else if (C_truep(C_bignump(y))) {
return C_s_a_u_i_integer_times(ptr, 2, x, y);
- } else if (C_block_header(y) == C_STRUCTURE3_TAG) {
- if (C_block_item(y, 0) == C_ratnum_type_tag) {
- return rat_times_integer(ptr, y, x);
- } else if (C_block_item(y, 0) == C_cplxnum_type_tag) {
- return cplx_times(ptr, x, C_fix(0),
- C_block_item(y, 1), C_block_item(y, 2));
- } else {
- barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "*", y);
- }
+ } else if (C_block_header(y) == C_RATNUM_TAG) {
+ return rat_times_integer(ptr, y, x);
+ } else if (C_block_header(y) == C_CPLXNUM_TAG) {
+ return cplx_times(ptr, x, C_fix(0),
+ C_u_i_cplxnum_real(y), C_u_i_cplxnum_imag(y));
} else {
barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "*", y);
}
@@ -7826,16 +7790,12 @@ C_s_a_i_times(C_word **ptr, C_word n, C_word x, C_word y)
return C_a_i_flonum_times(ptr, 2, x, y);
} else if (C_truep(C_bignump(y))) {
return C_flonum(ptr, C_flonum_magnitude(x) * C_bignum_to_double(y));
- } else if (C_block_header(y) == C_STRUCTURE3_TAG) {
- if (C_block_item(y, 0) == C_ratnum_type_tag) {
- return C_s_a_i_times(ptr, 2, x, C_a_i_exact_to_inexact(ptr, 1, y));
- } else if (C_block_item(y, 0) == C_cplxnum_type_tag) {
- C_word ab[C_SIZEOF_FLONUM], *a = ab;
- return cplx_times(ptr, x, C_flonum(&a, 0.0),
- C_block_item(y, 1), C_block_item(y, 2));
- } else {
- barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "*", y);
- }
+ } else if (C_block_header(y) == C_RATNUM_TAG) {
+ return C_s_a_i_times(ptr, 2, x, C_a_i_exact_to_inexact(ptr, 1, y));
+ } else if (C_block_header(y) == C_CPLXNUM_TAG) {
+ C_word ab[C_SIZEOF_FLONUM], *a = ab;
+ return cplx_times(ptr, x, C_flonum(&a, 0.0),
+ C_u_i_cplxnum_real(y), C_u_i_cplxnum_imag(y));
} else {
barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "*", y);
}
@@ -7848,52 +7808,39 @@ C_s_a_i_times(C_word **ptr, C_word n, C_word x, C_word y)
return C_flonum(ptr, C_bignum_to_double(x) * C_flonum_magnitude(y));
} else if (C_truep(C_bignump(y))) {
return C_s_a_u_i_integer_times(ptr, 2, x, y);
- } else if (C_block_header(y) == C_STRUCTURE3_TAG) {
- if (C_block_item(y, 0) == C_ratnum_type_tag) {
- return rat_times_integer(ptr, y, x);
- } else if (C_block_item(y, 0) == C_cplxnum_type_tag) {
- return cplx_times(ptr, x, C_fix(0),
- C_block_item(y, 1), C_block_item(y, 2));
- } else {
- barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "*", y);
- }
+ } else if (C_block_header(y) == C_RATNUM_TAG) {
+ return rat_times_integer(ptr, y, x);
+ } else if (C_block_header(y) == C_CPLXNUM_TAG) {
+ return cplx_times(ptr, x, C_fix(0),
+ C_u_i_cplxnum_real(y), C_u_i_cplxnum_imag(y));
} else {
barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "*", y);
}
- } else if (C_block_header(x) == C_STRUCTURE3_TAG) {
- if (C_block_item(x, 0) == C_ratnum_type_tag) {
- if (y & C_FIXNUM_BIT) {
- return rat_times_integer(ptr, 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) {
- return C_s_a_i_times(ptr, 2, C_a_i_exact_to_inexact(ptr, 1, x), y);
- } else if (C_truep(C_bignump(y))) {
- return rat_times_integer(ptr, x, y);
- } else if (C_block_header(y) == C_STRUCTURE3_TAG) {
- if (C_block_item(y, 0) == C_ratnum_type_tag) {
- return rat_times_rat(ptr, x, y);
- } else if (C_block_item(y, 0) == C_cplxnum_type_tag) {
- return cplx_times(ptr, x, C_fix(0),
- C_block_item(y, 1),C_block_item(y, 2));
- } else {
- barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "*", y);
- }
- } else {
- barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "*", y);
- }
- } else if (C_block_item(x, 0) == C_cplxnum_type_tag) {
- if (!C_immediatep(y) && C_block_header(y) == C_STRUCTURE3_TAG &&
- C_block_item(y, 0) == C_cplxnum_type_tag) {
- return cplx_times(ptr, C_block_item(x, 1), C_block_item(x, 2),
- C_block_item(y, 1), C_block_item(y, 2));
- } else {
- C_word ab[C_SIZEOF_FLONUM], *a = ab, yi;
- yi = C_truep(C_i_flonump(y)) ? C_flonum(&a,0) : C_fix(0);
- return cplx_times(ptr, C_block_item(x, 1), C_block_item(x, 2), y, yi);
- }
+ } else if (C_block_header(x) == C_RATNUM_TAG) {
+ if (y & C_FIXNUM_BIT) {
+ return rat_times_integer(ptr, 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) {
+ return C_s_a_i_times(ptr, 2, C_a_i_exact_to_inexact(ptr, 1, x), y);
+ } else if (C_truep(C_bignump(y))) {
+ return rat_times_integer(ptr, x, y);
+ } else if (C_block_header(y) == C_RATNUM_TAG) {
+ return rat_times_rat(ptr, x, y);
+ } else if (C_block_header(y) == C_CPLXNUM_TAG) {
+ return cplx_times(ptr, x, C_fix(0),
+ C_u_i_cplxnum_real(y), C_u_i_cplxnum_imag(y));
} else {
- barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "*", x);
+ barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "*", y);
+ }
+ } else if (C_block_header(x) == C_CPLXNUM_TAG) {
+ if (!C_immediatep(y) && C_block_header(y) == C_CPLXNUM_TAG) {
+ return cplx_times(ptr, C_u_i_cplxnum_real(x), C_u_i_cplxnum_imag(x),
+ C_u_i_cplxnum_real(y), C_u_i_cplxnum_imag(y));
+ } else {
+ C_word ab[C_SIZEOF_FLONUM], *a = ab, yi;
+ yi = C_truep(C_i_flonump(y)) ? C_flonum(&a,0) : C_fix(0);
+ return cplx_times(ptr, C_u_i_ratnum_num(x), C_u_i_ratnum_denom(x), y, yi);
}
} else {
barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "*", x);
@@ -8038,7 +7985,7 @@ void C_ccall C_times(C_word c, C_word *av)
C_word next_val,
result = C_fix(1),
prev_result = result;
- C_word ab[2][C_SIZEOF_STRUCTURE(3) * 3 + C_SIZEOF_BIGNUM(2) * 4], *a;
+ C_word ab[2][C_SIZEOF_CPLXNUM + C_SIZEOF_RATNUM*2 + C_SIZEOF_BIGNUM(2) * 4], *a;
c -= 2;
av += 2;
@@ -8143,15 +8090,15 @@ static C_word rat_plusmin_integer(C_word **ptr, C_word rat, C_word i, integer_pl
if (i == C_fix(0)) return rat;
- num = C_block_item(rat, 1);
- denom = C_block_item(rat, 2);
+ num = C_u_i_ratnum_num(rat);
+ denom = C_u_i_ratnum_denom(rat);
/* a/b [+-] c/d = (a*d [+-] b*c)/(b*d) | d = 1: (num + denom * i) / denom */
tmp = C_s_a_u_i_integer_times(&a, 2, denom, i);
res = plusmin_op(&a, 2, num, tmp);
res = move_buffer_object(ptr, ab, res);
clear_buffer_object(ab, tmp);
- return C_ratnum(ptr, res, C_block_item(rat, 2));
+ return C_ratnum(ptr, res, denom);
}
/* This is needed only for minus: plus is commutative but minus isn't. */
@@ -8160,8 +8107,8 @@ static C_word integer_minus_rat(C_word **ptr, C_word i, C_word rat)
C_word ab[C_SIZEOF_FIX_BIGNUM+C_SIZEOF_BIGNUM(2)], *a = ab,
num, denom, tmp, res;
- num = C_block_item(rat, 1);
- denom = C_block_item(rat, 2);
+ num = C_u_i_ratnum_num(rat);
+ denom = C_u_i_ratnum_denom(rat);
if (i == C_fix(0))
return C_ratnum(ptr, C_s_a_u_i_integer_negate(ptr, 1, num), denom);
@@ -8171,15 +8118,15 @@ static C_word integer_minus_rat(C_word **ptr, C_word i, C_word rat)
res = C_s_a_u_i_integer_minus(&a, 2, tmp, num);
res = move_buffer_object(ptr, ab, res);
clear_buffer_object(ab, tmp);
- return C_ratnum(ptr, res, C_block_item(rat, 2));
+ return C_ratnum(ptr, res, denom);
}
/* This is pretty braindead and ugly */
static C_word rat_plusmin_rat(C_word **ptr, C_word x, C_word y, integer_plusmin_op plusmin_op)
{
C_word ab[C_SIZEOF_FIX_BIGNUM*6 + C_SIZEOF_BIGNUM(2)*2], *a = ab,
- xnum = C_block_item(x, 1), ynum = C_block_item(y, 1),
- xdenom = C_block_item(x, 2), ydenom = C_block_item(y, 2),
+ xnum = C_u_i_ratnum_num(x), ynum = C_u_i_ratnum_num(y),
+ xdenom = C_u_i_ratnum_denom(x), ydenom = C_u_i_ratnum_denom(y),
xnorm, ynorm, tmp_r, g1, ydenom_g1, xdenom_g1, norm_sum, g2, len,
res_num, res_denom;
@@ -8233,8 +8180,8 @@ static C_word rat_plusmin_rat(C_word **ptr, C_word x, C_word y, integer_plusmin_
/* The maximum size this needs is that required to store a complex
* number result, where both real and imag parts consist of ratnums.
* The maximum size of those ratnums is if they consist of two "fix
- * bignums", so we're looking at C_SIZEOF_STRUCTURE(3) * 3 +
- * C_SIZEOF_FIX_BIGNUM * 4 = 32 words!
+ * bignums", so we're looking at C_SIZEOF_CPLXNUM + C_SIZEOF_RATNUM *
+ * 2 + C_SIZEOF_FIX_BIGNUM * 4 = 29 words!
*/
C_regparm C_word C_fcall
C_s_a_i_plus(C_word **ptr, C_word n, C_word x, C_word y)
@@ -8248,18 +8195,14 @@ C_s_a_i_plus(C_word **ptr, C_word n, C_word x, C_word y)
return C_flonum(ptr, (double)C_unfix(x) + C_flonum_magnitude(y));
} else if (C_truep(C_bignump(y))) {
return C_s_a_u_i_integer_plus(ptr, 2, x, y);
- } else if (C_block_header(y) == C_STRUCTURE3_TAG) {
- if (C_block_item(y, 0) == C_ratnum_type_tag) {
- return rat_plusmin_integer(ptr, y, x, C_s_a_u_i_integer_plus);
- } else if (C_block_item(y, 0) == C_cplxnum_type_tag) {
- C_word real_sum = C_s_a_i_plus(ptr, 2, x, C_block_item(y, 1)),
- imag = C_block_item(y, 2);
- if (C_truep(C_u_i_inexactp(real_sum)))
- imag = C_a_i_exact_to_inexact(ptr, 1, imag);
- return C_cplxnum(ptr, real_sum, imag);
- } else {
- barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "+", y);
- }
+ } else if (C_block_header(y) == C_RATNUM_TAG) {
+ return rat_plusmin_integer(ptr, y, x, C_s_a_u_i_integer_plus);
+ } else if (C_block_header(y) == C_CPLXNUM_TAG) {
+ C_word real_sum = C_s_a_i_plus(ptr, 2, x, C_u_i_cplxnum_real(y)),
+ imag = C_u_i_cplxnum_imag(y);
+ if (C_truep(C_u_i_inexactp(real_sum)))
+ imag = C_a_i_exact_to_inexact(ptr, 1, imag);
+ return C_cplxnum(ptr, real_sum, imag);
} else {
barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "+", y);
}
@@ -8274,18 +8217,14 @@ C_s_a_i_plus(C_word **ptr, C_word n, C_word x, C_word y)
return C_a_i_flonum_plus(ptr, 2, x, y);
} else if (C_truep(C_bignump(y))) {
return C_flonum(ptr, C_flonum_magnitude(x)+C_bignum_to_double(y));
- } else if (C_block_header(y) == C_STRUCTURE3_TAG) {
- if (C_block_item(y, 0) == C_ratnum_type_tag) {
- return C_s_a_i_plus(ptr, 2, x, C_a_i_exact_to_inexact(ptr, 1, y));
- } else if (C_block_item(y, 0) == C_cplxnum_type_tag) {
- C_word real_sum = C_s_a_i_plus(ptr, 2, x, C_block_item(y, 1)),
- imag = C_block_item(y, 2);
- if (C_truep(C_u_i_inexactp(real_sum)))
- imag = C_a_i_exact_to_inexact(ptr, 1, imag);
- return C_cplxnum(ptr, real_sum, imag);
- } else {
- barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "+", y);
- }
+ } else if (C_block_header(y) == C_RATNUM_TAG) {
+ return C_s_a_i_plus(ptr, 2, x, C_a_i_exact_to_inexact(ptr, 1, y));
+ } else if (C_block_header(y) == C_CPLXNUM_TAG) {
+ C_word real_sum = C_s_a_i_plus(ptr, 2, x, C_u_i_cplxnum_real(y)),
+ imag = C_u_i_cplxnum_imag(y);
+ if (C_truep(C_u_i_inexactp(real_sum)))
+ imag = C_a_i_exact_to_inexact(ptr, 1, imag);
+ return C_cplxnum(ptr, real_sum, imag);
} else {
barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "+", y);
}
@@ -8298,63 +8237,50 @@ C_s_a_i_plus(C_word **ptr, C_word n, C_word x, C_word y)
return C_flonum(ptr, C_bignum_to_double(x)+C_flonum_magnitude(y));
} else if (C_truep(C_bignump(y))) {
return C_s_a_u_i_integer_plus(ptr, 2, x, y);
- } else if (C_block_header(y) == C_STRUCTURE3_TAG) {
- if (C_block_item(y, 0) == C_ratnum_type_tag) {
- return rat_plusmin_integer(ptr, y, x, C_s_a_u_i_integer_plus);
- } else if (C_block_item(y, 0) == C_cplxnum_type_tag) {
- C_word real_sum = C_s_a_i_plus(ptr, 2, x, C_block_item(y, 1)),
- imag = C_block_item(y, 2);
- if (C_truep(C_u_i_inexactp(real_sum)))
- imag = C_a_i_exact_to_inexact(ptr, 1, imag);
- return C_cplxnum(ptr, real_sum, imag);
- } else {
- barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "+", y);
- }
+ } else if (C_block_header(y) == C_RATNUM_TAG) {
+ return rat_plusmin_integer(ptr, y, x, C_s_a_u_i_integer_plus);
+ } else if (C_block_header(y) == C_CPLXNUM_TAG) {
+ C_word real_sum = C_s_a_i_plus(ptr, 2, x, C_u_i_cplxnum_real(y)),
+ imag = C_u_i_cplxnum_imag(y);
+ if (C_truep(C_u_i_inexactp(real_sum)))
+ imag = C_a_i_exact_to_inexact(ptr, 1, imag);
+ return C_cplxnum(ptr, real_sum, imag);
} else {
barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "+", y);
}
- } else if (C_block_header(x) == C_STRUCTURE3_TAG) {
- if (C_block_item(x, 0) == C_ratnum_type_tag) {
- if (y & C_FIXNUM_BIT) {
- return rat_plusmin_integer(ptr, x, y, C_s_a_u_i_integer_plus);
- } else if (C_immediatep(y)) {
- barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "+", y);
- } else if (C_block_header(y) == C_FLONUM_TAG) {
- return C_s_a_i_plus(ptr, 2, C_a_i_exact_to_inexact(ptr, 1, x), y);
- } else if (C_truep(C_bignump(y))) {
- return rat_plusmin_integer(ptr, x, y, C_s_a_u_i_integer_plus);
- } else if (C_block_header(y) == C_STRUCTURE3_TAG) {
- if (C_block_item(y, 0) == C_ratnum_type_tag) {
- return rat_plusmin_rat(ptr, x, y, C_s_a_u_i_integer_plus);
- } else if (C_block_item(y, 0) == C_cplxnum_type_tag) {
- C_word real_sum = C_s_a_i_plus(ptr, 2, x, C_block_item(y, 1)),
- imag = C_block_item(y, 2);
- if (C_truep(C_u_i_inexactp(real_sum)))
- imag = C_a_i_exact_to_inexact(ptr, 1, imag);
- return C_cplxnum(ptr, real_sum, imag);
- } else {
- barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "+", y);
- }
- } else {
- barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "+", y);
- }
- } else if (C_block_item(x, 0) == C_cplxnum_type_tag) {
- if (!C_immediatep(y) && C_block_header(y) == C_STRUCTURE3_TAG &&
- C_block_item(y, 0) == C_cplxnum_type_tag) {
- C_word real_sum, imag_sum;
- real_sum = C_s_a_i_plus(ptr, 2, C_block_item(x, 1), C_block_item(y, 1));
- imag_sum = C_s_a_i_plus(ptr, 2, C_block_item(x, 2), C_block_item(y, 2));
- if (C_truep(C_u_i_zerop(imag_sum))) return real_sum;
- else return C_cplxnum(ptr, real_sum, imag_sum);
- } else {
- C_word real_sum = C_s_a_i_plus(ptr, 2, C_block_item(x, 1), y),
- imag = C_block_item(x, 2);
- if (C_truep(C_u_i_inexactp(real_sum)))
- imag = C_a_i_exact_to_inexact(ptr, 1, imag);
- return C_cplxnum(ptr, real_sum, imag);
- }
+ } else if (C_block_header(x) == C_RATNUM_TAG) {
+ if (y & C_FIXNUM_BIT) {
+ return rat_plusmin_integer(ptr, x, y, C_s_a_u_i_integer_plus);
+ } else if (C_immediatep(y)) {
+ barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "+", y);
+ } else if (C_block_header(y) == C_FLONUM_TAG) {
+ return C_s_a_i_plus(ptr, 2, C_a_i_exact_to_inexact(ptr, 1, x), y);
+ } else if (C_truep(C_bignump(y))) {
+ return rat_plusmin_integer(ptr, x, y, C_s_a_u_i_integer_plus);
+ } else if (C_block_header(y) == C_RATNUM_TAG) {
+ return rat_plusmin_rat(ptr, x, y, C_s_a_u_i_integer_plus);
+ } else if (C_block_header(y) == C_CPLXNUM_TAG) {
+ C_word real_sum = C_s_a_i_plus(ptr, 2, x, C_u_i_cplxnum_real(y)),
+ imag = C_u_i_cplxnum_imag(y);
+ if (C_truep(C_u_i_inexactp(real_sum)))
+ imag = C_a_i_exact_to_inexact(ptr, 1, imag);
+ return C_cplxnum(ptr, real_sum, imag);
} else {
- barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "+", x);
+ barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "+", y);
+ }
+ } else if (C_block_header(x) == C_CPLXNUM_TAG) {
+ if (!C_immediatep(y) && C_block_header(y) == C_CPLXNUM_TAG) {
+ C_word real_sum, imag_sum;
+ real_sum = C_s_a_i_plus(ptr, 2, C_u_i_cplxnum_real(x), C_u_i_cplxnum_real(y));
+ imag_sum = C_s_a_i_plus(ptr, 2, C_u_i_cplxnum_imag(x), C_u_i_cplxnum_imag(y));
+ if (C_truep(C_u_i_zerop(imag_sum))) return real_sum;
+ else return C_cplxnum(ptr, real_sum, imag_sum);
+ } else {
+ C_word real_sum = C_s_a_i_plus(ptr, 2, C_u_i_cplxnum_real(x), y),
+ imag = C_u_i_cplxnum_imag(x);
+ if (C_truep(C_u_i_inexactp(real_sum)))
+ imag = C_a_i_exact_to_inexact(ptr, 1, imag);
+ return C_cplxnum(ptr, real_sum, imag);
}
} else {
barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "+", x);
@@ -8394,7 +8320,7 @@ void C_ccall C_plus(C_word c, C_word *av)
C_word next_val,
result = C_fix(0),
prev_result = result;
- C_word ab[2][C_SIZEOF_STRUCTURE(3) * 3 + C_SIZEOF_FIX_BIGNUM * 4], *a;
+ C_word ab[2][C_SIZEOF_CPLXNUM + C_SIZEOF_RATNUM*2 + C_SIZEOF_FIX_BIGNUM * 4], *a;
c -= 2;
av += 2;
@@ -8496,7 +8422,7 @@ static C_word bignum_minus_unsigned(C_word **ptr, C_word x, C_word y)
return C_bignum_simplify(res);
}
-/* Like C_s_a_i_plus, this needs at most 32 words */
+/* Like C_s_a_i_plus, this needs at most 29 words */
C_regparm C_word C_fcall
C_s_a_i_minus(C_word **ptr, C_word n, C_word x, C_word y)
{
@@ -8509,18 +8435,14 @@ C_s_a_i_minus(C_word **ptr, C_word n, C_word x, C_word y)
return C_flonum(ptr, (double)C_unfix(x) - C_flonum_magnitude(y));
} else if (C_truep(C_bignump(y))) {
return C_s_a_u_i_integer_minus(ptr, 2, x, y);
- } else if (C_block_header(y) == C_STRUCTURE3_TAG) {
- if (C_block_item(y, 0) == C_ratnum_type_tag) {
- return integer_minus_rat(ptr, x, y);
- } else if (C_block_item(y, 0) == C_cplxnum_type_tag) {
- C_word real_diff = C_s_a_i_minus(ptr, 2, x, C_block_item(y, 1)),
- imag = C_s_a_i_negate(ptr, 1, C_block_item(y, 2));
- if (C_truep(C_u_i_inexactp(real_diff)))
- imag = C_a_i_exact_to_inexact(ptr, 1, imag);
- return C_cplxnum(ptr, real_diff, imag);
- } else {
- barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "-", y);
- }
+ } else if (C_block_header(y) == C_RATNUM_TAG) {
+ return integer_minus_rat(ptr, x, y);
+ } else if (C_block_header(y) == C_CPLXNUM_TAG) {
+ C_word real_diff = C_s_a_i_minus(ptr, 2, x, C_u_i_cplxnum_real(y)),
+ imag = C_s_a_i_negate(ptr, 1, C_u_i_cplxnum_imag(y));
+ if (C_truep(C_u_i_inexactp(real_diff)))
+ imag = C_a_i_exact_to_inexact(ptr, 1, imag);
+ return C_cplxnum(ptr, real_diff, imag);
} else {
barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "-", y);
}
@@ -8535,18 +8457,14 @@ C_s_a_i_minus(C_word **ptr, C_word n, C_word x, C_word y)
return C_a_i_flonum_difference(ptr, 2, x, y);
} else if (C_truep(C_bignump(y))) {
return C_flonum(ptr, C_flonum_magnitude(x)-C_bignum_to_double(y));
- } else if (C_block_header(y) == C_STRUCTURE3_TAG) {
- if (C_block_item(y, 0) == C_ratnum_type_tag) {
- return C_s_a_i_minus(ptr, 2, x, C_a_i_exact_to_inexact(ptr, 1, y));
- } else if (C_block_item(y, 0) == C_cplxnum_type_tag) {
- C_word real_diff = C_s_a_i_minus(ptr, 2, x, C_block_item(y, 1)),
- imag = C_s_a_i_negate(ptr, 1, C_block_item(y, 2));
- if (C_truep(C_u_i_inexactp(real_diff)))
- imag = C_a_i_exact_to_inexact(ptr, 1, imag);
- return C_cplxnum(ptr, real_diff, imag);
- } else {
- barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "-", y);
- }
+ } else if (C_block_header(y) == C_RATNUM_TAG) {
+ return C_s_a_i_minus(ptr, 2, x, C_a_i_exact_to_inexact(ptr, 1, y));
+ } else if (C_block_header(y) == C_CPLXNUM_TAG) {
+ C_word real_diff = C_s_a_i_minus(ptr, 2, x, C_u_i_cplxnum_real(y)),
+ imag = C_s_a_i_negate(ptr, 1, C_u_i_cplxnum_imag(y));
+ if (C_truep(C_u_i_inexactp(real_diff)))
+ imag = C_a_i_exact_to_inexact(ptr, 1, imag);
+ return C_cplxnum(ptr, real_diff, imag);
} else {
barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "-", y);
}
@@ -8559,63 +8477,50 @@ C_s_a_i_minus(C_word **ptr, C_word n, C_word x, C_word y)
return C_flonum(ptr, C_bignum_to_double(x)-C_flonum_magnitude(y));
} else if (C_truep(C_bignump(y))) {
return C_s_a_u_i_integer_minus(ptr, 2, x, y);
- } else if (C_block_header(y) == C_STRUCTURE3_TAG) {
- if (C_block_item(y, 0) == C_ratnum_type_tag) {
- return integer_minus_rat(ptr, x, y);
- } else if (C_block_item(y, 0) == C_cplxnum_type_tag) {
- C_word real_diff = C_s_a_i_minus(ptr, 2, x, C_block_item(y, 1)),
- imag = C_s_a_i_negate(ptr, 1, C_block_item(y, 2));
- if (C_truep(C_u_i_inexactp(real_diff)))
- imag = C_a_i_exact_to_inexact(ptr, 1, imag);
- return C_cplxnum(ptr, real_diff, imag);
- } else {
- barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "-", y);
- }
+ } else if (C_block_header(y) == C_RATNUM_TAG) {
+ return integer_minus_rat(ptr, x, y);
+ } else if (C_block_header(y) == C_CPLXNUM_TAG) {
+ C_word real_diff = C_s_a_i_minus(ptr, 2, x, C_u_i_cplxnum_real(y)),
+ imag = C_s_a_i_negate(ptr, 1, C_u_i_cplxnum_imag(y));
+ if (C_truep(C_u_i_inexactp(real_diff)))
+ imag = C_a_i_exact_to_inexact(ptr, 1, imag);
+ return C_cplxnum(ptr, real_diff, imag);
} else {
barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "-", y);
}
- } else if (C_block_header(x) == C_STRUCTURE3_TAG) {
- if (C_block_item(x, 0) == C_ratnum_type_tag) {
- if (y & C_FIXNUM_BIT) {
- return rat_plusmin_integer(ptr, x, y, C_s_a_u_i_integer_minus);
- } else if (C_immediatep(y)) {
- barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "-", y);
- } else if (C_block_header(y) == C_FLONUM_TAG) {
- return C_s_a_i_minus(ptr, 2, C_a_i_exact_to_inexact(ptr, 1, x), y);
- } else if (C_truep(C_bignump(y))) {
- return rat_plusmin_integer(ptr, x, y, C_s_a_u_i_integer_minus);
- } else if (C_block_header(y) == C_STRUCTURE3_TAG) {
- if (C_block_item(y, 0) == C_ratnum_type_tag) {
- return rat_plusmin_rat(ptr, x, y, C_s_a_u_i_integer_minus);
- } else if (C_block_item(y, 0) == C_cplxnum_type_tag) {
- C_word real_diff = C_s_a_i_minus(ptr, 2, x, C_block_item(y, 1)),
- imag = C_s_a_i_negate(ptr, 1, C_block_item(y, 2));
- if (C_truep(C_u_i_inexactp(real_diff)))
- imag = C_a_i_exact_to_inexact(ptr, 1, imag);
- return C_cplxnum(ptr, real_diff, imag);
- } else {
- barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "-", y);
- }
- } else {
- barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "-", y);
- }
- } else if (C_block_item(x, 0) == C_cplxnum_type_tag) {
- if (!C_immediatep(y) && C_block_header(y) == C_STRUCTURE3_TAG &&
- C_block_item(y, 0) == C_cplxnum_type_tag) {
- C_word real_diff, imag_diff;
- real_diff = C_s_a_i_minus(ptr,2,C_block_item(x, 1),C_block_item(y, 1));
- imag_diff = C_s_a_i_minus(ptr,2,C_block_item(x, 2),C_block_item(y, 2));
- if (C_truep(C_u_i_zerop(imag_diff))) return real_diff;
- else return C_cplxnum(ptr, real_diff, imag_diff);
- } else {
- C_word real_diff = C_s_a_i_minus(ptr, 2, C_block_item(x, 1), y),
- imag = C_block_item(x, 2);
- if (C_truep(C_u_i_inexactp(real_diff)))
- imag = C_a_i_exact_to_inexact(ptr, 1, imag);
- return C_cplxnum(ptr, real_diff, imag);
- }
+ } else if (C_block_header(x) == C_RATNUM_TAG) {
+ if (y & C_FIXNUM_BIT) {
+ return rat_plusmin_integer(ptr, x, y, C_s_a_u_i_integer_minus);
+ } else if (C_immediatep(y)) {
+ barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "-", y);
+ } else if (C_block_header(y) == C_FLONUM_TAG) {
+ return C_s_a_i_minus(ptr, 2, C_a_i_exact_to_inexact(ptr, 1, x), y);
+ } else if (C_truep(C_bignump(y))) {
+ return rat_plusmin_integer(ptr, x, y, C_s_a_u_i_integer_minus);
+ } else if (C_block_header(y) == C_RATNUM_TAG) {
+ return rat_plusmin_rat(ptr, x, y, C_s_a_u_i_integer_minus);
+ } else if (C_block_header(y) == C_CPLXNUM_TAG) {
+ C_word real_diff = C_s_a_i_minus(ptr, 2, x, C_u_i_cplxnum_real(y)),
+ imag = C_s_a_i_negate(ptr, 1, C_u_i_cplxnum_imag(y));
+ if (C_truep(C_u_i_inexactp(real_diff)))
+ imag = C_a_i_exact_to_inexact(ptr, 1, imag);
+ return C_cplxnum(ptr, real_diff, imag);
+ } else {
+ barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "-", y);
+ }
+ } else if (C_block_header(x) == C_CPLXNUM_TAG) {
+ if (!C_immediatep(y) && C_block_header(y) == C_CPLXNUM_TAG) {
+ C_word real_diff, imag_diff;
+ real_diff = C_s_a_i_minus(ptr,2,C_u_i_cplxnum_real(x),C_u_i_cplxnum_real(y));
+ imag_diff = C_s_a_i_minus(ptr,2,C_u_i_cplxnum_imag(x),C_u_i_cplxnum_imag(y));
+ if (C_truep(C_u_i_zerop(imag_diff))) return real_diff;
+ else return C_cplxnum(ptr, real_diff, imag_diff);
} else {
- barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "-", x);
+ C_word real_diff = C_s_a_i_minus(ptr, 2, C_u_i_cplxnum_real(x), y),
+ imag = C_u_i_cplxnum_imag(x);
+ if (C_truep(C_u_i_inexactp(real_diff)))
+ imag = C_a_i_exact_to_inexact(ptr, 1, imag);
+ return C_cplxnum(ptr, real_diff, imag);
}
} else {
barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "-", x);
@@ -8653,7 +8558,7 @@ void C_ccall C_minus(C_word c, C_word *av)
/* C_word closure = av[ 0 ]; */
C_word k = av[ 1 ];
C_word next_val, result, prev_result;
- C_word ab[2][C_SIZEOF_STRUCTURE(3) * 3 + C_SIZEOF_FIX_BIGNUM * 4], *a;
+ C_word ab[2][C_SIZEOF_CPLXNUM + C_SIZEOF_RATNUM*2 + C_SIZEOF_FIX_BIGNUM * 4], *a;
if (c < 3) {
C_bad_min_argc(c, 3);
@@ -9457,13 +9362,13 @@ static C_word rat_cmp(C_word x, C_word y)
/* Check for 1 or 0; if x or y is this, the other must be the ratnum */
if (x == C_fix(0)) { /* Only the sign of y1 matters */
- return basic_cmp(x, C_block_item(y, 1), "ratcmp", 0);
+ return basic_cmp(x, C_u_i_ratnum_num(y), "ratcmp", 0);
} else if (x == C_fix(1)) { /* x1*y1 <> x2*y2 --> y2 <> y1 | x1/x2 = 1/1 */
- return basic_cmp(C_block_item(y, 2), C_block_item(y, 1), "ratcmp", 0);
+ return basic_cmp(C_u_i_ratnum_denom(y), C_u_i_ratnum_num(y), "ratcmp", 0);
} else if (y == C_fix(0)) { /* Only the sign of x1 matters */
- return basic_cmp(C_block_item(x, 1), y, "ratcmp", 0);
+ return basic_cmp(C_u_i_ratnum_num(x), y, "ratcmp", 0);
} else if (y == C_fix(1)) { /* x1*y1 <> x2*y2 --> x1 <> x2 | y1/y2 = 1/1 */
- return basic_cmp(C_block_item(x, 1), C_block_item(x, 2), "ratcmp", 0);
+ return basic_cmp(C_u_i_ratnum_num(x), C_u_i_ratnum_denom(x), "ratcmp", 0);
}
/* Extract components x=x1/x2 and y=y1/y2 */
@@ -9471,16 +9376,16 @@ static C_word rat_cmp(C_word x, C_word y)
x1 = x;
x2 = C_fix(1);
} else {
- x1 = C_block_item(x, 1);
- x2 = C_block_item(x, 2);
+ x1 = C_u_i_ratnum_num(x);
+ x2 = C_u_i_ratnum_denom(x);
}
if (y & C_FIXNUM_BIT || C_truep(C_bignump(y))) {
y1 = y;
y2 = C_fix(1);
} else {
- y1 = C_block_item(y, 1);
- y2 = C_block_item(y, 2);
+ y1 = C_u_i_ratnum_num(y);
+ y2 = C_u_i_ratnum_denom(y);
}
/* We only want to deal with bignums (this is tricky enough) */
@@ -9653,7 +9558,7 @@ static C_word rat_flo_cmp(C_word ratnum, C_word flonum)
i = f; /* TODO: split i and f so it'll work for denormalized flonums */
- num = C_block_item(ratnum, 1);
+ num = C_u_i_ratnum_num(ratnum);
negp = C_i_negativep(num);
if (C_truep(negp) && i >= 0.0) { /* Save some time if signs differ */
@@ -9661,7 +9566,7 @@ static C_word rat_flo_cmp(C_word ratnum, C_word flonum)
} else if (!C_truep(negp) && i <= 0.0) { /* num is never 0 */
return C_fix(1);
} else {
- denom = C_block_item(ratnum, 2);
+ denom = C_u_i_ratnum_denom(ratnum);
i_int = C_s_a_u_i_flo_to_int(&a, 1, C_flonum(&a, i));
/* Multiply the scaled flonum integer by the denominator, and
@@ -9708,16 +9613,12 @@ static C_word basic_cmp(C_word x, C_word y, char *loc, int eqp)
} else if (C_truep(C_bignump(y))) {
C_word ab[C_SIZEOF_FIX_BIGNUM], *a = ab;
return C_i_bignum_cmp(C_a_u_i_fix_to_big(&a, x), y);
- } else if (C_block_header(y) == C_STRUCTURE3_TAG) {
- if (C_block_item(y, 0) == C_ratnum_type_tag) {
- if (eqp) return C_SCHEME_FALSE;
- else return rat_cmp(x, y);
- } else if (C_block_item(y, 0) == C_cplxnum_type_tag) {
- if (eqp) return C_SCHEME_FALSE;
- else barf(C_BAD_ARGUMENT_TYPE_COMPLEX_NO_ORDERING_ERROR, loc, y);
- } else {
- barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, loc, y);
- }
+ } else if (C_block_header(y) == C_RATNUM_TAG) {
+ if (eqp) return C_SCHEME_FALSE;
+ else return rat_cmp(x, y);
+ } else if (C_block_header(y) == C_CPLXNUM_TAG) {
+ if (eqp) return C_SCHEME_FALSE;
+ else barf(C_BAD_ARGUMENT_TYPE_COMPLEX_NO_ORDERING_ERROR, loc, y);
} else {
barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, loc, y);
}
@@ -9734,15 +9635,11 @@ static C_word basic_cmp(C_word x, C_word y, char *loc, int eqp)
else return C_fix((a < b) ? -1 : ((a > b) ? 1 : 0));
} else if (C_truep(C_bignump(y))) {
return flo_int_cmp(x, y);
- } else if (C_block_header(y) == C_STRUCTURE3_TAG) {
- if (C_block_item(y, 0) == C_ratnum_type_tag) {
- return flo_rat_cmp(x, y);
- } else if (C_block_item(y, 0) == C_cplxnum_type_tag) {
- if (eqp) return C_SCHEME_FALSE;
- else barf(C_BAD_ARGUMENT_TYPE_COMPLEX_NO_ORDERING_ERROR, loc, y);
- } else {
- barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, loc, y);
- }
+ } else if (C_block_header(y) == C_RATNUM_TAG) {
+ return flo_rat_cmp(x, y);
+ } else if (C_block_header(y) == C_CPLXNUM_TAG) {
+ if (eqp) return C_SCHEME_FALSE;
+ else barf(C_BAD_ARGUMENT_TYPE_COMPLEX_NO_ORDERING_ERROR, loc, y);
} else {
barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, loc, y);
}
@@ -9756,21 +9653,16 @@ static C_word basic_cmp(C_word x, C_word y, char *loc, int eqp)
return int_flo_cmp(x, y);
} else if (C_truep(C_bignump(y))) {
return C_i_bignum_cmp(x, y);
- } else if (C_block_header(y) == C_STRUCTURE3_TAG) {
- if (C_block_item(y, 0) == C_ratnum_type_tag) {
- if (eqp) return C_SCHEME_FALSE;
- else return rat_cmp(x, y);
- } else if (C_block_item(y, 0) == C_cplxnum_type_tag) {
- if (eqp) return C_SCHEME_FALSE;
- else barf(C_BAD_ARGUMENT_TYPE_COMPLEX_NO_ORDERING_ERROR, loc, y);
- } else {
- barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, loc, y);
- }
+ } else if (C_block_header(y) == C_RATNUM_TAG) {
+ if (eqp) return C_SCHEME_FALSE;
+ else return rat_cmp(x, y);
+ } else if (C_block_header(y) == C_CPLXNUM_TAG) {
+ if (eqp) return C_SCHEME_FALSE;
+ else barf(C_BAD_ARGUMENT_TYPE_COMPLEX_NO_ORDERING_ERROR, loc, y);
} else {
barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, loc, y);
}
- } else if (C_block_header(x) == C_STRUCTURE3_TAG &&
- (C_block_item(x, 0) == C_ratnum_type_tag)) {
+ } else if (C_block_header(x) == C_RATNUM_TAG) {
if (y & C_FIXNUM_BIT) {
if (eqp) return C_SCHEME_FALSE;
else return rat_cmp(x, y);
@@ -9781,26 +9673,23 @@ static C_word basic_cmp(C_word x, C_word y, char *loc, int eqp)
} else if (C_truep(C_bignump(y))) {
if (eqp) return C_SCHEME_FALSE;
else return rat_cmp(x, y);
- } else if (C_block_header(y) == C_STRUCTURE3_TAG &&
- (C_block_item(y, 0) == C_ratnum_type_tag)) {
+ } else if (C_block_header(y) == C_RATNUM_TAG) {
if (eqp) {
- return C_and(C_and(C_i_integer_equalp(C_block_item(x, 1),
- C_block_item(y, 1)),
- C_i_integer_equalp(C_block_item(x, 2),
- C_block_item(y, 2))),
+ return C_and(C_and(C_i_integer_equalp(C_u_i_ratnum_num(x),
+ C_u_i_ratnum_num(y)),
+ C_i_integer_equalp(C_u_i_ratnum_denom(x),
+ C_u_i_ratnum_denom(y))),
C_fix(0));
} else {
return rat_cmp(x, y);
}
- } else if (C_block_header(y) == C_STRUCTURE3_TAG &&
- (C_block_item(y, 0) == C_cplxnum_type_tag)) {
+ } else if (C_block_header(y) == C_CPLXNUM_TAG) {
if (eqp) return C_SCHEME_FALSE;
else barf(C_BAD_ARGUMENT_TYPE_COMPLEX_NO_ORDERING_ERROR, loc, y);
} else {
barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, loc, y);
}
- } else if (C_block_header(x) == C_STRUCTURE3_TAG &&
- (C_block_item(x, 0) == C_cplxnum_type_tag)) {
+ } else if (C_block_header(x) == C_CPLXNUM_TAG) {
if (!eqp) {
barf(C_BAD_ARGUMENT_TYPE_COMPLEX_NO_ORDERING_ERROR, loc, x);
} else if (y & C_FIXNUM_BIT) {
@@ -9809,13 +9698,11 @@ static C_word basic_cmp(C_word x, C_word y, char *loc, int eqp)
barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, loc, y);
} else if (C_block_header(y) == C_FLONUM_TAG ||
C_truep(C_bignump(x)) ||
- (C_block_header(y) == C_STRUCTURE3_TAG &&
- C_block_item(y, 0) == C_ratnum_type_tag)) {
+ C_block_header(y) == C_RATNUM_TAG) {
return C_SCHEME_FALSE;
- } else if (C_block_header(y) == C_STRUCTURE3_TAG &&
- (C_block_item(y, 0) == C_cplxnum_type_tag)) {
- return C_and(C_and(C_i_nequalp(C_block_item(x, 1), C_block_item(y, 1)),
- C_i_nequalp(C_block_item(x, 2), C_block_item(y, 2))),
+ } else if (C_block_header(y) == C_CPLXNUM_TAG) {
+ return C_and(C_and(C_i_nequalp(C_u_i_cplxnum_real(x), C_u_i_cplxnum_real(y)),
+ C_i_nequalp(C_u_i_cplxnum_imag(x), C_u_i_cplxnum_imag(y))),
C_fix(0));
} else {
barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, loc, y);
@@ -10662,7 +10549,7 @@ void C_ccall C_string_to_symbol(C_word c, C_word *av)
}
/* This will usually return a flonum, but it may also return a cplxnum
- * consisting of two flonums, making for a total of 12 words.
+ * consisting of two flonums, making for a total of 11 words.
*/
C_regparm C_word C_fcall
C_a_i_exact_to_inexact(C_word **ptr, int c, C_word n)
@@ -10675,19 +10562,17 @@ C_a_i_exact_to_inexact(C_word **ptr, int c, C_word n)
return n;
} else if (C_truep(C_bignump(n))) {
return C_a_u_i_big_to_flo(ptr, c, n);
- } else if (C_block_header(n) == C_STRUCTURE3_TAG &&
- (C_block_item(n, 0) == C_cplxnum_type_tag)) {
- return C_cplxnum(ptr, C_a_i_exact_to_inexact(ptr, 1, C_block_item(n, 1)),
- C_a_i_exact_to_inexact(ptr, 1, C_block_item(n, 2)));
+ } else if (C_block_header(n) == C_CPLXNUM_TAG) {
+ return C_cplxnum(ptr, C_a_i_exact_to_inexact(ptr, 1, C_u_i_cplxnum_real(n)),
+ C_a_i_exact_to_inexact(ptr, 1, C_u_i_cplxnum_imag(n)));
/* The horribly painful case: ratnums */
- } else if (C_block_header(n) == C_STRUCTURE3_TAG &&
- (C_block_item(n, 0) == C_ratnum_type_tag)) {
+ } else if (C_block_header(n) == C_RATNUM_TAG) {
/* This tries to keep the numbers within representable ranges and
* tries to drop as few significant digits as possible by bringing
* the two numbers to within the same powers of two. See
* algorithms M & N in Knuth, 4.2.1.
*/
- C_word num = C_block_item(n, 1), denom = C_block_item(n, 2),
+ C_word num = C_u_i_ratnum_num(n), denom = C_u_i_ratnum_denom(n),
/* e = approx. distance between the numbers in powers of 2.
* ie, 2^e-1 < n/d < 2^e+1 (e is the *un*biased value of
* e_w in M2. TODO: What if b!=2 (ie, flonum-radix isn't 2)?
diff --git a/types.db b/types.db
index bf1bcb6..998d03f 100644
--- a/types.db
+++ b/types.db
@@ -264,7 +264,7 @@
(zero? (#(procedure #:clean #:enforce #:foldable) zero? (number) boolean)
((integer) (eq? #(1) '0))
- (((or cplxnum ratnum)) '#f)
+ (((or cplxnum ratnum)) (let ((#(tmp) #(1))) '#f))
((number) (##core#inline "C_u_i_zerop" #(1)))
((*) (##core#inline "C_i_zerop" #(1))))
@@ -321,14 +321,14 @@
((integer integer) (integer)
(##core#inline_allocate ("C_s_a_u_i_integer_plus" 5) #(1) #(2)))
((* *) (number)
- (##core#inline_allocate ("C_s_a_i_plus" 32) #(1) #(2))))
+ (##core#inline_allocate ("C_s_a_i_plus" 29) #(1) #(2))))
(- (#(procedure #:clean #:enforce #:foldable) - (number #!rest number) number)
((fixnum) (integer) (##core#inline_allocate ("C_a_i_fixnum_negate" 5) #(1)))
((integer) (integer)
(##core#inline_allocate ("C_s_a_u_i_integer_negate" 5) #(1)))
((float) (float) (##core#inline_allocate ("C_a_i_flonum_negate" 4) #(1)))
- ((*) (*) (##core#inline_allocate ("C_s_a_i_negate" 32) #(1)))
+ ((*) (*) (##core#inline_allocate ("C_s_a_i_negate" 29) #(1)))
((float fixnum) (float)
(##core#inline_allocate
("C_a_i_flonum_difference" 4)
@@ -346,7 +346,7 @@
((integer integer) (integer)
(##core#inline_allocate ("C_s_a_u_i_integer_minus" 5) #(1) #(2)))
((* *) (number)
- (##core#inline_allocate ("C_s_a_i_minus" 32) #(1) #(2))))
+ (##core#inline_allocate ("C_s_a_i_minus" 29) #(1) #(2))))
(* (#(procedure #:clean #:enforce #:foldable) * (#!rest number) number)
(() (fixnum) '1)
@@ -374,7 +374,7 @@
((integer integer) (integer)
(##core#inline_allocate ("C_s_a_u_i_integer_times" 5) #(1) #(2)))
((* *) (number)
- (##core#inline_allocate ("C_s_a_i_times" 36) #(1) #(2))))
+ (##core#inline_allocate ("C_s_a_i_times" 33) #(1) #(2))))
(/ (#(procedure #:clean #:enforce #:foldable) / (number #!rest number) number)
((float fixnum) (float)
@@ -515,7 +515,7 @@
((integer) (integer)
(##core#inline_allocate ("C_s_a_u_i_integer_abs" 5) #(1)))
((*) (*)
- (##core#inline_allocate ("C_s_a_i_abs" 9) #(1))))
+ (##core#inline_allocate ("C_s_a_i_abs" 7) #(1))))
(floor (#(procedure #:clean #:enforce #:foldable) floor ((or integer ratnum float)) (or integer ratnum float))
((fixnum) (fixnum) #(1))
@@ -544,7 +544,7 @@
(exact->inexact (#(procedure #:clean #:enforce #:foldable) exact->inexact (number) (or float cplxnum))
((float) (float) #(1))
((fixnum) (float) (##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(1)))
- ((number) (##core#inline_allocate ("C_a_i_exact_to_inexact" 12) #(1))))
+ ((number) (##core#inline_allocate ("C_a_i_exact_to_inexact" 11) #(1))))
(inexact->exact (#(procedure #:clean #:enforce #:foldable) inexact->exact (number) (or integer ratnum))
((fixnum) (fixnum) #(1))
@@ -810,19 +810,19 @@
(real-part (#(procedure #:clean #:enforce #:foldable) real-part (number) (or integer float ratnum))
(((or fixnum float bignum ratnum)) #(1))
- ((cplxnum) (##sys#slot #(1) '1)))
+ ((cplxnum) (##core#inline "C_u_i_cplxnum_real" #(1))))
(imag-part (#(procedure #:clean #:enforce #:foldable) imag-part (number) (or integer float ratnum))
(((or fixnum bignum ratnum)) (let ((#(tmp) #(1))) '0))
((float) (let ((#(tmp) #(1))) '0.0))
- ((cplxnum) (##sys#slot #(1) '2)))
+ ((cplxnum) (##core#inline "C_u_i_cplxnum_imag" #(1))))
(magnitude (#(procedure #:clean #:enforce #:foldable) magnitude (number) number)
((fixnum) (integer) (##core#inline_allocate ("C_a_i_fixnum_abs" 5) #(1)))
((integer) (##core#inline_allocate ("C_s_a_u_i_integer_abs" 5) #(1)))
((float) (float) (##core#inline_allocate ("C_a_i_flonum_abs" 4) #(1)))
(((or fixnum float bignum ratnum))
- (##core#inline_allocate ("C_s_a_i_abs" 9) #(1))))
+ (##core#inline_allocate ("C_s_a_i_abs" 7) #(1))))
(angle (#(procedure #:clean #:enforce #:foldable) angle (number) float)
((float) (##core#inline_allocate ("C_a_i_flonum_atan2" 4) '0.0 #(1)))
@@ -830,22 +830,24 @@
("C_a_i_flonum_atan2" 4)
'0.0
(##core#inline_allocate ("C_a_i_fix_to_flo" 4) #(1))))
- ((cplxnum) (##core#inline_allocate
- ("C_a_i_flonum_atan2" 4)
- (##core#inline_allocate ("C_a_i_exact_to_inexact" 12)
- (##sys#slot #(1) '2))
- (##core#inline_allocate ("C_a_i_exact_to_inexact" 12)
- (##sys#slot #(1) '1)))))
+ ((cplxnum)
+ (let ((#(tmp) #(1)))
+ (##core#inline_allocate
+ ("C_a_i_flonum_atan2" 4)
+ (##core#inline_allocate ("C_a_i_exact_to_inexact" 11)
+ (##core#inline "C_u_i_cplxnum_imag" #(tmp)))
+ (##core#inline_allocate ("C_a_i_exact_to_inexact" 11)
+ (##core#inline "C_u_i_cplxnum_real" #(tmp)))))))
(numerator (#(procedure #:clean #:enforce #:foldable) numerator ((or float integer ratnum)) (or float integer))
((fixnum) (fixnum) #(1))
((bignum) (bignum) #(1))
((integer) (integer) #(1))
- ((ratnum) (integer) (##sys#slot #(1) '1)))
+ ((ratnum) (integer) (##core#inline "C_u_i_ratnum_num" #(1))))
(denominator (#(procedure #:clean #:enforce #:foldable) denominator ((or float integer ratnum)) (or float integer))
((integer) (fixnum) (let ((#(tmp) #(1))) '1))
- ((ratnum) (integer) (##sys#slot #(1) '2)))
+ ((ratnum) (integer) (##core#inline "C_u_i_ratnum_denom" #(1))))
;; eval
@@ -885,7 +887,7 @@
((float) (float)
(##core#inline_allocate ("C_a_i_flonum_plus" 4) #(1) '1.0))
((*) (number)
- (##core#inline_allocate ("C_s_a_i_plus" 32) #(1) '1)))
+ (##core#inline_allocate ("C_s_a_i_plus" 29) #(1) '1)))
(argc+argv (#(procedure #:clean) argc+argv () fixnum pointer))
(argv (#(procedure #:clean) argv () (list-of string)))
@@ -1308,7 +1310,8 @@
((float) (float)
(##core#inline_allocate ("C_a_u_i_flonum_signum" 4) #(1)))
((ratnum) (fixnum)
- (##core#inline "C_u_i_integer_signum" (##sys#slot #(1) '1)))
+ (##core#inline "C_u_i_integer_signum"
+ (##core#inline "C_u_i_ratnum_num" #(1))))
((cplxnum) ((or float cplxnum)) (##sys#extended-signum #(1))))
(sleep (#(procedure #:clean #:enforce) sleep (fixnum) undefined))
@@ -1326,7 +1329,7 @@
((float) (float)
(##core#inline_allocate ("C_a_i_flonum_difference" 4) #(1) '1.0))
((*) (number)
- (##core#inline_allocate ("C_s_a_i_minus" 32) #(1) '1)))
+ (##core#inline_allocate ("C_s_a_i_minus" 29) #(1) '1)))
(subvector (forall (a) (#(procedure #:clean #:enforce) subvector ((vector-of a) fixnum #!optional fixnum) (vector-of a))))
(symbol-escape (#(procedure #:clean) symbol-escape (#!optional *) *))
--
2.1.4
signature.asc
Description: Digital signature
_______________________________________________ Chicken-hackers mailing list Chicken-hackers@nongnu.org https://lists.nongnu.org/mailman/listinfo/chicken-hackers
