Changeset 32720 in project


Ignore:
Timestamp:
08/21/15 16:44:08 (4 years ago)
Author:
sjamaan
Message:

numbers: First attempt at converting to argvector. Start with wrappers for C_values and allocation continuation closures. Compiles cleanly, but crashes and burns (as expected)

Location:
release/4/numbers/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/4/numbers/trunk/numbers-c.c

    r32555 r32720  
    5656
    5757static C_word init_tags(___scheme_value tagvec);
    58 static void bignum_negate_2(C_word c, C_word self, C_word new_big) C_noret;
     58static void CONT_PROC(bignum_negate_2, c, self, new_big) C_noret;
    5959static C_word rat_cmp(C_word x, C_word y);
    6060static C_word basic_cmp(C_word x, C_word y, char *loc, int eqp);
    61 static void allocate_bignum_2(C_word c, C_word self, C_word bigvec) C_noret;
     61static void CONT_PROC(allocate_bignum_2, c, self, bigvec) C_noret;
    6262static C_word allocate_tmp_bignum(C_word size, C_word negp, C_word initp);
    6363static C_uword bignum_digits_destructive_scale_up_with_carry(C_uword *start, C_uword *end, C_uword factor, C_uword carry);
     
    6666static C_uword bignum_digits_destructive_shift_left(C_uword *start, C_uword *end, int shift_left);
    6767static void bignum_plus_unsigned(C_word k, C_word x, C_word y, C_word negp) C_noret;
    68 static void bignum_plus_unsigned_2(C_word c, C_word self, C_word result) C_noret;
     68static void CONT_PROC(bignum_plus_unsigned_2, c, self, result) C_noret;
    6969static C_word int_flo_cmp(C_word intnum, C_word flonum);
    7070static C_word flo_int_cmp(C_word flonum, C_word intnum);
     
    7373static int bignum_cmp_unsigned(C_word x, C_word y);
    7474static void bignum_minus_unsigned(C_word k, C_word x, C_word y) C_noret;
    75 static void bignum_minus_unsigned_2(C_word c, C_word self, C_word result) C_noret;
    76 static void integer_times_2(C_word c, C_word self, C_word new_big) C_noret;
     75static void CONT_PROC(bignum_minus_unsigned_2, c, self, result) C_noret;
     76static void CONT_PROC(integer_times_2, c, self, new_big) C_noret;
    7777static C_regparm void bignum_digits_multiply(C_word x, C_word y, C_word result);
    7878static void bignum_times_bignum_unsigned(C_word k, C_word x, C_word y, C_word negp) C_noret;
    79 static void bignum_times_bignum_unsigned_2(C_word c, C_word self, C_word result) C_noret;
    80 static void digits_to_integer_2(C_word c, C_word self, C_word result) C_noret;
     79static void CONT_PROC(bignum_times_bignum_unsigned_2, c, self, result) C_noret;
     80static void CONT_PROC(digits_to_integer_2, c, self, result) C_noret;
    8181static C_regparm C_word str_to_bignum(C_word bignum, char *str, char *str_end, int radix);
    82 static void bignum_to_str_2(C_word c, C_word self, C_word string) C_noret;
     82static void CONT_PROC(bignum_to_str_2, c, self, string) C_noret;
    8383static void fabs_frexp_to_digits(C_uword exp, double sign, C_uword *start, C_uword *scan);
    8484static C_word flo_to_tmp_bignum(C_word x);
    85 static void flo_to_int_2(C_word c, C_word self, C_word result) C_noret;
    86 static void bignum_actual_shift(C_word c, C_word self, C_word result) C_noret;
    87 static void bignum_actual_extraction(C_word c, C_word self, C_word result) C_noret;
    88 static void bignum_random_2(C_word c, C_word self, C_word result) C_noret;
    89 static void bignum_bitwise_and_2(C_word c, C_word self, C_word result) C_noret;
    90 static void bignum_bitwise_ior_2(C_word c, C_word self, C_word result) C_noret;
    91 static void bignum_bitwise_xor_2(C_word c, C_word self, C_word result) C_noret;
     85static void CONT_PROC(flo_to_int_2, c, self, result) C_noret;
     86static void CONT_PROC(bignum_actual_shift, c, self, result) C_noret;
     87static void CONT_PROC(bignum_actual_extraction, c, self, result) C_noret;
     88static void CONT_PROC(bignum_random_2, c, self, result) C_noret;
     89static void CONT_PROC(bignum_bitwise_and_2, c, self, result) C_noret;
     90static void CONT_PROC(bignum_bitwise_ior_2, c, self, result) C_noret;
     91static void CONT_PROC(bignum_bitwise_xor_2, c, self, result) C_noret;
    9292static void bignum_digits_destructive_negate(C_word result);
    93 static C_regparm void basic_divrem(C_word c, C_word self, C_word k, C_word x, C_word y, C_word return_r, C_word return_q) C_noret;
    94 static C_regparm void integer_divrem(C_word c, C_word self, C_word k, C_word x, C_word y, C_word return_q, C_word return_r) C_noret;
    95 static C_regparm void bignum_divrem(C_word c, C_word self, C_word k, C_word x, C_word y, C_word return_q, C_word return_r) C_noret;
     93static C_regparm void basic_divrem(C_word k, C_word x, C_word y, C_word return_r, C_word return_q) C_noret;
     94static C_regparm void integer_divrem(C_word k, C_word x, C_word y, C_word return_q, C_word return_r) C_noret;
     95static C_regparm void bignum_divrem(C_word k, C_word x, C_word y, C_word return_q, C_word return_r) C_noret;
    9696static void divrem_intflo_2(C_word c, C_word self, ...) C_noret;
    97 static void bignum_divrem_fixnum_2(C_word c, C_word self, C_word negated_big) C_noret;
    98 static void bignum_negneg_bitwise_op(C_word c, C_word self, C_word result) C_noret;
    99 static void bignum_posneg_bitwise_op(C_word c, C_word self, C_word result) C_noret;
    100 static void bignum_pospos_bitwise_op(C_word c, C_word self, C_word result) C_noret;
     97static void CONT_PROC(bignum_divrem_fixnum_2, c, self, negated_big) C_noret;
    10198static C_word bignum_remainder_unsigned_halfdigit(C_word num, C_word den);
    102 static void bignum_destructive_divide_unsigned_small(C_word c, C_word self, C_word quotient);
    103 static void bignum_divide_2_unsigned(C_word c, C_word self, C_word quotient) C_noret;
    104 static void bignum_divide_2_unsigned_2(C_word c, C_word self, C_word remainder) C_noret;
     99static void CONT_PROC(bignum_destructive_divide_unsigned_small, c, self, quotient);
     100static void CONT_PROC(bignum_divide_2_unsigned, c, self, quotient) C_noret;
     101static void CONT_PROC(bignum_divide_2_unsigned_2, c, self, remainder) C_noret;
    105102static void bignum_destructive_divide_normalized(C_word big_u, C_word big_v, C_word big_q);
    106103
     
    200197 
    201198  if(!C_immediatep(err)) {
     199#ifdef ARGVECTOR_CHICKEN
     200    C_word *av = C_alloc(c + 4);
     201
     202    va_start(v, loc);
     203    av[ 0 ] = err;
     204    /* No continuation is passed: '##sys#error-hook' may not return: */
     205    av[ 1 ] = C_SCHEME_UNDEFINED;
     206    av[ 2 ] = C_fix(code);
     207    av[ 3 ] = C_intern2(&a, loc); /* loc is never NULL here, unlike in core */
     208
     209    for(i = 0; i < c; ++i)
     210      av[ i + 4 ] = va_arg(v, C_word);
     211
     212    va_end(v);
     213    C_do_apply(c + 4, av);
     214#else
    202215    C_save(C_fix(code));
    203216   
    204     C_save(C_intern2(&a, loc));
     217    C_save(C_intern2(&a, loc)); /* loc is never NULL here, unlike in core */
    205218   
    206219    va_start(v, loc);
     
    212225    va_end(v);
    213226    /* No continuation is passed: '##sys#error-hook' may not return: */
    214     C_do_apply(c + 2, C_block_item(err, 0), C_SCHEME_UNDEFINED);
     227    C_do_apply(c + 2, C_block_item(err, 0), C_SCHEME_UNDEFINED);
     228#endif
    215229  } else {
    216230    fprintf(stderr, "No error hook!");
     
    249263
    250264  if (!C_immediatep(ext_proc) && C_closurep(ext_proc)) {
     265#ifdef ARGVECTOR_CHICKEN
     266    C_word *av = C_alloc(c + 1);
     267    av[ 0 ] = ext_proc;
     268    av[ 1 ] = k;
     269    va_start(v, k);
     270
     271    for(i = 0; i < c - 1; ++i)
     272      av[ i + 2 ] = va_arg(v, C_word);
     273
     274    va_end(v);
     275    C_do_apply(c + 1, av);
     276#else
    251277    va_start(v, k);
    252278    i = c - 1;
     
    257283    va_end(v);
    258284    C_do_apply(c - 1, ext_proc, k);
     285#endif
    259286  } else {
    260287    /* TODO: Convert to barf(), add new error code */
     
    674701}
    675702
    676 static void
    677 bignum_plus_unsigned_2(C_word c, C_word self, C_word result)
    678 {
     703static void CONT_PROC(bignum_plus_unsigned_2, c, self, result)
     704{
     705  CONT_BODY(self, result);
    679706  C_word k = C_block_item(self, 1),
    680707         x = C_block_item(self, 2),
     
    768795}
    769796
    770 static void
    771 bignum_minus_unsigned_2(C_word c, C_word self, C_word result)
    772 {
     797static void CONT_PROC(bignum_minus_unsigned_2, c, self, result)
     798{
     799  CONT_BODY(self, result);
    773800  C_word k = C_block_item(self, 1),
    774801         x = C_block_item(self, 2),
     
    9941021}
    9951022
    996 static void
    997 bignum_negate_2(C_word c, C_word self, C_word new_big)
    998 {
     1023static void CONT_PROC(bignum_negate_2, c, self, new_big)
     1024{
     1025  CONT_BODY(self, new_big);
    9991026  C_word k = C_block_item(self, 1),
    10001027         old_big = C_block_item(self, 2);
     
    15761603}
    15771604
     1605/* NOTE: If C_allocate_bignum is to be callable from Scheme, it needs
     1606 * to be converted to argvector.  But that's a very big change.
     1607 */
    15781608void C_ccall
    15791609C_allocate_bignum(C_word c, C_word self, C_word k, C_word size, C_word negp, C_word initp)
    15801610{
     1611#ifdef ARGVECTOR_CHICKEN
     1612  C_word kab[C_SIZEOF_CLOSURE(3)], *ka = kab, av[6];
     1613
     1614  av[ 0 ] = (C_word)NULL;   /* No "self" closure */
     1615  av[ 1 ] = C_closure(&ka, 3, (C_word)allocate_bignum_2, k, negp);
     1616  av[ 2 ] = C_bytes(C_fixnum_plus(size, C_fix(1))); /* Add header */
     1617  av[ 3 ] = C_SCHEME_TRUE;  /* Byte vector */
     1618  av[ 4 ] = C_and(initp, C_make_character('\0'));
     1619  av[ 5 ] = C_SCHEME_FALSE; /* Don't align at 8 bytes */
     1620  C_allocate_vector(6, av);
     1621#else
    15811622  C_word kab[C_SIZEOF_CLOSURE(3)], *ka = kab, k2, init;
    15821623  k2 = C_closure(&ka, 3, (C_word)allocate_bignum_2, k, negp);
     
    15871628                    /* Byte vec, initialization, align at 8 bytes */
    15881629                    C_SCHEME_TRUE, init, C_SCHEME_FALSE);
    1589 }
    1590 
    1591 static void
    1592 allocate_bignum_2(C_word c, C_word self, C_word bigvec)
    1593 {
     1630#endif
     1631}
     1632
     1633static void CONT_PROC(allocate_bignum_2, c, self, bigvec)
     1634{
     1635  CONT_BODY(self, bigvec);
    15941636  C_word ab[C_SIZEOF_STRUCTURE(2)], *a = ab, bignum,
    15951637         k = C_block_item(self, 1),
     
    18641906}
    18651907
    1866 static void
    1867 integer_times_2(C_word c, C_word self, C_word new_big)
    1868 {
     1908static void CONT_PROC(integer_times_2, c, self, new_big)
     1909{
     1910  CONT_BODY(self, new_big);
    18691911  C_word k = C_block_item(self, 1),
    18701912         old_bigx = C_block_item(self, 2),
     
    19321974}
    19331975
    1934 static void
    1935 bignum_times_bignum_unsigned_2(C_word c, C_word self, C_word result)
    1936 {
     1976static void CONT_PROC(bignum_times_bignum_unsigned_2, c, self, result)
     1977{
     1978  CONT_BODY(self, result);
    19371979  C_word k = C_block_item(self, 1),
    19381980         x = C_block_item(self, 2),
     
    19702012}
    19712013
    1972 static void
    1973 digits_to_integer_2(C_word c, C_word self, C_word result)
    1974 {
     2014static void CONT_PROC(digits_to_integer_2, c, self, result)
     2015{
     2016  CONT_BODY(self, result);
    19752017  C_word k = C_block_item(self, 1),
    19762018         str = C_block_item(self, 2),
     
    22232265                          4, k, num, radix, C_fix(len));
    22242266    } else {
     2267#ifdef ARGVECTOR_CHICKEN
     2268      C_word *ka, av[6];
     2269
     2270      av[ 0 ] = (C_word)NULL;   /* No "self" closure */
     2271      av[ 1 ] = C_closure(&ka, 4, (C_word)bignum_to_str_2, k, num, radix);
     2272      av[ 2 ] = C_fix(len);
     2273      av[ 3 ] = C_SCHEME_TRUE; /* Byte vector */
     2274      av[ 4 ] = C_SCHEME_FALSE; /* No initialization */
     2275      av[ 5 ] = C_SCHEME_FALSE; /* Don't align at 8 bytes */
     2276      C_allocate_vector(6, av);
     2277#else
    22252278      C_word k2, *ka;
    22262279      ka = C_alloc(C_SIZEOF_CLOSURE(4));
     
    22292282                        /* Byte vec, no initialization, no align at 8 bytes */
    22302283                        C_SCHEME_TRUE, C_SCHEME_FALSE, C_SCHEME_FALSE);
    2231     }
    2232   }
    2233 }
    2234 
    2235 static void
    2236 bignum_to_str_2(C_word c, C_word self, C_word string)
     2284#endif
     2285    }
     2286  }
     2287}
     2288
     2289static void CONT_PROC(bignum_to_str_2, c, self, string)
    22372290{
    22382291  static char *characters = "0123456789abcdef";
     2292  CONT_BODY(self, string);
    22392293  C_word k = C_block_item(self, 1),
    22402294         bignum = C_block_item(self, 2),
     
    24372491}
    24382492
    2439 static void
    2440 flo_to_int_2(C_word c, C_word self, C_word result)
    2441 {
     2493static void CONT_PROC(flo_to_int_2, c, self, result)
     2494{
     2495  CONT_BODY(self, result);
    24422496  C_word k = C_block_item(self, 1);
    24432497  C_uword exponent = C_unfix(C_block_item(self, 2)),
     
    25422596}
    25432597
    2544 static void
    2545 bignum_actual_shift(C_word c, C_word self, C_word result)
    2546 {
     2598static void CONT_PROC(bignum_actual_shift, c, self, result)
     2599{
     2600  CONT_BODY(self, result);
    25472601  C_word k = C_block_item(self, 1),
    25482602         x = C_block_item(self, 2),
     
    26232677}
    26242678
    2625 static void
    2626 bignum_actual_extraction(C_word c, C_word self, C_word result)
    2627 {
     2679static void CONT_PROC(bignum_actual_extraction, c, self, result)
     2680{
     2681  CONT_BODY(self, result);
    26282682  C_word k = C_block_item(self, 1),
    26292683         x = C_block_item(self, 2),
     
    26892743}
    26902744
    2691 static void
    2692 bignum_random_2(C_word c, C_word self, C_word result)
    2693 {
     2745static void CONT_PROC(bignum_random_2, c, self, result)
     2746{
     2747  CONT_BODY(self, result);
    26942748  C_word k = C_block_item(self, 1),
    26952749         max_top_digit = C_unfix(C_block_item(self, 2)),
     
    27622816}
    27632817
    2764 static void
    2765 bignum_bitwise_and_2(C_word c, C_word self, C_word result)
    2766 {
     2818static void CONT_PROC(bignum_bitwise_and_2, c, self, result)
     2819{
     2820  CONT_BODY(self, result);
    27672821  C_word k = C_block_item(self, 1),
    27682822         x = C_block_item(self, 2),
     
    28122866}
    28132867
    2814 static void
    2815 bignum_bitwise_ior_2(C_word c, C_word self, C_word result)
    2816 {
     2868static void CONT_PROC(bignum_bitwise_ior_2, c, self, result)
     2869{
     2870  CONT_BODY(self, result);
    28172871  C_word k = C_block_item(self, 1),
    28182872         x = C_block_item(self, 2),
     
    28642918}
    28652919
    2866 static void
    2867 bignum_bitwise_xor_2(C_word c, C_word self, C_word result)
    2868 {
     2920static void CONT_PROC(bignum_bitwise_xor_2, c, self, result)
     2921{
     2922  CONT_BODY(self, result);
    28692923  C_word k = C_block_item(self, 1),
    28702924         x = C_block_item(self, 2),
     
    29192973#define RETURN_Q_AND_OR_R(calc_q, calc_r)                 \
    29202974  if (C_truep(C_and(return_q, return_r))) {               \
    2921     C_values(4, C_SCHEME_UNDEFINED, k, calc_q, calc_r);   \
     2975    C_kontinue2(k, calc_q, calc_r);                       \
    29222976  } else if (C_truep(return_r)) {                         \
    29232977    C_kontinue(k, calc_r);                                \
     
    29312985
    29322986static C_regparm void
    2933 basic_divrem(C_word c, C_word self, C_word k, C_word x, C_word y, C_word return_q, C_word return_r)
     2987basic_divrem(C_word k, C_word x, C_word y, C_word return_q, C_word return_r)
    29342988{
    29352989  if (x & C_FIXNUM_BIT) {
     
    29503004                        C_a_i_flonum_remainder_checked(&a, 2, x, y));
    29513005    } else if (C_IS_BIGNUM_TYPE(y)) {
    2952       integer_divrem(6, (C_word)NULL, k, x, y, return_q, return_r);
     3006      integer_divrem(k, x, y, return_q, return_r);
    29533007    } else {
    29543008      barf(C_BAD_ARGUMENT_TYPE_NO_INTEGER_ERROR, DIVREM_LOC, y);
     
    29783032      x = flo_to_tmp_bignum(x);
    29793033      k2 = C_closure(&a, 3, (C_word)divrem_intflo_2, k, x);
    2980       integer_divrem(6, (C_word)NULL, k2, x, y, return_q, return_r);
     3034      integer_divrem(k2, x, y, return_q, return_r);
    29813035    } else {
    29823036      barf(C_BAD_ARGUMENT_TYPE_NO_INTEGER_ERROR, DIVREM_LOC, y);
     
    29843038  } else if (C_IS_BIGNUM_TYPE(x)) {
    29853039    if (y & C_FIXNUM_BIT) {
    2986       integer_divrem(6, (C_word)NULL, k, x, y, return_q, return_r);
     3040      integer_divrem(k, x, y, return_q, return_r);
    29873041    } else if (C_immediatep(y)) {
    29883042      barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, DIVREM_LOC, y);
     
    29963050        y = flo_to_tmp_bignum(y);
    29973051        k2 = C_closure(&a, 3, (C_word)divrem_intflo_2, k, y);
    2998         integer_divrem(6, (C_word)NULL, k2, x, y, return_q, return_r);
     3052        integer_divrem(k2, x, y, return_q, return_r);
    29993053      }
    30003054    } else if (C_IS_BIGNUM_TYPE(y)) {
    3001       bignum_divrem(6, (C_word)NULL, k, x, y, return_q, return_r);
     3055      bignum_divrem(k, x, y, return_q, return_r);
    30023056    } else {
    30033057      barf(C_BAD_ARGUMENT_TYPE_NO_INTEGER_ERROR, DIVREM_LOC, y);
     
    30333087    if (y & C_FIXNUM_BIT) y = C_a_i_fix_to_flo(&a, 1, y);
    30343088    else y = C_a_u_i_big_to_flo(&a, 1, y);
    3035     C_values(4, C_SCHEME_UNDEFINED, k, x, y);
    3036   }
    3037 }
    3038 
    3039 static void bignum_divrem_fixnum_2(C_word c, C_word self, C_word negated_big)
    3040 {
     3089    C_kontinue2(k, x, y);
     3090  }
     3091}
     3092
     3093static void CONT_PROC(bignum_divrem_fixnum_2, c, self, negated_big)
     3094{
     3095   CONT_BODY(self, negated_big);
    30413096   C_word k = C_block_item(self, 1),
    30423097          return_q = C_block_item(self, 2),
     
    30463101
    30473102static C_regparm void
    3048 integer_divrem(C_word c, C_word self, C_word k, C_word x, C_word y, C_word return_q, C_word return_r)
     3103integer_divrem(C_word k, C_word x, C_word y, C_word return_q, C_word return_r)
    30493104{
    30503105  if (!(y & C_FIXNUM_BIT)) { /* y is bignum. */
     
    30583113      }
    30593114    } else {
    3060       bignum_divrem(6, (C_word)NULL, k, x, y, return_q, return_r);
     3115      bignum_divrem(k, x, y, return_q, return_r);
    30613116    }
    30623117  } else if (x & C_FIXNUM_BIT) { /* both x and y are fixnum. */
     
    31083163    } else {                    /* Just divide it as two bignums */
    31093164      C_word ab[C_SIZEOF_FIX_BIGNUM], *a = ab;
    3110       bignum_divrem(6, (C_word)NULL, k, x, C_a_u_i_fix_to_big(&a, y),
    3111                     return_q, return_r);
     3165      bignum_divrem(k, x, C_a_u_i_fix_to_big(&a, y), return_q, return_r);
    31123166    }
    31133167  }
     
    31153169
    31163170static C_regparm void
    3117 bignum_divrem(C_word c, C_word self, C_word k, C_word x, C_word y, C_word return_q, C_word return_r)
     3171bignum_divrem(C_word k, C_word x, C_word y, C_word return_q, C_word return_r)
    31183172{
    31193173  C_word q_negp = C_mk_bool(C_bignum_negativep(y) ?
     
    31703224{
    31713225  if (c != 4) C_bad_argc_2(c, 4, self);
    3172   basic_divrem(6, (C_word)NULL, k, x, y, C_SCHEME_TRUE, C_SCHEME_TRUE);
     3226  basic_divrem(k, x, y, C_SCHEME_TRUE, C_SCHEME_TRUE);
    31733227}
    31743228
     
    31763230C_u_integer_divrem(C_word c, C_word self, C_word k, C_word x, C_word y)
    31773231{
    3178   integer_divrem(6, (C_word)NULL, k, x, y, C_SCHEME_TRUE, C_SCHEME_TRUE);
     3232  integer_divrem(k, x, y, C_SCHEME_TRUE, C_SCHEME_TRUE);
    31793233}
    31803234
     
    31833237{
    31843238  if (c != 4) C_bad_argc_2(c, 4, self);
    3185   basic_divrem(6, (C_word)NULL, k, x, y, C_SCHEME_FALSE, C_SCHEME_TRUE);
     3239  basic_divrem(k, x, y, C_SCHEME_FALSE, C_SCHEME_TRUE);
    31863240}
    31873241
     
    31893243C_u_integer_remainder(C_word c, C_word self, C_word k, C_word x, C_word y)
    31903244{
    3191   integer_divrem(6, (C_word)NULL, k, x, y, C_SCHEME_FALSE, C_SCHEME_TRUE);
     3245  integer_divrem(k, x, y, C_SCHEME_FALSE, C_SCHEME_TRUE);
    31923246}
    31933247
     
    31963250{
    31973251  if (c != 4) C_bad_argc_2(c, 4, self);
    3198   basic_divrem(6, (C_word)NULL, k, x, y, C_SCHEME_TRUE, C_SCHEME_FALSE);
     3252  basic_divrem(k, x, y, C_SCHEME_TRUE, C_SCHEME_FALSE);
    31993253}
    32003254
     
    32023256C_u_integer_quotient(C_word c, C_word self, C_word k, C_word x, C_word y)
    32033257{
    3204   integer_divrem(6, (C_word)NULL, k, x, y, C_SCHEME_TRUE, C_SCHEME_FALSE);
     3258  integer_divrem(k, x, y, C_SCHEME_TRUE, C_SCHEME_FALSE);
    32053259}
    32063260
    32073261/* "small" is either a number that fits a halfdigit, or a power of two */
    3208 static void
    3209 bignum_destructive_divide_unsigned_small(C_word c, C_word self, C_word quotient)
    3210 {
     3262static void CONT_PROC(bignum_destructive_divide_unsigned_small,
     3263                      c, self, quotient)
     3264{
     3265  CONT_BODY(self, quotient);
    32113266  C_word k = C_block_item(self, 1),
    32123267         numerator = C_block_item(self, 2),
     
    32353290  if (C_truep(return_remainder)) {
    32363291    remainder = C_truep(remainder_negp) ? -remainder : remainder;
    3237     C_values(4, C_SCHEME_UNDEFINED, k, quotient, C_fix(remainder));
     3292    C_kontinue2(k, quotient, C_fix(remainder));
    32383293  } else {
    32393294    C_kontinue(k, quotient);
     
    32443299/* Full bignum division */
    32453300
    3246 static void
    3247 bignum_divide_2_unsigned(C_word c, C_word self, C_word quotient)
    3248 {
     3301static void CONT_PROC(bignum_divide_2_unsigned, c, self, quotient)
     3302{
     3303  CONT_BODY(self, quotient);
    32493304  C_word k = C_block_item(self, 1),
    32503305         x = C_block_item(self, 2),
     
    32743329*/
    32753330
    3276 static void
    3277 bignum_divide_2_unsigned_2(C_word c, C_word self, C_word remainder)
    3278 {
     3331static void CONT_PROC(bignum_divide_2_unsigned_2, c, self, remainder)
     3332{
     3333  CONT_BODY(self, remainder);
    32793334  C_word k = C_block_item(self, 1),
    32803335         numerator = C_block_item(self, 2),
     
    33273382  if (C_truep(return_remainder)) {
    33283383    if (C_truep(return_quotient)) {
    3329       C_values(4, C_SCHEME_UNDEFINED, k,
    3330                C_bignum_simplify(quotient), C_bignum_simplify(remainder));
     3384      C_kontinue2(k, C_bignum_simplify(quotient),
     3385                  C_bignum_simplify(remainder));
    33313386    } else {
    33323387      C_kontinue(k, C_bignum_simplify(remainder));
  • release/4/numbers/trunk/numbers-c.h

    r32555 r32720  
    11/* numbers-c.h */
     2
     3/* C_cpsproc is only defined for argvector chickens */
     4#ifdef C_cpsproc
     5# define ARGVECTOR_CHICKEN
     6#endif
     7
     8/* Compat helpers for extracting procedure args in a common way */
     9#ifdef ARGVECTOR_CHICKEN
     10# define C_kontinue2(k, r1, r2)                                         \
     11  do {                                                                  \
     12    C_word avk[ 4 ];                                                    \
     13    avk[ 0 ] = C_SCHEME_UNDEFINED;                                      \
     14    avk[ 1 ] = (k);                                                     \
     15    avk[ 2 ] = (r1);                                                    \
     16    avk[ 3 ] = (r2);                                                    \
     17    ((C_proc)(void *)C_block_item((k),0))(4, avk); \
     18  } while(0)
     19/* "Allocation continuation" closures/functions; these don't receive a
     20 * continuation, but they get called through an allocating function.
     21 * The function that calls the allocation function needs to save the
     22 * continuation in the closure, the "self" argument.
     23 */
     24# define CONT_BODY(s, a1) C_word s = __av[0]; C_word a1 = __av[1];
     25# define CONT_PROC(name, c, s, a1)   name(C_word c, C_word *__av)
     26#else
     27# define C_kontinue2(k, r1, r2) C_values(4,C_SCHEME_UNDEFINED,k,r1,r2)
     28# define CONT_BODY(s, a1) /* Nothing */
     29# define CONT_PROC(name, c, s, a1)   name(C_word c, C_word s, C_word a1)
     30#endif
    231
    332#define BIG_TAG       0
Note: See TracChangeset for help on using the changeset viewer.