Changeset 8529
 Timestamp:
 Feb 21, 2008, 9:23:02 AM (12 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

trunk/source/level0/l0bignum64.lisp
r8405 r8529 779 779 (defun multiplybignumandfixnum (bignum fixnum) 780 780 (declare (type bignumtype bignum) (fixnum fixnum)) 781 (let* ((biglen (%bignumlength bignum)) 782 (bigneg (bignumminusp bignum)) 783 (signsdiffer (not (eq bigneg (minusp fixnum))))) 784 (flet ((multiplyunsignedbignumand2digitfixnum (a lena high low) 785 (declare (bignumtype a) 786 (bignumelementtype high low) 787 (bignumindex lena) 788 (optimize (speed 3) (safety 0))) 789 (let* ((lenres (+ lena 2)) 790 (res (%allocatebignum lenres)) ) 791 (declare (bignumindex lena lenres)) 792 (dotimes (i lena) 793 (declare (type bignumindex i)) 794 (let* ((carrydigit 0) 795 (x (bignumref a i)) 796 (k i)) 797 (declare (fixnum k)) 798 (multiplevaluebind (bigcarry resdigit) 799 (%multiplyandadd4 x 800 low 801 (bignumref res k) 802 carrydigit) 803 (setf (bignumref res k) resdigit 804 carrydigit bigcarry 805 k (1+ k))) 806 (multiplevaluebind (bigcarry resdigit) 807 (%multiplyandadd4 x 808 high 809 (bignumref res k) 810 carrydigit) 811 (setf (bignumref res k) resdigit 812 carrydigit bigcarry 813 k (1+ k))) 814 (setf (bignumref res k) carrydigit))) 815 res)) 816 (multiplyunsignedbignumand1digitfixnum (a lena fix) 817 (declare (bignumtype a) 818 (bignumelementtype fix) 819 (bignumindex lena) 820 (optimize (speed 3) (safety 0))) 821 (let* ((lenres (+ lena 1)) 822 (res (%allocatebignum lenres)) ) 823 (declare (bignumindex lena lenres)) 824 (dotimes (i lena) 825 (declare (type bignumindex i)) 826 (let* ((carrydigit 0) 827 (x (bignumref a i)) 828 (k i)) 829 (declare (fixnum k)) 830 (multiplevaluebind (bigcarry resdigit) 831 (%multiplyandadd4 x 832 fix 833 (bignumref res k) 834 carrydigit) 835 (setf (bignumref res k) resdigit 836 carrydigit bigcarry 837 k (1+ k))) 838 (setf (bignumref res k) carrydigit))) 839 res))) 840 (let* ((low (logand (1 (ash 1 32)) fixnum)) 841 (high (unless (<= (%fixnumintlen fixnum) 32) 842 (ldb (byte 32 32) fixnum))) 843 (res (if bigneg 844 (let* ((neglen (1+ biglen))) 845 (declare (type bignumindex neglen)) 846 (withbignumbuffers ((neg neglen)) 847 (negatebignum bignum nil neg) 781 (if (eql fixnum 1) 782 bignum 783 (if (eql fixnum target::targetmostnegativefixnum) 784 (withsmallbignumbuffers ((bigfix fixnum)) 785 (multiplybignums bignum bigfix)) 786 (let* ((biglen (%bignumlength bignum)) 787 (bigneg (bignumminusp bignum)) 788 (signsdiffer (not (eq bigneg (minusp fixnum))))) 789 (flet ((multiplyunsignedbignumand2digitfixnum (a lena high low) 790 (declare (bignumtype a) 791 (bignumelementtype high low) 792 (bignumindex lena) 793 (optimize (speed 3) (safety 0))) 794 (let* ((lenres (+ lena 2)) 795 (res (%allocatebignum lenres)) ) 796 (declare (bignumindex lena lenres)) 797 (dotimes (i lena) 798 (declare (type bignumindex i)) 799 (let* ((carrydigit 0) 800 (x (bignumref a i)) 801 (k i)) 802 (declare (fixnum k)) 803 (multiplevaluebind (bigcarry resdigit) 804 (%multiplyandadd4 x 805 low 806 (bignumref res k) 807 carrydigit) 808 (setf (bignumref res k) resdigit 809 carrydigit bigcarry 810 k (1+ k))) 811 (multiplevaluebind (bigcarry resdigit) 812 (%multiplyandadd4 x 813 high 814 (bignumref res k) 815 carrydigit) 816 (setf (bignumref res k) resdigit 817 carrydigit bigcarry 818 k (1+ k))) 819 (setf (bignumref res k) carrydigit))) 820 res)) 821 (multiplyunsignedbignumand1digitfixnum (a lena fix) 822 (declare (bignumtype a) 823 (bignumelementtype fix) 824 (bignumindex lena) 825 (optimize (speed 3) (safety 0))) 826 (let* ((lenres (+ lena 1)) 827 (res (%allocatebignum lenres)) ) 828 (declare (bignumindex lena lenres)) 829 (dotimes (i lena) 830 (declare (type bignumindex i)) 831 (let* ((carrydigit 0) 832 (x (bignumref a i)) 833 (k i)) 834 (declare (fixnum k)) 835 (multiplevaluebind (bigcarry resdigit) 836 (%multiplyandadd4 x 837 fix 838 (bignumref res k) 839 carrydigit) 840 (setf (bignumref res k) resdigit 841 carrydigit bigcarry 842 k (1+ k))) 843 (setf (bignumref res k) carrydigit))) 844 res))) 845 (let* ((fixnum (if (< fixnum 0) ( fixnum) fixnum)) 846 (low (logand (1 (ash 1 32)) fixnum)) 847 (high (unless (<= (%fixnumintlen fixnum) 32) 848 (ldb (byte 32 32) fixnum))) 849 (res (if bigneg 850 (let* ((neglen (1+ biglen))) 851 (declare (type bignumindex neglen)) 852 (withbignumbuffers ((neg neglen)) 853 (negatebignum bignum nil neg) 854 (setq neglen (%bignumlength bignum)) 855 (if high 856 (multiplyunsignedbignumand2digitfixnum 857 neg 858 neglen 859 high 860 low) 861 (multiplyunsignedbignumand1digitfixnum 862 neg 863 neglen 864 low)))) 848 865 (if high 849 866 (multiplyunsignedbignumand2digitfixnum 850 neg851 neglen867 bignum 868 biglen 852 869 high 853 870 low) 854 871 (multiplyunsignedbignumand1digitfixnum 855 neg 856 neglen 857 low)))) 858 (if high 859 (multiplyunsignedbignumand2digitfixnum 860 bignum 861 biglen 862 high 863 low) 864 (multiplyunsignedbignumand1digitfixnum 865 bignum 866 biglen 867 low))))) 868 (if signsdiffer (negatebignuminplace res)) 869 (%normalizebignummacro res))))) 872 bignum 873 biglen 874 low))))) 875 (if signsdiffer (negatebignuminplace res)) 876 (%normalizebignummacro res))))))) 870 877 871 878
Note: See TracChangeset
for help on using the changeset viewer.