projects
/
sbcl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Remove redundant LENGTH calls in NSUBSTITUTE[-IF[-NOT]]
[sbcl.git]
/
src
/
assembly
/
ppc
/
arith.lisp
diff --git
a/src/assembly/ppc/arith.lisp
b/src/assembly/ppc/arith.lisp
index
0abf902
..
60175d0
100644
(file)
--- a/
src/assembly/ppc/arith.lisp
+++ b/
src/assembly/ppc/arith.lisp
@@
-46,7
+46,9
@@
(lisp-return lra lip :offset 2)
DO-STATIC-FUN
(lisp-return lra lip :offset 2)
DO-STATIC-FUN
- (inst lwz lip null-tn (static-fun-offset 'two-arg-+) )
+ (inst addi lexenv-tn null-tn (static-fdefn-offset 'two-arg-+))
+ (loadw code-tn lexenv-tn fdefn-fun-slot other-pointer-lowtag)
+ (loadw lip lexenv-tn fdefn-raw-addr-slot other-pointer-lowtag)
(inst li nargs (fixnumize 2))
(inst mr ocfp cfp-tn)
(inst mr cfp-tn csp-tn)
(inst li nargs (fixnumize 2))
(inst mr ocfp cfp-tn)
(inst mr cfp-tn csp-tn)
@@
-94,7
+96,9
@@
(lisp-return lra lip :offset 2)
DO-STATIC-FUN
(lisp-return lra lip :offset 2)
DO-STATIC-FUN
- (inst lwz lip null-tn (static-fun-offset 'two-arg--))
+ (inst addi lexenv-tn null-tn (static-fdefn-offset 'two-arg--))
+ (loadw code-tn lexenv-tn fdefn-fun-slot other-pointer-lowtag)
+ (loadw lip lexenv-tn fdefn-raw-addr-slot other-pointer-lowtag)
(inst li nargs (fixnumize 2))
(inst mr ocfp cfp-tn)
(inst mr cfp-tn csp-tn)
(inst li nargs (fixnumize 2))
(inst mr ocfp cfp-tn)
(inst mr cfp-tn csp-tn)
@@
-153,17
+157,14
@@
CONS-BIGNUM
;; Allocate a BIGNUM for the result.
CONS-BIGNUM
;; Allocate a BIGNUM for the result.
- (pseudo-atomic (pa-flag :extra (pad-data-block (1+ bignum-digits-offset)))
+ (with-fixed-allocation (res pa-flag temp bignum-widetag
+ (+ bignum-digits-offset 2))
(let ((one-word (gen-label)))
(let ((one-word (gen-label)))
- (inst ori res alloc-tn other-pointer-lowtag)
;; We start out assuming that we need one word. Is that correct?
(inst srawi temp lo 31)
(inst xor. temp temp hi)
(inst li temp (logior (ash 1 n-widetag-bits) bignum-widetag))
(inst beq one-word)
;; We start out assuming that we need one word. Is that correct?
(inst srawi temp lo 31)
(inst xor. temp temp hi)
(inst li temp (logior (ash 1 n-widetag-bits) bignum-widetag))
(inst beq one-word)
- ;; Nope, we need two, so allocate the additional space.
- (inst addi alloc-tn alloc-tn (- (pad-data-block (+ 2 bignum-digits-offset))
- (pad-data-block (1+ bignum-digits-offset))))
(inst li temp (logior (ash 2 n-widetag-bits) bignum-widetag))
(storew hi res (1+ bignum-digits-offset) other-pointer-lowtag)
(emit-label one-word)
(inst li temp (logior (ash 2 n-widetag-bits) bignum-widetag))
(storew hi res (1+ bignum-digits-offset) other-pointer-lowtag)
(emit-label one-word)
@@
-174,7
+175,9
@@
(lisp-return lra lip :offset 2)
DO-STATIC-FUN
(lisp-return lra lip :offset 2)
DO-STATIC-FUN
- (inst lwz lip null-tn (static-fun-offset 'two-arg-*))
+ (inst addi lexenv-tn null-tn (static-fdefn-offset 'two-arg-*))
+ (loadw code-tn lexenv-tn fdefn-fun-slot other-pointer-lowtag)
+ (loadw lip lexenv-tn fdefn-raw-addr-slot other-pointer-lowtag)
(inst li nargs (fixnumize 2))
(inst mr ocfp cfp-tn)
(inst mr cfp-tn csp-tn)
(inst li nargs (fixnumize 2))
(inst mr ocfp cfp-tn)
(inst mr cfp-tn csp-tn)
@@
-199,7
+202,7
@@
`((inst srawi x x 2)))
(inst mullw res x y))))
(frob unsigned-* "unsigned *" 40 unsigned-num unsigned-reg)
`((inst srawi x x 2)))
(inst mullw res x y))))
(frob unsigned-* "unsigned *" 40 unsigned-num unsigned-reg)
- (frob signed-* "unsigned *" 41 signed-num signed-reg)
+ (frob signed-* "signed *" 41 signed-num signed-reg)
(frob fixnum-* "fixnum *" 30 tagged-num any-reg))
(frob fixnum-* "fixnum *" 30 tagged-num any-reg))
@@
-220,7
+223,7
@@
(:res quo any-reg nl2-offset)
(:res rem any-reg nl0-offset))
(aver (location= rem dividend))
(:res quo any-reg nl2-offset)
(:res rem any-reg nl0-offset))
(aver (location= rem dividend))
- (let ((error (generate-error-code nil division-by-zero-error
+ (let ((error (generate-error-code nil 'division-by-zero-error
dividend divisor)))
(inst cmpwi divisor 0)
(inst beq error))
dividend divisor)))
(inst cmpwi divisor 0)
(inst beq error))
@@
-245,7
+248,7
@@
(:res rem any-reg nl0-offset))
(aver (location= rem dividend))
(:res rem any-reg nl0-offset))
(aver (location= rem dividend))
- (let ((error (generate-error-code nil division-by-zero-error
+ (let ((error (generate-error-code nil 'division-by-zero-error
dividend divisor)))
(inst cmpwi divisor 0)
(inst beq error))
dividend divisor)))
(inst cmpwi divisor 0)
(inst beq error))
@@
-270,7
+273,7
@@
(:res quo signed-reg nl2-offset)
(:res rem signed-reg nl0-offset))
(:res quo signed-reg nl2-offset)
(:res rem signed-reg nl0-offset))
- (let ((error (generate-error-code nil division-by-zero-error
+ (let ((error (generate-error-code nil 'division-by-zero-error
dividend divisor)))
(inst cmpwi divisor 0)
(inst beq error))
dividend divisor)))
(inst cmpwi divisor 0)
(inst beq error))
@@
-306,7
+309,9
@@
(inst beq DO-COMPARE)
DO-STATIC-FN
(inst beq DO-COMPARE)
DO-STATIC-FN
- (inst lwz lip null-tn (static-fun-offset ',static-fn))
+ (inst addi lexenv-tn null-tn (static-fdefn-offset ',static-fn))
+ (loadw code-tn lexenv-tn fdefn-fun-slot other-pointer-lowtag)
+ (loadw lip lexenv-tn fdefn-raw-addr-slot other-pointer-lowtag)
(inst li nargs (fixnumize 2))
(inst mr ocfp cfp-tn)
(inst mr cfp-tn csp-tn)
(inst li nargs (fixnumize 2))
(inst mr ocfp cfp-tn)
(inst mr cfp-tn csp-tn)
@@
-351,7
+356,9
@@
(lisp-return lra lip :offset 2)
DO-STATIC-FN
(lisp-return lra lip :offset 2)
DO-STATIC-FN
- (inst lwz lip null-tn (static-fun-offset 'eql))
+ (inst addi lexenv-tn null-tn (static-fdefn-offset 'eql))
+ (loadw code-tn lexenv-tn fdefn-fun-slot other-pointer-lowtag)
+ (loadw lip lexenv-tn fdefn-raw-addr-slot other-pointer-lowtag)
(inst li nargs (fixnumize 2))
(inst mr ocfp cfp-tn)
(inst mr cfp-tn csp-tn)
(inst li nargs (fixnumize 2))
(inst mr ocfp cfp-tn)
(inst mr cfp-tn csp-tn)
@@
-387,7
+394,9
@@
(lisp-return lra lip :offset 2)
DO-STATIC-FN
(lisp-return lra lip :offset 2)
DO-STATIC-FN
- (inst lwz lip null-tn (static-fun-offset 'two-arg-=))
+ (inst addi lexenv-tn null-tn (static-fdefn-offset 'two-arg-=))
+ (loadw code-tn lexenv-tn fdefn-fun-slot other-pointer-lowtag)
+ (loadw lip lexenv-tn fdefn-raw-addr-slot other-pointer-lowtag)
(inst li nargs (fixnumize 2))
(inst mr ocfp cfp-tn)
(inst mr cfp-tn csp-tn)
(inst li nargs (fixnumize 2))
(inst mr ocfp cfp-tn)
(inst mr cfp-tn csp-tn)
@@
-422,7
+431,9
@@
(lisp-return lra lip :offset 2)
DO-STATIC-FN
(lisp-return lra lip :offset 2)
DO-STATIC-FN
- (inst lwz lip null-tn (static-fun-offset 'two-arg-/=))
+ (inst addi lexenv-tn null-tn (static-fdefn-offset 'two-arg-/=))
+ (loadw code-tn lexenv-tn fdefn-fun-slot other-pointer-lowtag)
+ (loadw lip lexenv-tn fdefn-raw-addr-slot other-pointer-lowtag)
(inst li nargs (fixnumize 2))
(inst mr ocfp cfp-tn)
(inst j lip 0)
(inst li nargs (fixnumize 2))
(inst mr ocfp cfp-tn)
(inst j lip 0)