Changeset 31473 in project
 Timestamp:
 09/21/14 15:55:33 (5 years ago)
 Location:
 release/4/numbers/trunk
 Files:

 4 edited
Legend:
 Unmodified
 Added
 Removed

release/4/numbers/trunk/numbersc.c
r31472 r31473 516 516 517 517 void C_ccall 518 C_ basic_gcd(C_word c, C_word self, C_word k, C_word x, C_word y)518 C_2_basic_gcd(C_word c, C_word self, C_word k, C_word x, C_word y) 519 519 { 520 520 C_word ab[C_SIZEOF_FLONUM*2+C_SIZEOF_CLOSURE(4)], *a = ab, k2; … … 522 522 if (x & C_FIXNUM_BIT) { 523 523 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)); 525 525 } else if (C_immediatep(y)) { 526 526 C_kontinue(k, C_SCHEME_FALSE); … … 531 531 C_kontinue(k, C_SCHEME_FALSE); 532 532 } 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)); 534 534 } 535 535 } 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); 537 537 } else { 538 538 C_kontinue(k, C_SCHEME_FALSE); … … 546 546 C_kontinue(k, C_SCHEME_FALSE); 547 547 } 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))); 549 549 } else if (C_immediatep(y)) { 550 550 C_kontinue(k, C_SCHEME_FALSE); … … 555 555 C_kontinue(k, C_SCHEME_FALSE); 556 556 } 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)); 558 558 } 559 559 } else if (C_IS_BIGNUM_TYPE(y)) { … … 569 569 } else if (C_IS_BIGNUM_TYPE(x)) { 570 570 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); 572 572 } else if (C_immediatep(y)) { 573 573 C_kontinue(k, C_SCHEME_FALSE); … … 580 580 } 581 581 } 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); 583 583 } else { 584 584 C_kontinue(k, C_SCHEME_FALSE); … … 598 598 k2 = C_closure(&ka, 2, (C_word)gcd_intflo_2, k); 599 599 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); 601 601 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); 603 603 } 604 604 … … 613 613 614 614 C_word C_ccall 615 C_u_i_ fixnum_gcd(C_word x, C_word y)615 C_u_i_2_fixnum_gcd(C_word x, C_word y) 616 616 { 617 617 C_word r; … … 632 632 633 633 C_word C_ccall 634 C_a_u_i_ flonum_gcd(C_word **p, C_word n, C_word x, C_word y)634 C_a_u_i_2_flonum_gcd(C_word **p, C_word n, C_word x, C_word y) 635 635 { 636 636 double xub, yub, r; … … 651 651 652 652 void C_ccall 653 C_u_ integer_gcd(C_word c, C_word self, C_word k, C_word x, C_word y)653 C_u_2_integer_gcd(C_word c, C_word self, C_word k, C_word x, C_word y) 654 654 { 655 655 if (y == C_fix(0)) { 656 656 C_u_integer_abs(3, (C_word)NULL, k, x); 657 657 } 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)); 659 659 } else { 660 660 C_word kab[C_SIZEOF_CLOSURE(3)], *ka = kab, k2; … … 667 667 668 668 void 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)669 C_u_2_bignum_gcd(C_word c, C_word self, C_word k, C_word x, C_word y) 670 670 { 671 671 C_word kab[C_SIZEOF_CLOSURE(3)], *ka = kab, k2; … … 683 683 C_word k = C_block_item(self, 1), 684 684 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); 686 686 } 687 687 } 
release/4/numbers/trunk/numbersc.h
r31472 r31473 81 81 C_word C_ccall C_bignum_normalize(C_word big); 82 82 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;83 void C_ccall C_2_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_2_fixnum_gcd(C_word x, C_word y); 85 C_word C_ccall C_a_u_i_2_flonum_gcd(C_word **p, C_word n, C_word x, C_word y); 86 void C_ccall C_u_2_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_2_bignum_gcd(C_word c, C_word self, C_word k, C_word x, C_word y) C_noret; 88 88 89 89 void 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 65 65 @fixnumquotient&remainder @flonumquotient&remainder 66 66 @integerquotient&remainder @basicquotient&remainder 67 @bignumquotient&remainder) 67 @bignumquotient&remainder 68 @fixnum2gcd @integer2gcd @basic2gcd @bignum2gcd) 68 69 69 70 (import (except scheme … … 137 138 (define @bignumquotient&remainder (##core#primitive "C_u_bignum_divrem")) 138 139 140 ;; There is no specialization for flonums because of the integer check. 141 ;; Perhaps that should change? 142 (define @basic2gcd (##core#primitive "C_2_basic_gcd")) 143 (define (@fixnum2gcd a b) (##core#inline "C_u_i_2_fixnum_gcd" a b)) 144 (define @integer2gcd (##core#primitive "C_u_2_integer_gcd")) 145 (define @bignum2gcd (##core#primitive "C_u_2_bignum_gcd")) 146 139 147 (defineforeignvariable FIX integer) 140 148 (defineforeignvariable FLO integer) … … 196 204 (defineinline (%big>flo n) (##core#inline_allocate ("C_a_u_i_big_to_flo" 4) n)) 197 205 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)) 199 207 200 208 (defineinline (%bigcmp x y) (##core#inline "C_u_i_bignum_cmp" x y)) … … 1170 1178 1171 1179 (define (%gcd0 loc x y) 1172 (cond (((##core#primitive "C_ basic_gcd") x y))1180 (cond (((##core#primitive "C_2_basic_gcd") x y)) 1173 1181 ((number? x) ; XXX What about nonintegral flonums? 1174 1182 (if (extendednumber? y) 
release/4/numbers/trunk/numbers.types
r31468 r31473 426 426 (numbers#@basicquotient&remainder 'truncate/ #(1) #(2)))) 427 427 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#@fixnum2gcd #(1) #(2))) 437 (((struct bignum) (struct bignum)) ((or fixnum (struct bignum))) 438 (numbers#@bignum2gcd #(1) #(2))) 439 (((or fixnum (struct bignum)) (or fixnum (struct bignum))) ((or fixnum (struct bignum))) 440 (numbers#@integer2gcd #(1) #(2))) 441 ;; XXX Disabled: it may return #f for nonintegral flonums 442 #;(((or fixnum (struct bignum) float) (or fixnum (struct bignum) float)) ((or fixnum (struct bignum) float)) 443 (numbers#@basic2gcd #(1) #(2)))) 444 429 445 (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)))) 430 446
Note: See TracChangeset
for help on using the changeset viewer.