X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Falpha%2Fnlx.lisp;h=d8444633e3e33810c5f7b58ef570e5e9d4f899d7;hb=104ee7ee303efa16e415f5e75df635ac54dba733;hp=5455fdfd469cab9b17898cdda828aa1b190ec220;hpb=dfa55a883f94470267b626dae77ce7e7dfac3df6;p=sbcl.git diff --git a/src/compiler/alpha/nlx.lisp b/src/compiler/alpha/nlx.lisp index 5455fdf..d844463 100644 --- a/src/compiler/alpha/nlx.lisp +++ b/src/compiler/alpha/nlx.lisp @@ -1,55 +1,42 @@ -;;; -*- Package: ALPHA -*- -;;; -;;; ********************************************************************** -;;; This code was written as part of the CMU Common Lisp project at -;;; Carnegie Mellon University, and has been placed in the public domain. -;;; +;;;; 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 +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. -;;; -;;; ********************************************************************** -;;; -;;; This file contains the definitions of VOPs used for non-local exit -;;; (throw, lexical exit, etc.) -;;; -;;; Written by Rob MacLachlan -;;; Conversion by Sean Hallgren -;;; (in-package "SB!VM") - -;;; MAKE-NLX-SP-TN -- Interface -;;; -;;; Make an environment-live stack TN for saving the SP for NLX entry. -;;; +;;; 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-NLX-Entry-Argument-Start-Location -- Interface -;;; -;;; Make a TN for the argument count passing location for a +;;; 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 restore 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 are implicitly processed during unwinding. If there -;;; were any additional stacks, then this would be the place to restore the top -;;; pointers. - - -;;; Make-Dynamic-State-TNs -- Interface -;;; -;;; Return a list of TNs that can be used to snapshot the dynamic state for +;;;; 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 +;;;; are implicitly processed during unwinding. If there were any +;;;; additional stacks, 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*) @@ -63,12 +50,12 @@ (eval :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*))) + (load-symbol-value eval *eval-stack-top*))) (define-vop (restore-dynamic-state) (:args (catch :scs (descriptor-reg)) @@ -78,8 +65,8 @@ (: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*) + (store-symbol-value eval *eval-stack-top*) (inst mskll nsp-tn 0 temp) (let ((cur-nfp (current-nfp-tn vop))) (when cur-nfp @@ -95,14 +82,11 @@ (:results (res :scs (any-reg descriptor-reg))) (:generator 1 (move bsp-tn res))) - - -;;;; Unwind block hackery: +;;;; unwind block hackery -;;; Compute the address of the catch block from its TN, then store into the -;;; block the current Fp, Env, Unwind-Protect, and the entry PC. -;;; +;;; Compute the address of the catch block from its TN, then store +;;; into the block the current Fp, Env, Unwind-Protect, and the entry PC. (define-vop (make-unwind-block) (:args (tn)) (:info entry-label) @@ -110,8 +94,8 @@ (: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*) + (inst lda block (* (tn-offset tn) sb!vm:n-word-bytes) cfp-tn) + (load-symbol-value temp *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) @@ -119,9 +103,8 @@ (storew temp block sb!vm:catch-block-entry-pc-slot))) -;;; Like Make-Unwind-Block, except that we also store in the specified tag, and -;;; link the block into the Current-Catch list. -;;; +;;; 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))) @@ -131,8 +114,8 @@ (: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*) + (inst lda result (* (tn-offset tn) sb!vm:n-word-bytes) cfp-tn) + (load-symbol-value temp *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) @@ -140,45 +123,40 @@ (storew temp result sb!vm:catch-block-entry-pc-slot) (storew tag result sb!vm:catch-block-tag-slot) - (load-symbol-value temp sb!impl::*current-catch-block*) + (load-symbol-value temp *current-catch-block*) (storew temp result sb!vm:catch-block-previous-catch-slot) - (store-symbol-value result sb!impl::*current-catch-block*) + (store-symbol-value result *current-catch-block*) (move result block))) - -;;; Just set the current unwind-protect to TN's address. This instantiates an -;;; unwind block as an unwind-protect. -;;; +;;; Just set the current unwind-protect to TN's address. This +;;; instantiates an unwind block as an unwind-protect. (define-vop (set-unwind-protect) (: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) sb!vm: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*) + (load-symbol-value block *current-catch-block*) (loadw block block sb!vm:catch-block-previous-catch-slot) - (store-symbol-value block sb!impl::*current-catch-block*))) + (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*) + (load-symbol-value block *current-unwind-protect-block*) (loadw block block sb!vm:unwind-block-current-uwp-slot) - (store-symbol-value block sb!impl::*current-unwind-protect-block*))) - + (store-symbol-value block *current-unwind-protect-block*))) -;;;; NLX entry VOPs: - +;;;; NLX entry VOPs (define-vop (nlx-entry) (:args (sp) ; Note: we can't list an sc-restriction, 'cause any load vops @@ -236,7 +214,6 @@ (inst br zero-tn defaulting-done)))))) (load-stack-tn csp-tn sp))) - (define-vop (nlx-entry-multiple) (:args (top :target dst) (start :target src) (count :target num)) ;; Again, no SC restrictions for the args, 'cause the loading would @@ -272,18 +249,16 @@ ;; Copy stuff on stack. (emit-label loop) (loadw temp src) - (inst lda src sb!vm:word-bytes src) + (inst lda src sb!vm:n-word-bytes src) (storew temp dst) (inst lda num (fixnumize -1) num) - (inst lda dst sb!vm:word-bytes dst) + (inst lda dst sb!vm:n-word-bytes dst) (inst bne num loop) (emit-label done) (inst move dst csp-tn)))) - ;;; This VOP is just to force the TNs used in the cleanup onto the stack. -;;; (define-vop (uwp-entry) (:info label) (:save-p :force-to-stack)