1.0.32.29: Add build flag :sb-xref-for-internals.

[sbcl.git] / src / compiler / ppc / call.lisp

diff --git a/src/compiler/ppc/call.lisp b/src/compiler/ppc/call.lisp
index 038a510..b490dee 100644 (file)
--- a/src/compiler/ppc/call.lisp
+++ b/src/compiler/ppc/call.lisp
@@ -129,7 +129,7 @@
   (:generator 1
     ;; Make sure the function is aligned, and drop a label pointing to this
     ;; function header.
-    (align n-lowtag-bits)
+    (emit-alignment n-lowtag-bits)
     (trace-table-entry trace-table-fun-prologue)
     (emit-label start-lab)
     ;; Allocate function header.
@@ -618,11 +618,11 @@ default-value-8
      ,@(unless (or (eq return :tail) variable)
          '((:move-args :full-call)))
 
-     (:vop-var vop)
-     (:info ,@(unless (or variable (eq return :tail)) '(arg-locs))
-            ,@(unless variable '(nargs))
-            ,@(when (eq return :fixed) '(nvals))
-            step-instrumenting)
+    (:vop-var vop)
+    (:info ,@(unless (or variable (eq return :tail)) '(arg-locs))
+           ,@(unless variable '(nargs))
+           ,@(when (eq return :fixed) '(nvals))
+           step-instrumenting)
 
      (:ignore
       ,@(unless (or variable (eq return :tail)) '(arg-locs))
@@ -750,7 +750,7 @@ default-value-8
                 (insert-step-instrumenting (callable-tn)
                   ;; Conditionally insert a conditional trap:
                   (when step-instrumenting
-                     ;; Get the symbol-value of SB!IMPL::*STEPPING*
+                    ;; Get the symbol-value of SB!IMPL::*STEPPING*
                     (loadw stepping
                            null-tn
                            (+ symbol-value-slot
@@ -847,7 +847,6 @@ default-value-8
 (define-full-call call-variable nil :fixed t)
 (define-full-call multiple-call-variable nil :unknown t)
 
-
 ;;; Defined separately, since needs special code that BLT's the
 ;;; arguments down.
 (define-vop (tail-call-variable)
@@ -856,33 +855,27 @@ default-value-8
    (function-arg :scs (descriptor-reg) :target lexenv)
    (old-fp-arg :scs (any-reg) :target old-fp)
    (lra-arg :scs (descriptor-reg) :target lra))
-
   (:temporary (:sc any-reg :offset nl0-offset :from (:argument 0)) args)
   (:temporary (:sc any-reg :offset lexenv-offset :from (:argument 1)) lexenv)
   (:temporary (:sc any-reg :offset ocfp-offset :from (:argument 2)) old-fp)
   (:temporary (:sc any-reg :offset lra-offset :from (:argument 3)) lra)
-
-
+  (:temporary (:sc any-reg) temp)
   (:vop-var vop)
-
   (:generator 75
-
     ;; Move these into the passing locations if they are not already there.
     (move args args-arg)
     (move lexenv function-arg)
     (move old-fp old-fp-arg)
     (move lra lra-arg)
-
-
     ;; Clear the number stack if anything is there.
     (let ((cur-nfp (current-nfp-tn vop)))
       (when cur-nfp
         (inst addi nsp-tn cur-nfp
               (- (bytes-needed-for-non-descriptor-stack-frame)
                  number-stack-displacement))))
-
-
-    (inst ba (make-fixup 'tail-call-variable :assembly-routine))))
+    (inst lr temp (make-fixup 'tail-call-variable :assembly-routine))
+    (inst mtlr temp)
+    (inst blr)))
 
 \f
 ;;;; Unknown values return:
@@ -978,17 +971,14 @@ default-value-8
    (lra-arg :scs (descriptor-reg) :to (:eval 1))
    (vals-arg :scs (any-reg) :target vals)
    (nvals-arg :scs (any-reg) :target nvals))
-
   (:temporary (:sc any-reg :offset nl1-offset :from (:argument 0)) old-fp)
   (:temporary (:sc descriptor-reg :offset lra-offset :from (:argument 1)) lra)
   (:temporary (:sc any-reg :offset nl0-offset :from (:argument 2)) vals)
   (:temporary (:sc any-reg :offset nargs-offset :from (:argument 3)) nvals)
   (:temporary (:sc descriptor-reg :offset a0-offset) a0)
   (:temporary (:scs (interior-reg)) lip)
-
-
+  (:temporary (:sc any-reg) temp)
   (:vop-var vop)
-
   (:generator 13
     (trace-table-entry trace-table-fun-epilogue)
     (let ((not-single (gen-label)))
@@ -998,24 +988,23 @@ default-value-8
           (inst addi nsp-tn cur-nfp
                 (- (bytes-needed-for-non-descriptor-stack-frame)
                    number-stack-displacement))))
-
       ;; Check for the single case.
       (inst cmpwi nvals-arg (fixnumize 1))
       (inst lwz a0 vals-arg 0)
       (inst bne not-single)
-
       ;; Return with one value.
       (move csp-tn cfp-tn)
       (move cfp-tn old-fp-arg)
       (lisp-return lra-arg lip :offset 2)
-
       ;; Nope, not the single case.
       (emit-label not-single)
       (move old-fp old-fp-arg)
       (move lra lra-arg)
       (move vals vals-arg)
       (move nvals nvals-arg)
-      (inst ba (make-fixup 'return-multiple :assembly-routine)))
+      (inst lr temp (make-fixup 'return-multiple :assembly-routine))
+      (inst mtlr temp)
+      (inst blr))
     (trace-table-entry trace-table-normal)))
 \f
 ;;;; XEP hackery:
@@ -1106,9 +1095,6 @@ default-value-8
   (:translate %more-arg))
 
 ;;; Turn more arg (context, count) into a list.
-(defoptimizer (%listify-rest-args stack-allocate-result) ((&rest args))
-  t)
-
 (define-vop (listify-rest-args)
   (:args (context-arg :target context :scs (descriptor-reg))
          (count-arg :target count :scs (any-reg)))
@@ -1222,7 +1208,7 @@ default-value-8
                 (:vop-var vop)
                 (:save-p :compute-only)
                 (:generator 1000
-                  (error-call vop ,error ,@args)))))
+                  (error-call vop ',error ,@args)))))
   (frob arg-count-error invalid-arg-count-error
     sb!c::%arg-count-error nargs)
   (frob type-check-error object-not-type-error sb!c::%type-check-error