X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fassembly%2Falpha%2Farith.lisp;h=e3d7216911598020099e5ec687d961fd7f457aa6;hb=f6a2be77637d025bfded9430f02863c28f74f77a;hp=32890fc24affc03d7308d8a2a7e8f88262656c76;hpb=dfa55a883f94470267b626dae77ce7e7dfac3df6;p=sbcl.git diff --git a/src/assembly/alpha/arith.lisp b/src/assembly/alpha/arith.lisp index 32890fc..e3d7216 100644 --- 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) @@ -39,33 +35,33 @@ (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) - ; 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 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))) - (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) - (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 - (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) @@ -96,33 +92,33 @@ (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) - ; 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 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))) - (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) - (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 - (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) @@ -154,53 +150,53 @@ (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) - ;; 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) - ;; 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 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 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))) - (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 - (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))) - (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. - (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 - (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) @@ -209,7 +205,7 @@ DONE) -;;;; Division. +;;;; division (define-assembly-routine (signed-truncate (:note "(signed-byte 32) truncate") @@ -271,7 +267,7 @@ (emit-label label))) -;;;; Comparison routines. +;;;; comparison routines (macrolet ((define-cond-assem-rtn (name translate static-fn cmp not-p) @@ -296,7 +292,7 @@ (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) @@ -341,7 +337,7 @@ (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) @@ -377,7 +373,7 @@ (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) @@ -413,7 +409,7 @@ (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)