X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fassembly%2Fppc%2Fsupport.lisp;h=18c0a3a6b796d939629e61a8fae96ece24bf9868;hb=518493eab883e50237043153c0d45b245e929c7d;hp=d15bc71b1366c305ad9d94b788a063c961d209c8;hpb=4898ef32c639b1c7f4ee13a5ba566ce6debd03e6;p=sbcl.git diff --git a/src/assembly/ppc/support.lisp b/src/assembly/ppc/support.lisp index d15bc71..18c0a3a 100644 --- a/src/assembly/ppc/support.lisp +++ b/src/assembly/ppc/support.lisp @@ -11,14 +11,18 @@ (in-package "SB!VM") -(!def-vm-support-routine generate-call-sequence (name style vop) +(defun generate-call-sequence (name style vop) (ecase style ((:raw :none) - (values - `((inst bla (make-fixup ',name :assembly-routine))) - `())) + (let ((jump (make-symbol "JUMP"))) + (values + `((inst lr ,jump (make-fixup ',name :assembly-routine)) + (inst mtlr ,jump) + (inst blrl)) + `((:temporary (:sc any-reg) ,jump))))) (:full-call (let ((temp (make-symbol "TEMP")) + (jump (make-symbol "JUMP")) (nfp-save (make-symbol "NFP-SAVE")) (lra (make-symbol "LRA"))) (values @@ -28,26 +32,29 @@ (store-stack-tn ,nfp-save cur-nfp)) (inst compute-lra-from-code ,lra code-tn lra-label ,temp) (note-next-instruction ,vop :call-site) - (inst ba (make-fixup ',name :assembly-routine)) + (inst lr ,jump (make-fixup ',name :assembly-routine)) + (inst mtlr ,jump) + (inst blr) (emit-return-pc lra-label) (note-this-location ,vop :single-value-return) (without-scheduling () - (move csp-tn ocfp-tn) - (inst nop)) - (inst compute-code-from-lra code-tn code-tn + (move csp-tn ocfp-tn) + (inst nop)) + (inst compute-code-from-lra code-tn lra-tn lra-label ,temp) (when cur-nfp (load-stack-tn cur-nfp ,nfp-save)))) `((:temporary (:scs (non-descriptor-reg) :from (:eval 0) :to (:eval 1)) - ,temp) + ,temp) (:temporary (:sc descriptor-reg :offset lra-offset - :from (:eval 0) :to (:eval 1)) - ,lra) + :from (:eval 0) :to (:eval 1)) + ,lra) (:temporary (:scs (control-stack) :offset nfp-save-offset) - ,nfp-save) + ,nfp-save) + (:temporary (:sc any-reg) ,jump) (:save-p :compute-only))))))) -(!def-vm-support-routine generate-return-sequence (style) +(defun generate-return-sequence (style) (ecase style (:raw `((inst blr)))