0.8.19.15:

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

diff --git a/src/assembly/alpha/arith.lisp b/src/assembly/alpha/arith.lisp
index 32890fc..fad4209 100644 (file)
--- a/src/assembly/alpha/arith.lisp
+++ b/src/assembly/alpha/arith.lisp
@@ -1,19 +1,15 @@
-;;; **********************************************************************
-;;; This code was written as part of the CMU Common Lisp project at
-;;; Carnegie Mellon University, and has been placed in the public domain.
-;;;
-;;;
-;;; **********************************************************************
-;;;
-;;; Stuff to handle simple cases for generic arithmetic.
-;;;
-;;; Written by William Lott.
-;;; Conversion by Sean Hallgren
-;;;
-
-(in-package "SB!VM")
+;;;; stuff to handle simple cases for generic arithmetic

 
 

+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; This software is derived from the CMU CL system, which was
+;;;; written at Carnegie Mellon University and released into the
+;;;; public domain. The software is in the public domain and is
+;;;; provided with absolutely no warranty. See the COPYING and CREDITS
+;;;; files for more information.

 
 

+(in-package "SB!VM")

 
 (define-assembly-routine (generic-+
                          (:cost 10)
 
 (define-assembly-routine (generic-+
                          (:cost 10)

@@ -39,33 +35,33 @@
   (inst bne temp DO-STATIC-FUN)
   (inst addq x y res)
   
   (inst bne temp DO-STATIC-FUN)
   (inst addq x y res)
   

-  ; Check to see if we need a bignum
+  ; Check whether we need a bignum.

   (inst sra res 31 temp)
   (inst beq temp DONE)
   (inst not temp temp)
   (inst beq temp DONE)
   (inst sra res 2 temp3)
   
   (inst sra res 31 temp)
   (inst beq temp DONE)
   (inst not temp temp)
   (inst beq temp DONE)
   (inst sra res 2 temp3)
   

-  ; From move-from-signed
+  ; from move-from-signed

   (inst li 2 temp2)
   (inst sra temp3 31 temp)
   (inst cmoveq temp 1 temp2)
   (inst not temp temp)
   (inst cmoveq temp 1 temp2)
   (inst li 2 temp2)
   (inst sra temp3 31 temp)
   (inst cmoveq temp 1 temp2)
   (inst not temp temp)
   (inst cmoveq temp 1 temp2)

-  (inst sll temp2 type-bits temp2)
-  (inst bis temp2 bignum-type temp2)
+  (inst sll temp2 n-widetag-bits temp2)
+  (inst bis temp2 bignum-widetag temp2)

   
   (pseudo-atomic (:extra (pad-data-block (+ bignum-digits-offset 3)))
   
   (pseudo-atomic (:extra (pad-data-block (+ bignum-digits-offset 3)))

-    (inst bis alloc-tn other-pointer-type res)
-    (storew temp2 res 0 other-pointer-type)
-    (storew temp3 res bignum-digits-offset other-pointer-type)
+    (inst bis alloc-tn other-pointer-lowtag res)
+    (storew temp2 res 0 other-pointer-lowtag)
+    (storew temp3 res bignum-digits-offset other-pointer-lowtag)

     (inst srl temp3 32 temp)
     (inst srl temp3 32 temp)

-    (storew temp res (1+ bignum-digits-offset) other-pointer-type))
+    (storew temp res (1+ bignum-digits-offset) other-pointer-lowtag))

   DONE
   (lisp-return lra lip :offset 2)
 
   DO-STATIC-FUN
   DONE
   (lisp-return lra lip :offset 2)
 
   DO-STATIC-FUN

-  (inst ldl lip (static-function-offset 'two-arg-+) null-tn)
+  (inst ldl lip (static-fun-offset 'two-arg-+) null-tn)

   (inst li (fixnumize 2) nargs)
   (inst move cfp-tn ocfp)
   (inst move csp-tn cfp-tn)
   (inst li (fixnumize 2) nargs)
   (inst move cfp-tn ocfp)
   (inst move csp-tn cfp-tn)

@@ -96,33 +92,33 @@
   (inst bne temp DO-STATIC-FUN)
   (inst subq x y res)
   
   (inst bne temp DO-STATIC-FUN)
   (inst subq x y res)
   

-  ; Check to see if we need a bignum
+  ; Check whether we need a bignum.

   (inst sra res 31 temp)
   (inst beq temp DONE)
   (inst not temp temp)
   (inst beq temp DONE)
   (inst sra res 2 temp3)
   
   (inst sra res 31 temp)
   (inst beq temp DONE)
   (inst not temp temp)
   (inst beq temp DONE)
   (inst sra res 2 temp3)
   

-  ; From move-from-signed
+  ; from move-from-signed

   (inst li 2 temp2)
   (inst sra temp3 31 temp)
   (inst cmoveq temp 1 temp2)
   (inst not temp temp)
   (inst cmoveq temp 1 temp2)
   (inst li 2 temp2)
   (inst sra temp3 31 temp)
   (inst cmoveq temp 1 temp2)
   (inst not temp temp)
   (inst cmoveq temp 1 temp2)

-  (inst sll temp2 type-bits temp2)
-  (inst bis temp2 bignum-type temp2)
+  (inst sll temp2 n-widetag-bits temp2)
+  (inst bis temp2 bignum-widetag temp2)

   
   (pseudo-atomic (:extra (pad-data-block (+ bignum-digits-offset 3)))
   
   (pseudo-atomic (:extra (pad-data-block (+ bignum-digits-offset 3)))

-    (inst bis alloc-tn other-pointer-type res)
-    (storew temp2 res 0 other-pointer-type)
-    (storew temp3 res bignum-digits-offset other-pointer-type)
+    (inst bis alloc-tn other-pointer-lowtag res)
+    (storew temp2 res 0 other-pointer-lowtag)
+    (storew temp3 res bignum-digits-offset other-pointer-lowtag)

     (inst srl temp3 32 temp)
     (inst srl temp3 32 temp)

-    (storew temp res (1+ bignum-digits-offset) other-pointer-type))
+    (storew temp res (1+ bignum-digits-offset) other-pointer-lowtag))

   DONE
   (lisp-return lra lip :offset 2)
 
   DO-STATIC-FUN
   DONE
   (lisp-return lra lip :offset 2)
 
   DO-STATIC-FUN

-  (inst ldl lip (static-function-offset 'two-arg--) null-tn)
+  (inst ldl lip (static-fun-offset 'two-arg--) null-tn)

   (inst li (fixnumize 2) nargs)
   (inst move cfp-tn ocfp)
   (inst move csp-tn cfp-tn)
   (inst li (fixnumize 2) nargs)
   (inst move cfp-tn ocfp)
   (inst move csp-tn cfp-tn)

@@ -154,53 +150,53 @@
   (inst and y 3 temp)
   (inst bne temp DO-STATIC-FUN)
 
   (inst and y 3 temp)
   (inst bne temp DO-STATIC-FUN)
 

-  ;; Remove the tag from one arg so that the result will have the correct
-  ;; fixnum tag.
+  ;; Remove the tag from one arg so that the result will have the
+  ;; correct fixnum tag.

   (inst sra x 2 temp)
   (inst mulq temp y lo)
   (inst sra lo 32 hi)
   (inst sll lo 32 res)
   (inst sra res 32 res)
   (inst sra x 2 temp)
   (inst mulq temp y lo)
   (inst sra lo 32 hi)
   (inst sll lo 32 res)
   (inst sra res 32 res)

-  ;; Check to see if the result will fit in a fixnum.  (I.e. the high word
-  ;; is just 32 copies of the sign bit of the low word).
+  ;; Check to see if the result will fit in a fixnum. (I.e. the high
+  ;; word is just 32 copies of the sign bit of the low word).

   (inst sra res 31 temp)
   (inst xor hi temp temp)
   (inst beq temp DONE)
   (inst sra res 31 temp)
   (inst xor hi temp temp)
   (inst beq temp DONE)

-  ;; Shift the double word hi:res down two bits into hi:low to get rid of the
-  ;; fixnum tag.
+  ;; Shift the double word hi:res down two bits into hi:low to get rid
+  ;; of the fixnum tag.

   (inst sra lo 2 lo)
   (inst sra lo 32 hi)
 
   ;; Do we need one word or two?  Assume two.
   (inst sra lo 2 lo)
   (inst sra lo 32 hi)
 
   ;; Do we need one word or two?  Assume two.

-  (inst li (logior (ash 2 type-bits) bignum-type) temp2)
+  (inst li (logior (ash 2 n-widetag-bits) bignum-widetag) temp2)

   (inst sra lo 31 temp)
   (inst xor temp hi temp)
   (inst bne temp two-words)
 
   ;; Only need one word, fix the header.
   (inst sra lo 31 temp)
   (inst xor temp hi temp)
   (inst bne temp two-words)
 
   ;; Only need one word, fix the header.

-  (inst li (logior (ash 1 type-bits) bignum-type) temp2)
+  (inst li (logior (ash 1 n-widetag-bits) bignum-widetag) temp2)

   ;; Allocate one word.
   (pseudo-atomic (:extra (pad-data-block (1+ bignum-digits-offset)))
   ;; Allocate one word.
   (pseudo-atomic (:extra (pad-data-block (1+ bignum-digits-offset)))

-    (inst bis alloc-tn other-pointer-type res)
-    (storew temp2 res 0 other-pointer-type))
+    (inst bis alloc-tn other-pointer-lowtag res)
+    (storew temp2 res 0 other-pointer-lowtag))

   ;; Store one word
   ;; Store one word

-  (storew lo res bignum-digits-offset other-pointer-type)
+  (storew lo res bignum-digits-offset other-pointer-lowtag)

   ;; Out of here
   (lisp-return lra lip :offset 2)
 
   TWO-WORDS
   ;; Allocate two words.
   (pseudo-atomic (:extra (pad-data-block (+ 2 bignum-digits-offset)))
   ;; Out of here
   (lisp-return lra lip :offset 2)
 
   TWO-WORDS
   ;; Allocate two words.
   (pseudo-atomic (:extra (pad-data-block (+ 2 bignum-digits-offset)))

-    (inst bis alloc-tn other-pointer-type res)
-    (storew temp2 res 0 other-pointer-type))
+    (inst bis alloc-tn other-pointer-lowtag res)
+    (storew temp2 res 0 other-pointer-lowtag))

   ;; Store two words.
   ;; Store two words.

-  (storew lo res bignum-digits-offset other-pointer-type)
-  (storew hi res (1+ bignum-digits-offset) other-pointer-type)
-  ;; Out of here
+  (storew lo res bignum-digits-offset other-pointer-lowtag)
+  (storew hi res (1+ bignum-digits-offset) other-pointer-lowtag)
+  ;; out of here

   (lisp-return lra lip :offset 2)
 
   DO-STATIC-FUN
   (lisp-return lra lip :offset 2)
 
   DO-STATIC-FUN

-  (inst ldl lip (static-function-offset 'two-arg-*) null-tn)
+  (inst ldl lip (static-fun-offset 'two-arg-*) null-tn)

   (inst li (fixnumize 2) nargs)
   (inst move cfp-tn ocfp)
   (inst move csp-tn cfp-tn)
   (inst li (fixnumize 2) nargs)
   (inst move cfp-tn ocfp)
   (inst move csp-tn cfp-tn)

@@ -209,10 +205,10 @@
   DONE)
 
 \f
   DONE)
 
 \f

-;;;; Division.
+;;;; division

 
 (define-assembly-routine (signed-truncate
 
 (define-assembly-routine (signed-truncate

-                         (:note "(signed-byte 32) truncate")
+                         (:note "(signed-byte 64) truncate")

                          (:cost 60)
                          (:policy :fast-safe)
                          (:translate truncate)
                          (:cost 60)
                          (:policy :fast-safe)
                          (:translate truncate)

@@ -245,9 +241,8 @@
     (emit-label label))
   (inst move zero-tn rem)
   (inst move zero-tn quo)
     (emit-label label))
   (inst move zero-tn rem)
   (inst move zero-tn quo)

-  (inst sll dividend 32 dividend)

 
 

-  (dotimes (i 32)
+  (dotimes (i 64)

     (inst srl dividend 63 temp1)
     (inst sll rem 1 rem)
     (inst bis temp1 rem rem)
     (inst srl dividend 63 temp1)
     (inst sll rem 1 rem)
     (inst bis temp1 rem rem)

@@ -271,7 +266,7 @@
     (emit-label label)))
 
 \f
     (emit-label label)))
 
 \f

-;;;; Comparison routines.
+;;;; comparison routines

 
 (macrolet
     ((define-cond-assem-rtn (name translate static-fn cmp not-p)
 
 (macrolet
     ((define-cond-assem-rtn (name translate static-fn cmp not-p)

@@ -296,7 +291,7 @@
          (inst beq temp DO-COMPARE)
          
          DO-STATIC-FN
          (inst beq temp DO-COMPARE)
          
          DO-STATIC-FN

-         (inst ldl lip (static-function-offset ',static-fn) null-tn)
+         (inst ldl lip (static-fun-offset ',static-fn) null-tn)

          (inst li (fixnumize 2) nargs)
          (inst move cfp-tn ocfp)
          (inst move csp-tn cfp-tn)
          (inst li (fixnumize 2) nargs)
          (inst move cfp-tn ocfp)
          (inst move csp-tn cfp-tn)

@@ -341,7 +336,7 @@
   (lisp-return lra lip :offset 2)
 
   DO-STATIC-FN
   (lisp-return lra lip :offset 2)
 
   DO-STATIC-FN

-  (inst ldl lip (static-function-offset 'eql) null-tn)
+  (inst ldl lip (static-fun-offset 'eql) null-tn)

   (inst li (fixnumize 2) nargs)
   (inst move cfp-tn ocfp)
   (inst move csp-tn cfp-tn)
   (inst li (fixnumize 2) nargs)
   (inst move cfp-tn ocfp)
   (inst move csp-tn cfp-tn)

@@ -377,7 +372,7 @@
   (lisp-return lra lip :offset 2)
 
   DO-STATIC-FN
   (lisp-return lra lip :offset 2)
 
   DO-STATIC-FN

-  (inst ldl lip (static-function-offset 'two-arg-=) null-tn)
+  (inst ldl lip (static-fun-offset 'two-arg-=) null-tn)

   (inst li (fixnumize 2) nargs)
   (inst move cfp-tn ocfp)
   (inst move csp-tn cfp-tn)
   (inst li (fixnumize 2) nargs)
   (inst move cfp-tn ocfp)
   (inst move csp-tn cfp-tn)

@@ -413,7 +408,7 @@
   (lisp-return lra lip :offset 2)
 
   DO-STATIC-FN
   (lisp-return lra lip :offset 2)
 
   DO-STATIC-FN

-  (inst ldl lip (static-function-offset 'two-arg-=) null-tn)
+  (inst ldl lip (static-fun-offset 'two-arg-=) null-tn)

   (inst li (fixnumize 2) nargs)
   (inst move cfp-tn ocfp)
   (inst move csp-tn cfp-tn)
   (inst li (fixnumize 2) nargs)
   (inst move cfp-tn ocfp)
   (inst move csp-tn cfp-tn)