X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fassembly%2Fhppa%2Fsupport.lisp;h=2a5e4e11f57a183002a4f773a434d550e1a648ca;hb=eaec8176060e89efa39f01017df1f6204e491ecc;hp=76c39b5384aac94a35e140956aaf26e9135616e9;hpb=4898ef32c639b1c7f4ee13a5ba566ce6debd03e6;p=sbcl.git diff --git a/src/assembly/hppa/support.lisp b/src/assembly/hppa/support.lisp index 76c39b5..2a5e4e1 100644 --- a/src/assembly/hppa/support.lisp +++ b/src/assembly/hppa/support.lisp @@ -13,13 +13,12 @@ (!def-vm-support-routine generate-call-sequence (name style vop) (ecase style - (:raw + ((:raw :none) (with-unique-names (fixup) (values `((let ((fixup (make-fixup ',name :assembly-routine))) (inst ldil fixup ,fixup) - (inst ble fixup lisp-heap-space ,fixup :nullify t)) - (inst nop)) + (inst ble fixup lisp-heap-space ,fixup :nullify t))) `((:temporary (:scs (any-reg) :from (:eval 0) :to (:eval 1)) ,fixup))))) (:full-call @@ -32,32 +31,26 @@ (when cur-nfp (store-stack-tn ,nfp-save cur-nfp)) (inst compute-lra-from-code code-tn lra-label ,temp ,lra) - (note-this-location ,vop :call-site) + (note-next-instruction ,vop :call-site) (let ((fixup (make-fixup ',name :assembly-routine))) (inst ldil fixup ,temp) (inst be fixup lisp-heap-space ,temp :nullify t)) - (emit-return-pc lra-label) - (note-this-location ,vop :single-value-return) - (move ocfp-tn csp-tn) + (without-scheduling () + (emit-return-pc lra-label) + (note-this-location ,vop :single-value-return) + (inst move ocfp-tn csp-tn) + (inst nop)) ; this nop is here because of emit-return-pc align (inst compute-code-from-lra code-tn lra-label ,temp code-tn) (when cur-nfp (load-stack-tn cur-nfp ,nfp-save)))) `((:temporary (:scs (non-descriptor-reg) :from (:eval 0) :to (:eval 1)) ,temp) (:temporary (:sc descriptor-reg :offset lra-offset - :from (:eval 0) :to (:eval 1)) + :from (:eval 0) :to (:eval 1)) ,lra) (:temporary (:scs (control-stack) :offset nfp-save-offset) ,nfp-save) - (:save-p :compute-only))))) - (:none - (with-unique-names (fixup) - (values - `((let ((fixup (make-fixup ',name :assembly-routine))) - (inst ldil fixup ,fixup) - (inst be fixup lisp-heap-space ,fixup :nullify t))) - `((:temporary (:scs (any-reg) :from (:eval 0) :to (:eval 1)) - ,fixup))))))) + (:save-p t))))))) (!def-vm-support-routine generate-return-sequence (style) (ecase style