X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcompiler%2Falpha%2Fnlx.lisp;h=89c2e8d4eab4342af7a15a400098b46b07f3157b;hb=1f7f3d741e06d63b6a5e140a0e6045bba29e17fb;hp=bb061541158f66bf4de778797a02cfd2ac8b1208;hpb=63fcb94b875a97e468d9add229e220ecceec2352;p=sbcl.git diff --git a/src/compiler/alpha/nlx.lisp b/src/compiler/alpha/nlx.lisp index bb06154..89c2e8d 100644 --- a/src/compiler/alpha/nlx.lisp +++ b/src/compiler/alpha/nlx.lisp @@ -1,4 +1,4 @@ -;;;; the definitions of VOPs used for non-local exit (throw, lexical +;;;; the definitions of VOPs used for non-local exit (THROW, lexical ;;;; exit, etc.) ;;;; This software is part of the SBCL system. See the README file for @@ -14,59 +14,46 @@ ;;; Make an environment-live stack TN for saving the SP for NLX entry. (!def-vm-support-routine make-nlx-sp-tn (env) - (environment-live-tn + (physenv-live-tn (make-representation-tn *fixnum-primitive-type* immediate-arg-scn) env)) ;;; Make a TN for the argument count passing location for a ;;; non-local entry. -(!def-vm-support-routine make-nlx-entry-argument-start-location () +(!def-vm-support-routine make-nlx-entry-arg-start-location () (make-wired-tn *fixnum-primitive-type* immediate-arg-scn ocfp-offset)) - ;;;; save and restoring the dynamic environment ;;;; ;;;; These VOPs are used in the reentered function to restore the ;;;; appropriate dynamic environment. Currently we only save the -;;;; Current-Catch and binding stack pointer. We don't need to -;;;; save/restore the current unwind-protect, since unwind-protects +;;;; CURRENT-CATCH and binding stack pointer. We don't need to +;;;; save/restore the current UNWIND-PROTECT, since UNWIND-PROTECTS ;;;; are implicitly processed during unwinding. If there were any -;;;; additional stacks, then this would be the place to restore the +;;;; additional stacks (as e.g. there was an interpreter "eval stack" +;;;; before sbcl-0.7.0), then this would be the place to restore the ;;;; top pointers. - -;;; Return a list of TNs that can be used to snapshot the dynamic state for -;;; use with the Save/Restore-Dynamic-Environment VOPs. -(!def-vm-support-routine make-dynamic-state-tns () - (list (make-normal-tn *backend-t-primitive-type*) - (make-normal-tn *backend-t-primitive-type*) - (make-normal-tn *backend-t-primitive-type*) - (make-normal-tn *backend-t-primitive-type*))) - (define-vop (save-dynamic-state) (:results (catch :scs (descriptor-reg)) (nfp :scs (descriptor-reg)) - (nsp :scs (descriptor-reg)) - (eval :scs (descriptor-reg))) + (nsp :scs (descriptor-reg))) (:vop-var vop) (:generator 13 - (load-symbol-value catch sb!impl::*current-catch-block*) + (load-symbol-value catch *current-catch-block*) (let ((cur-nfp (current-nfp-tn vop))) (when cur-nfp (inst mskll cur-nfp 4 nfp))) - (inst mskll nsp-tn 4 nsp) - (load-symbol-value eval sb!impl::*eval-stack-top*))) + (inst mskll nsp-tn 4 nsp))) (define-vop (restore-dynamic-state) (:args (catch :scs (descriptor-reg)) (nfp :scs (descriptor-reg)) - (nsp :scs (descriptor-reg)) - (eval :scs (descriptor-reg))) + (nsp :scs (descriptor-reg))) (:vop-var vop) (:temporary (:sc any-reg) temp) (:generator 10 - (store-symbol-value catch sb!impl::*current-catch-block*) - (store-symbol-value eval sb!impl::*eval-stack-top*) + (store-symbol-value catch *current-catch-block*) (inst mskll nsp-tn 0 temp) (let ((cur-nfp (current-nfp-tn vop))) (when cur-nfp @@ -94,38 +81,38 @@ (:temporary (:scs (descriptor-reg)) temp) (:temporary (:scs (non-descriptor-reg)) ndescr) (:generator 22 - (inst lda block (* (tn-offset tn) sb!vm:word-bytes) cfp-tn) - (load-symbol-value temp sb!impl::*current-unwind-protect-block*) - (storew temp block sb!vm:unwind-block-current-uwp-slot) - (storew cfp-tn block sb!vm:unwind-block-current-cont-slot) - (storew code-tn block sb!vm:unwind-block-current-code-slot) + (inst lda block (* (tn-offset tn) n-word-bytes) cfp-tn) + (load-symbol-value temp *current-unwind-protect-block*) + (storew temp block unwind-block-current-uwp-slot) + (storew cfp-tn block unwind-block-current-cont-slot) + (storew code-tn block unwind-block-current-code-slot) (inst compute-lra-from-code temp code-tn entry-label ndescr) - (storew temp block sb!vm:catch-block-entry-pc-slot))) + (storew temp block catch-block-entry-pc-slot))) ;;; This is like Make-Unwind-Block, except that we also store in the ;;; specified tag, and link the block into the Current-Catch list. (define-vop (make-catch-block) (:args (tn) - (tag :scs (descriptor-reg))) + (tag :scs (any-reg descriptor-reg))) (:info entry-label) (:results (block :scs (any-reg))) (:temporary (:scs (descriptor-reg)) temp) (:temporary (:scs (descriptor-reg) :target block :to (:result 0)) result) (:temporary (:scs (non-descriptor-reg)) ndescr) (:generator 44 - (inst lda result (* (tn-offset tn) sb!vm:word-bytes) cfp-tn) - (load-symbol-value temp sb!impl::*current-unwind-protect-block*) - (storew temp result sb!vm:catch-block-current-uwp-slot) - (storew cfp-tn result sb!vm:catch-block-current-cont-slot) - (storew code-tn result sb!vm:catch-block-current-code-slot) + (inst lda result (* (tn-offset tn) n-word-bytes) cfp-tn) + (load-symbol-value temp *current-unwind-protect-block*) + (storew temp result catch-block-current-uwp-slot) + (storew cfp-tn result catch-block-current-cont-slot) + (storew code-tn result catch-block-current-code-slot) (inst compute-lra-from-code temp code-tn entry-label ndescr) - (storew temp result sb!vm:catch-block-entry-pc-slot) + (storew temp result catch-block-entry-pc-slot) - (storew tag result sb!vm:catch-block-tag-slot) - (load-symbol-value temp sb!impl::*current-catch-block*) - (storew temp result sb!vm:catch-block-previous-catch-slot) - (store-symbol-value result sb!impl::*current-catch-block*) + (storew tag result catch-block-tag-slot) + (load-symbol-value temp *current-catch-block*) + (storew temp result catch-block-previous-catch-slot) + (store-symbol-value result *current-catch-block*) (move result block))) @@ -135,27 +122,26 @@ (:args (tn)) (:temporary (:scs (descriptor-reg)) new-uwp) (:generator 7 - (inst lda new-uwp (* (tn-offset tn) sb!vm:word-bytes) cfp-tn) - (store-symbol-value new-uwp sb!impl::*current-unwind-protect-block*))) - + (inst lda new-uwp (* (tn-offset tn) n-word-bytes) cfp-tn) + (store-symbol-value new-uwp *current-unwind-protect-block*))) (define-vop (unlink-catch-block) (:temporary (:scs (any-reg)) block) (:policy :fast-safe) (:translate %catch-breakup) (:generator 17 - (load-symbol-value block sb!impl::*current-catch-block*) - (loadw block block sb!vm:catch-block-previous-catch-slot) - (store-symbol-value block sb!impl::*current-catch-block*))) + (load-symbol-value block *current-catch-block*) + (loadw block block catch-block-previous-catch-slot) + (store-symbol-value block *current-catch-block*))) (define-vop (unlink-unwind-protect) (:temporary (:scs (any-reg)) block) (:policy :fast-safe) (:translate %unwind-protect-breakup) (:generator 17 - (load-symbol-value block sb!impl::*current-unwind-protect-block*) - (loadw block block sb!vm:unwind-block-current-uwp-slot) - (store-symbol-value block sb!impl::*current-unwind-protect-block*))) + (load-symbol-value block *current-unwind-protect-block*) + (loadw block block unwind-block-current-uwp-slot) + (store-symbol-value block *current-unwind-protect-block*))) ;;;; NLX entry VOPs @@ -250,10 +236,10 @@ ;; Copy stuff on stack. (emit-label loop) (loadw temp src) - (inst lda src sb!vm:word-bytes src) + (inst lda src n-word-bytes src) (storew temp dst) (inst lda num (fixnumize -1) num) - (inst lda dst sb!vm:word-bytes dst) + (inst lda dst n-word-bytes dst) (inst bne num loop) (emit-label done)