0.8.7.4:

[sbcl.git] / src / compiler / alpha / arith.lisp

diff --git a/src/compiler/alpha/arith.lisp b/src/compiler/alpha/arith.lisp
index 40051b9..fccb1f0 100644 (file)
--- a/src/compiler/alpha/arith.lisp
+++ b/src/compiler/alpha/arith.lisp
@@ -24,7 +24,7 @@
 (define-vop (signed-unop)
   (:args (x :scs (signed-reg)))
   (:results (res :scs (signed-reg)))
 (define-vop (signed-unop)
   (:args (x :scs (signed-reg)))
   (:results (res :scs (signed-reg)))

-  (:note "inline (signed-byte 32) arithmetic")
+  (:note "inline (signed-byte 64) arithmetic")

   (:arg-types signed-num)
   (:result-types signed-num)
   (:policy :fast-safe))
   (:arg-types signed-num)
   (:result-types signed-num)
   (:policy :fast-safe))

@@ -70,7 +70,7 @@
   (:arg-types unsigned-num unsigned-num)
   (:results (r :scs (unsigned-reg)))
   (:result-types unsigned-num)
   (:arg-types unsigned-num unsigned-num)
   (:results (r :scs (unsigned-reg)))
   (:result-types unsigned-num)

-  (:note "inline (unsigned-byte 32) arithmetic")
+  (:note "inline (unsigned-byte 64) arithmetic")

   (:effects)
   (:affected)
   (:policy :fast-safe))
   (:effects)
   (:affected)
   (:policy :fast-safe))

@@ -81,7 +81,7 @@
   (:arg-types signed-num signed-num)
   (:results (r :scs (signed-reg)))
   (:result-types signed-num)
   (:arg-types signed-num signed-num)
   (:results (r :scs (signed-reg)))
   (:result-types signed-num)

-  (:note "inline (signed-byte 32) arithmetic")
+  (:note "inline (signed-byte 64) arithmetic")

   (:effects)
   (:affected)
   (:policy :fast-safe))
   (:effects)
   (:affected)
   (:policy :fast-safe))

@@ -186,61 +186,92 @@
 \f
 ;;;; shifting
 
 \f
 ;;;; shifting
 

-(define-vop (fast-ash)
+(define-vop (fast-ash/unsigned=>unsigned)

   (:note "inline ASH")
   (:note "inline ASH")

-  (:args (number :scs (signed-reg unsigned-reg) :to :save)
+  (:args (number :scs (unsigned-reg) :to :save)

         (amount :scs (signed-reg)))
         (amount :scs (signed-reg)))

-  (:arg-types (:or signed-num unsigned-num) signed-num)
-  (:results (result :scs (signed-reg unsigned-reg)))
-  (:result-types (:or signed-num unsigned-num))
+  (:arg-types unsigned-num signed-num)
+  (:results (result :scs (unsigned-reg)))
+  (:result-types unsigned-num)

   (:translate ash)
   (:policy :fast-safe)
   (:temporary (:sc non-descriptor-reg) ndesc)
   (:translate ash)
   (:policy :fast-safe)
   (:temporary (:sc non-descriptor-reg) ndesc)

-  (:temporary (:sc non-descriptor-reg :to :eval) temp)
+  (:temporary (:sc non-descriptor-reg) temp)

   (:generator 3
     (inst bge amount positive)
     (inst subq zero-tn amount ndesc)
   (:generator 3
     (inst bge amount positive)
     (inst subq zero-tn amount ndesc)

-    (inst cmplt ndesc 31 temp)
-    (sc-case number
-      (signed-reg (inst sra number ndesc result))
-      (unsigned-reg (inst srl number ndesc result)))
+    (inst cmplt ndesc 64 temp)
+    (inst srl number ndesc result)
+    ;; FIXME: this looks like a candidate for a conditional move --
+    ;; CSR, 2003-09-10

     (inst bne temp done)
     (inst bne temp done)

-    (sc-case number
-      (signed-reg (inst sra number 31 result))
-      (unsigned-reg (inst srl number 31 result)))
+    (move zero-tn result)

     (inst br zero-tn done)
       
     POSITIVE
     (inst br zero-tn done)
       
     POSITIVE

-    ;; The result-type assures us that this shift will not overflow.

     (inst sll number amount result)
       
     DONE))
 
     (inst sll number amount result)
       
     DONE))
 

