X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fassembly%2Fppc%2Farith.lisp;h=60175d031f5973b77be316e2160e95d2e4625aad;hb=518493eab883e50237043153c0d45b245e929c7d;hp=ea9fc110e877b08a20c505b0fdbf645b594f1a55;hpb=b6094d5640a59f36d2f727df08b271c422aa9e1c;p=sbcl.git

diff --git a/src/assembly/ppc/arith.lisp b/src/assembly/ppc/arith.lisp
index ea9fc11..60175d0 100644
--- 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
-  (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)
@@ -94,7 +96,9 @@
   (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)
@@ -153,17 +157,14 @@
 
   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)))
-      (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)
-      ;; 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)
@@ -174,7 +175,9 @@
   (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)
@@ -220,7 +223,7 @@
                           (: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))
@@ -245,7 +248,7 @@
                           (: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))
@@ -270,7 +273,7 @@
                           (: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))
@@ -306,7 +309,9 @@
           (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)
@@ -351,7 +356,9 @@
   (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)
@@ -387,7 +394,9 @@
   (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)
@@ -422,7 +431,9 @@
   (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)