Ticket #1773: numeric-type-hash-switches-dyadic-procs.patch
File numeric-type-hash-switches-dyadic-procs.patch, 32.9 KB (added by , 2 years ago) |
---|
-
runtime.c
diff --git a/runtime.c b/runtime.c index cf7351e7..56e91c9e 100644
a b static C_TLS int timezone; 269 269 #define C_thread_id(x) C_block_item((x), 14) 270 270 271 271 272 #ifdef C_SIXTY_FOUR 273 # define C_TYPE_HASH_SHIFT 48 274 #else 275 # define C_TYPE_HASH_SHIFT 16 276 #endif 277 272 278 /* A numeric type hash packs the type bits into the bottom 12 bits (regardless of immediate/block type). */ 273 279 /* NOTE: Only fixnum-immediates are currently distinguished - to make this more generic one would need to use one more test */ 274 #define C_type_hash(x) (((x) & C_IMMEDIATE_MARK_BITS) ? ((x) & C_FIXNUM_BIT) : C_header_bits(x)) 280 #define C_type_hash(x) (((x) & C_IMMEDIATE_MARK_BITS) ? ((x) & C_FIXNUM_BIT) : (C_header_bits(x) >> C_TYPE_HASH_SHIFT)) 281 /* For dyadic procedures (with two arguments), combine both type hashes */ 282 #define C_dyadic_hash(x, y) ((x << 16) | y) 275 283 276 284 /* We only care about numeric type hashes currently */ 277 285 #define C_FIXNUM_TYPE_HASH C_FIXNUM_BIT 278 #define C_FLONUM_TYPE_HASH C_FLONUM_TYPE279 #define C_BIGNUM_TYPE_HASH C_BIGNUM_TYPE280 #define C_RATNUM_TYPE_HASH C_RATNUM_TYPE281 #define C_CPLXNUM_TYPE_HASH C_CPLXNUM_TYPE286 #define C_FLONUM_TYPE_HASH (C_FLONUM_TYPE >> C_TYPE_HASH_SHIFT) 287 #define C_BIGNUM_TYPE_HASH (C_BIGNUM_TYPE >> C_TYPE_HASH_SHIFT) 288 #define C_RATNUM_TYPE_HASH (C_RATNUM_TYPE >> C_TYPE_HASH_SHIFT) 289 #define C_CPLXNUM_TYPE_HASH (C_CPLXNUM_TYPE >> C_TYPE_HASH_SHIFT) 282 290 283 291 284 292 /* Type definitions: */ … … cplx_times(C_word **ptr, C_word rx, C_word ix, C_word ry, C_word iy) 8035 8043 C_regparm C_word C_fcall 8036 8044 C_s_a_i_times(C_word **ptr, C_word n, C_word x, C_word y) 8037 8045 { 8038 switch(C_type_hash(x)) { /* TODO: Use dyadic_hash? */ 8039 case C_FIXNUM_TYPE_HASH: 8040 switch(C_type_hash(y)) { 8041 case C_FIXNUM_TYPE_HASH: 8042 return C_a_i_fixnum_times(ptr, 2, x, y); 8046 switch(C_dyadic_hash(C_type_hash(x), C_type_hash(y))) { 8047 case C_dyadic_hash(C_FIXNUM_TYPE_HASH, C_FIXNUM_TYPE_HASH): 8048 return C_a_i_fixnum_times(ptr, 2, x, y); 8043 8049 8044 case C_FLONUM_TYPE_HASH:8045 8050 case C_dyadic_hash(C_FIXNUM_TYPE_HASH, C_FLONUM_TYPE_HASH): 8051 return C_flonum(ptr, (double)C_unfix(x) * C_flonum_magnitude(y)); 8046 8052 8047 case C_BIGNUM_TYPE_HASH:8048 8053 case C_dyadic_hash(C_FIXNUM_TYPE_HASH, C_BIGNUM_TYPE_HASH): 8054 return C_s_a_u_i_integer_times(ptr, 2, x, y); 8049 8055 8050 case C_RATNUM_TYPE_HASH:8051 8056 case C_dyadic_hash(C_FIXNUM_TYPE_HASH, C_RATNUM_TYPE_HASH): 8057 return rat_times_integer(ptr, y, x); 8052 8058 8053 case C_CPLXNUM_TYPE_HASH:8054 8055 8059 case C_dyadic_hash(C_FIXNUM_TYPE_HASH, C_CPLXNUM_TYPE_HASH): 8060 return cplx_times(ptr, x, C_fix(0), 8061 C_u_i_cplxnum_real(y), C_u_i_cplxnum_imag(y)); 8056 8062 8057 default:8058 barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "*", y);8059 }8060 8063 8061 case C_FLONUM_TYPE_HASH: 8062 switch(C_type_hash(y)) { 8063 case C_FIXNUM_TYPE_HASH: 8064 return C_flonum(ptr, C_flonum_magnitude(x) * (double)C_unfix(y)); 8064 case C_dyadic_hash(C_FLONUM_TYPE_HASH, C_FIXNUM_TYPE_HASH): 8065 return C_flonum(ptr, C_flonum_magnitude(x) * (double)C_unfix(y)); 8065 8066 8066 case C_FLONUM_TYPE_HASH:8067 8067 case C_dyadic_hash(C_FLONUM_TYPE_HASH, C_FLONUM_TYPE_HASH): 8068 return C_a_i_flonum_times(ptr, 2, x, y); 8068 8069 8069 case C_BIGNUM_TYPE_HASH:8070 8070 case C_dyadic_hash(C_FLONUM_TYPE_HASH, C_BIGNUM_TYPE_HASH): 8071 return C_flonum(ptr, C_flonum_magnitude(x) * C_bignum_to_double(y)); 8071 8072 8072 case C_RATNUM_TYPE_HASH: 8073 return C_s_a_i_times(ptr, 2, x, C_a_i_exact_to_inexact(ptr, 1, y)); 8074 8075 case C_CPLXNUM_TYPE_HASH: 8076 { 8077 C_word ab[C_SIZEOF_FLONUM], *a = ab; 8078 return cplx_times(ptr, x, C_flonum(&a, 0.0), 8079 C_u_i_cplxnum_real(y), C_u_i_cplxnum_imag(y)); 8080 } 8073 case C_dyadic_hash(C_FLONUM_TYPE_HASH, C_RATNUM_TYPE_HASH): 8074 return C_s_a_i_times(ptr, 2, x, C_a_i_exact_to_inexact(ptr, 1, y)); 8081 8075 8082 default: 8083 barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "*", y); 8084 } 8076 case C_dyadic_hash(C_FLONUM_TYPE_HASH, C_CPLXNUM_TYPE_HASH): 8077 { 8078 C_word ab[C_SIZEOF_FLONUM], *a = ab; 8079 return cplx_times(ptr, x, C_flonum(&a, 0.0), 8080 C_u_i_cplxnum_real(y), C_u_i_cplxnum_imag(y)); 8081 } 8085 8082 8086 case C_BIGNUM_TYPE_HASH: 8087 switch(C_type_hash(y)) { 8088 case C_FIXNUM_TYPE_HASH: 8089 return C_s_a_u_i_integer_times(ptr, 2, x, y); 8083 case C_dyadic_hash(C_BIGNUM_TYPE_HASH, C_FIXNUM_TYPE_HASH): 8084 return C_s_a_u_i_integer_times(ptr, 2, x, y); 8090 8085 8091 case C_FLONUM_TYPE_HASH:8092 8086 case C_dyadic_hash(C_BIGNUM_TYPE_HASH, C_FLONUM_TYPE_HASH): 8087 return C_flonum(ptr, C_bignum_to_double(x) * C_flonum_magnitude(y)); 8093 8088 8094 case C_BIGNUM_TYPE_HASH:8095 8089 case C_dyadic_hash(C_BIGNUM_TYPE_HASH, C_BIGNUM_TYPE_HASH): 8090 return C_s_a_u_i_integer_times(ptr, 2, x, y); 8096 8091 8097 case C_RATNUM_TYPE_HASH:8098 8092 case C_dyadic_hash(C_BIGNUM_TYPE_HASH, C_RATNUM_TYPE_HASH): 8093 return rat_times_integer(ptr, y, x); 8099 8094 8100 case C_CPLXNUM_TYPE_HASH:8101 8102 8095 case C_dyadic_hash(C_BIGNUM_TYPE_HASH, C_CPLXNUM_TYPE_HASH): 8096 return cplx_times(ptr, x, C_fix(0), 8097 C_u_i_cplxnum_real(y), C_u_i_cplxnum_imag(y)); 8103 8098 8104 default:8105 barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "*", y);8106 }8107 8099 8108 case C_RATNUM_TYPE_HASH: 8109 switch(C_type_hash(y)) { 8110 case C_FIXNUM_TYPE_HASH: 8111 return rat_times_integer(ptr, x, y); 8100 case C_dyadic_hash(C_RATNUM_TYPE_HASH, C_FIXNUM_TYPE_HASH): 8101 return rat_times_integer(ptr, x, y); 8112 8102 8113 case C_FLONUM_TYPE_HASH:8114 8103 case C_dyadic_hash(C_RATNUM_TYPE_HASH, C_FLONUM_TYPE_HASH): 8104 return C_s_a_i_times(ptr, 2, C_a_i_exact_to_inexact(ptr, 1, x), y); 8115 8105 8116 case C_BIGNUM_TYPE_HASH:8117 8106 case C_dyadic_hash(C_RATNUM_TYPE_HASH, C_BIGNUM_TYPE_HASH): 8107 return rat_times_integer(ptr, x, y); 8118 8108 8119 case C_RATNUM_TYPE_HASH:8120 8109 case C_dyadic_hash(C_RATNUM_TYPE_HASH, C_RATNUM_TYPE_HASH): 8110 return rat_times_rat(ptr, x, y); 8121 8111 8122 case C_CPLXNUM_TYPE_HASH:8123 8124 8112 case C_dyadic_hash(C_RATNUM_TYPE_HASH, C_CPLXNUM_TYPE_HASH): 8113 return cplx_times(ptr, x, C_fix(0), 8114 C_u_i_cplxnum_real(y), C_u_i_cplxnum_imag(y)); 8125 8115 8126 default:8127 barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "*", y);8128 }8116 case C_dyadic_hash(C_CPLXNUM_TYPE_HASH, C_CPLXNUM_TYPE_HASH): 8117 return cplx_times(ptr, C_u_i_cplxnum_real(x), C_u_i_cplxnum_imag(x), 8118 C_u_i_cplxnum_real(y), C_u_i_cplxnum_imag(y)); 8129 8119 8130 case C_CPLXNUM_TYPE_HASH:8131 if (!C_immediatep(y) && C_block_header(y) == C_CPLXNUM_TAG) {8132 return cplx_times(ptr, C_u_i_cplxnum_real(x), C_u_i_cplxnum_imag(x),8133 C_u_i_cplxnum_real(y), C_u_i_cplxnum_imag(y));8134 } else{8135 8136 8137 8138 8120 case C_dyadic_hash(C_CPLXNUM_TYPE_HASH, C_FIXNUM_TYPE_HASH): 8121 case C_dyadic_hash(C_CPLXNUM_TYPE_HASH, C_FLONUM_TYPE_HASH): 8122 case C_dyadic_hash(C_CPLXNUM_TYPE_HASH, C_BIGNUM_TYPE_HASH): 8123 case C_dyadic_hash(C_CPLXNUM_TYPE_HASH, C_RATNUM_TYPE_HASH): 8124 { 8125 C_word ab[C_SIZEOF_FLONUM], *a = ab, yi; 8126 yi = C_truep(C_i_flonump(y)) ? C_flonum(&a,0) : C_fix(0); 8127 return cplx_times(ptr, C_u_i_ratnum_num(x), C_u_i_ratnum_denom(x), y, yi); 8128 } 8139 8129 8140 8130 default: 8141 barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "*", x); 8131 if (!C_truep(C_i_numberp(x))) 8132 barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "*", x); 8133 else 8134 barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "*", y); 8142 8135 } 8143 8136 } 8144 8137 … … static C_word rat_plusmin_rat(C_word **ptr, C_word x, C_word y, integer_plusmin_ 8452 8445 C_regparm C_word C_fcall 8453 8446 C_s_a_i_plus(C_word **ptr, C_word n, C_word x, C_word y) 8454 8447 { 8455 switch(C_type_hash(x)) { /* TODO: Use dyadic_hash? */ 8456 case C_FIXNUM_TYPE_HASH: 8457 switch(C_type_hash(y)) { 8458 case C_FIXNUM_TYPE_HASH: 8459 return C_a_i_fixnum_plus(ptr, 2, x, y); 8448 switch(C_dyadic_hash(C_type_hash(x), C_type_hash(y))) { 8449 case C_dyadic_hash(C_FIXNUM_TYPE_HASH, C_FIXNUM_TYPE_HASH): 8450 return C_a_i_fixnum_plus(ptr, 2, x, y); 8460 8451 8461 case C_FLONUM_TYPE_HASH:8462 8452 case C_dyadic_hash(C_FIXNUM_TYPE_HASH, C_FLONUM_TYPE_HASH): 8453 return C_flonum(ptr, (double)C_unfix(x) + C_flonum_magnitude(y)); 8463 8454 8464 case C_BIGNUM_TYPE_HASH:8465 8455 case C_dyadic_hash(C_FIXNUM_TYPE_HASH, C_BIGNUM_TYPE_HASH): 8456 return C_s_a_u_i_integer_plus(ptr, 2, x, y); 8466 8457 8467 case C_RATNUM_TYPE_HASH:8468 8458 case C_dyadic_hash(C_FIXNUM_TYPE_HASH, C_RATNUM_TYPE_HASH): 8459 return rat_plusmin_integer(ptr, y, x, C_s_a_u_i_integer_plus); 8469 8460 8470 case C_CPLXNUM_TYPE_HASH: 8471 { 8472 C_word real_sum = C_s_a_i_plus(ptr, 2, x, C_u_i_cplxnum_real(y)), 8473 imag = C_u_i_cplxnum_imag(y); 8474 if (C_truep(C_u_i_inexactp(real_sum))) 8475 imag = C_a_i_exact_to_inexact(ptr, 1, imag); 8476 return C_cplxnum(ptr, real_sum, imag); 8477 } 8478 8479 default: 8480 barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "+", y); 8481 } 8461 case C_dyadic_hash(C_FIXNUM_TYPE_HASH, C_CPLXNUM_TYPE_HASH): 8462 { 8463 C_word real_sum = C_s_a_i_plus(ptr, 2, x, C_u_i_cplxnum_real(y)), 8464 imag = C_u_i_cplxnum_imag(y); 8465 if (C_truep(C_u_i_inexactp(real_sum))) 8466 imag = C_a_i_exact_to_inexact(ptr, 1, imag); 8467 return C_cplxnum(ptr, real_sum, imag); 8468 } 8482 8469 8483 case C_FLONUM_TYPE_HASH: 8484 switch(C_type_hash(y)) { 8485 case C_FIXNUM_TYPE_HASH: 8486 return C_flonum(ptr, C_flonum_magnitude(x) + (double)C_unfix(y)); 8470 case C_dyadic_hash(C_FLONUM_TYPE_HASH, C_FIXNUM_TYPE_HASH): 8471 return C_flonum(ptr, C_flonum_magnitude(x) + (double)C_unfix(y)); 8487 8472 8488 case C_FLONUM_TYPE_HASH:8489 8473 case C_dyadic_hash(C_FLONUM_TYPE_HASH, C_FLONUM_TYPE_HASH): 8474 return C_a_i_flonum_plus(ptr, 2, x, y); 8490 8475 8491 case C_BIGNUM_TYPE_HASH:8492 8476 case C_dyadic_hash(C_FLONUM_TYPE_HASH, C_BIGNUM_TYPE_HASH): 8477 return C_flonum(ptr, C_flonum_magnitude(x)+C_bignum_to_double(y)); 8493 8478 8494 case C_RATNUM_TYPE_HASH:8495 8479 case C_dyadic_hash(C_FLONUM_TYPE_HASH, C_RATNUM_TYPE_HASH): 8480 return C_s_a_i_plus(ptr, 2, x, C_a_i_exact_to_inexact(ptr, 1, y)); 8496 8481 8497 case C_CPLXNUM_TYPE_HASH:8498 8499 8500 8501 8502 8503 8504 8482 case C_dyadic_hash(C_FLONUM_TYPE_HASH, C_CPLXNUM_TYPE_HASH): 8483 { 8484 C_word real_sum = C_s_a_i_plus(ptr, 2, x, C_u_i_cplxnum_real(y)), 8485 imag = C_u_i_cplxnum_imag(y); 8486 if (C_truep(C_u_i_inexactp(real_sum))) 8487 imag = C_a_i_exact_to_inexact(ptr, 1, imag); 8488 return C_cplxnum(ptr, real_sum, imag); 8489 } 8505 8490 8506 default: 8507 barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "+", y); 8508 } 8491 case C_dyadic_hash(C_BIGNUM_TYPE_HASH, C_FIXNUM_TYPE_HASH): 8492 return C_s_a_u_i_integer_plus(ptr, 2, x, y); 8509 8493 8510 case C_BIGNUM_TYPE_HASH: 8511 switch(C_type_hash(y)) { 8512 case C_FIXNUM_TYPE_HASH: 8513 return C_s_a_u_i_integer_plus(ptr, 2, x, y); 8514 case C_FLONUM_TYPE_HASH: 8515 return C_flonum(ptr, C_bignum_to_double(x)+C_flonum_magnitude(y)); 8494 case C_dyadic_hash(C_BIGNUM_TYPE_HASH, C_FLONUM_TYPE_HASH): 8495 return C_flonum(ptr, C_bignum_to_double(x)+C_flonum_magnitude(y)); 8516 8496 8517 case C_BIGNUM_TYPE_HASH:8518 8497 case C_dyadic_hash(C_BIGNUM_TYPE_HASH, C_BIGNUM_TYPE_HASH): 8498 return C_s_a_u_i_integer_plus(ptr, 2, x, y); 8519 8499 8520 case C_RATNUM_TYPE_HASH:8521 8500 case C_dyadic_hash(C_BIGNUM_TYPE_HASH, C_RATNUM_TYPE_HASH): 8501 return rat_plusmin_integer(ptr, y, x, C_s_a_u_i_integer_plus); 8522 8502 8523 case C_CPLXNUM_TYPE_HASH:8524 8525 8526 8527 8528 8529 8530 8503 case C_dyadic_hash(C_BIGNUM_TYPE_HASH, C_CPLXNUM_TYPE_HASH): 8504 { 8505 C_word real_sum = C_s_a_i_plus(ptr, 2, x, C_u_i_cplxnum_real(y)), 8506 imag = C_u_i_cplxnum_imag(y); 8507 if (C_truep(C_u_i_inexactp(real_sum))) 8508 imag = C_a_i_exact_to_inexact(ptr, 1, imag); 8509 return C_cplxnum(ptr, real_sum, imag); 8510 } 8531 8511 8532 default: 8533 barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "+", y); 8534 } 8535 8536 case C_RATNUM_TYPE_HASH: 8537 switch(C_type_hash(y)) { 8538 case C_FIXNUM_TYPE_HASH: 8539 case C_BIGNUM_TYPE_HASH: 8540 return rat_plusmin_integer(ptr, x, y, C_s_a_u_i_integer_plus); 8541 8542 case C_FLONUM_TYPE_HASH: 8543 return C_s_a_i_plus(ptr, 2, C_a_i_exact_to_inexact(ptr, 1, x), y); 8512 case C_dyadic_hash(C_RATNUM_TYPE_HASH, C_FIXNUM_TYPE_HASH): 8513 case C_dyadic_hash(C_RATNUM_TYPE_HASH, C_BIGNUM_TYPE_HASH): 8514 return rat_plusmin_integer(ptr, x, y, C_s_a_u_i_integer_plus); 8544 8515 8545 case C_RATNUM_TYPE_HASH:8546 return rat_plusmin_rat(ptr, x, y, C_s_a_u_i_integer_plus);8516 case C_dyadic_hash(C_RATNUM_TYPE_HASH, C_FLONUM_TYPE_HASH): 8517 return C_s_a_i_plus(ptr, 2, C_a_i_exact_to_inexact(ptr, 1, x), y); 8547 8518 8548 case C_CPLXNUM_TYPE_HASH: 8549 { 8550 C_word real_sum = C_s_a_i_plus(ptr, 2, x, C_u_i_cplxnum_real(y)), 8551 imag = C_u_i_cplxnum_imag(y); 8552 if (C_truep(C_u_i_inexactp(real_sum))) 8553 imag = C_a_i_exact_to_inexact(ptr, 1, imag); 8554 return C_cplxnum(ptr, real_sum, imag); 8555 } 8519 case C_dyadic_hash(C_RATNUM_TYPE_HASH, C_RATNUM_TYPE_HASH): 8520 return rat_plusmin_rat(ptr, x, y, C_s_a_u_i_integer_plus); 8556 8521 8557 default: 8558 barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "+", y); 8559 } 8522 case C_dyadic_hash(C_RATNUM_TYPE_HASH, C_CPLXNUM_TYPE_HASH): 8523 { 8524 C_word real_sum = C_s_a_i_plus(ptr, 2, x, C_u_i_cplxnum_real(y)), 8525 imag = C_u_i_cplxnum_imag(y); 8526 if (C_truep(C_u_i_inexactp(real_sum))) 8527 imag = C_a_i_exact_to_inexact(ptr, 1, imag); 8528 return C_cplxnum(ptr, real_sum, imag); 8529 } 8560 8530 8561 case C_ CPLXNUM_TYPE_HASH:8562 if (!C_immediatep(y) && C_block_header(y) == C_CPLXNUM_TAG){8531 case C_dyadic_hash(C_CPLXNUM_TYPE_HASH, C_CPLXNUM_TYPE_HASH): 8532 { 8563 8533 C_word real_sum, imag_sum; 8564 8534 real_sum = C_s_a_i_plus(ptr, 2, C_u_i_cplxnum_real(x), C_u_i_cplxnum_real(y)); 8565 8535 imag_sum = C_s_a_i_plus(ptr, 2, C_u_i_cplxnum_imag(x), C_u_i_cplxnum_imag(y)); 8566 8536 if (C_truep(C_u_i_zerop2(imag_sum))) return real_sum; 8567 8537 else return C_cplxnum(ptr, real_sum, imag_sum); 8568 } else { 8569 C_word real_sum = C_s_a_i_plus(ptr, 2, C_u_i_cplxnum_real(x), y), 8570 imag = C_u_i_cplxnum_imag(x); 8571 if (C_truep(C_u_i_inexactp(real_sum))) 8572 imag = C_a_i_exact_to_inexact(ptr, 1, imag); 8573 return C_cplxnum(ptr, real_sum, imag); 8574 } 8538 } 8539 8540 case C_dyadic_hash(C_CPLXNUM_TYPE_HASH, C_FIXNUM_TYPE_HASH): 8541 case C_dyadic_hash(C_CPLXNUM_TYPE_HASH, C_FLONUM_TYPE_HASH): 8542 case C_dyadic_hash(C_CPLXNUM_TYPE_HASH, C_BIGNUM_TYPE_HASH): 8543 case C_dyadic_hash(C_CPLXNUM_TYPE_HASH, C_RATNUM_TYPE_HASH): 8544 { 8545 C_word real_sum = C_s_a_i_plus(ptr, 2, C_u_i_cplxnum_real(x), y), 8546 imag = C_u_i_cplxnum_imag(x); 8547 if (C_truep(C_u_i_inexactp(real_sum))) 8548 imag = C_a_i_exact_to_inexact(ptr, 1, imag); 8549 return C_cplxnum(ptr, real_sum, imag); 8550 } 8575 8551 8576 8552 default: 8577 barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "+", x); 8553 if (!C_truep(C_i_numberp(x))) 8554 barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "+", x); 8555 else 8556 barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "+", y); 8578 8557 } 8579 8558 } 8580 8559 … … static C_word bignum_minus_unsigned(C_word **ptr, C_word x, C_word y) 8688 8667 C_regparm C_word C_fcall 8689 8668 C_s_a_i_minus(C_word **ptr, C_word n, C_word x, C_word y) 8690 8669 { 8691 switch(C_type_hash(x)) { /* TODO: Use dyadic_hash? */ 8692 case C_FIXNUM_TYPE_HASH: 8693 switch(C_type_hash(y)) { 8694 case C_FIXNUM_TYPE_HASH: 8695 return C_a_i_fixnum_difference(ptr, 2, x, y); 8696 8697 case C_FLONUM_TYPE_HASH: 8698 return C_flonum(ptr, (double)C_unfix(x) - C_flonum_magnitude(y)); 8699 8700 case C_BIGNUM_TYPE_HASH: 8701 return C_s_a_u_i_integer_minus(ptr, 2, x, y); 8670 switch(C_dyadic_hash(C_type_hash(x), C_type_hash(y))) { 8671 case C_dyadic_hash(C_FIXNUM_TYPE_HASH, C_FIXNUM_TYPE_HASH): 8672 return C_a_i_fixnum_difference(ptr, 2, x, y); 8702 8673 8703 case C_RATNUM_TYPE_HASH:8704 return integer_minus_rat(ptr, x, y);8674 case C_dyadic_hash(C_FIXNUM_TYPE_HASH, C_FLONUM_TYPE_HASH): 8675 return C_flonum(ptr, (double)C_unfix(x) - C_flonum_magnitude(y)); 8705 8676 8706 case C_CPLXNUM_TYPE_HASH: 8707 { 8708 C_word real_diff = C_s_a_i_minus(ptr, 2, x, C_u_i_cplxnum_real(y)), 8709 imag = C_s_a_i_negate(ptr, 1, C_u_i_cplxnum_imag(y)); 8710 if (C_truep(C_u_i_inexactp(real_diff))) 8711 imag = C_a_i_exact_to_inexact(ptr, 1, imag); 8712 return C_cplxnum(ptr, real_diff, imag); 8713 } 8714 8715 default: 8716 barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "-", y); 8717 } 8677 case C_dyadic_hash(C_FIXNUM_TYPE_HASH, C_BIGNUM_TYPE_HASH): 8678 return C_s_a_u_i_integer_minus(ptr, 2, x, y); 8718 8679 8719 case C_FLONUM_TYPE_HASH: 8720 switch(C_type_hash(y)) { 8721 case C_FIXNUM_TYPE_HASH: 8722 return C_flonum(ptr, C_flonum_magnitude(x) - (double)C_unfix(y)); 8680 case C_dyadic_hash(C_FIXNUM_TYPE_HASH, C_RATNUM_TYPE_HASH): 8681 return integer_minus_rat(ptr, x, y); 8723 8682 8724 case C_FLONUM_TYPE_HASH: 8725 return C_a_i_flonum_difference(ptr, 2, x, y); 8683 case C_dyadic_hash(C_FIXNUM_TYPE_HASH, C_CPLXNUM_TYPE_HASH): 8684 { 8685 C_word real_diff = C_s_a_i_minus(ptr, 2, x, C_u_i_cplxnum_real(y)), 8686 imag = C_s_a_i_negate(ptr, 1, C_u_i_cplxnum_imag(y)); 8687 if (C_truep(C_u_i_inexactp(real_diff))) 8688 imag = C_a_i_exact_to_inexact(ptr, 1, imag); 8689 return C_cplxnum(ptr, real_diff, imag); 8690 } 8726 8691 8727 case C_BIGNUM_TYPE_HASH:8728 return C_flonum(ptr, C_flonum_magnitude(x)-C_bignum_to_double(y));8692 case C_dyadic_hash(C_FLONUM_TYPE_HASH, C_FIXNUM_TYPE_HASH): 8693 return C_flonum(ptr, C_flonum_magnitude(x) - (double)C_unfix(y)); 8729 8694 8730 case C_RATNUM_TYPE_HASH:8731 return C_s_a_i_minus(ptr, 2, x, C_a_i_exact_to_inexact(ptr, 1, y));8695 case C_dyadic_hash(C_FLONUM_TYPE_HASH, C_FLONUM_TYPE_HASH): 8696 return C_a_i_flonum_difference(ptr, 2, x, y); 8732 8697 8733 case C_CPLXNUM_TYPE_HASH: 8734 { 8735 C_word real_diff = C_s_a_i_minus(ptr, 2, x, C_u_i_cplxnum_real(y)), 8736 imag = C_s_a_i_negate(ptr, 1, C_u_i_cplxnum_imag(y)); 8737 if (C_truep(C_u_i_inexactp(real_diff))) 8738 imag = C_a_i_exact_to_inexact(ptr, 1, imag); 8739 return C_cplxnum(ptr, real_diff, imag); 8740 } 8698 case C_dyadic_hash(C_FLONUM_TYPE_HASH, C_BIGNUM_TYPE_HASH): 8699 return C_flonum(ptr, C_flonum_magnitude(x)-C_bignum_to_double(y)); 8741 8700 8742 default: 8743 barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "-", y); 8744 } 8701 case C_dyadic_hash(C_FLONUM_TYPE_HASH, C_RATNUM_TYPE_HASH): 8702 return C_s_a_i_minus(ptr, 2, x, C_a_i_exact_to_inexact(ptr, 1, y)); 8745 8703 8746 case C_BIGNUM_TYPE_HASH: 8747 switch(C_type_hash(y)) { 8748 case C_FIXNUM_TYPE_HASH: 8749 return C_s_a_u_i_integer_minus(ptr, 2, x, y); 8704 case C_dyadic_hash(C_FLONUM_TYPE_HASH, C_CPLXNUM_TYPE_HASH): 8705 { 8706 C_word real_diff = C_s_a_i_minus(ptr, 2, x, C_u_i_cplxnum_real(y)), 8707 imag = C_s_a_i_negate(ptr, 1, C_u_i_cplxnum_imag(y)); 8708 if (C_truep(C_u_i_inexactp(real_diff))) 8709 imag = C_a_i_exact_to_inexact(ptr, 1, imag); 8710 return C_cplxnum(ptr, real_diff, imag); 8711 } 8750 8712 8751 case C_FLONUM_TYPE_HASH:8752 return C_flonum(ptr, C_bignum_to_double(x)-C_flonum_magnitude(y));8713 case C_dyadic_hash(C_BIGNUM_TYPE_HASH, C_FIXNUM_TYPE_HASH): 8714 return C_s_a_u_i_integer_minus(ptr, 2, x, y); 8753 8715 8754 case C_BIGNUM_TYPE_HASH:8755 return C_s_a_u_i_integer_minus(ptr, 2, x, y);8716 case C_dyadic_hash(C_BIGNUM_TYPE_HASH, C_FLONUM_TYPE_HASH): 8717 return C_flonum(ptr, C_bignum_to_double(x)-C_flonum_magnitude(y)); 8756 8718 8757 case C_RATNUM_TYPE_HASH:8758 return integer_minus_rat(ptr, x, y);8719 case C_dyadic_hash(C_BIGNUM_TYPE_HASH, C_BIGNUM_TYPE_HASH): 8720 return C_s_a_u_i_integer_minus(ptr, 2, x, y); 8759 8721 8760 case C_CPLXNUM_TYPE_HASH: 8761 { 8762 C_word real_diff = C_s_a_i_minus(ptr, 2, x, C_u_i_cplxnum_real(y)), 8763 imag = C_s_a_i_negate(ptr, 1, C_u_i_cplxnum_imag(y)); 8764 if (C_truep(C_u_i_inexactp(real_diff))) 8765 imag = C_a_i_exact_to_inexact(ptr, 1, imag); 8766 return C_cplxnum(ptr, real_diff, imag); 8767 } 8722 case C_dyadic_hash(C_BIGNUM_TYPE_HASH, C_RATNUM_TYPE_HASH): 8723 return integer_minus_rat(ptr, x, y); 8768 8724 8769 default: 8770 barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "-", y); 8771 } 8725 case C_dyadic_hash(C_BIGNUM_TYPE_HASH, C_CPLXNUM_TYPE_HASH): 8726 { 8727 C_word real_diff = C_s_a_i_minus(ptr, 2, x, C_u_i_cplxnum_real(y)), 8728 imag = C_s_a_i_negate(ptr, 1, C_u_i_cplxnum_imag(y)); 8729 if (C_truep(C_u_i_inexactp(real_diff))) 8730 imag = C_a_i_exact_to_inexact(ptr, 1, imag); 8731 return C_cplxnum(ptr, real_diff, imag); 8732 } 8772 8733 8773 case C_RATNUM_TYPE_HASH: 8774 switch(C_type_hash(y)) { 8775 case C_FIXNUM_TYPE_HASH: 8776 return rat_plusmin_integer(ptr, x, y, C_s_a_u_i_integer_minus); 8734 case C_dyadic_hash(C_RATNUM_TYPE_HASH, C_FIXNUM_TYPE_HASH): 8735 return rat_plusmin_integer(ptr, x, y, C_s_a_u_i_integer_minus); 8777 8736 8778 case C_FLONUM_TYPE_HASH:8779 8737 case C_dyadic_hash(C_RATNUM_TYPE_HASH, C_FLONUM_TYPE_HASH): 8738 return C_s_a_i_minus(ptr, 2, C_a_i_exact_to_inexact(ptr, 1, x), y); 8780 8739 8781 case C_BIGNUM_TYPE_HASH:8782 8740 case C_dyadic_hash(C_RATNUM_TYPE_HASH, C_BIGNUM_TYPE_HASH): 8741 return rat_plusmin_integer(ptr, x, y, C_s_a_u_i_integer_minus); 8783 8742 8784 case C_RATNUM_TYPE_HASH:8785 8743 case C_dyadic_hash(C_RATNUM_TYPE_HASH, C_RATNUM_TYPE_HASH): 8744 return rat_plusmin_rat(ptr, x, y, C_s_a_u_i_integer_minus); 8786 8745 8787 case C_CPLXNUM_TYPE_HASH:8788 8789 8790 8791 8792 8793 8794 8746 case C_dyadic_hash(C_RATNUM_TYPE_HASH, C_CPLXNUM_TYPE_HASH): 8747 { 8748 C_word real_diff = C_s_a_i_minus(ptr, 2, x, C_u_i_cplxnum_real(y)), 8749 imag = C_s_a_i_negate(ptr, 1, C_u_i_cplxnum_imag(y)); 8750 if (C_truep(C_u_i_inexactp(real_diff))) 8751 imag = C_a_i_exact_to_inexact(ptr, 1, imag); 8752 return C_cplxnum(ptr, real_diff, imag); 8753 } 8795 8754 8796 default: 8797 barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "-", y); 8798 } 8755 case C_dyadic_hash(C_CPLXNUM_TYPE_HASH, C_CPLXNUM_TYPE_HASH): 8756 { 8757 C_word real_diff, imag_diff; 8758 real_diff = C_s_a_i_minus(ptr,2,C_u_i_cplxnum_real(x),C_u_i_cplxnum_real(y)); 8759 imag_diff = C_s_a_i_minus(ptr,2,C_u_i_cplxnum_imag(x),C_u_i_cplxnum_imag(y)); 8760 if (C_truep(C_u_i_zerop2(imag_diff))) return real_diff; 8761 else return C_cplxnum(ptr, real_diff, imag_diff); 8762 } 8799 8763 8800 case C_CPLXNUM_TYPE_HASH: 8801 if (!C_immediatep(y) && C_block_header(y) == C_CPLXNUM_TAG) { 8802 C_word real_diff, imag_diff; 8803 real_diff = C_s_a_i_minus(ptr,2,C_u_i_cplxnum_real(x),C_u_i_cplxnum_real(y)); 8804 imag_diff = C_s_a_i_minus(ptr,2,C_u_i_cplxnum_imag(x),C_u_i_cplxnum_imag(y)); 8805 if (C_truep(C_u_i_zerop2(imag_diff))) return real_diff; 8806 else return C_cplxnum(ptr, real_diff, imag_diff); 8807 } else { 8808 C_word real_diff = C_s_a_i_minus(ptr, 2, C_u_i_cplxnum_real(x), y), 8809 imag = C_u_i_cplxnum_imag(x); 8810 if (C_truep(C_u_i_inexactp(real_diff))) 8811 imag = C_a_i_exact_to_inexact(ptr, 1, imag); 8812 return C_cplxnum(ptr, real_diff, imag); 8813 } 8764 case C_dyadic_hash(C_CPLXNUM_TYPE_HASH, C_FIXNUM_TYPE_HASH): 8765 case C_dyadic_hash(C_CPLXNUM_TYPE_HASH, C_FLONUM_TYPE_HASH): 8766 case C_dyadic_hash(C_CPLXNUM_TYPE_HASH, C_BIGNUM_TYPE_HASH): 8767 case C_dyadic_hash(C_CPLXNUM_TYPE_HASH, C_RATNUM_TYPE_HASH): 8768 { 8769 C_word real_diff = C_s_a_i_minus(ptr, 2, C_u_i_cplxnum_real(x), y), 8770 imag = C_u_i_cplxnum_imag(x); 8771 if (C_truep(C_u_i_inexactp(real_diff))) 8772 imag = C_a_i_exact_to_inexact(ptr, 1, imag); 8773 return C_cplxnum(ptr, real_diff, imag); 8774 } 8814 8775 8815 8776 default: 8816 barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "-", x); 8777 if (!C_truep(C_i_numberp(x))) 8778 barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "-", x); 8779 else 8780 barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "-", y); 8817 8781 } 8818 8782 } 8819 8783 … … static C_word flo_rat_cmp(C_word flonum, C_word ratnum) 9722 9686 */ 9723 9687 static C_word basic_cmp(C_word x, C_word y, char *loc, int eqp) 9724 9688 { 9725 switch(C_type_hash(x)) { /* TODO: Use dyadic_hash? */ 9726 case C_FIXNUM_TYPE_HASH: 9727 switch(C_type_hash(y)) { 9728 case C_FIXNUM_TYPE_HASH: 9729 return C_fix((x < y) ? -1 : ((x > y) ? 1 : 0)); 9689 switch(C_dyadic_hash(C_type_hash(x), C_type_hash(y))) { 9690 case C_dyadic_hash(C_FIXNUM_TYPE_HASH, C_FIXNUM_TYPE_HASH): 9691 return C_fix((x < y) ? -1 : ((x > y) ? 1 : 0)); 9730 9692 9731 case C_FLONUM_TYPE_HASH:9732 9693 case C_dyadic_hash(C_FIXNUM_TYPE_HASH, C_FLONUM_TYPE_HASH): 9694 return int_flo_cmp(x, y); 9733 9695 9734 case C_BIGNUM_TYPE_HASH:9735 9736 9737 9738 9696 case C_dyadic_hash(C_FIXNUM_TYPE_HASH, C_BIGNUM_TYPE_HASH): 9697 { 9698 C_word ab[C_SIZEOF_FIX_BIGNUM], *a = ab; 9699 return C_i_bignum_cmp(C_a_u_i_fix_to_big(&a, x), y); 9700 } 9739 9701 9740 case C_RATNUM_TYPE_HASH:9741 9742 9702 case C_dyadic_hash(C_FIXNUM_TYPE_HASH, C_RATNUM_TYPE_HASH): 9703 if (eqp) return C_SCHEME_FALSE; 9704 else return rat_cmp(x, y); 9743 9705 9744 case C_CPLXNUM_TYPE_HASH:9745 9746 9706 case C_dyadic_hash(C_FIXNUM_TYPE_HASH, C_CPLXNUM_TYPE_HASH): 9707 if (eqp) return C_SCHEME_FALSE; 9708 else barf(C_BAD_ARGUMENT_TYPE_COMPLEX_NO_ORDERING_ERROR, loc, y); 9747 9709 9748 default:9749 barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, loc, y);9750 }9751 9752 case C_FLONUM_TYPE_HASH:9753 switch(C_type_hash(y)) {9754 case C_FIXNUM_TYPE_HASH:9755 return flo_int_cmp(x, y);9756 9710 9757 case C_FLONUM_TYPE_HASH: 9758 { 9759 double a = C_flonum_magnitude(x), b = C_flonum_magnitude(y); 9760 if (C_isnan(a) || C_isnan(b)) return C_SCHEME_FALSE; /* "mu" */ 9761 else return C_fix((a < b) ? -1 : ((a > b) ? 1 : 0)); 9762 } 9711 case C_dyadic_hash(C_FLONUM_TYPE_HASH, C_FIXNUM_TYPE_HASH): 9712 return flo_int_cmp(x, y); 9763 9713 9764 case C_BIGNUM_TYPE_HASH: 9765 return flo_int_cmp(x, y); 9714 case C_dyadic_hash(C_FLONUM_TYPE_HASH, C_FLONUM_TYPE_HASH): 9715 { 9716 double a = C_flonum_magnitude(x), b = C_flonum_magnitude(y); 9717 if (C_isnan(a) || C_isnan(b)) return C_SCHEME_FALSE; /* "mu" */ 9718 else return C_fix((a < b) ? -1 : ((a > b) ? 1 : 0)); 9719 } 9766 9720 9767 case C_RATNUM_TYPE_HASH:9768 return flo_rat_cmp(x, y);9721 case C_dyadic_hash(C_FLONUM_TYPE_HASH, C_BIGNUM_TYPE_HASH): 9722 return flo_int_cmp(x, y); 9769 9723 9770 case C_CPLXNUM_TYPE_HASH: 9771 if (eqp) return C_SCHEME_FALSE; 9772 else barf(C_BAD_ARGUMENT_TYPE_COMPLEX_NO_ORDERING_ERROR, loc, y); 9724 case C_dyadic_hash(C_FLONUM_TYPE_HASH, C_RATNUM_TYPE_HASH): 9725 return flo_rat_cmp(x, y); 9773 9726 9774 default:9775 barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, loc, y);9776 }9727 case C_dyadic_hash(C_FLONUM_TYPE_HASH, C_CPLXNUM_TYPE_HASH): 9728 if (eqp) return C_SCHEME_FALSE; 9729 else barf(C_BAD_ARGUMENT_TYPE_COMPLEX_NO_ORDERING_ERROR, loc, y); 9777 9730 9778 case C_BIGNUM_TYPE_HASH: 9779 switch(C_type_hash(y)) { 9780 case C_FIXNUM_TYPE_HASH: 9781 { 9782 C_word ab[C_SIZEOF_FIX_BIGNUM], *a = ab; 9783 return C_i_bignum_cmp(x, C_a_u_i_fix_to_big(&a, y)); 9784 } 9731 case C_dyadic_hash(C_BIGNUM_TYPE_HASH, C_FIXNUM_TYPE_HASH): 9732 { 9733 C_word ab[C_SIZEOF_FIX_BIGNUM], *a = ab; 9734 return C_i_bignum_cmp(x, C_a_u_i_fix_to_big(&a, y)); 9735 } 9785 9736 9786 case C_FLONUM_TYPE_HASH:9787 9737 case C_dyadic_hash(C_BIGNUM_TYPE_HASH, C_FLONUM_TYPE_HASH): 9738 return int_flo_cmp(x, y); 9788 9739 9789 case C_BIGNUM_TYPE_HASH:9790 9740 case C_dyadic_hash(C_BIGNUM_TYPE_HASH, C_BIGNUM_TYPE_HASH): 9741 return C_i_bignum_cmp(x, y); 9791 9742 9792 case C_RATNUM_TYPE_HASH:9793 9794 9743 case C_dyadic_hash(C_BIGNUM_TYPE_HASH, C_RATNUM_TYPE_HASH): 9744 if (eqp) return C_SCHEME_FALSE; 9745 else return rat_cmp(x, y); 9795 9746 9796 case C_CPLXNUM_TYPE_HASH:9797 9798 9747 case C_dyadic_hash(C_BIGNUM_TYPE_HASH, C_CPLXNUM_TYPE_HASH): 9748 if (eqp) return C_SCHEME_FALSE; 9749 else barf(C_BAD_ARGUMENT_TYPE_COMPLEX_NO_ORDERING_ERROR, loc, y); 9799 9750 9800 default:9801 barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, loc, y);9802 }9751 case C_dyadic_hash(C_RATNUM_TYPE_HASH, C_FIXNUM_TYPE_HASH): 9752 if (eqp) return C_SCHEME_FALSE; 9753 else return rat_cmp(x, y); 9803 9754 9804 case C_RATNUM_TYPE_HASH: 9805 switch(C_type_hash(y)) { 9806 case C_FIXNUM_TYPE_HASH: 9807 if (eqp) return C_SCHEME_FALSE; 9808 else return rat_cmp(x, y); 9809 9810 case C_FLONUM_TYPE_HASH: 9811 return rat_flo_cmp(x, y); 9812 9813 case C_BIGNUM_TYPE_HASH: 9814 if (eqp) return C_SCHEME_FALSE; 9815 else return rat_cmp(x, y); 9816 9817 case C_RATNUM_TYPE_HASH: 9818 if (eqp) { 9819 return C_and(C_and(C_i_integer_equalp(C_u_i_ratnum_num(x), 9820 C_u_i_ratnum_num(y)), 9821 C_i_integer_equalp(C_u_i_ratnum_denom(x), 9822 C_u_i_ratnum_denom(y))), 9823 C_fix(0)); 9824 } else { 9825 return rat_cmp(x, y); 9826 } 9755 case C_dyadic_hash(C_RATNUM_TYPE_HASH, C_FLONUM_TYPE_HASH): 9756 return rat_flo_cmp(x, y); 9827 9757 9828 case C_CPLXNUM_TYPE_HASH:9829 9830 else barf(C_BAD_ARGUMENT_TYPE_COMPLEX_NO_ORDERING_ERROR, loc, y);9758 case C_dyadic_hash(C_RATNUM_TYPE_HASH, C_BIGNUM_TYPE_HASH): 9759 if (eqp) return C_SCHEME_FALSE; 9760 else return rat_cmp(x, y); 9831 9761 9832 default: 9833 barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, loc, y); 9762 case C_dyadic_hash(C_RATNUM_TYPE_HASH, C_RATNUM_TYPE_HASH): 9763 if (eqp) { 9764 return C_and(C_and(C_i_integer_equalp(C_u_i_ratnum_num(x), 9765 C_u_i_ratnum_num(y)), 9766 C_i_integer_equalp(C_u_i_ratnum_denom(x), 9767 C_u_i_ratnum_denom(y))), 9768 C_fix(0)); 9769 } else { 9770 return rat_cmp(x, y); 9834 9771 } 9835 9772 9836 case C_CPLXNUM_TYPE_HASH: 9773 case C_dyadic_hash(C_RATNUM_TYPE_HASH, C_CPLXNUM_TYPE_HASH): 9774 if (eqp) return C_SCHEME_FALSE; 9775 else barf(C_BAD_ARGUMENT_TYPE_COMPLEX_NO_ORDERING_ERROR, loc, y); 9776 9777 9778 case C_dyadic_hash(C_CPLXNUM_TYPE_HASH, C_FIXNUM_TYPE_HASH): 9779 case C_dyadic_hash(C_CPLXNUM_TYPE_HASH, C_FLONUM_TYPE_HASH): 9780 case C_dyadic_hash(C_CPLXNUM_TYPE_HASH, C_BIGNUM_TYPE_HASH): 9781 case C_dyadic_hash(C_CPLXNUM_TYPE_HASH, C_RATNUM_TYPE_HASH): 9837 9782 if (!eqp) 9838 9783 barf(C_BAD_ARGUMENT_TYPE_COMPLEX_NO_ORDERING_ERROR, loc, x); 9839 9840 switch(C_type_hash(y)) { 9841 case C_FIXNUM_TYPE_HASH: 9842 case C_FLONUM_TYPE_HASH: 9843 case C_BIGNUM_TYPE_HASH: 9844 case C_RATNUM_TYPE_HASH: 9784 else 9845 9785 return C_SCHEME_FALSE; 9846 9786 9847 case C_CPLXNUM_TYPE_HASH: 9787 case C_dyadic_hash(C_CPLXNUM_TYPE_HASH, C_CPLXNUM_TYPE_HASH): 9788 if (!eqp) 9789 barf(C_BAD_ARGUMENT_TYPE_COMPLEX_NO_ORDERING_ERROR, loc, x); 9790 else 9848 9791 return C_and(C_and(C_i_nequalp(C_u_i_cplxnum_real(x), C_u_i_cplxnum_real(y)), 9849 9792 C_i_nequalp(C_u_i_cplxnum_imag(x), C_u_i_cplxnum_imag(y))), 9850 9793 C_fix(0)); 9851 9794 9852 default:9853 barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, loc, y);9854 }9855 9856 9795 default: 9857 barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, loc, x); 9796 if (!C_truep(C_i_numberp(x))) 9797 barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, loc, x); 9798 else 9799 barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, loc, y); 9858 9800 } 9859 9801 } 9860 9802