-(define-vop (fast-ash-c)
+(define-vop (fast-ash/signed=>signed)
+  (:note "inline ASH")
+  (:args (number :scs (signed-reg) :to :save)
+        (amount :scs (signed-reg)))
+  (:arg-types signed-num signed-num)
+  (:results (result :scs (signed-reg)))
+  (:result-types signed-num)
+  (:translate ash)
+  (:policy :fast-safe)
+  (:temporary (:sc non-descriptor-reg) ndesc)
+  (:temporary (:sc non-descriptor-reg) temp)
+  (:generator 3
+    (inst bge amount positive)
+    (inst subq zero-tn amount ndesc)
+    (inst cmplt ndesc 63 temp)
+    (inst sra number ndesc result)
+    (inst bne temp done)
+    (inst sra number 63 result)
+    (inst br zero-tn done)
+      
+    POSITIVE
+    (inst sll number amount result)
+      
+    DONE))
+
+(define-vop (fast-ash-c/signed=>signed)

   (:policy :fast-safe)
   (:translate ash)
   (:note nil)
   (:policy :fast-safe)
   (:translate ash)
   (:note nil)

-  (:args (number :scs (signed-reg unsigned-reg)))
+  (:args (number :scs (signed-reg)))

   (:info count)
   (:info count)

-  (:arg-types (:or signed-num unsigned-num) (:constant integer))
-  (:results (result :scs (signed-reg unsigned-reg)))
-  (:result-types (:or signed-num unsigned-num))
+  (:arg-types signed-num (:constant integer))
+  (:results (result :scs (signed-reg)))
+  (:result-types signed-num)

   (:generator 1
   (:generator 1

-    (cond ((< count 0)
-          ;; It is a right shift.
-          (sc-case number
-            (signed-reg (inst sra number (- count) result))
-            (unsigned-reg (inst srl number (- count) result))))
-         ((> count 0)
-          ;; It is a left shift.
-          (inst sll number count result))
-         (t
-          ;; Count=0?  Shouldn't happen, but it's easy:
-          (move number result)))))
+    (cond
+      ((< count 0) (inst sra number (min 63 (- count)) result))
+      ((> count 0) (inst sll number (min 63 count) result))
+      (t (bug "identity ASH not transformed away")))))

 
 

-(define-vop (signed-byte-32-len)
+(define-vop (fast-ash-c/unsigned=>unsigned)
+  (:policy :fast-safe)
+  (:translate ash)
+  (:note nil)
+  (:args (number :scs (unsigned-reg)))
+  (:info count)
+  (:arg-types unsigned-num (:constant integer))
+  (:results (result :scs (unsigned-reg)))
+  (:result-types unsigned-num)
+  (:generator 1
+    (cond
+      ((< count -63) (move zero-tn result))
+      ((< count 0) (inst sra number (- count) result))
+      ((> count 0) (inst sll number (min 63 count) result))
+      (t (bug "identity ASH not transformed away")))))
+
+(define-vop (signed-byte-64-len)

   (:translate integer-length)
   (:translate integer-length)

-  (:note "inline (signed-byte 32) integer-length")
+  (:note "inline (signed-byte 64) integer-length")

   (:policy :fast-safe)
   (:args (arg :scs (signed-reg) :to (:argument 1)))
   (:arg-types signed-num)
   (:policy :fast-safe)
   (:args (arg :scs (signed-reg) :to (:argument 1)))
   (:arg-types signed-num)

@@ -250,16 +281,16 @@
   (:generator 30
     (inst not arg shift)
     (inst cmovge arg arg shift)
   (:generator 30
     (inst not arg shift)
     (inst cmovge arg arg shift)

-    (inst subq zero-tn 4 res)
+    (inst subq zero-tn (fixnumize 1) res)

     (inst sll shift 1 shift)
     LOOP
     (inst addq res (fixnumize 1) res)
     (inst srl shift 1 shift)
     (inst bne shift loop)))
 
     (inst sll shift 1 shift)
     LOOP
     (inst addq res (fixnumize 1) res)
     (inst srl shift 1 shift)
     (inst bne shift loop)))
 

