Changeset 31291 in project


Ignore:
Timestamp:
08/25/14 22:27:43 (5 years ago)
Author:
sjamaan
Message:

numbers: convert negation of bignums to core naming convention. This includes an on-stack/native heap C_allocate_bignum (in CPS context)

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

Legend:

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

    r31287 r31291  
    15801580}
    15811581
    1582 static void
    1583 big_neg(C_word c, C_word self, C_word k, C_word x)
    1584 {
    1585   bignum_type big = big_of(x);
    1586   C_return_bignum(k, bignum_new_sign(big, !(BIGNUM_NEGATIVE_P (big))));
    1587 }
    1588 
    15891582static C_word
    15901583big_comp_big(C_word x, C_word y)
     
    23372330 * Below you will find the functions that have been refactored to
    23382331 * match the "core" style.
     2332 *
     2333 * Naming convention idea: Maybe name these fixnum ops differently,
     2334 * _p_ for "promoting"?  OTOH, it may be safer and cleaner to rename
     2335 * the old fixnum ops to have _fx_ to indicate they run in fixnum mode.
    23392336 */
     2337static void bignum_negate_2(C_word c, C_word self, C_word new_big);
     2338static void allocate_bignum_2(C_word c, C_word self, C_word bigvec);
    23402339
    23412340/* Eventually this will probably need to be integrated into C_2_plus. */
    2342 static void
     2341void C_ccall
    23432342C_u_2_fixnum_plus(C_word c, C_word self, C_word k, C_word x, C_word y)
    23442343{
     
    23652364 * TODO: Convert this to be an inline function and move to header?
    23662365 */
    2367 static void
     2366void C_ccall
    23682367C_u_fixnum_neg(C_word c, C_word self, C_word k, C_word x)
    23692368{
     
    23772376}
    23782377
    2379 static void
     2378void C_ccall
    23802379C_fixnum_gcd(C_word c, C_word self, C_word k, C_word x, C_word y)
    23812380{
     
    23952394   C_kontinue(k, C_fix(x));
    23962395}
     2396
     2397void C_ccall
     2398C_u_bignum_negate(C_word c, C_word self, C_word k, C_word x)
     2399{
     2400  C_word kab[C_SIZEOF_CLOSURE(3)], *ka = kab, k2, negp, size;
     2401
     2402  negp = C_i_not(C_u_i_bignum_negativep(x));
     2403  k2 = C_closure(&ka, 3, (C_word)bignum_negate_2, k, x);
     2404 
     2405  size = C_u_i_bignum_size(x);
     2406  C_allocate_bignum(3, (C_word)NULL, k2, size, negp, C_SCHEME_FALSE);
     2407}
     2408
     2409static void
     2410bignum_negate_2(C_word c, C_word self, C_word new_big)
     2411{
     2412  C_word k = C_block_item(self, 1),
     2413         old_big = C_block_item(self, 2);
     2414  C_memcpy(C_bignum_digits(new_big), C_bignum_digits(old_big),
     2415           /* TODO: This is currently in bytes.  If we change the
     2416            * representation that needs to change!
     2417            * We subtract the size of the header, too.
     2418            */
     2419           C_header_size(C_internal_bignum(old_big))-C_wordstobytes(1));
     2420  C_kontinue(k, new_big);
     2421}
     2422
     2423void C_ccall
     2424C_allocate_bignum(C_word c, C_word self, C_word k, C_word size, C_word negp, C_word initp)
     2425{
     2426  C_word kab[C_SIZEOF_CLOSURE(3)], *ka = kab, k2, init;
     2427  k2 = C_closure(&ka, 3, (C_word)allocate_bignum_2, k, negp);
     2428
     2429  init = C_and(initp, C_make_character('\0'));
     2430  C_allocate_vector(6, (C_word)NULL, k2,
     2431                    C_bytes(C_fixnum_plus(size, C_fix(1))), /* Add header */
     2432                    /* Byte vec, initialization, align at 8 bytes */
     2433                    C_SCHEME_TRUE, init, C_SCHEME_FALSE);
     2434}
     2435
     2436static void
     2437allocate_bignum_2(C_word c, C_word self, C_word bigvec)
     2438{
     2439  C_word ab[C_SIZEOF_STRUCTURE(2)], *a = ab, bignum,
     2440         k = C_block_item(self, 1),
     2441         negp = C_truep(C_block_item(self, 2)),
     2442         size = C_bytestowords(C_header_size(bigvec))-1;
     2443
     2444  C_word tagvec = CHICKEN_gc_root_ref(tags);
     2445
     2446  C_set_block_item(bigvec, 0, negp ? C_BIGNUM_HEADER_SIGN_BIT | size : size);
     2447
     2448  bignum = C_structure(&a, 2, C_block_item(tagvec, BIG_TAG), bigvec);
     2449  C_kontinue(k, bignum);
     2450}
  • release/4/numbers/trunk/numbers-c.h

    r31287 r31291  
    163163 */
    164164#define C_SIZEOF_STRUCTURE(n)           ((n)+2) /* missing from chicken.h */
    165 #define C_SIZEOF_BIGNUM(n)              (C_SIZEOF_VECTOR((n)+1)+C_SIZEOF_STRUCTURE(2))
     165#define C_SIZEOF_CLOSURE(n)             ((n)+1) /* missing from chicken.h */
     166/* The "internal"/"external" bignum distinction should die */
     167#define C_SIZEOF_INTERNAL_BIGNUM(n)     (C_SIZEOF_VECTOR((n)+1))
     168#define C_internal_bignum(b)            (C_block_item(b,1))
     169
     170#define C_SIZEOF_BIGNUM(n)              (C_SIZEOF_INTERNAL_BIGNUM(n)+C_SIZEOF_STRUCTURE(2))
    166171
    167172/* CHAR_BIT is from <limits.h>, and it equals the number of bits in a char */
     
    180185#define C_a_i_bignum2(a,n,negp,d1,d2)   C_bignum2((a),(n),C_truep(negp),(C_uword)C_unfix(d1),(C_uword)C_unfix(d2))
    181186
    182 #define C_bignum_header(b)              (*(C_word *)C_data_pointer(C_block_item(b,1)))
    183 #define C_bignum_digits(b)              (((C_word *)C_data_pointer(C_block_item(b,1)))+1)
     187#define C_bignum_header(b)              (*(C_word *)C_data_pointer(C_internal_bignum(b)))
     188#define C_bignum_digits(b)              (((C_word *)C_data_pointer(C_internal_bignum(b)))+1)
    184189#define C_u_i_bignum_negativep(b)       C_mk_bool(C_bignum_header(b) & C_BIGNUM_HEADER_SIGN_BIT)
    185190#define C_u_i_bignum_oddp(b)            C_mk_bool(C_bignum_digits(b)[0] & 1)
     191/* The bytes->words conversion should be killed, but that can only be
     192 * done when the representation is made part of core (otherwise the GC
     193 * will trip on the vector's contents not being proper Scheme objects:
     194 * it skips objects marked with C_BYTEBLOCK_BIT).  We could set
     195 * SPECIALBLOCK_BIT, but that would disable the number-syntax hack.
     196 * So, for now we'll live with back and forth byte<->word conversion.
     197 */
     198#define C_u_i_bignum_size(b)            (C_fix(C_bytestowords(C_header_size(C_internal_bignum(b)))-1))
     199
     200void C_ccall C_u_2_fixnum_plus(C_word c, C_word self, C_word k, C_word x, C_word y);
     201void C_ccall C_u_fixnum_neg(C_word c, C_word self, C_word k, C_word x);
     202void C_ccall C_fixnum_gcd(C_word c, C_word self, C_word k, C_word x, C_word y);
     203void C_ccall C_u_bignum_negate(C_word c, C_word self, C_word k, C_word x);
     204void C_ccall C_allocate_bignum(C_word c, C_word self, C_word k, C_word size, C_word negp, C_word initp);
    186205
    187206/* TODO: low to high, or high to low? (ie, big or little endian?) */
  • release/4/numbers/trunk/numbers.scm

    r31287 r31291  
    142142(define %big+big (##core#primitive "big_plus_big"))
    143143
    144 (define %big-neg (##core#primitive "big_neg"))
     144(define %big-neg (##core#primitive "C_u_bignum_negate"))
    145145;; Can't use fxneg because that breaks in the edge case of negating
    146146;; the most negative fixnum.  Yes, 2's complement is fun!
  • release/4/numbers/trunk/numbers.setup

    r30516 r31291  
    33(compile -s -O3 -d1 numbers.scm -j numbers)
    44(compile -s -O3 -d0 numbers.import.scm)
    5 
    6 (compile -s -d1 numbers-syntax.scm -j numbers)
    75
    86(install-extension
  • release/4/numbers/trunk/tests/numbers-test.scm

    r30515 r31291  
    9191 (test "-: negate flo" -33.2 (- 33.2))
    9292 (test-assert "-: negate rat" (show (- r1)))
    93  (test-assert "-: negate big (should be -2147483668)" (show (- b1)))
     93 (test "-: double-negate big" b1 (- (- b1)))
    9494 (test "-: negate comp" (make-rectangular -33 -44) (- c1))
    9595 (test "-: fixnums" -11 (- 33 44))
Note: See TracChangeset for help on using the changeset viewer.