Changeset 15570
 Timestamp:
 Jan 8, 2013, 8:34:00 AM (6 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

trunk/source/level0/l0bignum64.lisp
r15377 r15570 801 801 (defun multiplybignums (a b) 802 802 (let* ((signsdiffer (not (eq (bignumminusp a) (bignumminusp b))))) 803 (flet ((multiplyunsignedbignums (a b) 804 (let* ((lena (%bignumlength a)) 805 (lenb (%bignumlength b)) 806 (lenres (+ lena lenb)) 807 (res (%allocatebignum lenres))) 808 (declare (bignumindex lena lenb lenres)) 809 (dotimes (i lena) 810 (declare (type bignumindex i)) 811 (%multiplyandaddloop a b res i lenb)) 812 res)) 813 (multiplyunsignedbignums64 (a b) 803 (flet ((multiplyunsignedbignums64 (a b) 814 804 (let* ((lena (ceiling (%bignumlength a) 2)) 815 805 (lenb (ceiling (%bignumlength b) 2)) … … 826 816 (%normalizebignummacro res))))) 827 817 818 #+old 828 819 (defun multiplybignumandfixnum (bignum fixnum) 829 820 (declare (type bignumtype bignum) (fixnum fixnum)) … … 833 824 (multiplybignums bignum bigfix)))) 834 825 835 #+slower836 826 (defun multiplybignumandfixnum (bignum fixnum) 837 827 (declare (type bignumtype bignum) (fixnum fixnum)) 838 828 (if (eql fixnum 1) 839 829 bignum 840 (if (eql fixnum target::targetmostnegativefixnum) 841 (withsmallbignumbuffers ((bigfix fixnum)) 842 (multiplybignums bignum bigfix)) 843 (let* ((biglen (%bignumlength bignum)) 844 (bigneg (bignumminusp bignum)) 845 (signsdiffer (not (eq bigneg (minusp fixnum))))) 846 (flet ((multiplyunsignedbignumand2digitfixnum (a lena high low) 847 (declare (bignumtype a) 848 (bignumelementtype high low) 849 (bignumindex lena) 850 (optimize (speed 3) (safety 0))) 851 (let* ((lenres (+ lena 2)) 852 (res (%allocatebignum lenres)) ) 853 (declare (bignumindex lena lenres)) 854 (dotimes (i lena) 855 (declare (type bignumindex i)) 856 (let* ((carrydigit 0) 857 (x (bignumref a i)) 858 (k i)) 859 (declare (fixnum k)) 860 (multiplevaluebind (bigcarry resdigit) 861 (%multiplyandadd4 x 862 low 863 (bignumref res k) 864 carrydigit) 865 (setf (bignumref res k) resdigit 866 carrydigit bigcarry 867 k (1+ k))) 868 (multiplevaluebind (bigcarry resdigit) 869 (%multiplyandadd4 x 870 high 871 (bignumref res k) 872 carrydigit) 873 (setf (bignumref res k) resdigit 874 carrydigit bigcarry 875 k (1+ k))) 876 (setf (bignumref res k) carrydigit))) 877 res)) 878 (multiplyunsignedbignumand1digitfixnum (a lena fix) 879 (declare (bignumtype a) 880 (bignumelementtype fix) 881 (bignumindex lena) 882 (optimize (speed 3) (safety 0))) 883 (let* ((lenres (+ lena 1)) 884 (res (%allocatebignum lenres)) ) 885 (declare (bignumindex lena lenres)) 886 (dotimes (i lena) 887 (declare (type bignumindex i)) 888 (let* ((carrydigit 0) 889 (x (bignumref a i)) 890 (k i)) 891 (declare (fixnum k)) 892 (multiplevaluebind (bigcarry resdigit) 893 (%multiplyandadd4 x 894 fix 895 (bignumref res k) 896 carrydigit) 897 (setf (bignumref res k) resdigit 898 carrydigit bigcarry 899 k (1+ k))) 900 (setf (bignumref res k) carrydigit))) 901 res))) 902 (let* ((fixnum (if (< fixnum 0) ( fixnum) fixnum)) 903 (low (logand (1 (ash 1 32)) fixnum)) 904 (high (unless (<= (%fixnumintlen fixnum) 32) 905 (ldb (byte 32 32) fixnum))) 906 (res (if bigneg 907 (let* ((neglen (1+ biglen))) 908 (declare (type bignumindex neglen)) 909 (withbignumbuffers ((neg neglen)) 910 (negatebignum bignum nil neg) 911 (setq neglen (%bignumlength bignum)) 912 (if high 913 (multiplyunsignedbignumand2digitfixnum 914 neg 915 neglen 916 high 917 low) 918 (multiplyunsignedbignumand1digitfixnum 919 neg 920 neglen 921 low)))) 922 (if high 923 (multiplyunsignedbignumand2digitfixnum 924 bignum 925 biglen 926 high 927 low) 928 (multiplyunsignedbignumand1digitfixnum 929 bignum 930 biglen 931 low))))) 932 (if signsdiffer (negatebignuminplace res)) 933 (%normalizebignummacro res))))))) 830 (let* ((bignumlen (%bignumlength bignum)) 831 (bignumplusp (bignumplusp bignum)) 832 (fixnumplusp (not (minusp fixnum))) 833 (negateres (neq bignumplusp fixnumplusp))) 834 (declare (type bignumtype bignum) 835 (type bignumindex bignumlen)) 836 (flet ((doit (bignum fixnum negateres) 837 (let* ((bignumlen (%bignumlength bignum)) 838 (result (%allocatebignum (the fixnum (+ bignumlen 2)))) 839 (len64 (ash (1+ bignumlen) 1))) 840 (declare (type bignumtype bignum) 841 (type bignumindex bignumlen len64)) 842 (%multiplyandaddfixnumloop len64 bignum fixnum result) 843 (when negateres 844 (negatebignuminplace result)) 845 (%normalizebignummacro result )))) 846 (declare (dynamicextent #'doit)) 847 (if bignumplusp 848 (doit bignum (if fixnumplusp fixnum ( fixnum)) negateres) 849 (withbignumbuffers ((b1 (the fixnum (1+ bignumlen)))) 850 (negatebignum bignum nil b1) 851 (doit b1 (if fixnumplusp fixnum ( fixnum)) negateres))))))) 934 852 935 853
Note: See TracChangeset
for help on using the changeset viewer.