Changeset 9552

Timestamp:

May 19, 2008, 11:01:33 PM (17 years ago)

Author:

R. Matthew Emerson

Message:

Redo bignum-shift-left-loop. Implement truncate-guess-loop,
%multiply-and-add-1.

Correct errors in %floor-99.

File:

• branches/ia32/level-0/X86/X8632/x8632-bignum.lisp (modified) (6 diffs)

branches/ia32/level-0/X86/X8632/x8632-bignum.lisp

@@ -654 +654 @@
     (single-value-return 3)))
 
+;;; shift bignum left by nbits bits (1 <= nbits < 32)
+;;; j is one more than the number of digits in bignum
 (defx8632lapfunction bignum-shift-left-loop ((nbits 12) (result 8)
                                              (bignum 4) #|(ra 0)|#
                                              (res-len-1 arg_y) (j arg_z))
-  (movl (@ nbits (% esp)) (% imm0))
+  (movl (% ebp) (@ 16 (% esp)))
+  (leal (@ 16 (% esp)) (% ebp))
+  (popl (@ 4 (% ebp)))
+  (push (% arg_y))                      ;ebp - 16
+  (push (% arg_z))                      ;ebp - 20
+
+  (movl (@ -4 (% ebp)) (% imm0))
   (sarl ($ x8632::fixnumshift) (% imm0))
   (movd (% imm0) (% mm7))               ;shift count
   (negl (% imm0))
-  (addl ($ 32) (% imm0))                ;remaining-bits = 32 - shift-count
+  (addl ($ 32) (% imm0))
   (movd (% imm0) (% mm6))               ;remaining bits
-  (movl (@ result (% esp)) (% temp0))
-  (movl (@ bignum (% esp)) (% temp1))
-  (push (% arg_z))
-  (push (% arg_y))
-  (xorl (% arg_y) (% arg_y))            ;i
-  (jmp @test)
-  @loop
-  (movd (@ x8632::misc-data-offset (% temp1) (% arg_y)) (% mm0)) ;b[i]
-  (psrlq (% mm6) (% mm0))
-  (movd (@ (+ 4 x8632::misc-data-offset) (% temp1) (% arg_y)) (% mm1)) ;b[i+1]
-  (psllq (% mm7) (% mm1))
-  (por (% mm1) (% mm0))
-  (movd (% mm0) (@ x8632::misc-data-offset (% temp0) (% arg_z))) ;r[j]
-  (addl ($ '1) (% arg_y))
-  (addl ($ '1) (% arg_z))
-  @test
-  (cmpl (@ (% esp)) (% j))              ;pity res-len-1 can't stay in a reg
-  (jne @loop)
-  (add ($ '1) (% esp))                  ;discard pushed res-len-1
-  (movd (@ x8632::misc-data-offset (% temp1) (% arg_y)) (% mm0)) ;b[i]
-  (psrlq (% mm6) (% mm0))
-  (movd (% mm0) (@ x8632::misc-data-offset (% temp0) (% arg_z))) ;r[j]
-  ;; reconstitute "digits" arg to bignum-ashift-left-unaligned
-  (pop (% arg_z))
-  (subl ($ '1) (% arg_z))
-  (movd (@ x8632::misc-data-offset (% temp1)) (% mm0)) ;b[0]
-  (psllq (% mm7) (% mm0))
-  (movd (% mm0) (@ x8632::misc-data-offset (% temp0) (% arg_z))) ;b[digits]
-  (single-value-return 5))
+
+  (let ((rl-1 -16)
+        (r temp0)
+        (b temp1)
+        (i arg_y)
+        (i+1 imm0))
+    (movl (@ -8 (% ebp)) (% r))
+    (movl (@ -12 (% ebp)) (% b))
+    (xorl (% i) (% i))
+    (movl ($ '1) (% i+1))
+    ;; j (in arg_z) is already (1+ digits)
+    (jmp @test)
+    @loop
+    (movd (@ x8632::misc-data-offset (% b) (% i)) (% mm0))
+    (psrlq (% mm6) (% mm0))
+    (movd (@ x8632::misc-data-offset (% b) (% i+1)) (% mm1))
+    (psllq (% mm7) (% mm1))
+    (por (% mm1) (% mm0))
+    (movd (% mm0) (@ x8632::misc-data-offset (% r) (% j)))
+    (movl (% i+1) (% i))
+    (addl ($ '1) (% i))
+    (addl ($ '1) (% j))
+    @test
+    (cmpl (@ rl-1 (% ebp)) (% j))
+    (jne @loop)
+    (movd (@ x8632::misc-data-offset (% b)) (% mm0))
+    (psllq (% mm7) (% mm0))
+    (movl (@ -20 (% ebp)) (% imm0))     ;digits + 1 (that is, the original j)
+    (subl ($ '1) (% imm0))              ;digits
+    (movd (% mm0) (@ x8632::misc-data-offset (% r) (% imm0)))
+    (movd (@ x8632::misc-data-offset (% b) (% i)) (% mm0))
+    (psrad (% mm6) (% mm0))
+    (addl ($ '1) (% imm0))              ;original j again
+    (movd (% mm0) (@ x8632::misc-data-offset (% r) (% j))))
+  (leave)
+  (ret))
 
 ;;; shift bignum right by i words plus nbits bits.
@@ -834 +849 @@
   (jmp-subprim .SPvalues))
 
+;;; transliterated from bignum-truncate-guess in l0-bignum64.lisp
+;;; this is not beautiful...
 (defx8632lapfunction truncate-guess-loop ((guess-h 16) (guess-l 12) (x 8)
                                           (xidx 4) #|(ra 0)|#
                                           (yptr arg_y) (yidx arg_z))
-  (int ($ 3)))
+  (movl (% ebp) (@ 20 (% esp)))
+  (leal (@ 20 (% esp)) (% ebp))
+  (popl (@ 4 (% ebp)))
+  (push (% arg_y))
+  (push (% arg_z))
+
+  (movl (@ -4 (% ebp)) (% temp0))       ;guess-h
+  (movl (@ -8 (% ebp)) (% temp1))       ;guess-l
+  (compose-digit temp0 temp1 imm0)
+  (movd (% imm0) (% mm0))               ;save guess
+
+  (movd (@ (- x8632::misc-data-offset 0) (% yptr) (% yidx)) (% mm1)) ;y1 (high)
+  ;; (%multiply guess y1)
+  (pmuludq (% mm0) (% mm1))
+  ;; (%multiply guess y2)
+  (movd (@ (- x8632::misc-data-offset 4) (% yptr) (% yidx)) (% mm2)) ;y2 (low)
+  (pmuludq (% mm0) (% mm2))
+
+  (movl (@ -12 (% ebp)) (% temp0))       ;x
+  (movl (@ -16 (% ebp)) (% arg_y))       ;xidx
+  (mark-as-imm temp1)                    ;edx now unboxed
+
+  ;; (%subtract-with-borrow x-i-1 low-guess*y1 1)
+  (movl (@ (- x8632::misc-data-offset 4) (% temp0) (% arg_y)) (% edx)) ;x-i-1
+  (movd (% mm1) (% eax))                ;low part of y1*guess
+  (subl (% eax) (% edx))
+  (movd (% edx) (% mm6))                ;save middle digit
+  ;; (%subtract-with-borrow x-i high-guess*y1 borrow)
+  (movl (@ (- x8632::misc-data-offset 0) (% temp0) (% arg_y)) (% edx)) ;x-i
+  (movq (% mm1) (% mm3))
+  (psrlq ($ 32) (% mm3))                ;get high part into low half
+  (movd (% mm3) (% eax))                ;high part of y1*guess
+  (sbbl (% eax) (% edx))
+  (movd (% edx) (% mm7))                ;save high digit
+  ;; guess is now either good, or one too large
+  (setc (%b arg_z.bh))                  ;save borrow (arg_z already tag-fixnum)
+  ;; if (and (= high-digit 0)
+  (test (% edx) (% edx))
+  (jne @return)
+  ;;         (or (> high-guess*y2 middle-digit)
+  (movq (% mm2) (% mm3))
+  (psrlq ($ 32) (% mm3))
+  (movd (% mm3) (% eax))                ;high part of y2*guess
+  (movd (% mm6) (% edx))                ;middle-digit
+  (cmpl (% edx) (% eax))
+  (jg @decrement)
+  ;;             (and (= middle-digit high-guess*y2)
+  (jne @decrement)
+  ;;                  (> low-guess*y2 x-i-2)
+  (movd (% mm2) (% eax))                ;low part of y2*guess
+  (movl (@ (- x8632::misc-data-offset 8) (% temp0) (% arg_y)) (% edx)) ;x-i-2
+  (cmpl (% edx) (% eax))
+  (jg @decrement)
+  @return
+  (mark-as-node edx)
+  (leave)
+  (movl (% esp) (% temp0))
+  (movd (% mm0) (% imm0))
+  (shrl ($ 16) (% imm0))
+  (shll ($ x8632::fixnumshift) (% imm0)) ;high half
+  (push (% imm0))
+  (movd (% mm0) (% imm0))
+  (shll ($ 16) (% imm0))
+  (shrl ($ (- 16 x8632::fixnumshift)) (% imm0))
+  (push (% imm0))                       ;low half
+  (set-nargs 2)
+  (jmp-subprim .SPvalues)
+  @decrement
+  (movd (% mm0) (% imm0))               ;guess
+  (btl ($ 8) (% temp0))                 ;restore state of carry flag
+  (sbb ($ 1) (% imm0))
+  (movd (% imm0) (% mm0))
+  (jmp @return))
 
 ;;; If x[i] = y[j], return the all ones digit (as two halves).
@@ -847 +936 @@
   (pop (% temp1))
   (discard-reserved-frame)
-  (push (% temp1))
-  (movl (% imm0) (% temp1))
-  (movl (@ (% temp0) (% temp1)) (% imm0)) ;x[i]
-  (cmpl (% imm0) (@ (% yptr) (% yidx)))   ;y[j]
+  (push (% temp0))
+  (movl (% imm0) (% temp0))
+  (movl (@ x8632::misc-data-offset (% temp1) (% temp0)) (% imm0)) ;x[i]
+  (cmpl (% imm0) (@ x8632::misc-data-offset (% yptr) (% yidx)))   ;y[j]
   (jne @more)
   (pushl ($ '#xffff))
@@ -859 +948 @@
   @more
   (mark-as-imm edx)                     ;aka temp1 (contains a fixnum)
-  (movl (@ -4 (% temp0) (% temp1)) (% eax)) ;low digit
-  (movl (@ (% temp0) (% temp1)) (% edx))    ;high digit
+  (movl (@ (- x8632::misc-data-offset 4) (% temp1) (% temp0)) (% eax)) ;low
+  (movl (@ x8632::misc-data-offset (% temp1) (% temp0)) (% edx))    ;high digit
   (divl (@ (% yptr) (% yidx)))
   (mark-as-node edx)
@@ -876 +965 @@
   (jmp-subprim .SPvalues))
 
+;;; x * y + carry
 (defx8632lapfunction %multiply-and-add-1 ((x-high 16)
                                           (x-low 12)
@@ -883 +973 @@
                                           (carry-in-high arg_y)
                                           (carry-in-low arg_z))
-  (int ($ 3)))
+  (movl (@ x-high (% esp)) (% temp0))
+  (movl (@ x-low (% esp)) (% temp1))
+  (compose-digit temp0 temp1 imm0)
+  (movd (% imm0) (% mm0))
+  (movl (@ y-high (% esp)) (% temp0))
+  (movl (@ y-low (% esp)) (% temp1))
+  (compose-digit temp0 temp1 imm0)
+  (movd (% imm0) (% mm1))
+  (pmuludq (% mm1) (% mm0))             ;x * y
+  (compose-digit arg_y arg_z imm0)
+  (movd (% imm0) (% mm1))
+  (paddq (% mm1) (% mm0))               ;add in carry digit
+  (movq (% mm0) (% mm1))
+  (psrlq ($ 32) (% mm1))                ;resultant carry digit
+  ;; clean up stack
+  (pop (% temp0))
+  (addl ($ '6) (% esp))
+  (push (% temp0))
+  ;; return (values carry-h carry-l result-h result-l) 
+  (movl (% esp) (% temp0))
+  (movd (% mm1) (% imm0))
+  (shrl ($ 16) (% imm0))
+  (shll ($ x8632::fixnumshift) (% imm0)) ;carry-h
+  (push (% imm0))
+  (movd (% mm1) (% imm0))
+  (shll ($ 16) (% imm0))
+  (shrl ($ (- 16 x8632::fixnumshift)) (% imm0)) ;carry-l
+  (push (% imm0))
+  (movd (% mm0) (% imm0))
+  (shrl ($ 16) (% imm0))
+  (shll ($ x8632::fixnumshift) (% imm0)) ;result-h
+  (push (% imm0))
+  (movd (% mm0) (% imm0))
+  (shll ($ 16) (% imm0))
+  (shrl ($ (- 16 x8632::fixnumshift)) (% imm0)) ;result-l
+  (push (% imm0))
+  (set-nargs 4)
+  (jmp-subprim .SPvalues))
 
 ;;; Copy the limb SRC points to to where DEST points.