X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Fnlx.lisp;h=523ef3199ebbeda15f70680685acc456a84b3690;hb=69e6aef5e6fb3bd682c7a2cbf774034d2ea58ee8;hp=dd31d2a6473fd7e8ef22cf38332b4abd7a83f748;hpb=878638b5b594ec6c3e8b2310f7d31435c5935ef2;p=sbcl.git diff --git a/src/compiler/x86-64/nlx.lisp b/src/compiler/x86-64/nlx.lisp index dd31d2a..523ef31 100644 --- a/src/compiler/x86-64/nlx.lisp +++ b/src/compiler/x86-64/nlx.lisp @@ -12,19 +12,19 @@ (in-package "SB!VM") ;;; Make an environment-live stack TN for saving the SP for NLX entry. -(!def-vm-support-routine make-nlx-sp-tn (env) +(defun make-nlx-sp-tn (env) (physenv-live-tn (make-representation-tn *fixnum-primitive-type* any-reg-sc-number) env)) ;;; Make a TN for the argument count passing location for a non-local entry. -(!def-vm-support-routine make-nlx-entry-arg-start-location () +(defun make-nlx-entry-arg-start-location () (make-wired-tn *fixnum-primitive-type* any-reg-sc-number rbx-offset)) (defun catch-block-ea (tn) (aver (sc-is tn catch-block)) (make-ea :qword :base rbp-tn - :disp (- (* (+ (tn-offset tn) catch-block-size) n-word-bytes)))) + :disp (frame-byte-offset (+ -1 (tn-offset tn) catch-block-size)))) ;;;; Save and restore dynamic environment. @@ -168,9 +168,10 @@ (storew rdx-tn rbx-tn -1)) (sc-case tn ((descriptor-reg any-reg) - (loadw tn start (frame-word-offset i))) + (loadw tn start (frame-word-offset (+ sp->fp-offset i)))) ((control-stack) - (loadw move-temp start (frame-word-offset i)) + (loadw move-temp start + (frame-word-offset (+ sp->fp-offset i))) (inst mov tn move-temp))))) (let ((defaulting-done (gen-label))) (emit-label defaulting-done) @@ -211,7 +212,7 @@ (inst sub rdi n-word-bytes) (move rcx count) ; fixnum words == bytes (move num rcx) - (inst shr rcx word-shift) ; word count for + (inst shr rcx n-fixnum-tag-bits) ; word count for ;; If we got zero, we be done. (inst jrcxz DONE) ;; Copy them down. @@ -238,17 +239,17 @@ (define-vop (unwind-to-frame-and-call) (:args (ofp :scs (descriptor-reg)) (uwp :scs (descriptor-reg)) - (function :scs (descriptor-reg))) + (function :scs (descriptor-reg) :to :load :target saved-function)) (:arg-types system-area-pointer system-area-pointer t) (:temporary (:sc sap-reg) temp) + (:temporary (:sc descriptor-reg :offset rbx-offset) saved-function) (:temporary (:sc unsigned-reg :offset rax-offset) block) (:generator 22 ;; Store the function into a non-stack location, since we'll be ;; unwinding the stack and destroying register contents before we - ;; use it. - (store-tl-symbol-value function - *unwind-to-frame-function* - temp) + ;; use it. It turns out that RBX is preserved as part of the + ;; normal multiple-value handling of an unwind, so use that. + (move saved-function function) ;; Allocate space for magic UWP block. (inst sub rsp-tn (* unwind-block-size n-word-bytes)) @@ -265,19 +266,20 @@ catch-block-entry-pc-slot) ;; Run any required UWPs. - (inst lea temp-reg-tn (make-fixup 'unwind :assembly-routine)) + (inst mov temp-reg-tn (make-fixup 'unwind :assembly-routine)) (inst jmp temp-reg-tn) ENTRY-LABEL - ;; Load function from symbol - (load-tl-symbol-value block *unwind-to-frame-function*) + ;; Move our saved function to where we want it now. + (move block saved-function) ;; No parameters (zeroize rcx-tn) ;; Clear the stack (inst lea rsp-tn - (make-ea :qword :base rbp-tn :disp (* -3 n-word-bytes))) + (make-ea :qword :base rbp-tn + :disp (* (- sp->fp-offset 3) n-word-bytes))) ;; Push the return-pc so it looks like we just called. (pushw rbp-tn (frame-word-offset return-pc-save-offset))