-(define-vop (unsigned-byte-32-count)
+(define-vop (unsigned-byte-64-count)

   (:translate logcount)
   (:translate logcount)

-  (:note "inline (unsigned-byte 32) logcount")
+  (:note "inline (unsigned-byte 64) logcount")

   (:policy :fast-safe)
   (:args (arg :scs (unsigned-reg) :target num))
   (:arg-types unsigned-num)
   (:policy :fast-safe)
   (:args (arg :scs (unsigned-reg) :target num))
   (:arg-types unsigned-num)

@@ -268,31 +299,38 @@
   (:temporary (:scs (non-descriptor-reg) :from (:argument 0) :to (:result 0)
                    :target res) num)
   (:temporary (:scs (non-descriptor-reg)) mask temp)
   (:temporary (:scs (non-descriptor-reg) :from (:argument 0) :to (:result 0)
                    :target res) num)
   (:temporary (:scs (non-descriptor-reg)) mask temp)

-  (:generator 30
-    (inst li #x55555555 mask)
+  (:generator 60
+    ;; FIXME: now this looks expensive, what with these 64bit loads.
+    ;; Maybe a loop and count would be faster?  -- CSR, 2003-09-10
+    (inst li #x5555555555555555 mask)

     (inst srl arg 1 temp)
     (inst and arg mask num)
     (inst and temp mask temp)
     (inst addq num temp num)
     (inst srl arg 1 temp)
     (inst and arg mask num)
     (inst and temp mask temp)
     (inst addq num temp num)

-    (inst li #x33333333 mask)
+    (inst li #x3333333333333333 mask)

     (inst srl num 2 temp)
     (inst and num mask num)
     (inst and temp mask temp)
     (inst addq num temp num)
     (inst srl num 2 temp)
     (inst and num mask num)
     (inst and temp mask temp)
     (inst addq num temp num)

-    (inst li #x0f0f0f0f mask)
+    (inst li #x0f0f0f0f0f0f0f0f mask)

     (inst srl num 4 temp)
     (inst and num mask num)
     (inst and temp mask temp)
     (inst addq num temp num)
     (inst srl num 4 temp)
     (inst and num mask num)
     (inst and temp mask temp)
     (inst addq num temp num)

-    (inst li #x00ff00ff mask)
+    (inst li #x00ff00ff00ff00ff mask)

     (inst srl num 8 temp)
     (inst and num mask num)
     (inst and temp mask temp)
     (inst addq num temp num)
     (inst srl num 8 temp)
     (inst and num mask num)
     (inst and temp mask temp)
     (inst addq num temp num)

-    (inst li #x0000ffff mask)
+    (inst li #x0000ffff0000ffff mask)

     (inst srl num 16 temp)
     (inst and num mask num)
     (inst and temp mask temp)
     (inst srl num 16 temp)
     (inst and num mask num)
     (inst and temp mask temp)

+    (inst addq num temp num)
+    (inst li #x00000000ffffffff mask)
+    (inst srl num 32 temp)
+    (inst and num mask num)
+    (inst and temp mask temp)

     (inst addq num temp res)))
 \f
 ;;;; multiplying
     (inst addq num temp res)))
 \f
 ;;;; multiplying

@@ -326,11 +364,15 @@
   (:generator 1
     (inst not x res)))
 
   (:generator 1
     (inst not x res)))
 

+(define-vop (fast-ash-left-mod64-c/unsigned=>unsigned
+            fast-ash-c/unsigned=>unsigned)
+  (:translate ash-left-mod64))
+

 (macrolet
     ((define-modular-backend (fun &optional constantp)
        (let ((mfun-name (symbolicate fun '-mod64))
              (modvop (symbolicate 'fast- fun '-mod64/unsigned=>unsigned))
 (macrolet
     ((define-modular-backend (fun &optional constantp)
        (let ((mfun-name (symbolicate fun '-mod64))
              (modvop (symbolicate 'fast- fun '-mod64/unsigned=>unsigned))

-             (modcvop (symbolicate 'fast- fun 'mod64-c/unsigned=>unsigned))
+             (modcvop (symbolicate 'fast- fun '-mod64-c/unsigned=>unsigned))

              (vop (symbolicate 'fast- fun '/unsigned=>unsigned))
              (cvop (symbolicate 'fast- fun '-c/unsigned=>unsigned)))
          `(progn
              (vop (symbolicate 'fast- fun '/unsigned=>unsigned))
              (cvop (symbolicate 'fast- fun '-c/unsigned=>unsigned)))
          `(progn

@@ -341,6 +383,7 @@
                 `((define-vop (,modcvop ,cvop)
                     (:translate ,mfun-name))))))))
   (define-modular-backend + t)
                 `((define-vop (,modcvop ,cvop)
                     (:translate ,mfun-name))))))))
   (define-modular-backend + t)

+  (define-modular-backend - t)

   (define-modular-backend logxor t)
   (define-modular-backend logeqv t)
   (define-modular-backend logandc1)
   (define-modular-backend logxor t)
   (define-modular-backend logeqv t)
   (define-modular-backend logandc1)

@@ -378,7 +421,7 @@
   (:args (x :scs (signed-reg))
         (y :scs (signed-reg)))
   (:arg-types signed-num signed-num)
   (:args (x :scs (signed-reg))
         (y :scs (signed-reg)))
   (:arg-types signed-num signed-num)

-  (:note "inline (signed-byte 32) comparison"))
+  (:note "inline (signed-byte 64) comparison"))

 
 (define-vop (fast-conditional-c/signed fast-conditional/signed)
   (:args (x :scs (signed-reg)))
 
 (define-vop (fast-conditional-c/signed fast-conditional/signed)
   (:args (x :scs (signed-reg)))

@@ -389,7 +432,7 @@
   (:args (x :scs (unsigned-reg))
         (y :scs (unsigned-reg)))
   (:arg-types unsigned-num unsigned-num)
   (:args (x :scs (unsigned-reg))
         (y :scs (unsigned-reg)))
   (:arg-types unsigned-num unsigned-num)

-  (:note "inline (unsigned-byte 32) comparison"))
+  (:note "inline (unsigned-byte 64) comparison"))

 
 (define-vop (fast-conditional-c/unsigned fast-conditional/unsigned)
   (:args (x :scs (unsigned-reg)))
 
 (define-vop (fast-conditional-c/unsigned fast-conditional/unsigned)
   (:args (x :scs (unsigned-reg)))

@@ -602,21 +645,21 @@
 ;;;; bignum stuff
 
 (define-vop (bignum-length get-header-data)
 ;;;; bignum stuff
 
 (define-vop (bignum-length get-header-data)

-  (:translate sb!bignum::%bignum-length)
+  (:translate sb!bignum:%bignum-length)

   (:policy :fast-safe))
 
 (define-vop (bignum-set-length set-header-data)
   (:policy :fast-safe))
 
 (define-vop (bignum-set-length set-header-data)

-  (:translate sb!bignum::%bignum-set-length)
+  (:translate sb!bignum:%bignum-set-length)

   (:policy :fast-safe))
 
 (define-full-reffer bignum-ref * bignum-digits-offset other-pointer-lowtag
   (:policy :fast-safe))
 
 (define-full-reffer bignum-ref * bignum-digits-offset other-pointer-lowtag

-  (unsigned-reg) unsigned-num sb!bignum::%bignum-ref)
+  (unsigned-reg) unsigned-num sb!bignum:%bignum-ref)

 
 (define-full-setter bignum-set * bignum-digits-offset other-pointer-lowtag
 
 (define-full-setter bignum-set * bignum-digits-offset other-pointer-lowtag

-  (unsigned-reg) unsigned-num sb!bignum::%bignum-set #!+gengc nil)
+  (unsigned-reg) unsigned-num sb!bignum:%bignum-set #!+gengc nil)

 
 (define-vop (digit-0-or-plus)
 
 (define-vop (digit-0-or-plus)

-  (:translate sb!bignum::%digit-0-or-plusp)
+  (:translate sb!bignum:%digit-0-or-plusp)

   (:policy :fast-safe)
   (:args (digit :scs (unsigned-reg)))
   (:arg-types unsigned-num)
   (:policy :fast-safe)
   (:args (digit :scs (unsigned-reg)))
   (:arg-types unsigned-num)

@@ -630,7 +673,7 @@
        (inst bge temp target))))
 
 (define-vop (add-w/carry)
        (inst bge temp target))))
 
 (define-vop (add-w/carry)

-  (:translate sb!bignum::%add-with-carry)
+  (:translate sb!bignum:%add-with-carry)

   (:policy :fast-safe)
   (:args (a :scs (unsigned-reg))
         (b :scs (unsigned-reg))
   (:policy :fast-safe)
   (:args (a :scs (unsigned-reg))
         (b :scs (unsigned-reg))

@@ -646,7 +689,7 @@
     (inst mskll result 4 result)))
 
 (define-vop (sub-w/borrow)
     (inst mskll result 4 result)))
 
 (define-vop (sub-w/borrow)

-  (:translate sb!bignum::%subtract-with-borrow)
+  (:translate sb!bignum:%subtract-with-borrow)

   (:policy :fast-safe)
   (:args (a :scs (unsigned-reg))
         (b :scs (unsigned-reg))
   (:policy :fast-safe)
   (:args (a :scs (unsigned-reg))
         (b :scs (unsigned-reg))

@@ -664,7 +707,7 @@
     (inst mskll result 4 result)))
 
 (define-vop (bignum-mult-and-add-3-arg)
     (inst mskll result 4 result)))
 
 (define-vop (bignum-mult-and-add-3-arg)

-  (:translate sb!bignum::%multiply-and-add)
+  (:translate sb!bignum:%multiply-and-add)

   (:policy :fast-safe)
   (:args (x :scs (unsigned-reg))
         (y :scs (unsigned-reg))
   (:policy :fast-safe)
   (:args (x :scs (unsigned-reg))
         (y :scs (unsigned-reg))

@@ -676,12 +719,12 @@
   (:generator 6
     (inst mulq x y lo)
     (inst addq lo carry-in lo)
   (:generator 6
     (inst mulq x y lo)
     (inst addq lo carry-in lo)

-    (inst sra lo 32 hi)
+    (inst srl lo 32 hi)

     (inst mskll lo 4 lo)))
 
 
 (define-vop (bignum-mult-and-add-4-arg)
     (inst mskll lo 4 lo)))
 
 
 (define-vop (bignum-mult-and-add-4-arg)

-  (:translate sb!bignum::%multiply-and-add)
+  (:translate sb!bignum:%multiply-and-add)

   (:policy :fast-safe)
   (:args (x :scs (unsigned-reg))
         (y :scs (unsigned-reg))
   (:policy :fast-safe)
   (:args (x :scs (unsigned-reg))
         (y :scs (unsigned-reg))

@@ -695,11 +738,11 @@
     (inst mulq x y lo)
     (inst addq lo prev lo)
     (inst addq lo carry-in lo)
     (inst mulq x y lo)
     (inst addq lo prev lo)
     (inst addq lo carry-in lo)

-    (inst sra lo 32 hi)
+    (inst srl lo 32 hi)

     (inst mskll lo 4 lo)))
 
 (define-vop (bignum-mult)
     (inst mskll lo 4 lo)))
 
 (define-vop (bignum-mult)

-  (:translate sb!bignum::%multiply)
+  (:translate sb!bignum:%multiply)

   (:policy :fast-safe)
   (:args (x :scs (unsigned-reg))
         (y :scs (unsigned-reg)))
   (:policy :fast-safe)
   (:args (x :scs (unsigned-reg))
         (y :scs (unsigned-reg)))

@@ -713,7 +756,7 @@
     (inst mskll lo 4 lo)))
 
 (define-vop (bignum-lognot)
     (inst mskll lo 4 lo)))
 
 (define-vop (bignum-lognot)

-  (:translate sb!bignum::%lognot)
+  (:translate sb!bignum:%lognot)

   (:policy :fast-safe)
   (:args (x :scs (unsigned-reg)))
   (:arg-types unsigned-num)
   (:policy :fast-safe)
   (:args (x :scs (unsigned-reg)))
   (:arg-types unsigned-num)

@@ -724,7 +767,7 @@
     (inst mskll r 4 r)))
 
 (define-vop (fixnum-to-digit)
     (inst mskll r 4 r)))
 
 (define-vop (fixnum-to-digit)

-  (:translate sb!bignum::%fixnum-to-digit)
+  (:translate sb!bignum:%fixnum-to-digit)

   (:policy :fast-safe)
   (:args (fixnum :scs (any-reg)))
   (:arg-types tagged-num)
   (:policy :fast-safe)
   (:args (fixnum :scs (any-reg)))
   (:arg-types tagged-num)

@@ -734,7 +777,7 @@
     (inst sra fixnum 2 digit)))
 
 (define-vop (bignum-floor)
     (inst sra fixnum 2 digit)))
 
 (define-vop (bignum-floor)

-  (:translate sb!bignum::%floor)
+  (:translate sb!bignum:%floor)

   (:policy :fast-safe)
   (:args (num-high :scs (unsigned-reg))
         (num-low :scs (unsigned-reg))
   (:policy :fast-safe)
   (:args (num-high :scs (unsigned-reg))
         (num-low :scs (unsigned-reg))

@@ -764,7 +807,7 @@
        (emit-label shift2)))))
 
 (define-vop (signify-digit)
        (emit-label shift2)))))
 
 (define-vop (signify-digit)

-  (:translate sb!bignum::%fixnum-digit-with-correct-sign)
+  (:translate sb!bignum:%fixnum-digit-with-correct-sign)

   (:policy :fast-safe)
   (:args (digit :scs (unsigned-reg) :target res))
   (:arg-types unsigned-num)
   (:policy :fast-safe)
   (:args (digit :scs (unsigned-reg) :target res))
   (:arg-types unsigned-num)

@@ -781,7 +824,7 @@
 
 
 (define-vop (digit-ashr)
 
 
 (define-vop (digit-ashr)

-  (:translate sb!bignum::%ashr)
+  (:translate sb!bignum:%ashr)

   (:policy :fast-safe)
   (:args (digit :scs (unsigned-reg))
         (count :scs (unsigned-reg)))
   (:policy :fast-safe)
   (:args (digit :scs (unsigned-reg))
         (count :scs (unsigned-reg)))

@@ -794,12 +837,12 @@
     (inst srl result 32 result)))
 
 (define-vop (digit-lshr digit-ashr)
     (inst srl result 32 result)))
 
 (define-vop (digit-lshr digit-ashr)

-  (:translate sb!bignum::%digit-logical-shift-right)
+  (:translate sb!bignum:%digit-logical-shift-right)

   (:generator 1
     (inst srl digit count result)))
 
 (define-vop (digit-ashl digit-ashr)
   (:generator 1
     (inst srl digit count result)))
 
 (define-vop (digit-ashl digit-ashr)

-  (:translate sb!bignum::%ashl)
+  (:translate sb!bignum:%ashl)

   (:generator 1
     (inst sll digit count result)))
 \f
   (:generator 1
     (inst sll digit count result)))
 \f