~ chicken-core (chicken-5) 7f60f95c7f376fb981d662943d27feabab7e1d21
commit 7f60f95c7f376fb981d662943d27feabab7e1d21
Author: Peter Bex <peter@more-magic.net>
AuthorDate: Mon Aug 8 22:33:41 2016 +0200
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Mon Oct 3 12:18:50 2016 +0200
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.
Signed-off-by: felix <felix@call-with-current-continuation.org>
diff --git a/c-backend.scm b/c-backend.scm
index f58d3d4f..9b09312e 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 d9296511..25098e45 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 96a03ea4..2740d91d 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)
/* unused (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)
/* unused (0x0f000000 ...) */
#endif
#define C_VECTOR_TYPE 0x00000000
@@ -523,6 +523,8 @@ static inline int isinf_ld (long double x)
#define C_SIZEOF_VECTOR(n) ((n) + 1)
#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
@@ -1307,6 +1309,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))
@@ -1378,7 +1384,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))
@@ -1735,9 +1743,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;
@@ -2428,14 +2434,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)
@@ -2766,12 +2784,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)
@@ -2828,9 +2844,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 */
@@ -2840,8 +2855,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 */
@@ -2856,8 +2870,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);
}
}
@@ -2892,18 +2905,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;
}
}
@@ -2913,12 +2924,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;
}
}
@@ -2945,16 +2955,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 81622bba..2b976b4c 100644
--- a/library.scm
+++ b/library.scm
@@ -1016,15 +1016,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)
@@ -1066,9 +1066,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
@@ -1173,7 +1173,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 ee84a20b..0bc2a158 100644
--- a/runtime.c
+++ b/runtime.c
@@ -339,9 +339,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;
@@ -1125,8 +1123,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"));
@@ -3607,8 +3603,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);
@@ -3941,8 +3935,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);
@@ -5322,14 +5314,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);
}
@@ -5345,14 +5334,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);
}
@@ -5368,14 +5354,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);
}
@@ -5391,13 +5374,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);
}
@@ -5414,13 +5394,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);
}
@@ -5435,10 +5412,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);
@@ -5465,11 +5441,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);
@@ -5498,11 +5472,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);
@@ -5974,7 +5946,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)
{
@@ -5986,12 +5958,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);
@@ -6035,7 +6005,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)
@@ -6048,14 +6018,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);
}
@@ -7669,13 +7637,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) */
@@ -7711,10 +7679,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)) */
@@ -7761,9 +7729,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 */
@@ -7792,7 +7760,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)
@@ -7806,15 +7774,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);
}
@@ -7829,16 +7793,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);
}
@@ -7851,52 +7811,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);
@@ -8041,7 +7988,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;
@@ -8146,15 +8093,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. */
@@ -8163,8 +8110,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);
@@ -8174,15 +8121,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;
@@ -8236,8 +8183,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)
@@ -8251,18 +8198,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);
}
@@ -8277,18 +8220,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);
}
@@ -8301,63 +8240,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);
@@ -8397,7 +8323,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;
@@ -8499,7 +8425,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)
{
@@ -8512,18 +8438,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);
}
@@ -8538,18 +8460,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);
}
@@ -8562,63 +8480,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);
@@ -8656,7 +8561,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);
@@ -9460,13 +9365,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 */
@@ -9474,16 +9379,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) */
@@ -9656,7 +9561,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 */
@@ -9664,7 +9569,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
@@ -9711,16 +9616,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);
}
@@ -9737,15 +9638,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);
}
@@ -9759,21 +9656,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);
@@ -9784,26 +9676,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) {
@@ -9812,13 +9701,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);
@@ -10665,7 +10552,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)
@@ -10678,19 +10565,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 0d970d5c..4ac0c074 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 *) *))
Trap