Ticket #1773: numeric-type-hash-switches.patch

File numeric-type-hash-switches.patch, 40.1 KB (added by sjamaan, 4 months ago)

Initial version of switch-based numeric type dispatch

  • runtime.c

    diff --git a/runtime.c b/runtime.c
    index 93dd9d29..cf7351e7 100644
    a b static C_TLS int timezone; 
    269269#define C_thread_id(x)   C_block_item((x), 14)
    270270
    271271
     272/* A numeric type hash packs the type bits into the bottom 12 bits (regardless of immediate/block type). */
     273/* 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))
     275
     276/* We only care about numeric type hashes currently */
     277#define C_FIXNUM_TYPE_HASH           C_FIXNUM_BIT
     278#define C_FLONUM_TYPE_HASH           C_FLONUM_TYPE
     279#define C_BIGNUM_TYPE_HASH           C_BIGNUM_TYPE
     280#define C_RATNUM_TYPE_HASH           C_RATNUM_TYPE
     281#define C_CPLXNUM_TYPE_HASH          C_CPLXNUM_TYPE
     282
     283
    272284/* Type definitions: */
    273285
    274286typedef 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) 
    52875299
    52885300C_regparm C_word C_fcall C_i_nanp(C_word x)
    52895301{
    5290   if (x & C_FIXNUM_BIT) {
     5302  switch(C_type_hash(x)) {
     5303  case C_FIXNUM_TYPE_HASH:
     5304  case C_BIGNUM_TYPE_HASH:
     5305  case C_RATNUM_TYPE_HASH:
    52915306    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) {
     5307
     5308  case C_FLONUM_TYPE_HASH:
    52955309    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) {
     5310
     5311  case C_CPLXNUM_TYPE_HASH:
    53015312    return C_mk_bool(C_truep(C_i_nanp(C_u_i_cplxnum_real(x))) ||
    53025313                     C_truep(C_i_nanp(C_u_i_cplxnum_imag(x))));
    5303   } else {
     5314
     5315  default:
    53045316    barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "nan?", x);
    53055317  }
    53065318}
    53075319
    53085320C_regparm C_word C_fcall C_i_finitep(C_word x)
    53095321{
    5310   if (x & C_FIXNUM_BIT) {
     5322  switch(C_type_hash(x)) {
     5323  case C_FIXNUM_TYPE_HASH:
     5324  case C_BIGNUM_TYPE_HASH:
     5325  case C_RATNUM_TYPE_HASH:
    53115326    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) {
     5327
     5328  case C_FLONUM_TYPE_HASH:
    53155329    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) {
     5330
     5331  case C_CPLXNUM_TYPE_HASH:
    53215332    return C_and(C_i_finitep(C_u_i_cplxnum_real(x)),
    53225333                 C_i_finitep(C_u_i_cplxnum_imag(x)));
    5323   } else {
     5334
     5335  default:
    53245336    barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "finite?", x);
    53255337  }
    53265338}
    53275339
    53285340C_regparm C_word C_fcall C_i_infinitep(C_word x)
    53295341{
    5330   if (x & C_FIXNUM_BIT) {
     5342  switch(C_type_hash(x)) {
     5343  case C_FIXNUM_TYPE_HASH:
     5344  case C_BIGNUM_TYPE_HASH:
     5345  case C_RATNUM_TYPE_HASH:
    53315346    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) {
     5347
     5348  case C_FLONUM_TYPE_HASH:
    53355349    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) {
     5350
     5351  case C_CPLXNUM_TYPE_HASH:
    53415352    return C_mk_bool(C_truep(C_i_infinitep(C_u_i_cplxnum_real(x))) ||
    53425353                     C_truep(C_i_infinitep(C_u_i_cplxnum_imag(x))));
    5343   } else {
     5354
     5355  default:
    53445356    barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "infinite?", x);
    53455357  }
    53465358}
    53475359
    53485360C_regparm C_word C_fcall C_i_exactp(C_word x)
    53495361{
    5350   if (x & C_FIXNUM_BIT) {
     5362  switch(C_type_hash(x)) {
     5363  case C_FIXNUM_TYPE_HASH:
     5364  case C_BIGNUM_TYPE_HASH:
     5365  case C_RATNUM_TYPE_HASH:
    53515366    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) {
     5367
     5368  case C_FLONUM_TYPE_HASH:
    53555369    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) {
     5370
     5371  case C_CPLXNUM_TYPE_HASH:
    53615372    return C_i_exactp(C_u_i_cplxnum_real(x)); /* Exactness of i and r matches */
    5362   } else {
     5373
     5374  default:
    53635375    barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "exact?", x);
    53645376  }
    53655377}
    C_regparm C_word C_fcall C_i_exactp(C_word x) 
    53675379
    53685380C_regparm C_word C_fcall C_i_inexactp(C_word x)
    53695381{
    5370   if (x & C_FIXNUM_BIT) {
     5382  switch(C_type_hash(x)) {
     5383  case C_FIXNUM_TYPE_HASH:
     5384  case C_BIGNUM_TYPE_HASH:
     5385  case C_RATNUM_TYPE_HASH:
    53715386    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) {
     5387
     5388  case C_FLONUM_TYPE_HASH:
    53755389    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) {
     5390
     5391  case C_CPLXNUM_TYPE_HASH:
    53815392    return C_i_inexactp(C_u_i_cplxnum_real(x)); /* Exactness of i and r matches */
    5382   } else {
     5393
     5394  default:
    53835395    barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "inexact?", x);
    53845396  }
    53855397}
    C_regparm C_word C_fcall C_i_inexactp(C_word x) 
    53875399
    53885400C_regparm C_word C_fcall C_i_zerop(C_word x)
    53895401{
    5390   if (x & C_FIXNUM_BIT) {
     5402  switch(C_type_hash(x)) {
     5403  case C_FIXNUM_TYPE_HASH:
    53915404    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) {
     5405
     5406  case C_FLONUM_TYPE_HASH:
    53955407    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) {
     5408
     5409  case C_BIGNUM_TYPE_HASH:
     5410  case C_RATNUM_TYPE_HASH:
     5411  case C_CPLXNUM_TYPE_HASH:
    53995412    return C_SCHEME_FALSE;
    5400   } else {
     5413
     5414  default:
    54015415    barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "zero?", x);
    54025416  }
    54035417}
    C_regparm C_word C_fcall C_u_i_zerop(C_word x) 
    54145428
    54155429C_regparm C_word C_fcall C_i_positivep(C_word x)
    54165430{
    5417   if (x & C_FIXNUM_BIT)
     5431  switch(C_type_hash(x)) {
     5432  case C_FIXNUM_TYPE_HASH:
    54185433    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)
     5434
     5435  case C_FLONUM_TYPE_HASH:
    54225436    return C_mk_bool(C_flonum_magnitude(x) > 0.0);
    5423   else if (C_truep(C_bignump(x)))
     5437
     5438  case C_BIGNUM_TYPE_HASH:
    54245439    return C_mk_nbool(C_bignum_negativep(x));
    5425   else if (C_block_header(x) == C_RATNUM_TAG)
     5440
     5441  case C_RATNUM_TYPE_HASH:
    54265442    return C_i_integer_positivep(C_u_i_ratnum_num(x));
    5427   else if (C_block_header(x) == C_CPLXNUM_TAG)
     5443
     5444  case C_CPLXNUM_TYPE_HASH:
    54285445    barf(C_BAD_ARGUMENT_TYPE_NO_REAL_ERROR, "positive?", x);
    5429   else
     5446
     5447  default:
    54305448    barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "positive?", x);
     5449  }
    54315450}
    54325451
    54335452C_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) 
    54385457
    54395458C_regparm C_word C_fcall C_i_negativep(C_word x)
    54405459{
    5441   if (x & C_FIXNUM_BIT)
     5460  switch(C_type_hash(x)) {
     5461  case C_FIXNUM_TYPE_HASH:
    54425462    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)
     5463
     5464  case C_FLONUM_TYPE_HASH:
    54465465    return C_mk_bool(C_flonum_magnitude(x) < 0.0);
    5447   else if (C_truep(C_bignump(x)))
     5466
     5467  case C_BIGNUM_TYPE_HASH:
    54485468    return C_mk_bool(C_bignum_negativep(x));
    5449   else if (C_block_header(x) == C_RATNUM_TAG)
     5469
     5470  case C_RATNUM_TYPE_HASH:
    54505471    return C_i_integer_negativep(C_u_i_ratnum_num(x));
    5451   else if (C_block_header(x) == C_CPLXNUM_TAG)
     5472
     5473  case C_CPLXNUM_TYPE_HASH:
    54525474    barf(C_BAD_ARGUMENT_TYPE_NO_REAL_ERROR, "negative?", x);
    5453   else
     5475
     5476  default:
    54545477    barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "negative?", x);
     5478  }
    54555479}
    54565480
    54575481
    C_regparm C_word C_fcall C_i_integer_negativep(C_word x) 
    54645488
    54655489C_regparm C_word C_fcall C_i_evenp(C_word x)
    54665490{
    5467   if(x & C_FIXNUM_BIT) {
     5491  switch(C_type_hash(x)) {
     5492  case C_FIXNUM_TYPE_HASH:
    54685493    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) {
     5494
     5495  case C_FLONUM_TYPE_HASH:
     5496  {
    54725497    double val, dummy;
    54735498    val = C_flonum_magnitude(x);
    54745499    if(C_isnan(val) || C_isinf(val) || C_modf(val, &dummy) != 0.0)
    54755500      barf(C_BAD_ARGUMENT_TYPE_NO_INTEGER_ERROR, "even?", x);
    54765501    else
    54775502      return C_mk_bool(fmod(val, 2.0) == 0.0);
    5478   } else if (C_truep(C_bignump(x))) {
     5503  }
     5504
     5505  case C_BIGNUM_TYPE_HASH:
    54795506    return C_mk_nbool(C_bignum_digits(x)[0] & 1);
    5480   } else { /* No need to try extended number */
     5507
     5508  default:
    54815509    barf(C_BAD_ARGUMENT_TYPE_NO_INTEGER_ERROR, "even?", x);
    54825510  }
    54835511}
    C_regparm C_word C_fcall C_i_integer_evenp(C_word x) 
    54915519
    54925520C_regparm C_word C_fcall C_i_oddp(C_word x)
    54935521{
    5494   if(x & C_FIXNUM_BIT) {
     5522  switch(C_type_hash(x)) {
     5523  case C_FIXNUM_TYPE_HASH:
    54955524    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) {
     5525
     5526  case C_FLONUM_TYPE_HASH:
     5527  {
    54995528    double val, dummy;
    55005529    val = C_flonum_magnitude(x);
    55015530    if(C_isnan(val) || C_isinf(val) || C_modf(val, &dummy) != 0.0)
    55025531      barf(C_BAD_ARGUMENT_TYPE_NO_INTEGER_ERROR, "odd?", x);
    55035532    else
    55045533      return C_mk_bool(fmod(val, 2.0) != 0.0);
    5505   } else if (C_truep(C_bignump(x))) {
     5534  }
     5535
     5536  case C_BIGNUM_TYPE_HASH:
    55065537    return C_mk_bool(C_bignum_digits(x)[0] & 1);
    5507   } else {
     5538
     5539  default:
    55085540    barf(C_BAD_ARGUMENT_TYPE_NO_INTEGER_ERROR, "odd?", x);
    55095541  }
    55105542}
    C_regparm C_word C_fcall C_i_f64vector_set(C_word v, C_word i, C_word x) 
    64006432C_regparm C_word C_fcall
    64016433C_s_a_i_abs(C_word **ptr, C_word n, C_word x)
    64026434{
    6403   if (x & C_FIXNUM_BIT) {
     6435  switch(C_type_hash(x)) {
     6436  case C_FIXNUM_TYPE_HASH:
    64046437    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) {
     6438
     6439  case C_FLONUM_TYPE_HASH:
    64086440    return C_a_i_flonum_abs(ptr, 1, x);
    6409   } else if (C_truep(C_bignump(x))) {
     6441
     6442  case C_BIGNUM_TYPE_HASH:
    64106443    return C_s_a_u_i_integer_abs(ptr, 1, x);
    6411   } else if (C_block_header(x) == C_RATNUM_TAG) {
     6444
     6445  case C_RATNUM_TYPE_HASH:
    64126446    return C_ratnum(ptr, C_s_a_u_i_integer_abs(ptr, 1, C_u_i_ratnum_num(x)),
    64136447                    C_u_i_ratnum_denom(x));
    6414   } else if (C_block_header(x) == C_CPLXNUM_TAG) {
     6448
     6449  case C_CPLXNUM_TYPE_HASH:
    64156450    barf(C_BAD_ARGUMENT_TYPE_COMPLEX_ABS, "abs", x);
    6416   } else {
     6451
     6452  default:
    64176453    barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "abs", x);
    64186454  }
    64196455}
    void C_ccall C_signum(C_word c, C_word *av) 
    64276463  x = av[ 2 ];
    64286464  y = av[ 3 ];
    64296465
    6430   if (x & C_FIXNUM_BIT) {
     6466  switch(C_type_hash(x)) {
     6467  case C_FIXNUM_TYPE_HASH:
    64316468    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) {
     6469
     6470  case C_FLONUM_TYPE_HASH:
     6471  {
    64356472    C_word *a = C_alloc(C_SIZEOF_FLONUM);
    64366473    C_kontinue(k, C_a_u_i_flonum_signum(&a, 1, x));
    6437   } else if (C_truep(C_bignump(x))) {
     6474  }
     6475 
     6476  case C_BIGNUM_TYPE_HASH:
    64386477    C_kontinue(k, C_bignum_negativep(x) ? C_fix(-1) : C_fix(1));
    6439   } else {
     6478
     6479  case C_RATNUM_TYPE_HASH:
     6480  case C_CPLXNUM_TYPE_HASH:
    64406481    try_extended_number("##sys#extended-signum", 2, k, x);
     6482
     6483  default:
     6484    barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "signum", x);
    64416485  }
    64426486}
    64436487
    void C_ccall C_signum(C_word c, C_word *av) 
    64496493C_regparm C_word C_fcall
    64506494C_s_a_i_negate(C_word **ptr, C_word n, C_word x)
    64516495{
    6452   if (x & C_FIXNUM_BIT) {
     6496  switch(C_type_hash(x)) {
     6497  case C_FIXNUM_TYPE_HASH:
    64536498    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) {
     6499
     6500  case C_FLONUM_TYPE_HASH:
    64576501    return C_a_i_flonum_negate(ptr, 1, x);
    6458   } else if (C_truep(C_bignump(x))) {
     6502
     6503  case C_BIGNUM_TYPE_HASH:
    64596504    return C_s_a_u_i_integer_negate(ptr, 1, x);
    6460   } else if (C_block_header(x) == C_RATNUM_TAG) {
     6505
     6506  case C_RATNUM_TYPE_HASH:
    64616507    return C_ratnum(ptr, C_s_a_u_i_integer_negate(ptr, 1, C_u_i_ratnum_num(x)),
    64626508                    C_u_i_ratnum_denom(x));
    6463   } else if (C_block_header(x) == C_CPLXNUM_TAG) {
     6509
     6510  case C_CPLXNUM_TYPE_HASH:
    64646511    return C_cplxnum(ptr, C_s_a_i_negate(ptr, 1, C_u_i_cplxnum_real(x)),
    64656512                     C_s_a_i_negate(ptr, 1, C_u_i_cplxnum_imag(x)));
    6466   } else {
     6513
     6514  default:
    64676515    barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "-", x);
    64686516  }
    64696517}
    cplx_times(C_word **ptr, C_word rx, C_word ix, C_word ry, C_word iy) 
    79878035C_regparm C_word C_fcall
    79888036C_s_a_i_times(C_word **ptr, C_word n, C_word x, C_word y)
    79898037{
    7990   if (x & C_FIXNUM_BIT) {
    7991     if (y & C_FIXNUM_BIT) {
     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:
    79928042      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) {
     8043
     8044    case C_FLONUM_TYPE_HASH:
    79968045      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)) {
    8031       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))) {
     8046
     8047    case C_BIGNUM_TYPE_HASH:
    80358048      return C_s_a_u_i_integer_times(ptr, 2, x, y);
    8036     } else if (C_block_header(y) == C_RATNUM_TAG) {
     8049
     8050    case C_RATNUM_TYPE_HASH:
    80378051      return rat_times_integer(ptr, y, x);
    8038     } else if (C_block_header(y) == C_CPLXNUM_TAG) {
     8052
     8053    case C_CPLXNUM_TYPE_HASH:
    80398054      return cplx_times(ptr, x, C_fix(0),
    80408055                        C_u_i_cplxnum_real(y), C_u_i_cplxnum_imag(y));
    8041     } else {
     8056
     8057    default:
    80428058      barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "*", y);
    80438059    }
    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) {
     8060
     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));
     8065
     8066      case C_FLONUM_TYPE_HASH:
     8067        return C_a_i_flonum_times(ptr, 2, x, y);
     8068
     8069      case C_BIGNUM_TYPE_HASH:
     8070        return C_flonum(ptr, C_flonum_magnitude(x) * C_bignum_to_double(y));
     8071
     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      }
     8081
     8082      default:
     8083        barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "*", y);
     8084      }
     8085
     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);
     8090
     8091      case C_FLONUM_TYPE_HASH:
     8092        return C_flonum(ptr, C_bignum_to_double(x) * C_flonum_magnitude(y));
     8093
     8094      case C_BIGNUM_TYPE_HASH:
     8095        return C_s_a_u_i_integer_times(ptr, 2, x, y);
     8096
     8097      case C_RATNUM_TYPE_HASH:
     8098        return rat_times_integer(ptr, y, x);
     8099
     8100      case C_CPLXNUM_TYPE_HASH:
     8101        return cplx_times(ptr, x, C_fix(0),
     8102                          C_u_i_cplxnum_real(y), C_u_i_cplxnum_imag(y));
     8103
     8104      default:
     8105        barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "*", y);
     8106      }
     8107
     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);
     8112
     8113      case C_FLONUM_TYPE_HASH:
     8114        return C_s_a_i_times(ptr, 2, C_a_i_exact_to_inexact(ptr, 1, x), y);
     8115
     8116      case C_BIGNUM_TYPE_HASH:
     8117        return rat_times_integer(ptr, x, y);
     8118
     8119      case C_RATNUM_TYPE_HASH:
    80548120        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 {
    8059       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 {
     8121
     8122      case C_CPLXNUM_TYPE_HASH:
     8123        return cplx_times(ptr, x, C_fix(0),
     8124                          C_u_i_cplxnum_real(y), C_u_i_cplxnum_imag(y));
     8125
     8126      default:
     8127        barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "*", y);
     8128      }
     8129
     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        C_word ab[C_SIZEOF_FLONUM], *a = ab, yi;
     8136        yi = C_truep(C_i_flonump(y)) ? C_flonum(&a,0) : C_fix(0);
     8137        return cplx_times(ptr, C_u_i_ratnum_num(x), C_u_i_ratnum_denom(x), y, yi);
     8138      }
     8139
     8140  default:
    80718141    barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "*", x);
    80728142  }
    80738143}
    static C_word rat_plusmin_rat(C_word **ptr, C_word x, C_word y, integer_plusmin_ 
    83828452C_regparm C_word C_fcall
    83838453C_s_a_i_plus(C_word **ptr, C_word n, C_word x, C_word y)
    83848454{
    8385   if (x & C_FIXNUM_BIT) {
    8386     if (y & C_FIXNUM_BIT) {
     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:
    83878459      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) {
     8460
     8461    case C_FLONUM_TYPE_HASH:
    83918462      return C_flonum(ptr, (double)C_unfix(x) + C_flonum_magnitude(y));
    8392     } else if (C_truep(C_bignump(y))) {
     8463
     8464    case C_BIGNUM_TYPE_HASH:
    83938465      return C_s_a_u_i_integer_plus(ptr, 2, x, y);
    8394     } else if (C_block_header(y) == C_RATNUM_TAG) {
     8466
     8467    case C_RATNUM_TYPE_HASH:
    83958468      return rat_plusmin_integer(ptr, y, x, C_s_a_u_i_integer_plus);
    8396     } else if (C_block_header(y) == C_CPLXNUM_TAG) {
     8469
     8470    case C_CPLXNUM_TYPE_HASH:
     8471    {
    83978472      C_word real_sum = C_s_a_i_plus(ptr, 2, x, C_u_i_cplxnum_real(y)),
    83988473             imag = C_u_i_cplxnum_imag(y);
    83998474      if (C_truep(C_u_i_inexactp(real_sum)))
    84008475        imag = C_a_i_exact_to_inexact(ptr, 1, imag);
    84018476      return C_cplxnum(ptr, real_sum, imag);
    8402     } else {
    8403       barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "+", y);
    84048477    }
    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 {
     8478
     8479    default:
    84258480      barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "+", y);
    84268481    }
    8427   } else if (C_truep(C_bignump(x))) {
    8428     if (y & C_FIXNUM_BIT) {
     8482
     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));
     8487
     8488      case C_FLONUM_TYPE_HASH:
     8489        return C_a_i_flonum_plus(ptr, 2, x, y);
     8490
     8491      case C_BIGNUM_TYPE_HASH:
     8492        return C_flonum(ptr, C_flonum_magnitude(x)+C_bignum_to_double(y));
     8493
     8494      case C_RATNUM_TYPE_HASH:
     8495        return C_s_a_i_plus(ptr, 2, x, C_a_i_exact_to_inexact(ptr, 1, y));
     8496
     8497      case C_CPLXNUM_TYPE_HASH:
     8498      {
     8499        C_word real_sum = C_s_a_i_plus(ptr, 2, x, C_u_i_cplxnum_real(y)),
     8500          imag = C_u_i_cplxnum_imag(y);
     8501        if (C_truep(C_u_i_inexactp(real_sum)))
     8502          imag = C_a_i_exact_to_inexact(ptr, 1, imag);
     8503        return C_cplxnum(ptr, real_sum, imag);
     8504      }
     8505
     8506      default:
     8507        barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "+", y);
     8508    }
     8509
     8510  case C_BIGNUM_TYPE_HASH:
     8511    switch(C_type_hash(y)) {
     8512    case C_FIXNUM_TYPE_HASH:
    84298513      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) {
     8514    case C_FLONUM_TYPE_HASH:
    84338515      return C_flonum(ptr, C_bignum_to_double(x)+C_flonum_magnitude(y));
    8434     } else if (C_truep(C_bignump(y))) {
     8516
     8517    case C_BIGNUM_TYPE_HASH:
    84358518      return C_s_a_u_i_integer_plus(ptr, 2, x, y);
    8436     } else if (C_block_header(y) == C_RATNUM_TAG) {
     8519
     8520    case C_RATNUM_TYPE_HASH:
    84378521      return rat_plusmin_integer(ptr, y, x, C_s_a_u_i_integer_plus);
    8438     } else if (C_block_header(y) == C_CPLXNUM_TAG) {
     8522
     8523    case C_CPLXNUM_TYPE_HASH:
     8524    {
    84398525      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);
     8526        imag = C_u_i_cplxnum_imag(y);
    84418527      if (C_truep(C_u_i_inexactp(real_sum)))
    84428528        imag = C_a_i_exact_to_inexact(ptr, 1, imag);
    84438529      return C_cplxnum(ptr, real_sum, imag);
    8444     } else {
     8530    }
     8531     
     8532    default:
    84458533      barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "+", y);
    84468534    }
    8447   } else if (C_block_header(x) == C_RATNUM_TAG) {
    8448     if (y & C_FIXNUM_BIT) {
     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:
    84498540      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) {
     8541
     8542    case C_FLONUM_TYPE_HASH:
    84538543      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) {
     8544
     8545    case C_RATNUM_TYPE_HASH:
    84578546      return rat_plusmin_rat(ptr, x, y, C_s_a_u_i_integer_plus);
    8458     } else if (C_block_header(y) == C_CPLXNUM_TAG) {
     8547
     8548    case C_CPLXNUM_TYPE_HASH:
     8549    {
    84598550      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);
     8551        imag = C_u_i_cplxnum_imag(y);
    84618552      if (C_truep(C_u_i_inexactp(real_sum)))
    84628553        imag = C_a_i_exact_to_inexact(ptr, 1, imag);
    84638554      return C_cplxnum(ptr, real_sum, imag);
    8464     } else {
     8555    }
     8556
     8557    default:
    84658558      barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "+", y);
    84668559    }
    8467   } else if (C_block_header(x) == C_CPLXNUM_TAG) {
     8560
     8561  case C_CPLXNUM_TYPE_HASH:
    84688562    if (!C_immediatep(y) && C_block_header(y) == C_CPLXNUM_TAG) {
    84698563      C_word real_sum, imag_sum;
    84708564      real_sum = C_s_a_i_plus(ptr, 2, C_u_i_cplxnum_real(x), C_u_i_cplxnum_real(y));
    C_s_a_i_plus(C_word **ptr, C_word n, C_word x, C_word y) 
    84738567      else return C_cplxnum(ptr, real_sum, imag_sum);
    84748568    } else {
    84758569      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);
     8570        imag = C_u_i_cplxnum_imag(x);
    84778571      if (C_truep(C_u_i_inexactp(real_sum)))
    84788572        imag = C_a_i_exact_to_inexact(ptr, 1, imag);
    84798573      return C_cplxnum(ptr, real_sum, imag);
    84808574    }
    8481   } else {
     8575
     8576  default:
    84828577    barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "+", x);
    84838578  }
    84848579}
    static C_word bignum_minus_unsigned(C_word **ptr, C_word x, C_word y) 
    85938688C_regparm C_word C_fcall
    85948689C_s_a_i_minus(C_word **ptr, C_word n, C_word x, C_word y)
    85958690{
    8596   if (x & C_FIXNUM_BIT) {
    8597     if (y & C_FIXNUM_BIT) {
     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:
    85988695      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) {
     8696
     8697    case C_FLONUM_TYPE_HASH:
    86028698      return C_flonum(ptr, (double)C_unfix(x) - C_flonum_magnitude(y));
    8603     } else if (C_truep(C_bignump(y))) {
     8699
     8700    case C_BIGNUM_TYPE_HASH:
    86048701      return C_s_a_u_i_integer_minus(ptr, 2, x, y);
    8605     } else if (C_block_header(y) == C_RATNUM_TAG) {
     8702
     8703    case C_RATNUM_TYPE_HASH:
    86068704      return integer_minus_rat(ptr, x, y);
    8607     } else if (C_block_header(y) == C_CPLXNUM_TAG) {
     8705
     8706    case C_CPLXNUM_TYPE_HASH:
     8707    {
    86088708      C_word real_diff = C_s_a_i_minus(ptr, 2, x, C_u_i_cplxnum_real(y)),
    86098709             imag = C_s_a_i_negate(ptr, 1, C_u_i_cplxnum_imag(y));
    86108710      if (C_truep(C_u_i_inexactp(real_diff)))
    86118711        imag = C_a_i_exact_to_inexact(ptr, 1, imag);
    86128712      return C_cplxnum(ptr, real_diff, imag);
    8613     } else {
     8713    }
     8714
     8715    default:
    86148716      barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "-", y);
    86158717    }
    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) {
     8718
     8719  case C_FLONUM_TYPE_HASH:
     8720    switch(C_type_hash(y)) {
     8721    case C_FIXNUM_TYPE_HASH:
    86208722      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) {
     8723
     8724    case C_FLONUM_TYPE_HASH:
    86248725      return C_a_i_flonum_difference(ptr, 2, x, y);
    8625     } else if (C_truep(C_bignump(y))) {
     8726
     8727    case C_BIGNUM_TYPE_HASH:
    86268728      return C_flonum(ptr, C_flonum_magnitude(x)-C_bignum_to_double(y));
    8627     } else if (C_block_header(y) == C_RATNUM_TAG) {
     8729
     8730    case C_RATNUM_TYPE_HASH:
    86288731      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) {
     8732
     8733    case C_CPLXNUM_TYPE_HASH:
     8734    {
    86308735      C_word real_diff = C_s_a_i_minus(ptr, 2, x, C_u_i_cplxnum_real(y)),
    86318736             imag = C_s_a_i_negate(ptr, 1, C_u_i_cplxnum_imag(y));
    86328737      if (C_truep(C_u_i_inexactp(real_diff)))
    86338738        imag = C_a_i_exact_to_inexact(ptr, 1, imag);
    86348739      return C_cplxnum(ptr, real_diff, imag);
    8635     } else {
     8740    }
     8741
     8742    default:
    86368743      barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "-", y);
    86378744    }
    8638   } else if (C_truep(C_bignump(x))) {
    8639     if (y & C_FIXNUM_BIT) {
     8745
     8746  case C_BIGNUM_TYPE_HASH:
     8747    switch(C_type_hash(y)) {
     8748    case C_FIXNUM_TYPE_HASH:
    86408749      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) {
     8750
     8751    case C_FLONUM_TYPE_HASH:
    86448752      return C_flonum(ptr, C_bignum_to_double(x)-C_flonum_magnitude(y));
    8645     } else if (C_truep(C_bignump(y))) {
     8753
     8754    case C_BIGNUM_TYPE_HASH:
    86468755      return C_s_a_u_i_integer_minus(ptr, 2, x, y);
    8647     } else if (C_block_header(y) == C_RATNUM_TAG) {
     8756
     8757    case C_RATNUM_TYPE_HASH:
    86488758      return integer_minus_rat(ptr, x, y);
    8649     } else if (C_block_header(y) == C_CPLXNUM_TAG) {
     8759
     8760    case C_CPLXNUM_TYPE_HASH:
     8761    {
    86508762      C_word real_diff = C_s_a_i_minus(ptr, 2, x, C_u_i_cplxnum_real(y)),
    86518763             imag = C_s_a_i_negate(ptr, 1, C_u_i_cplxnum_imag(y));
    86528764      if (C_truep(C_u_i_inexactp(real_diff)))
    86538765        imag = C_a_i_exact_to_inexact(ptr, 1, imag);
    86548766      return C_cplxnum(ptr, real_diff, imag);
    8655     } else {
     8767    }
     8768
     8769    default:
    86568770      barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "-", y);
    86578771    }
    8658   } else if (C_block_header(x) == C_RATNUM_TAG) {
    8659     if (y & C_FIXNUM_BIT) {
     8772
     8773  case C_RATNUM_TYPE_HASH:
     8774    switch(C_type_hash(y)) {
     8775    case C_FIXNUM_TYPE_HASH:
    86608776      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) {
     8777
     8778    case C_FLONUM_TYPE_HASH:
    86648779      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))) {
     8780
     8781    case C_BIGNUM_TYPE_HASH:
    86668782      return rat_plusmin_integer(ptr, x, y, C_s_a_u_i_integer_minus);
    8667     } else if (C_block_header(y) == C_RATNUM_TAG) {
     8783
     8784    case C_RATNUM_TYPE_HASH:
    86688785      return rat_plusmin_rat(ptr, x, y, C_s_a_u_i_integer_minus);
    8669     } else if (C_block_header(y) == C_CPLXNUM_TAG) {
     8786
     8787    case C_CPLXNUM_TYPE_HASH:
     8788    {
    86708789      C_word real_diff = C_s_a_i_minus(ptr, 2, x, C_u_i_cplxnum_real(y)),
    86718790             imag = C_s_a_i_negate(ptr, 1, C_u_i_cplxnum_imag(y));
    86728791      if (C_truep(C_u_i_inexactp(real_diff)))
    86738792        imag = C_a_i_exact_to_inexact(ptr, 1, imag);
    86748793      return C_cplxnum(ptr, real_diff, imag);
    8675     } else {
     8794    }
     8795
     8796    default:
    86768797      barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "-", y);
    86778798    }
    8678   } else if (C_block_header(x) == C_CPLXNUM_TAG) {
     8799
     8800  case C_CPLXNUM_TYPE_HASH:
    86798801    if (!C_immediatep(y) && C_block_header(y) == C_CPLXNUM_TAG) {
    86808802      C_word real_diff, imag_diff;
    86818803      real_diff = C_s_a_i_minus(ptr,2,C_u_i_cplxnum_real(x),C_u_i_cplxnum_real(y));
    C_s_a_i_minus(C_word **ptr, C_word n, C_word x, C_word y) 
    86898811        imag = C_a_i_exact_to_inexact(ptr, 1, imag);
    86908812      return C_cplxnum(ptr, real_diff, imag);
    86918813    }
    8692   } else {
     8814
     8815  default:
    86938816    barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "-", x);
    86948817  }
    86958818}
    static C_word flo_rat_cmp(C_word flonum, C_word ratnum) 
    95999722 */
    96009723static C_word basic_cmp(C_word x, C_word y, char *loc, int eqp)
    96019724{
    9602   if (x & C_FIXNUM_BIT) {
    9603     if (y & C_FIXNUM_BIT) {
     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:
    96049729      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) {
     9730
     9731    case C_FLONUM_TYPE_HASH:
    96089732      return int_flo_cmp(x, y);
    9609     } else if (C_truep(C_bignump(y))) {
     9733
     9734    case C_BIGNUM_TYPE_HASH:
     9735    {
    96109736      C_word ab[C_SIZEOF_FIX_BIGNUM], *a = ab;
    96119737      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) {
     9738    }
     9739
     9740    case C_RATNUM_TYPE_HASH:
    96139741      if (eqp) return C_SCHEME_FALSE;
    96149742      else return rat_cmp(x, y);
    9615     } else if (C_block_header(y) == C_CPLXNUM_TAG) {
     9743
     9744    case C_CPLXNUM_TYPE_HASH:
    96169745      if (eqp) return C_SCHEME_FALSE;
    96179746      else barf(C_BAD_ARGUMENT_TYPE_COMPLEX_NO_ORDERING_ERROR, loc, y);
    9618     } else {
     9747
     9748    default:
    96199749      barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, loc, y);
    96209750    }
    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) {
     9751
     9752  case C_FLONUM_TYPE_HASH:
     9753    switch(C_type_hash(y)) {
     9754    case C_FIXNUM_TYPE_HASH:
    96259755      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) {
     9756
     9757    case C_FLONUM_TYPE_HASH:
     9758    {
    96299759      double a = C_flonum_magnitude(x), b = C_flonum_magnitude(y);
    96309760      if (C_isnan(a) || C_isnan(b)) return C_SCHEME_FALSE; /* "mu" */
    96319761      else return C_fix((a < b) ? -1 : ((a > b) ? 1 : 0));
    9632     } else if (C_truep(C_bignump(y))) {
     9762    }
     9763
     9764    case C_BIGNUM_TYPE_HASH:
    96339765      return flo_int_cmp(x, y);
    9634     } else if (C_block_header(y) == C_RATNUM_TAG) {
     9766
     9767    case C_RATNUM_TYPE_HASH:
    96359768      return flo_rat_cmp(x, y);
    9636     } else if (C_block_header(y) == C_CPLXNUM_TAG) {
     9769
     9770    case C_CPLXNUM_TYPE_HASH:
    96379771      if (eqp) return C_SCHEME_FALSE;
    96389772      else barf(C_BAD_ARGUMENT_TYPE_COMPLEX_NO_ORDERING_ERROR, loc, y);
    9639     } else {
     9773
     9774    default:
    96409775      barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, loc, y);
    96419776    }
    9642   } else if (C_truep(C_bignump(x))) {
    9643     if (y & C_FIXNUM_BIT) {
     9777
     9778  case C_BIGNUM_TYPE_HASH:
     9779    switch(C_type_hash(y)) {
     9780    case C_FIXNUM_TYPE_HASH:
     9781    {
    96449782      C_word ab[C_SIZEOF_FIX_BIGNUM], *a = ab;
    96459783      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) {
     9784    }
     9785
     9786    case C_FLONUM_TYPE_HASH:
    96499787      return int_flo_cmp(x, y);
    9650     } else if (C_truep(C_bignump(y))) {
     9788
     9789    case C_BIGNUM_TYPE_HASH:
    96519790      return C_i_bignum_cmp(x, y);
    9652     } else if (C_block_header(y) == C_RATNUM_TAG) {
     9791
     9792    case C_RATNUM_TYPE_HASH:
    96539793      if (eqp) return C_SCHEME_FALSE;
    96549794      else return rat_cmp(x, y);
    9655     } else if (C_block_header(y) == C_CPLXNUM_TAG) {
     9795
     9796    case C_CPLXNUM_TYPE_HASH:
    96569797      if (eqp) return C_SCHEME_FALSE;
    96579798      else barf(C_BAD_ARGUMENT_TYPE_COMPLEX_NO_ORDERING_ERROR, loc, y);
    9658     } else {
     9799
     9800    default:
    96599801      barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, loc, y);
    96609802    }
    9661   } else if (C_block_header(x) == C_RATNUM_TAG) {
    9662     if (y & C_FIXNUM_BIT) {
     9803
     9804  case C_RATNUM_TYPE_HASH:
     9805    switch(C_type_hash(y)) {
     9806    case C_FIXNUM_TYPE_HASH:
    96639807      if (eqp) return C_SCHEME_FALSE;
    96649808      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) {
     9809
     9810    case C_FLONUM_TYPE_HASH:
    96689811      return rat_flo_cmp(x, y);
    9669     } else if (C_truep(C_bignump(y))) {
     9812
     9813    case C_BIGNUM_TYPE_HASH:
    96709814      if (eqp) return C_SCHEME_FALSE;
    96719815      else return rat_cmp(x, y);
    9672     } else if (C_block_header(y) == C_RATNUM_TAG) {
     9816
     9817    case C_RATNUM_TYPE_HASH:
    96739818      if (eqp) {
    96749819        return C_and(C_and(C_i_integer_equalp(C_u_i_ratnum_num(x),
    96759820                                              C_u_i_ratnum_num(y)),
    static C_word basic_cmp(C_word x, C_word y, char *loc, int eqp) 
    96799824      } else {
    96809825        return rat_cmp(x, y);
    96819826      }
    9682     } else if (C_block_header(y) == C_CPLXNUM_TAG) {
     9827
     9828    case C_CPLXNUM_TYPE_HASH:
    96839829      if (eqp) return C_SCHEME_FALSE;
    96849830      else barf(C_BAD_ARGUMENT_TYPE_COMPLEX_NO_ORDERING_ERROR, loc, y);
    9685     } else {
     9831
     9832    default:
    96869833      barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, loc, y);
    96879834    }
    9688   } else if (C_block_header(x) == C_CPLXNUM_TAG) {
    9689     if (!eqp) {
     9835
     9836  case C_CPLXNUM_TYPE_HASH:
     9837    if (!eqp)
    96909838      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) {
     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:
    96989845      return C_SCHEME_FALSE;
    9699     } else if (C_block_header(y) == C_CPLXNUM_TAG) {
     9846
     9847    case C_CPLXNUM_TYPE_HASH:
    97009848      return C_and(C_and(C_i_nequalp(C_u_i_cplxnum_real(x), C_u_i_cplxnum_real(y)),
    97019849                         C_i_nequalp(C_u_i_cplxnum_imag(x), C_u_i_cplxnum_imag(y))),
    97029850                   C_fix(0));
    9703     } else {
     9851
     9852    default:
    97049853      barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, loc, y);
    97059854    }
    9706   } else {
     9855
     9856  default:
    97079857    barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, loc, x);
    97089858  }
    97099859}
    void C_ccall C_string_to_keyword(C_word c, C_word *av) 
    1058210732C_regparm C_word C_fcall
    1058310733C_a_i_exact_to_inexact(C_word **ptr, int c, C_word n)
    1058410734{
    10585   if (n & C_FIXNUM_BIT) {
     10735  switch(C_type_hash(n)) {
     10736  case C_FIXNUM_TYPE_HASH:
    1058610737    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) {
     10738
     10739  case C_FLONUM_TYPE_HASH:
    1059010740    return n;
    10591   } else if (C_truep(C_bignump(n))) {
     10741
     10742  case C_BIGNUM_TYPE_HASH:
    1059210743    return C_a_u_i_big_to_flo(ptr, c, n);
    10593   } else if (C_block_header(n) == C_CPLXNUM_TAG) {
     10744
     10745  case C_CPLXNUM_TYPE_HASH:
    1059410746    return C_cplxnum(ptr, C_a_i_exact_to_inexact(ptr, 1, C_u_i_cplxnum_real(n)),
    1059510747                     C_a_i_exact_to_inexact(ptr, 1, C_u_i_cplxnum_imag(n)));
     10748
    1059610749  /* The horribly painful case: ratnums */
    10597   } else if (C_block_header(n) == C_RATNUM_TAG) {
     10750  case C_RATNUM_TYPE_HASH:
     10751  {
    1059810752    /* This tries to keep the numbers within representable ranges and
    1059910753     * tries to drop as few significant digits as possible by bringing
    1060010754     * 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) 
    1066610820     shift_amount = nmin(DBL_MANT_DIG-1, e - (DBL_MIN_EXP - DBL_MANT_DIG));
    1066710821     res = ldexp(fraction, e - shift_amount);
    1066810822     return C_flonum(ptr, C_truep(negp) ? -res : res);
    10669   } else {
     10823  }
     10824
     10825  default:
    1067010826    barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "exact->inexact", n);
    1067110827  }
    1067210828}
    static char *to_n_nary(C_uword num, C_uword base, int negp, int as_flonum) 
    1100911165void C_ccall C_number_to_string(C_word c, C_word *av)
    1101011166{
    1101111167  C_word radix, num;
     11168  C_word k = av[ 1 ];
    1101211169
    1101311170  if(c == 3) {
    1101411171    radix = C_fix(10);
    void C_ccall C_number_to_string(C_word c, C_word *av) 
    1102211179
    1102311180  num = av[ 2 ];
    1102411181
    11025   if(num & C_FIXNUM_BIT) {
     11182  switch(C_type_hash(num)) {
     11183  case C_FIXNUM_TYPE_HASH:
    1102611184    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) {
     11185
     11186  case C_FLONUM_TYPE_HASH:
    1103011187    C_flonum_to_string(c, av); /* reuse av */
    11031   } else if (C_truep(C_bignump(num))) {
     11188
     11189  case C_BIGNUM_TYPE_HASH:
    1103211190    C_integer_to_string(c, av); /* reuse av */
    11033   } else {
    11034     C_word k = av[ 1 ];
     11191
     11192  case C_RATNUM_TYPE_HASH:
     11193  case C_CPLXNUM_TYPE_HASH:
    1103511194    try_extended_number("##sys#extended-number->string", 3, k, num, radix);
     11195
     11196  default:
     11197    barf(C_BAD_ARGUMENT_TYPE_ERROR, "number->string", num);
    1103611198  }
    1103711199}
    1103811200