Changeset 31285 in project


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

Refactor (and simplify in the process) the fixnum negation and addition functions, to make them fit the CHICKEN naming convention. This makes it easier to integrate into core. malloc() is now avoided.

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

Legend:

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

    r30583 r31285  
    4242static void *tags;
    4343
     44#include "numbers-c.h"
     45
    4446#define fix_to_flo(p, n, f)       C_flonum(p, C_unfix(f))
    4547#define big_of(v)                 ((bignum_type)C_data_pointer(C_block_item(v, 1)))
     
    389391}
    390392
    391 static void
    392 fix_plus_fix(C_word c, C_word self, C_word k, C_word x, C_word y)
    393 {
    394   C_word z;
     393/* Eventually this will probably need to be integrated into C_2_plus. */
     394static void /* REFACTORED */
     395C_u_2_fixnum_plus(C_word c, C_word self, C_word k, C_word x, C_word y)
     396{
     397  C_word z, ab[C_SIZEOF_BIGNUM(2)], *a = ab;
    395398
    396399  /* Exceptional situation: this will cause a real overflow */
    397400  if (x == C_fix(C_MOST_NEGATIVE_FIXNUM) && y == C_fix(C_MOST_NEGATIVE_FIXNUM)) {
    398     bignum_type big;
    399     bignum_digit_type *ref;
    400     big = bignum_allocate(2, 1);
    401     ref = BIGNUM_START_PTR(big);
    402     *ref++ = 0;
    403     *ref = 2;
    404     C_return_bignum(k, big);
    405   }
    406 
    407   z = C_unfix(x) + C_unfix(y);
    408 
    409   /* This code "knows" that both fixnums and bignums have 2 reserved bits */
    410   if(!C_fitsinfixnump(z)) {
    411     bignum_type big;
    412     bignum_digit_type *ref;
    413     big = bignum_allocate(2, (z < 0));
    414     ref = BIGNUM_START_PTR(big);
    415     *ref++ = labs(z) & BIGNUM_DIGIT_MASK;
    416     *ref = 1;
    417     C_return_bignum(k, big);
    418   }
    419 
    420   C_kontinue(k, C_fix(z));
     401    C_kontinue(k, C_bignum2(&a, 1, 0, 2));
     402  } else {
     403    z = C_unfix(x) + C_unfix(y);
     404
     405    /* This code "knows" that both fixnums and bignums have 2 reserved bits */
     406    if(!C_fitsinfixnump(z)) {
     407      C_kontinue(k, C_bignum2(&a, (z < 0), labs(z) & (C_uword)BIGNUM_DIGIT_MASK, 1));
     408    } else {
     409      C_kontinue(k, C_fix(z));
     410    }
     411  }
    421412}
    422413
     
    16321623}
    16331624
    1634 static void
    1635 fix_neg(C_word c, C_word self, C_word k, C_word x)
    1636 {
    1637   x = C_unfix(x);
    1638   /* This code "knows" that bignums have 2 "reserved" bits, like fixnums */
    1639   if (x != C_MOST_NEGATIVE_FIXNUM) { /* C_fitsinfixnump(x) */
    1640     C_kontinue(k, C_fix(-x));
     1625/* TODO: This should probably be renamed C_fixnum_negate to replace
     1626 * what's in core.  Unfortunately, that one is allocating inline.
     1627 * That one may be renamed to C_u_i_fixnum_negate() or some such.
     1628 * TODO: Convert this to be an inline function and move to header?
     1629 */
     1630static void /* REFACTORED */
     1631C_u_fixnum_neg(C_word c, C_word self, C_word k, C_word x)
     1632{
     1633  /* Exceptional situation: this will cause an overflow to itself */
     1634  if (x == C_fix(C_MOST_NEGATIVE_FIXNUM)) { /* C_fitsinfixnump(x) */
     1635    C_word ab[C_SIZEOF_BIGNUM(2)], *a = ab;
     1636    C_kontinue(k, C_bignum2(&a, 0, 0, 1));
    16411637  } else {
    1642     bignum_digit_type *ref;
    1643     bignum_type big;
    1644     big = bignum_allocate(2, 0);
    1645     ref = BIGNUM_START_PTR(big);
    1646     *ref++ = 0;
    1647     *ref = 1;
    1648     C_return_bignum(k, big);
     1638    C_kontinue(k, C_fix(-C_unfix(x)));
    16491639  }
    16501640}
  • release/4/numbers/trunk/numbers-c.h

    r30582 r31285  
    154154#define BIGNUM_BITS_TO_DIGITS(n)                                        \
    155155  (((n) + (BIGNUM_DIGIT_LENGTH - 1)) / BIGNUM_DIGIT_LENGTH)
     156
     157
     158/*
     159 * Below is a duplication of the above, as port of a refactoring to
     160 * fit CHICKEN naming conventions and general C style.  This should
     161 * bring additional performance (eventually) and make it easier to
     162 * integrate into core, if that day will ever arrive...
     163 */
     164#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))
     166#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))
     167
     168/* CHAR_BIT is from <limits.h>, and it equals the number of bits in a char */
     169#define C_bytestobits(n)           ((n) * CHAR_BIT)
     170
     171#ifdef C_SIXTY_FOUR
     172# define C_BIGNUM_HEADER_SIGN_BIT  0x4000000000000000L
     173# define C_BIGNUM_HEADER_SIZE_MASK 0x3fffffffffffffffL
     174# define C_BIGNUM_DIGIT_MASK       0x3fffffffffffffffL
     175#else
     176# define C_BIGNUM_HEADER_SIGN_BIT  0x40000000
     177# define C_BIGNUM_HEADER_SIZE_MASK 0x3fffffff
     178# define C_BIGNUM_DIGIT_MASK       0x3fffffff
     179#endif
     180
     181/* TODO: low to high, or high to low? (ie, big or little endian?) */
     182C_inline C_word C_bignum2(C_word **ptr, int negp, C_uword d1, C_uword d2)
     183{
     184  C_word *p = *ptr, p0 = (C_word)p;
     185
     186  /**
     187   * TODO: Rewrite to fit into the bit representation, get rid of
     188   * structure wrapper and tag vector.  Also, remove the unnecessary
     189   * extra length slot if possible...
     190   */
     191  C_word tagvec = CHICKEN_gc_root_ref(tags);
     192
     193  /* Not using C_a_i_vector2, to make it easier to rewrite later */
     194  *(p++) = C_STRING_TYPE | (3 * sizeof(C_word));
     195  *(p++) = negp ? C_BIGNUM_HEADER_SIGN_BIT | 2 : 2;
     196  *(p++) = d1;
     197  *(p++) = d2;
     198  *ptr = p;
     199
     200  /* TODO: Maybe add C_a_i_structureN, like C_a_i_vectorN? */
     201  return C_structure(ptr, 2, C_block_item(tagvec, BIG_TAG), p0);
     202}
  • release/4/numbers/trunk/numbers.scm

    r30583 r31285  
    7373          foreign)
    7474
    75 (foreign-declare "#include \"numbers-c.h\"")
    7675(foreign-declare "#include \"numbers-c.c\"")
    7776
     
    139138(define-inline (%big->flo n) (##core#inline_allocate ("big_to_flo" 4) n))
    140139
    141 (define %fix+fix (##core#primitive "fix_plus_fix"))
     140(define %fix+fix (##core#primitive "C_u_2_fixnum_plus"))
    142141(define %fix+big (##core#primitive "fix_plus_big"))
    143142(define %big+big (##core#primitive "big_plus_big"))
     
    146145;; Can't use fxneg because that breaks in the edge case of negating
    147146;; the most negative fixnum.  Yes, 2's complement is fun!
    148 (define %fix-neg (##core#primitive "fix_neg"))
     147(define %fix-neg (##core#primitive "C_u_fixnum_neg"))
    149148
    150149(define %fix-big (##core#primitive "fix_minus_big"))
Note: See TracChangeset for help on using the changeset viewer.