Ticket #1773: numeric-type-hash-full-change.patch

File numeric-type-hash-full-change.patch, 49.4 KB (added by sjamaan, 4 years ago)

Full patch for switch-based dispatching, for both single and dual-argument procedures

  • runtime.c 

    diff --git a/runtime.c b/runtime.c
index 93dd9d29..56e91c9e 100644
    a b static C_TLS int timezone; 
    269269#define C_thread_id(x)   C_block_item((x), 14)
    270270
    271271
     272#ifdef C_SIXTY_FOUR
     273# define C_TYPE_HASH_SHIFT           48
     274#else
     275# define C_TYPE_HASH_SHIFT           16
     276#endif
     277
     278/* A numeric type hash packs the type bits into the bottom 12 bits (regardless of immediate/block type). */
     279/* NOTE: Only fixnum-immediates are currently distinguished - to make this more generic one would need to use one more test */
     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)
     283
     284/* We only care about numeric type hashes currently */
     285#define C_FIXNUM_TYPE_HASH           C_FIXNUM_BIT
     286#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)
     290
     291
    272292/* Type definitions: */
    273293
    274294typedef C_regparm C_word C_fcall (*integer_plusmin_op) (C_word **ptr, C_word n, C_word x, C_word y);
    … … C_word C_fcall C_a_i_smart_mpointer(C_word **ptr, int c, C_word x) 
    52875307
    52885308C_regparm C_word C_fcall C_i_nanp(C_word x)
    52895309{
    5290   if (x & C_FIXNUM_BIT) {
     5310  switch(C_type_hash(x)) {
     5311  case C_FIXNUM_TYPE_HASH:
     5312  case C_BIGNUM_TYPE_HASH:
     5313  case C_RATNUM_TYPE_HASH:
    52915314    return C_SCHEME_FALSE;
    5292   } else if (C_immediatep(x)) {
    5293     barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "nan?", x);
    5294   } else if (C_block_header(x) == C_FLONUM_TAG) {
     5315
     5316  case C_FLONUM_TYPE_HASH:
    52955317    return C_u_i_flonum_nanp(x);
    5296   } else if (C_truep(C_bignump(x))) {
    5297     return C_SCHEME_FALSE;
    5298   } else if (C_block_header(x) == C_RATNUM_TAG) {
    5299     return C_SCHEME_FALSE;
    5300   } else if (C_block_header(x) == C_CPLXNUM_TAG) {
     5318
     5319  case C_CPLXNUM_TYPE_HASH:
    53015320    return C_mk_bool(C_truep(C_i_nanp(C_u_i_cplxnum_real(x))) ||
    53025321                     C_truep(C_i_nanp(C_u_i_cplxnum_imag(x))));
    5303   } else {
     5322
     5323  default:
    53045324    barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "nan?", x);
    53055325  }
    53065326}
    53075327
    53085328C_regparm C_word C_fcall C_i_finitep(C_word x)
    53095329{
    5310   if (x & C_FIXNUM_BIT) {
     5330  switch(C_type_hash(x)) {
     5331  case C_FIXNUM_TYPE_HASH:
     5332  case C_BIGNUM_TYPE_HASH:
     5333  case C_RATNUM_TYPE_HASH:
    53115334    return C_SCHEME_TRUE;
    5312   } else if (C_immediatep(x)) {
    5313     barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "finite?", x);
    5314   } else if (C_block_header(x) == C_FLONUM_TAG) {
     5335
     5336  case C_FLONUM_TYPE_HASH:
    53155337    return C_u_i_flonum_finitep(x);
    5316   } else if (C_truep(C_bignump(x))) {
    5317     return C_SCHEME_TRUE;
    5318   } else if (C_block_header(x) == C_RATNUM_TAG) {
    5319     return C_SCHEME_TRUE;
    5320   } else if (C_block_header(x) == C_CPLXNUM_TAG) {
     5338
     5339  case C_CPLXNUM_TYPE_HASH:
    53215340    return C_and(C_i_finitep(C_u_i_cplxnum_real(x)),
    53225341                 C_i_finitep(C_u_i_cplxnum_imag(x)));
    5323   } else {
     5342
     5343  default:
    53245344    barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "finite?", x);
    53255345  }
    53265346}
    53275347
    53285348C_regparm C_word C_fcall C_i_infinitep(C_word x)
    53295349{
    5330   if (x & C_FIXNUM_BIT) {
     5350  switch(C_type_hash(x)) {
     5351  case C_FIXNUM_TYPE_HASH:
     5352  case C_BIGNUM_TYPE_HASH:
     5353  case C_RATNUM_TYPE_HASH:
    53315354    return C_SCHEME_FALSE;
    5332   } else if (C_immediatep(x)) {
    5333     barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "infinite?", x);
    5334   } else if (C_block_header(x) == C_FLONUM_TAG) {
     5355
     5356  case C_FLONUM_TYPE_HASH:
    53355357    return C_u_i_flonum_infinitep(x);
    5336   } else if (C_truep(C_bignump(x))) {
    5337     return C_SCHEME_FALSE;
    5338   } else if (C_block_header(x) == C_RATNUM_TAG) {
    5339     return C_SCHEME_FALSE;
    5340   } else if (C_block_header(x) == C_CPLXNUM_TAG) {
     5358
     5359  case C_CPLXNUM_TYPE_HASH:
    53415360    return C_mk_bool(C_truep(C_i_infinitep(C_u_i_cplxnum_real(x))) ||
    53425361                     C_truep(C_i_infinitep(C_u_i_cplxnum_imag(x))));
    5343   } else {
     5362
     5363  default:
    53445364    barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "infinite?", x);
    53455365  }
    53465366}
    53475367
    53485368C_regparm C_word C_fcall C_i_exactp(C_word x)
    53495369{
    5350   if (x & C_FIXNUM_BIT) {
     5370  switch(C_type_hash(x)) {
     5371  case C_FIXNUM_TYPE_HASH:
     5372  case C_BIGNUM_TYPE_HASH:
     5373  case C_RATNUM_TYPE_HASH:
    53515374    return C_SCHEME_TRUE;
    5352   } else if (C_immediatep(x)) {
    5353     barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "exact?", x);
    5354   } else if (C_block_header(x) == C_FLONUM_TAG) {
     5375
     5376  case C_FLONUM_TYPE_HASH:
    53555377    return C_SCHEME_FALSE;
    5356   } else if (C_truep(C_bignump(x))) {
    5357     return C_SCHEME_TRUE;
    5358   } else if (C_block_header(x) == C_RATNUM_TAG) {
    5359     return C_SCHEME_TRUE;
    5360   } else if (C_block_header(x) == C_CPLXNUM_TAG) {
     5378
     5379  case C_CPLXNUM_TYPE_HASH:
    53615380    return C_i_exactp(C_u_i_cplxnum_real(x)); /* Exactness of i and r matches */
    5362   } else {
     5381
     5382  default:
    53635383    barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "exact?", x);
    53645384  }
    53655385}
    … … C_regparm C_word C_fcall C_i_exactp(C_word x) 
    53675387
    53685388C_regparm C_word C_fcall C_i_inexactp(C_word x)
    53695389{
    5370   if (x & C_FIXNUM_BIT) {
     5390  switch(C_type_hash(x)) {
     5391  case C_FIXNUM_TYPE_HASH:
     5392  case C_BIGNUM_TYPE_HASH:
     5393  case C_RATNUM_TYPE_HASH:
    53715394    return C_SCHEME_FALSE;
    5372   } else if (C_immediatep(x)) {
    5373     barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "inexact?", x);
    5374   } else if (C_block_header(x) == C_FLONUM_TAG) {
     5395
     5396  case C_FLONUM_TYPE_HASH:
    53755397    return C_SCHEME_TRUE;
    5376   } else if (C_truep(C_bignump(x))) {
    5377     return C_SCHEME_FALSE;
    5378   } else if (C_block_header(x) == C_RATNUM_TAG) {
    5379     return C_SCHEME_FALSE;
    5380   } else if (C_block_header(x) == C_CPLXNUM_TAG) {
     5398
     5399  case C_CPLXNUM_TYPE_HASH:
    53815400    return C_i_inexactp(C_u_i_cplxnum_real(x)); /* Exactness of i and r matches */
    5382   } else {
     5401
     5402  default:
    53835403    barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "inexact?", x);
    53845404  }
    53855405}
    … … C_regparm C_word C_fcall C_i_inexactp(C_word x) 
    53875407
    53885408C_regparm C_word C_fcall C_i_zerop(C_word x)
    53895409{
    5390   if (x & C_FIXNUM_BIT) {
     5410  switch(C_type_hash(x)) {
     5411  case C_FIXNUM_TYPE_HASH:
    53915412    return C_mk_bool(x == C_fix(0));
    5392   } else if (C_immediatep(x)) {
    5393     barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "zero?", x);
    5394   } else if (C_block_header(x) == C_FLONUM_TAG) {
     5413
     5414  case C_FLONUM_TYPE_HASH:
    53955415    return C_mk_bool(C_flonum_magnitude(x) == 0.0);
    5396   } else if (C_block_header(x) == C_BIGNUM_TAG ||
    5397              C_block_header(x) == C_RATNUM_TAG ||
    5398              C_block_header(x) == C_CPLXNUM_TAG) {
     5416
     5417  case C_BIGNUM_TYPE_HASH:
     5418  case C_RATNUM_TYPE_HASH:
     5419  case C_CPLXNUM_TYPE_HASH:
    53995420    return C_SCHEME_FALSE;
    5400   } else {
     5421
     5422  default:
    54015423    barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "zero?", x);
    54025424  }
    54035425}
    … … C_regparm C_word C_fcall C_u_i_zerop(C_word x) 
    54145436
    54155437C_regparm C_word C_fcall C_i_positivep(C_word x)
    54165438{
    5417   if (x & C_FIXNUM_BIT)
     5439  switch(C_type_hash(x)) {
     5440  case C_FIXNUM_TYPE_HASH:
    54185441    return C_i_fixnum_positivep(x);
    5419   else if (C_immediatep(x))
    5420     barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "positive?", x);
    5421   else if (C_block_header(x) == C_FLONUM_TAG)
     5442
     5443  case C_FLONUM_TYPE_HASH:
    54225444    return C_mk_bool(C_flonum_magnitude(x) > 0.0);
    5423   else if (C_truep(C_bignump(x)))
     5445
     5446  case C_BIGNUM_TYPE_HASH:
    54245447    return C_mk_nbool(C_bignum_negativep(x));
    5425   else if (C_block_header(x) == C_RATNUM_TAG)
     5448
     5449  case C_RATNUM_TYPE_HASH:
    54265450    return C_i_integer_positivep(C_u_i_ratnum_num(x));
    5427   else if (C_block_header(x) == C_CPLXNUM_TAG)
     5451
     5452  case C_CPLXNUM_TYPE_HASH:
    54285453    barf(C_BAD_ARGUMENT_TYPE_NO_REAL_ERROR, "positive?", x);
    5429   else
     5454
     5455  default:
    54305456    barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "positive?", x);
     5457  }
    54315458}
    54325459
    54335460C_regparm C_word C_fcall C_i_integer_positivep(C_word x)
    … … C_regparm C_word C_fcall C_i_integer_positivep(C_word x) 
    54385465
    54395466C_regparm C_word C_fcall C_i_negativep(C_word x)
    54405467{
    5441   if (x & C_FIXNUM_BIT)
     5468  switch(C_type_hash(x)) {
     5469  case C_FIXNUM_TYPE_HASH:
    54425470    return C_i_fixnum_negativep(x);
    5443   else if (C_immediatep(x))
    5444     barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "negative?", x);
    5445   else if (C_block_header(x) == C_FLONUM_TAG)
     5471
     5472  case C_FLONUM_TYPE_HASH:
    54465473    return C_mk_bool(C_flonum_magnitude(x) < 0.0);
    5447   else if (C_truep(C_bignump(x)))
     5474
     5475  case C_BIGNUM_TYPE_HASH:
    54485476    return C_mk_bool(C_bignum_negativep(x));
    5449   else if (C_block_header(x) == C_RATNUM_TAG)
     5477
     5478  case C_RATNUM_TYPE_HASH:
    54505479    return C_i_integer_negativep(C_u_i_ratnum_num(x));
    5451   else if (C_block_header(x) == C_CPLXNUM_TAG)
     5480
     5481  case C_CPLXNUM_TYPE_HASH:
    54525482    barf(C_BAD_ARGUMENT_TYPE_NO_REAL_ERROR, "negative?", x);
    5453   else
     5483
     5484  default:
    54545485    barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "negative?", x);
     5486  }
    54555487}
    54565488
    54575489
    … … C_regparm C_word C_fcall C_i_integer_negativep(C_word x) 
    54645496
    54655497C_regparm C_word C_fcall C_i_evenp(C_word x)
    54665498{
    5467   if(x & C_FIXNUM_BIT) {
     5499  switch(C_type_hash(x)) {
     5500  case C_FIXNUM_TYPE_HASH:
    54685501    return C_i_fixnumevenp(x);
    5469   } else if(C_immediatep(x)) {
    5470     barf(C_BAD_ARGUMENT_TYPE_NO_INTEGER_ERROR, "even?", x);
    5471   } else if (C_block_header(x) == C_FLONUM_TAG) {
     5502
     5503  case C_FLONUM_TYPE_HASH:
     5504  {
    54725505    double val, dummy;
    54735506    val = C_flonum_magnitude(x);
    54745507    if(C_isnan(val) || C_isinf(val) || C_modf(val, &dummy) != 0.0)
    54755508      barf(C_BAD_ARGUMENT_TYPE_NO_INTEGER_ERROR, "even?", x);
    54765509    else
    54775510      return C_mk_bool(fmod(val, 2.0) == 0.0);
    5478   } else if (C_truep(C_bignump(x))) {
     5511  }
     5512
     5513  case C_BIGNUM_TYPE_HASH:
    54795514    return C_mk_nbool(C_bignum_digits(x)[0] & 1);
    5480   } else { /* No need to try extended number */
     5515
     5516  default:
    54815517    barf(C_BAD_ARGUMENT_TYPE_NO_INTEGER_ERROR, "even?", x);
    54825518  }
    54835519}
    … … C_regparm C_word C_fcall C_i_integer_evenp(C_word x) 
    54915527
    54925528C_regparm C_word C_fcall C_i_oddp(C_word x)
    54935529{
    5494   if(x & C_FIXNUM_BIT) {
     5530  switch(C_type_hash(x)) {
     5531  case C_FIXNUM_TYPE_HASH:
    54955532    return C_i_fixnumoddp(x);
    5496   } else if(C_immediatep(x)) {
    5497     barf(C_BAD_ARGUMENT_TYPE_NO_INTEGER_ERROR, "odd?", x);
    5498   } else if(C_block_header(x) == C_FLONUM_TAG) {
     5533
     5534  case C_FLONUM_TYPE_HASH:
     5535  {
    54995536    double val, dummy;
    55005537    val = C_flonum_magnitude(x);
    55015538    if(C_isnan(val) || C_isinf(val) || C_modf(val, &dummy) != 0.0)
    55025539      barf(C_BAD_ARGUMENT_TYPE_NO_INTEGER_ERROR, "odd?", x);
    55035540    else
    55045541      return C_mk_bool(fmod(val, 2.0) != 0.0);
    5505   } else if (C_truep(C_bignump(x))) {
     5542  }
     5543
     5544  case C_BIGNUM_TYPE_HASH:
    55065545    return C_mk_bool(C_bignum_digits(x)[0] & 1);
    5507   } else {
     5546
     5547  default:
    55085548    barf(C_BAD_ARGUMENT_TYPE_NO_INTEGER_ERROR, "odd?", x);
    55095549  }
    55105550}
    … … C_regparm C_word C_fcall C_i_f64vector_set(C_word v, C_word i, C_word x) 
    64006440C_regparm C_word C_fcall
    64016441C_s_a_i_abs(C_word **ptr, C_word n, C_word x)
    64026442{
    6403   if (x & C_FIXNUM_BIT) {
     6443  switch(C_type_hash(x)) {
     6444  case C_FIXNUM_TYPE_HASH:
    64046445    return C_a_i_fixnum_abs(ptr, 1, x);
    6405   } else if (C_immediatep(x)) {
    6406     barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "abs", x);
    6407   } else if (C_block_header(x) == C_FLONUM_TAG) {
     6446
     6447  case C_FLONUM_TYPE_HASH:
    64086448    return C_a_i_flonum_abs(ptr, 1, x);
    6409   } else if (C_truep(C_bignump(x))) {
     6449
     6450  case C_BIGNUM_TYPE_HASH:
    64106451    return C_s_a_u_i_integer_abs(ptr, 1, x);
    6411   } else if (C_block_header(x) == C_RATNUM_TAG) {
     6452
     6453  case C_RATNUM_TYPE_HASH:
    64126454    return C_ratnum(ptr, C_s_a_u_i_integer_abs(ptr, 1, C_u_i_ratnum_num(x)),
    64136455                    C_u_i_ratnum_denom(x));
    6414   } else if (C_block_header(x) == C_CPLXNUM_TAG) {
     6456
     6457  case C_CPLXNUM_TYPE_HASH:
    64156458    barf(C_BAD_ARGUMENT_TYPE_COMPLEX_ABS, "abs", x);
    6416   } else {
     6459
     6460  default:
    64176461    barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "abs", x);
    64186462  }
    64196463}
    … … void C_ccall C_signum(C_word c, C_word *av) 
    64276471  x = av[ 2 ];
    64286472  y = av[ 3 ];
    64296473
    6430   if (x & C_FIXNUM_BIT) {
     6474  switch(C_type_hash(x)) {
     6475  case C_FIXNUM_TYPE_HASH:
    64316476    C_kontinue(k, C_i_fixnum_signum(x));
    6432   } else if (C_immediatep(x)) {
    6433     barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "signum", x);
    6434   } else if (C_block_header(x) == C_FLONUM_TAG) {
     6477
     6478  case C_FLONUM_TYPE_HASH:
     6479  {
    64356480    C_word *a = C_alloc(C_SIZEOF_FLONUM);
    64366481    C_kontinue(k, C_a_u_i_flonum_signum(&a, 1, x));
    6437   } else if (C_truep(C_bignump(x))) {
     6482  }
     6483 
     6484  case C_BIGNUM_TYPE_HASH:
    64386485    C_kontinue(k, C_bignum_negativep(x) ? C_fix(-1) : C_fix(1));
    6439   } else {
     6486
     6487  case C_RATNUM_TYPE_HASH:
     6488  case C_CPLXNUM_TYPE_HASH:
    64406489    try_extended_number("##sys#extended-signum", 2, k, x);
     6490
     6491  default:
     6492    barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "signum", x);
    64416493  }
    64426494}
    64436495
    … … void C_ccall C_signum(C_word c, C_word *av) 
    64496501C_regparm C_word C_fcall
    64506502C_s_a_i_negate(C_word **ptr, C_word n, C_word x)
    64516503{
    6452   if (x & C_FIXNUM_BIT) {
     6504  switch(C_type_hash(x)) {
     6505  case C_FIXNUM_TYPE_HASH:
    64536506    return C_a_i_fixnum_negate(ptr, 1, x);
    6454   } else if (C_immediatep(x)) {
    6455     barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "-", x);
    6456   } else if (C_block_header(x) == C_FLONUM_TAG) {
     6507
     6508  case C_FLONUM_TYPE_HASH:
    64576509    return C_a_i_flonum_negate(ptr, 1, x);
    6458   } else if (C_truep(C_bignump(x))) {
     6510
     6511  case C_BIGNUM_TYPE_HASH:
    64596512    return C_s_a_u_i_integer_negate(ptr, 1, x);
    6460   } else if (C_block_header(x) == C_RATNUM_TAG) {
     6513
     6514  case C_RATNUM_TYPE_HASH:
    64616515    return C_ratnum(ptr, C_s_a_u_i_integer_negate(ptr, 1, C_u_i_ratnum_num(x)),
    64626516                    C_u_i_ratnum_denom(x));
    6463   } else if (C_block_header(x) == C_CPLXNUM_TAG) {
     6517
     6518  case C_CPLXNUM_TYPE_HASH:
    64646519    return C_cplxnum(ptr, C_s_a_i_negate(ptr, 1, C_u_i_cplxnum_real(x)),
    64656520                     C_s_a_i_negate(ptr, 1, C_u_i_cplxnum_imag(x)));
    6466   } else {
     6521
     6522  default:
    64676523    barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "-", x);
    64686524  }
    64696525}
    … … cplx_times(C_word **ptr, C_word rx, C_word ix, C_word ry, C_word iy) 
    79878043C_regparm C_word C_fcall
    79888044C_s_a_i_times(C_word **ptr, C_word n, C_word x, C_word y)
    79898045{
    7990   if (x & C_FIXNUM_BIT) {
    7991     if (y & C_FIXNUM_BIT) {
    7992       return C_a_i_fixnum_times(ptr, 2, x, y);
    7993     } else if (C_immediatep(y)) {
    7994       barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "*", y);
    7995     } else if (C_block_header(y) == C_FLONUM_TAG) {
    7996       return C_flonum(ptr, (double)C_unfix(x) * C_flonum_magnitude(y));
    7997     } else if (C_truep(C_bignump(y))) {
    7998       return C_s_a_u_i_integer_times(ptr, 2, x, y);
    7999     } else if (C_block_header(y) == C_RATNUM_TAG) {
    8000       return rat_times_integer(ptr, y, x);
    8001     } else if (C_block_header(y) == C_CPLXNUM_TAG) {
    8002       return cplx_times(ptr, x, C_fix(0),
    8003                         C_u_i_cplxnum_real(y), C_u_i_cplxnum_imag(y));
    8004     } else {
    8005       barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "*", y);
    8006     }
    8007   } else if (C_immediatep(x)) {
    8008     barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "*", x);
    8009   } else if (C_block_header(x) == C_FLONUM_TAG) {
    8010     if (y & C_FIXNUM_BIT) {
    8011       return C_flonum(ptr, C_flonum_magnitude(x) * (double)C_unfix(y));
    8012     } else if (C_immediatep(y)) {
    8013       barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "*", y);
    8014     } else if (C_block_header(y) == C_FLONUM_TAG) {
    8015       return C_a_i_flonum_times(ptr, 2, x, y);
    8016     } else if (C_truep(C_bignump(y))) {
    8017       return C_flonum(ptr, C_flonum_magnitude(x) * C_bignum_to_double(y));
    8018     } else if (C_block_header(y) == C_RATNUM_TAG) {
    8019       return C_s_a_i_times(ptr, 2, x, C_a_i_exact_to_inexact(ptr, 1, y));
    8020     } else if (C_block_header(y) == C_CPLXNUM_TAG) {
    8021       C_word ab[C_SIZEOF_FLONUM], *a = ab;
    8022       return cplx_times(ptr, x, C_flonum(&a, 0.0),
    8023                         C_u_i_cplxnum_real(y), C_u_i_cplxnum_imag(y));
    8024     } else {
    8025       barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "*", y);
    8026     }
    8027   } else if (C_truep(C_bignump(x))) {
    8028     if (y & C_FIXNUM_BIT) {
    8029       return C_s_a_u_i_integer_times(ptr, 2, x, y);
    8030     } else if (C_immediatep(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);
     8049
     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));
     8052
     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);
     8055
     8056  case C_dyadic_hash(C_FIXNUM_TYPE_HASH, C_RATNUM_TYPE_HASH):
     8057    return rat_times_integer(ptr, y, x);
     8058
     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));
     8062
     8063
     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));
     8066
     8067  case C_dyadic_hash(C_FLONUM_TYPE_HASH, C_FLONUM_TYPE_HASH):
     8068    return C_a_i_flonum_times(ptr, 2, x, y);
     8069
     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));
     8072
     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));
     8075
     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  }
     8082
     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);
     8085
     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));
     8088
     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);
     8091
     8092  case C_dyadic_hash(C_BIGNUM_TYPE_HASH, C_RATNUM_TYPE_HASH):
     8093    return rat_times_integer(ptr, y, x);
     8094
     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));
     8098
     8099
     8100  case C_dyadic_hash(C_RATNUM_TYPE_HASH, C_FIXNUM_TYPE_HASH):
     8101    return rat_times_integer(ptr, x, y);
     8102
     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);
     8105
     8106  case C_dyadic_hash(C_RATNUM_TYPE_HASH, C_BIGNUM_TYPE_HASH):
     8107    return rat_times_integer(ptr, x, y);
     8108
     8109  case C_dyadic_hash(C_RATNUM_TYPE_HASH, C_RATNUM_TYPE_HASH):
     8110    return rat_times_rat(ptr, x, y);
     8111
     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));
     8115
     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));
     8119
     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  }
     8129
     8130  default:
     8131    if (!C_truep(C_i_numberp(x)))
    80318132      barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "*", x);
    8032     } else if (C_block_header(y) == C_FLONUM_TAG) {
    8033       return C_flonum(ptr, C_bignum_to_double(x) * C_flonum_magnitude(y));
    8034     } else if (C_truep(C_bignump(y))) {
    8035       return C_s_a_u_i_integer_times(ptr, 2, x, y);
    8036     } else if (C_block_header(y) == C_RATNUM_TAG) {
    8037       return rat_times_integer(ptr, y, x);
    8038     } else if (C_block_header(y) == C_CPLXNUM_TAG) {
    8039       return cplx_times(ptr, x, C_fix(0),
    8040                         C_u_i_cplxnum_real(y), C_u_i_cplxnum_imag(y));
    8041     } else {
    8042       barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "*", y);
    8043     }
    8044   } else if (C_block_header(x) == C_RATNUM_TAG) {
    8045     if (y & C_FIXNUM_BIT) {
    8046       return rat_times_integer(ptr, x, y);
    8047     } else if (C_immediatep(y)) {
    8048       barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "*", y);
    8049     } else if (C_block_header(y) == C_FLONUM_TAG) {
    8050       return C_s_a_i_times(ptr, 2, C_a_i_exact_to_inexact(ptr, 1, x), y);
    8051     } else if (C_truep(C_bignump(y))) {
    8052       return rat_times_integer(ptr, x, y);
    8053     } else if (C_block_header(y) == C_RATNUM_TAG) {
    8054         return rat_times_rat(ptr, x, y);
    8055     } else if (C_block_header(y) == C_CPLXNUM_TAG) {
    8056       return cplx_times(ptr, x, C_fix(0),
    8057                         C_u_i_cplxnum_real(y), C_u_i_cplxnum_imag(y));
    8058     } else {
     8133    else
    80598134      barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "*", y);
    8060     }
    8061   } else if (C_block_header(x) == C_CPLXNUM_TAG) {
    8062     if (!C_immediatep(y) && C_block_header(y) == C_CPLXNUM_TAG) {
    8063       return cplx_times(ptr, C_u_i_cplxnum_real(x), C_u_i_cplxnum_imag(x),
    8064                         C_u_i_cplxnum_real(y), C_u_i_cplxnum_imag(y));
    8065     } else {
    8066       C_word ab[C_SIZEOF_FLONUM], *a = ab, yi;
    8067       yi = C_truep(C_i_flonump(y)) ? C_flonum(&a,0) : C_fix(0);
    8068       return cplx_times(ptr, C_u_i_ratnum_num(x), C_u_i_ratnum_denom(x), y, yi);
    8069     }
    8070   } else {
    8071     barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "*", x);
    80728135  }
    80738136}
    80748137
    … … static C_word rat_plusmin_rat(C_word **ptr, C_word x, C_word y, integer_plusmin_ 
    83828445C_regparm C_word C_fcall
    83838446C_s_a_i_plus(C_word **ptr, C_word n, C_word x, C_word y)
    83848447{
    8385   if (x & C_FIXNUM_BIT) {
    8386     if (y & C_FIXNUM_BIT) {
    8387       return C_a_i_fixnum_plus(ptr, 2, x, y);
    8388     } else if (C_immediatep(y)) {
    8389       barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "+", y);
    8390     } else if (C_block_header(y) == C_FLONUM_TAG) {
    8391       return C_flonum(ptr, (double)C_unfix(x) + C_flonum_magnitude(y));
    8392     } else if (C_truep(C_bignump(y))) {
    8393       return C_s_a_u_i_integer_plus(ptr, 2, x, y);
    8394     } else if (C_block_header(y) == C_RATNUM_TAG) {
    8395       return rat_plusmin_integer(ptr, y, x, C_s_a_u_i_integer_plus);
    8396     } else if (C_block_header(y) == C_CPLXNUM_TAG) {
    8397       C_word real_sum = C_s_a_i_plus(ptr, 2, x, C_u_i_cplxnum_real(y)),
    8398              imag = C_u_i_cplxnum_imag(y);
    8399       if (C_truep(C_u_i_inexactp(real_sum)))
    8400         imag = C_a_i_exact_to_inexact(ptr, 1, imag);
    8401       return C_cplxnum(ptr, real_sum, imag);
    8402     } else {
    8403       barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "+", y);
    8404     }
    8405   } else if (C_immediatep(x)) {
    8406     barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "+", x);
    8407   } else if (C_block_header(x) == C_FLONUM_TAG) {
    8408     if (y & C_FIXNUM_BIT) {
    8409       return C_flonum(ptr, C_flonum_magnitude(x) + (double)C_unfix(y));
    8410     } else if (C_immediatep(y)) {
    8411       barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "+", y);
    8412     } else if (C_block_header(y) == C_FLONUM_TAG) {
    8413       return C_a_i_flonum_plus(ptr, 2, x, y);
    8414     } else if (C_truep(C_bignump(y))) {
    8415       return C_flonum(ptr, C_flonum_magnitude(x)+C_bignum_to_double(y));
    8416     } else if (C_block_header(y) == C_RATNUM_TAG) {
    8417       return C_s_a_i_plus(ptr, 2, x, C_a_i_exact_to_inexact(ptr, 1, y));
    8418     } else if (C_block_header(y) == C_CPLXNUM_TAG) {
    8419       C_word real_sum = C_s_a_i_plus(ptr, 2, x, C_u_i_cplxnum_real(y)),
    8420              imag = C_u_i_cplxnum_imag(y);
    8421       if (C_truep(C_u_i_inexactp(real_sum)))
    8422         imag = C_a_i_exact_to_inexact(ptr, 1, imag);
    8423       return C_cplxnum(ptr, real_sum, imag);
    8424     } else {
    8425       barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "+", y);
    8426     }
    8427   } else if (C_truep(C_bignump(x))) {
    8428     if (y & C_FIXNUM_BIT) {
    8429       return C_s_a_u_i_integer_plus(ptr, 2, x, y);
    8430     } else if (C_immediatep(y)) {
    8431       barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "+", y);
    8432     } else if (C_block_header(y) == C_FLONUM_TAG) {
    8433       return C_flonum(ptr, C_bignum_to_double(x)+C_flonum_magnitude(y));
    8434     } else if (C_truep(C_bignump(y))) {
    8435       return C_s_a_u_i_integer_plus(ptr, 2, x, y);
    8436     } else if (C_block_header(y) == C_RATNUM_TAG) {
    8437       return rat_plusmin_integer(ptr, y, x, C_s_a_u_i_integer_plus);
    8438     } else if (C_block_header(y) == C_CPLXNUM_TAG) {
    8439       C_word real_sum = C_s_a_i_plus(ptr, 2, x, C_u_i_cplxnum_real(y)),
    8440              imag = C_u_i_cplxnum_imag(y);
    8441       if (C_truep(C_u_i_inexactp(real_sum)))
    8442         imag = C_a_i_exact_to_inexact(ptr, 1, imag);
    8443       return C_cplxnum(ptr, real_sum, imag);
    8444     } else {
    8445       barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "+", y);
    8446     }
    8447   } else if (C_block_header(x) == C_RATNUM_TAG) {
    8448     if (y & C_FIXNUM_BIT) {
    8449       return rat_plusmin_integer(ptr, x, y, C_s_a_u_i_integer_plus);
    8450     } else if (C_immediatep(y)) {
    8451       barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "+", y);
    8452     } else if (C_block_header(y) == C_FLONUM_TAG) {
    8453       return C_s_a_i_plus(ptr, 2, C_a_i_exact_to_inexact(ptr, 1, x), y);
    8454     } else if (C_truep(C_bignump(y))) {
    8455       return rat_plusmin_integer(ptr, x, y, C_s_a_u_i_integer_plus);
    8456     } else if (C_block_header(y) == C_RATNUM_TAG) {
    8457       return rat_plusmin_rat(ptr, x, y, C_s_a_u_i_integer_plus);
    8458     } else if (C_block_header(y) == C_CPLXNUM_TAG) {
    8459       C_word real_sum = C_s_a_i_plus(ptr, 2, x, C_u_i_cplxnum_real(y)),
    8460              imag = C_u_i_cplxnum_imag(y);
    8461       if (C_truep(C_u_i_inexactp(real_sum)))
    8462         imag = C_a_i_exact_to_inexact(ptr, 1, imag);
    8463       return C_cplxnum(ptr, real_sum, imag);
    8464     } else {
    8465       barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "+", y);
    8466     }
    8467   } else if (C_block_header(x) == C_CPLXNUM_TAG) {
    8468     if (!C_immediatep(y) && C_block_header(y) == C_CPLXNUM_TAG) {
     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);
     8451
     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));
     8454
     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);
     8457
     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);
     8460
     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  }
     8469
     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));
     8472
     8473  case C_dyadic_hash(C_FLONUM_TYPE_HASH, C_FLONUM_TYPE_HASH):
     8474    return C_a_i_flonum_plus(ptr, 2, x, y);
     8475
     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));
     8478
     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));
     8481
     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  }
     8490
     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);
     8493
     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));
     8496
     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);
     8499
     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);
     8502
     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  }
     8511     
     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);
     8515
     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);
     8518
     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);
     8521
     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  }
     8530
     8531  case C_dyadic_hash(C_CPLXNUM_TYPE_HASH, C_CPLXNUM_TYPE_HASH):
     8532  {
    84698533      C_word real_sum, imag_sum;
    84708534      real_sum = C_s_a_i_plus(ptr, 2, C_u_i_cplxnum_real(x), C_u_i_cplxnum_real(y));
    84718535      imag_sum = C_s_a_i_plus(ptr, 2, C_u_i_cplxnum_imag(x), C_u_i_cplxnum_imag(y));
    84728536      if (C_truep(C_u_i_zerop2(imag_sum))) return real_sum;
    84738537      else return C_cplxnum(ptr, real_sum, imag_sum);
    8474     } else {
    8475       C_word real_sum = C_s_a_i_plus(ptr, 2, C_u_i_cplxnum_real(x), y),
    8476              imag = C_u_i_cplxnum_imag(x);
    8477       if (C_truep(C_u_i_inexactp(real_sum)))
    8478         imag = C_a_i_exact_to_inexact(ptr, 1, imag);
    8479       return C_cplxnum(ptr, real_sum, imag);
    8480     }
    8481   } else {
    8482     barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "+", x);
     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  }
     8551
     8552  default:
     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);
    84838557  }
    84848558}
    84858559
    … … static C_word bignum_minus_unsigned(C_word **ptr, C_word x, C_word y) 
    85938667C_regparm C_word C_fcall
    85948668C_s_a_i_minus(C_word **ptr, C_word n, C_word x, C_word y)
    85958669{
    8596   if (x & C_FIXNUM_BIT) {
    8597     if (y & C_FIXNUM_BIT) {
    8598       return C_a_i_fixnum_difference(ptr, 2, x, y);
    8599     } else if (C_immediatep(y)) {
    8600       barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "-", y);
    8601     } else if (C_block_header(y) == C_FLONUM_TAG) {
    8602       return C_flonum(ptr, (double)C_unfix(x) - C_flonum_magnitude(y));
    8603     } else if (C_truep(C_bignump(y))) {
    8604       return C_s_a_u_i_integer_minus(ptr, 2, x, y);
    8605     } else if (C_block_header(y) == C_RATNUM_TAG) {
    8606       return integer_minus_rat(ptr, x, y);
    8607     } else if (C_block_header(y) == C_CPLXNUM_TAG) {
    8608       C_word real_diff = C_s_a_i_minus(ptr, 2, x, C_u_i_cplxnum_real(y)),
    8609              imag = C_s_a_i_negate(ptr, 1, C_u_i_cplxnum_imag(y));
    8610       if (C_truep(C_u_i_inexactp(real_diff)))
    8611         imag = C_a_i_exact_to_inexact(ptr, 1, imag);
    8612       return C_cplxnum(ptr, real_diff, imag);
    8613     } else {
    8614       barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "-", y);
    8615     }
    8616   } else if (C_immediatep(x)) {
    8617     barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "-", x);
    8618   } else if (C_block_header(x) == C_FLONUM_TAG) {
    8619     if (y & C_FIXNUM_BIT) {
    8620       return C_flonum(ptr, C_flonum_magnitude(x) - (double)C_unfix(y));
    8621     } else if (C_immediatep(y)) {
    8622       barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "-", y);
    8623     } else if (C_block_header(y) == C_FLONUM_TAG) {
    8624       return C_a_i_flonum_difference(ptr, 2, x, y);
    8625     } else if (C_truep(C_bignump(y))) {
    8626       return C_flonum(ptr, C_flonum_magnitude(x)-C_bignum_to_double(y));
    8627     } else if (C_block_header(y) == C_RATNUM_TAG) {
    8628       return C_s_a_i_minus(ptr, 2, x, C_a_i_exact_to_inexact(ptr, 1, y));
    8629     } else if (C_block_header(y) == C_CPLXNUM_TAG) {
    8630       C_word real_diff = C_s_a_i_minus(ptr, 2, x, C_u_i_cplxnum_real(y)),
    8631              imag = C_s_a_i_negate(ptr, 1, C_u_i_cplxnum_imag(y));
    8632       if (C_truep(C_u_i_inexactp(real_diff)))
    8633         imag = C_a_i_exact_to_inexact(ptr, 1, imag);
    8634       return C_cplxnum(ptr, real_diff, imag);
    8635     } else {
    8636       barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "-", y);
    8637     }
    8638   } else if (C_truep(C_bignump(x))) {
    8639     if (y & C_FIXNUM_BIT) {
    8640       return C_s_a_u_i_integer_minus(ptr, 2, x, y);
    8641     } else if (C_immediatep(y)) {
    8642       barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "-", y);
    8643     } else if (C_block_header(y) == C_FLONUM_TAG) {
    8644       return C_flonum(ptr, C_bignum_to_double(x)-C_flonum_magnitude(y));
    8645     } else if (C_truep(C_bignump(y))) {
    8646       return C_s_a_u_i_integer_minus(ptr, 2, x, y);
    8647     } else if (C_block_header(y) == C_RATNUM_TAG) {
    8648       return integer_minus_rat(ptr, x, y);
    8649     } else if (C_block_header(y) == C_CPLXNUM_TAG) {
    8650       C_word real_diff = C_s_a_i_minus(ptr, 2, x, C_u_i_cplxnum_real(y)),
    8651              imag = C_s_a_i_negate(ptr, 1, C_u_i_cplxnum_imag(y));
    8652       if (C_truep(C_u_i_inexactp(real_diff)))
    8653         imag = C_a_i_exact_to_inexact(ptr, 1, imag);
    8654       return C_cplxnum(ptr, real_diff, imag);
    8655     } else {
    8656       barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "-", y);
    8657     }
    8658   } else if (C_block_header(x) == C_RATNUM_TAG) {
    8659     if (y & C_FIXNUM_BIT) {
    8660       return rat_plusmin_integer(ptr, x, y, C_s_a_u_i_integer_minus);
    8661     } else if (C_immediatep(y)) {
    8662       barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "-", y);
    8663     } else if (C_block_header(y) == C_FLONUM_TAG) {
    8664       return C_s_a_i_minus(ptr, 2, C_a_i_exact_to_inexact(ptr, 1, x), y);
    8665     } else if (C_truep(C_bignump(y))) {
    8666       return rat_plusmin_integer(ptr, x, y, C_s_a_u_i_integer_minus);
    8667     } else if (C_block_header(y) == C_RATNUM_TAG) {
    8668       return rat_plusmin_rat(ptr, x, y, C_s_a_u_i_integer_minus);
    8669     } else if (C_block_header(y) == C_CPLXNUM_TAG) {
    8670       C_word real_diff = C_s_a_i_minus(ptr, 2, x, C_u_i_cplxnum_real(y)),
    8671              imag = C_s_a_i_negate(ptr, 1, C_u_i_cplxnum_imag(y));
    8672       if (C_truep(C_u_i_inexactp(real_diff)))
    8673         imag = C_a_i_exact_to_inexact(ptr, 1, imag);
    8674       return C_cplxnum(ptr, real_diff, imag);
    8675     } else {
     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);
     8673
     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));
     8676
     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);
     8679
     8680  case C_dyadic_hash(C_FIXNUM_TYPE_HASH, C_RATNUM_TYPE_HASH):
     8681    return integer_minus_rat(ptr, x, y);
     8682
     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  }
     8691
     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));
     8694
     8695  case C_dyadic_hash(C_FLONUM_TYPE_HASH, C_FLONUM_TYPE_HASH):
     8696    return C_a_i_flonum_difference(ptr, 2, x, y);
     8697
     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));
     8700
     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));
     8703
     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  }
     8712
     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);
     8715
     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));
     8718
     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);
     8721
     8722  case C_dyadic_hash(C_BIGNUM_TYPE_HASH, C_RATNUM_TYPE_HASH):
     8723    return integer_minus_rat(ptr, x, y);
     8724
     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  }
     8733
     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);
     8736
     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);
     8739
     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);
     8742
     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);
     8745
     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  }
     8754
     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  }
     8763
     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  }
     8775
     8776  default:
     8777    if (!C_truep(C_i_numberp(x)))
     8778      barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "-", x);
     8779    else
    86768780      barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "-", y);
    8677     }
    8678   } else if (C_block_header(x) == C_CPLXNUM_TAG) {
    8679     if (!C_immediatep(y) && C_block_header(y) == C_CPLXNUM_TAG) {
    8680       C_word real_diff, imag_diff;
    8681       real_diff = C_s_a_i_minus(ptr,2,C_u_i_cplxnum_real(x),C_u_i_cplxnum_real(y));
    8682       imag_diff = C_s_a_i_minus(ptr,2,C_u_i_cplxnum_imag(x),C_u_i_cplxnum_imag(y));
    8683       if (C_truep(C_u_i_zerop2(imag_diff))) return real_diff;
    8684       else return C_cplxnum(ptr, real_diff, imag_diff);
    8685     } else {
    8686       C_word real_diff = C_s_a_i_minus(ptr, 2, C_u_i_cplxnum_real(x), y),
    8687              imag = C_u_i_cplxnum_imag(x);
    8688       if (C_truep(C_u_i_inexactp(real_diff)))
    8689         imag = C_a_i_exact_to_inexact(ptr, 1, imag);
    8690       return C_cplxnum(ptr, real_diff, imag);
    8691     }
    8692   } else {
    8693     barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "-", x);
    86948781  }
    86958782}
    86968783
    … … static C_word flo_rat_cmp(C_word flonum, C_word ratnum) 
    95999686 */
    96009687static C_word basic_cmp(C_word x, C_word y, char *loc, int eqp)
    96019688{
    9602   if (x & C_FIXNUM_BIT) {
    9603     if (y & C_FIXNUM_BIT) {
    9604       return C_fix((x < y) ? -1 : ((x > y) ? 1 : 0));
    9605     } else if (C_immediatep(y)) {
    9606       barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, loc, y);
    9607     } else if (C_block_header(y) == C_FLONUM_TAG) {
    9608       return int_flo_cmp(x, y);
    9609     } else if (C_truep(C_bignump(y))) {
    9610       C_word ab[C_SIZEOF_FIX_BIGNUM], *a = ab;
    9611       return C_i_bignum_cmp(C_a_u_i_fix_to_big(&a, x), y);
    9612     } else if (C_block_header(y) == C_RATNUM_TAG) {
    9613       if (eqp) return C_SCHEME_FALSE;
    9614       else return rat_cmp(x, y);
    9615     } else if (C_block_header(y) == C_CPLXNUM_TAG) {
    9616       if (eqp) return C_SCHEME_FALSE;
    9617       else barf(C_BAD_ARGUMENT_TYPE_COMPLEX_NO_ORDERING_ERROR, loc, y);
    9618     } else {
    9619       barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, loc, y);
    9620     }
    9621   } else if (C_immediatep(x)) {
    9622     barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, loc, x);
    9623   } else if (C_block_header(x) == C_FLONUM_TAG) {
    9624     if (y & C_FIXNUM_BIT) {
    9625       return flo_int_cmp(x, y);
    9626     } else if (C_immediatep(y)) {
    9627       barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, loc, y);
    9628     } else if (C_block_header(y) == C_FLONUM_TAG) {
    9629       double a = C_flonum_magnitude(x), b = C_flonum_magnitude(y);
    9630       if (C_isnan(a) || C_isnan(b)) return C_SCHEME_FALSE; /* "mu" */
    9631       else return C_fix((a < b) ? -1 : ((a > b) ? 1 : 0));
    9632     } else if (C_truep(C_bignump(y))) {
    9633       return flo_int_cmp(x, y);
    9634     } else if (C_block_header(y) == C_RATNUM_TAG) {
    9635       return flo_rat_cmp(x, y);
    9636     } else if (C_block_header(y) == C_CPLXNUM_TAG) {
    9637       if (eqp) return C_SCHEME_FALSE;
    9638       else barf(C_BAD_ARGUMENT_TYPE_COMPLEX_NO_ORDERING_ERROR, loc, y);
    9639     } else {
    9640       barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, loc, y);
    9641     }
    9642   } else if (C_truep(C_bignump(x))) {
    9643     if (y & C_FIXNUM_BIT) {
    9644       C_word ab[C_SIZEOF_FIX_BIGNUM], *a = ab;
    9645       return C_i_bignum_cmp(x, C_a_u_i_fix_to_big(&a, y));
    9646     } else if (C_immediatep(y)) {
    9647       barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, loc, y);
    9648     } else if (C_block_header(y) == C_FLONUM_TAG) {
    9649       return int_flo_cmp(x, y);
    9650     } else if (C_truep(C_bignump(y))) {
    9651       return C_i_bignum_cmp(x, y);
    9652     } else if (C_block_header(y) == C_RATNUM_TAG) {
    9653       if (eqp) return C_SCHEME_FALSE;
    9654       else return rat_cmp(x, y);
    9655     } else if (C_block_header(y) == C_CPLXNUM_TAG) {
    9656       if (eqp) return C_SCHEME_FALSE;
    9657       else barf(C_BAD_ARGUMENT_TYPE_COMPLEX_NO_ORDERING_ERROR, loc, y);
    9658     } else {
    9659       barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, loc, y);
    9660     }
    9661   } else if (C_block_header(x) == C_RATNUM_TAG) {
    9662     if (y & C_FIXNUM_BIT) {
    9663       if (eqp) return C_SCHEME_FALSE;
    9664       else return rat_cmp(x, y);
    9665     } else if (C_immediatep(y)) {
    9666       barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, loc, y);
    9667     } else if (C_block_header(y) == C_FLONUM_TAG) {
    9668       return rat_flo_cmp(x, y);
    9669     } else if (C_truep(C_bignump(y))) {
    9670       if (eqp) return C_SCHEME_FALSE;
    9671       else return rat_cmp(x, y);
    9672     } else if (C_block_header(y) == C_RATNUM_TAG) {
    9673       if (eqp) {
    9674         return C_and(C_and(C_i_integer_equalp(C_u_i_ratnum_num(x),
    9675                                               C_u_i_ratnum_num(y)),
    9676                            C_i_integer_equalp(C_u_i_ratnum_denom(x),
    9677                                               C_u_i_ratnum_denom(y))),
    9678                      C_fix(0));
    9679       } else {
    9680         return rat_cmp(x, y);
    9681       }
    9682     } else if (C_block_header(y) == C_CPLXNUM_TAG) {
    9683       if (eqp) return C_SCHEME_FALSE;
    9684       else barf(C_BAD_ARGUMENT_TYPE_COMPLEX_NO_ORDERING_ERROR, loc, y);
     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));
     9692
     9693  case C_dyadic_hash(C_FIXNUM_TYPE_HASH, C_FLONUM_TYPE_HASH):
     9694    return int_flo_cmp(x, y);
     9695
     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  }
     9701
     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);
     9705
     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);
     9709
     9710
     9711  case C_dyadic_hash(C_FLONUM_TYPE_HASH, C_FIXNUM_TYPE_HASH):
     9712    return flo_int_cmp(x, y);
     9713
     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  }
     9720
     9721  case C_dyadic_hash(C_FLONUM_TYPE_HASH, C_BIGNUM_TYPE_HASH):
     9722    return flo_int_cmp(x, y);
     9723
     9724  case C_dyadic_hash(C_FLONUM_TYPE_HASH, C_RATNUM_TYPE_HASH):
     9725    return flo_rat_cmp(x, y);
     9726
     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);
     9730
     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  }
     9736
     9737  case C_dyadic_hash(C_BIGNUM_TYPE_HASH, C_FLONUM_TYPE_HASH):
     9738    return int_flo_cmp(x, y);
     9739
     9740  case C_dyadic_hash(C_BIGNUM_TYPE_HASH, C_BIGNUM_TYPE_HASH):
     9741    return C_i_bignum_cmp(x, y);
     9742
     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);
     9746
     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);
     9750
     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);
     9754
     9755  case C_dyadic_hash(C_RATNUM_TYPE_HASH, C_FLONUM_TYPE_HASH):
     9756    return rat_flo_cmp(x, y);
     9757
     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);
     9761
     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));
    96859769    } else {
    9686       barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, loc, y);
     9770      return rat_cmp(x, y);
    96879771    }
    9688   } else if (C_block_header(x) == C_CPLXNUM_TAG) {
    9689     if (!eqp) {
     9772
     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):
     9782    if (!eqp)
    96909783      barf(C_BAD_ARGUMENT_TYPE_COMPLEX_NO_ORDERING_ERROR, loc, x);
    9691     } else if (y & C_FIXNUM_BIT) {
    9692       return C_SCHEME_FALSE;
    9693     } else if (C_immediatep(y)) {
    9694       barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, loc, y);
    9695     } else if (C_block_header(y) == C_FLONUM_TAG ||
    9696                C_truep(C_bignump(x)) ||
    9697                C_block_header(y) == C_RATNUM_TAG) {
     9784    else
    96989785      return C_SCHEME_FALSE;
    9699     } else if (C_block_header(y) == C_CPLXNUM_TAG) {
     9786
     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
    97009791      return C_and(C_and(C_i_nequalp(C_u_i_cplxnum_real(x), C_u_i_cplxnum_real(y)),
    97019792                         C_i_nequalp(C_u_i_cplxnum_imag(x), C_u_i_cplxnum_imag(y))),
    97029793                   C_fix(0));
    9703     } else {
     9794
     9795  default:
     9796    if (!C_truep(C_i_numberp(x)))
     9797      barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, loc, x);
     9798    else
    97049799      barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, loc, y);
    9705     }
    9706   } else {
    9707     barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, loc, x);
    97089800  }
    97099801}
    97109802
    … … void C_ccall C_string_to_keyword(C_word c, C_word *av) 
    1058210674C_regparm C_word C_fcall
    1058310675C_a_i_exact_to_inexact(C_word **ptr, int c, C_word n)
    1058410676{
    10585   if (n & C_FIXNUM_BIT) {
     10677  switch(C_type_hash(n)) {
     10678  case C_FIXNUM_TYPE_HASH:
    1058610679    return C_flonum(ptr, (double)C_unfix(n));
    10587   } else if (C_immediatep(n)) {
    10588     barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "exact->inexact", n);
    10589   } else if (C_block_header(n) == C_FLONUM_TAG) {
     10680
     10681  case C_FLONUM_TYPE_HASH:
    1059010682    return n;
    10591   } else if (C_truep(C_bignump(n))) {
     10683
     10684  case C_BIGNUM_TYPE_HASH:
    1059210685    return C_a_u_i_big_to_flo(ptr, c, n);
    10593   } else if (C_block_header(n) == C_CPLXNUM_TAG) {
     10686
     10687  case C_CPLXNUM_TYPE_HASH:
    1059410688    return C_cplxnum(ptr, C_a_i_exact_to_inexact(ptr, 1, C_u_i_cplxnum_real(n)),
    1059510689                     C_a_i_exact_to_inexact(ptr, 1, C_u_i_cplxnum_imag(n)));
     10690
    1059610691  /* The horribly painful case: ratnums */
    10597   } else if (C_block_header(n) == C_RATNUM_TAG) {
     10692  case C_RATNUM_TYPE_HASH:
     10693  {
    1059810694    /* This tries to keep the numbers within representable ranges and
    1059910695     * tries to drop as few significant digits as possible by bringing
    1060010696     * the two numbers to within the same powers of two.  See
    … … C_a_i_exact_to_inexact(C_word **ptr, int c, C_word n) 
    1066610762     shift_amount = nmin(DBL_MANT_DIG-1, e - (DBL_MIN_EXP - DBL_MANT_DIG));
    1066710763     res = ldexp(fraction, e - shift_amount);
    1066810764     return C_flonum(ptr, C_truep(negp) ? -res : res);
    10669   } else {
     10765  }
     10766
     10767  default:
    1067010768    barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "exact->inexact", n);
    1067110769  }
    1067210770}
    … … static char *to_n_nary(C_uword num, C_uword base, int negp, int as_flonum) 
    1100911107void C_ccall C_number_to_string(C_word c, C_word *av)
    1101011108{
    1101111109  C_word radix, num;
     11110  C_word k = av[ 1 ];
    1101211111
    1101311112  if(c == 3) {
    1101411113    radix = C_fix(10);
    … … void C_ccall C_number_to_string(C_word c, C_word *av) 
    1102211121
    1102311122  num = av[ 2 ];
    1102411123
    11025   if(num & C_FIXNUM_BIT) {
     11124  switch(C_type_hash(num)) {
     11125  case C_FIXNUM_TYPE_HASH:
    1102611126    C_fixnum_to_string(c, av); /* reuse av */
    11027   } else if (C_immediatep(num)) {
    11028     barf(C_BAD_ARGUMENT_TYPE_ERROR, "number->string", num);
    11029   } else if(C_block_header(num) == C_FLONUM_TAG) {
     11127
     11128  case C_FLONUM_TYPE_HASH:
    1103011129    C_flonum_to_string(c, av); /* reuse av */
    11031   } else if (C_truep(C_bignump(num))) {
     11130
     11131  case C_BIGNUM_TYPE_HASH:
    1103211132    C_integer_to_string(c, av); /* reuse av */
    11033   } else {
    11034     C_word k = av[ 1 ];
     11133
     11134  case C_RATNUM_TYPE_HASH:
     11135  case C_CPLXNUM_TYPE_HASH:
    1103511136    try_extended_number("##sys#extended-number->string", 3, k, num, radix);
     11137
     11138  default:
     11139    barf(C_BAD_ARGUMENT_TYPE_ERROR, "number->string", num);
    1103611140  }
    1103711141}
    1103811142