Changeset 31473 in project


Ignore:
Timestamp:
09/21/14 15:55:33 (5 years ago)
Author:
sjamaan
Message:

numbers: Restore _2_ naming convention. Add specialization for gcd.

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

Legend:

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

    r31472 r31473  
    516516
    517517void C_ccall
    518 C_basic_gcd(C_word c, C_word self, C_word k, C_word x, C_word y)
     518C_2_basic_gcd(C_word c, C_word self, C_word k, C_word x, C_word y)
    519519{
    520520  C_word ab[C_SIZEOF_FLONUM*2+C_SIZEOF_CLOSURE(4)], *a = ab, k2;
     
    522522  if (x & C_FIXNUM_BIT) {
    523523    if (y & C_FIXNUM_BIT) {
    524       C_kontinue(k, C_u_i_fixnum_gcd(x, y));
     524      C_kontinue(k, C_u_i_2_fixnum_gcd(x, y));
    525525    } else if (C_immediatep(y)) {
    526526      C_kontinue(k, C_SCHEME_FALSE);
     
    531531        C_kontinue(k, C_SCHEME_FALSE);
    532532      } else {
    533         C_kontinue(k, C_a_u_i_flonum_gcd(&a, 1, C_a_i_fix_to_flo(&a, 1, x), y));
     533        C_kontinue(k, C_a_u_i_2_flonum_gcd(&a, 1, C_a_i_fix_to_flo(&a, 1, x), y));
    534534      }
    535535    } else if (C_IS_BIGNUM_TYPE(y)) {
    536       C_u_integer_gcd(4, (C_word)NULL, k, x, y);
     536      C_u_2_integer_gcd(4, (C_word)NULL, k, x, y);
    537537    } else {
    538538      C_kontinue(k, C_SCHEME_FALSE);
     
    546546      C_kontinue(k, C_SCHEME_FALSE);
    547547    } else if (y & C_FIXNUM_BIT) {
    548       C_kontinue(k, C_a_u_i_flonum_gcd(&a, 1, x, C_a_i_fix_to_flo(&a, 1, y)));
     548      C_kontinue(k, C_a_u_i_2_flonum_gcd(&a, 1, x, C_a_i_fix_to_flo(&a, 1, y)));
    549549    } else if (C_immediatep(y)) {
    550550      C_kontinue(k, C_SCHEME_FALSE);
     
    555555        C_kontinue(k, C_SCHEME_FALSE);
    556556      } else {
    557         C_kontinue(k, C_a_u_i_flonum_gcd(&a, 1, x, y));
     557        C_kontinue(k, C_a_u_i_2_flonum_gcd(&a, 1, x, y));
    558558      }
    559559    } else if (C_IS_BIGNUM_TYPE(y)) {
     
    569569  } else if (C_IS_BIGNUM_TYPE(x)) {
    570570    if (y & C_FIXNUM_BIT) {
    571       C_u_integer_gcd(4, (C_word)NULL, k, x, y);
     571      C_u_2_integer_gcd(4, (C_word)NULL, k, x, y);
    572572    } else if (C_immediatep(y)) {
    573573      C_kontinue(k, C_SCHEME_FALSE);
     
    580580      }
    581581    } else if (C_IS_BIGNUM_TYPE(y)) {
    582       C_u_bignum_gcd(4, (C_word)NULL, k, x, y);
     582      C_u_2_bignum_gcd(4, (C_word)NULL, k, x, y);
    583583    } else {
    584584      C_kontinue(k, C_SCHEME_FALSE);
     
    598598  k2 = C_closure(&ka, 2, (C_word)gcd_intflo_2, k);
    599599  if (C_truep(intnum_is_x))
    600     C_u_integer_gcd(4, (C_word)NULL, k2, intnum, other_arg);
     600    C_u_2_integer_gcd(4, (C_word)NULL, k2, intnum, other_arg);
    601601  else
    602     C_u_integer_gcd(4, (C_word)NULL, k2, other_arg, intnum);
     602    C_u_2_integer_gcd(4, (C_word)NULL, k2, other_arg, intnum);
    603603}
    604604
     
    613613
    614614C_word C_ccall
    615 C_u_i_fixnum_gcd(C_word x, C_word y)
     615C_u_i_2_fixnum_gcd(C_word x, C_word y)
    616616{
    617617   C_word r;
     
    632632
    633633C_word C_ccall
    634 C_a_u_i_flonum_gcd(C_word **p, C_word n, C_word x, C_word y)
     634C_a_u_i_2_flonum_gcd(C_word **p, C_word n, C_word x, C_word y)
    635635{
    636636   double xub, yub, r;
     
    651651
    652652void C_ccall
    653 C_u_integer_gcd(C_word c, C_word self, C_word k, C_word x, C_word y)
     653C_u_2_integer_gcd(C_word c, C_word self, C_word k, C_word x, C_word y)
    654654{
    655655  if (y == C_fix(0)) {
    656656    C_u_integer_abs(3, (C_word)NULL, k, x);
    657657  } else if (x & C_FIXNUM_BIT && y & C_FIXNUM_BIT) {
    658     C_kontinue(k, C_u_i_fixnum_gcd(x, y));
     658    C_kontinue(k, C_u_i_2_fixnum_gcd(x, y));
    659659  } else {
    660660    C_word kab[C_SIZEOF_CLOSURE(3)], *ka = kab, k2;
     
    667667
    668668void C_ccall /* A bit silly to have this? */
    669 C_u_bignum_gcd(C_word c, C_word self, C_word k, C_word x, C_word y)
     669C_u_2_bignum_gcd(C_word c, C_word self, C_word k, C_word x, C_word y)
    670670{
    671671  C_word kab[C_SIZEOF_CLOSURE(3)], *ka = kab, k2;
     
    683683    C_word k = C_block_item(self, 1),
    684684           x = C_block_item(self, 2); /* Old y = new x */
    685     C_u_integer_gcd(4, (C_word)NULL, k, x, new_y);
     685    C_u_2_integer_gcd(4, (C_word)NULL, k, x, new_y);
    686686  }
    687687}
  • release/4/numbers/trunk/numbers-c.h

    r31472 r31473  
    8181C_word C_ccall C_bignum_normalize(C_word big);
    8282
    83 void C_ccall C_basic_gcd(C_word c, C_word self, C_word k, C_word x, C_word y) C_noret;
    84 C_word C_ccall C_u_i_fixnum_gcd(C_word x, C_word y);
    85 C_word C_ccall C_a_u_i_flonum_gcd(C_word **p, C_word n, C_word x, C_word y);
    86 void C_ccall C_u_integer_gcd(C_word c, C_word self, C_word k, C_word x, C_word y) C_noret;
    87 void C_ccall C_u_bignum_gcd(C_word c, C_word self, C_word k, C_word x, C_word y) C_noret;
     83void C_ccall C_2_basic_gcd(C_word c, C_word self, C_word k, C_word x, C_word y) C_noret;
     84C_word C_ccall C_u_i_2_fixnum_gcd(C_word x, C_word y);
     85C_word C_ccall C_a_u_i_2_flonum_gcd(C_word **p, C_word n, C_word x, C_word y);
     86void C_ccall C_u_2_integer_gcd(C_word c, C_word self, C_word k, C_word x, C_word y) C_noret;
     87void C_ccall C_u_2_bignum_gcd(C_word c, C_word self, C_word k, C_word x, C_word y) C_noret;
    8888
    8989void C_ccall C_2_basic_plus(C_word c, C_word self, C_word k, C_word x, C_word y) C_noret;
  • release/4/numbers/trunk/numbers.scm

    r31472 r31473  
    6565       @fixnum-quotient&remainder @flonum-quotient&remainder
    6666       @integer-quotient&remainder @basic-quotient&remainder
    67        @bignum-quotient&remainder)
     67       @bignum-quotient&remainder
     68       @fixnum-2-gcd @integer-2-gcd @basic-2-gcd @bignum-2-gcd)
    6869
    6970  (import (except scheme
     
    137138(define @bignum-quotient&remainder (##core#primitive "C_u_bignum_divrem"))
    138139
     140;; There is no specialization for flonums because of the integer check.
     141;; Perhaps that should change?
     142(define @basic-2-gcd (##core#primitive "C_2_basic_gcd"))
     143(define (@fixnum-2-gcd a b) (##core#inline "C_u_i_2_fixnum_gcd" a b))
     144(define @integer-2-gcd (##core#primitive "C_u_2_integer_gcd"))
     145(define @bignum-2-gcd (##core#primitive "C_u_2_bignum_gcd"))
     146
    139147(define-foreign-variable FIX integer)
    140148(define-foreign-variable FLO integer)
     
    196204(define-inline (%big->flo n) (##core#inline_allocate ("C_a_u_i_big_to_flo" 4) n))
    197205
    198 (define (fxgcd x y) (##core#inline "C_u_i_fixnum_gcd" x y))
     206(define (fxgcd x y) (##core#inline "C_u_i_2_fixnum_gcd" x y))
    199207
    200208(define-inline (%big-cmp x y) (##core#inline "C_u_i_bignum_cmp" x y))
     
    11701178
    11711179(define (%gcd-0 loc x y)
    1172   (cond (((##core#primitive "C_basic_gcd") x y))
     1180  (cond (((##core#primitive "C_2_basic_gcd") x y))
    11731181        ((number? x)                ; XXX What about non-integral flonums?
    11741182         (if (extended-number? y)
  • release/4/numbers/trunk/numbers.types

    r31468 r31473  
    426426                   (numbers#@basic-quotient&remainder 'truncate/ #(1) #(2))))
    427427
    428 (numbers#gcd (#(procedure #:clean #:enforce) numbers#gcd (#!rest (or fixnum float (struct bignum) (struct compnum) (struct ratnum))) (or fixnum float (struct bignum) (struct compnum) (struct ratnum))))
     428(numbers#gcd (#(procedure #:clean #:enforce) numbers#gcd (#!rest (or fixnum float (struct bignum) (struct compnum) (struct ratnum))) (or fixnum float (struct bignum) (struct compnum) (struct ratnum)))
     429             (() (fixnum) '0)
     430             ((fixnum) (fixnum) #(1))
     431             ;; XXX Must be an integer flonum!
     432             #;((float) (float) #(1))
     433             #;((number) (number) #(1))
     434             (((struct bignum)) ((struct bignum)) #(1))
     435             ((fixnum fixnum) ((or fixnum (struct bignum)))
     436              (numbers#@fixnum-2-gcd #(1) #(2)))
     437             (((struct bignum) (struct bignum)) ((or fixnum (struct bignum)))
     438              (numbers#@bignum-2-gcd #(1) #(2)))
     439             (((or fixnum (struct bignum)) (or fixnum (struct bignum))) ((or fixnum (struct bignum)))
     440              (numbers#@integer-2-gcd #(1) #(2)))
     441             ;; XXX Disabled: it may return #f for non-integral flonums
     442             #;(((or fixnum (struct bignum) float) (or fixnum (struct bignum) float)) ((or fixnum (struct bignum) float))
     443              (numbers#@basic-2-gcd #(1) #(2))))
     444
    429445(numbers#lcm (#(procedure #:clean #:enforce) numbers#lcm (#!rest (or fixnum float (struct bignum) (struct compnum) (struct ratnum))) (or fixnum float (struct bignum) (struct compnum) (struct ratnum))))
    430446
Note: See TracChangeset for help on using the changeset viewer.