X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Falpha%2Fnlx.lisp;h=14c35169850e8653d39562b2114acb1448dc9c51;hb=6822034325136cde4e14773c83c3769b42721306;hp=e11c7461b4b7b0900d8b6c43000e62484ad366c0;hpb=aaaec08b138d6e23c2ac6cc8d2145673a01a95c6;p=sbcl.git diff --git a/src/compiler/alpha/nlx.lisp b/src/compiler/alpha/nlx.lisp index e11c746..14c3516 100644 --- a/src/compiler/alpha/nlx.lisp +++ b/src/compiler/alpha/nlx.lisp @@ -22,7 +22,6 @@ ;;; non-local entry. (!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 ;;;; @@ -35,32 +34,22 @@ ;;;; 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- and 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))) + (nfp :scs (descriptor-reg)) + (nsp :scs (descriptor-reg))) (:vop-var vop) (:generator 13 (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 cur-nfp 4 nfp))) (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))) + (nfp :scs (descriptor-reg)) + (nsp :scs (descriptor-reg))) (:vop-var vop) (:temporary (:sc any-reg) temp) (:generator 10 @@ -68,7 +57,7 @@ (inst mskll nsp-tn 0 temp) (let ((cur-nfp (current-nfp-tn vop))) (when cur-nfp - (inst bis nfp temp cur-nfp))) + (inst bis nfp temp cur-nfp))) (inst bis nsp temp nsp-tn))) (define-vop (current-stack-pointer) @@ -92,37 +81,37 @@ (:temporary (:scs (descriptor-reg)) temp) (:temporary (:scs (non-descriptor-reg)) ndescr) (:generator 22 - (inst lda block (* (tn-offset tn) sb!vm:n-word-bytes) cfp-tn) + (inst lda block (* (tn-offset tn) 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) + (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 (any-reg 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:n-word-bytes) cfp-tn) + (inst lda result (* (tn-offset tn) 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) + (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) + (storew tag result catch-block-tag-slot) (load-symbol-value temp *current-catch-block*) - (storew temp result sb!vm:catch-block-previous-catch-slot) + (storew temp result catch-block-previous-catch-slot) (store-symbol-value result *current-catch-block*) (move result block))) @@ -133,7 +122,7 @@ (:args (tn)) (:temporary (:scs (descriptor-reg)) new-uwp) (:generator 7 - (inst lda new-uwp (* (tn-offset tn) sb!vm:n-word-bytes) cfp-tn) + (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) @@ -142,7 +131,7 @@ (:translate %catch-breakup) (:generator 17 (load-symbol-value block *current-catch-block*) - (loadw block block sb!vm:catch-block-previous-catch-slot) + (loadw block block catch-block-previous-catch-slot) (store-symbol-value block *current-catch-block*))) (define-vop (unlink-unwind-protect) @@ -151,16 +140,16 @@ (:translate %unwind-protect-breakup) (:generator 17 (load-symbol-value block *current-unwind-protect-block*) - (loadw block block sb!vm:unwind-block-current-uwp-slot) + (loadw block block unwind-block-current-uwp-slot) (store-symbol-value block *current-unwind-protect-block*))) ;;;; NLX entry VOPs (define-vop (nlx-entry) (:args (sp) ; Note: we can't list an sc-restriction, 'cause any load vops - ; would be inserted before the LRA. - (start) - (count)) + ; would be inserted before the LRA. + (start) + (count)) (:results (values :more t)) (:temporary (:scs (descriptor-reg)) move-temp) (:temporary (:sc non-descriptor-reg) temp) @@ -171,45 +160,45 @@ (emit-return-pc label) (note-this-location vop :non-local-entry) (cond ((zerop nvals)) - ((= nvals 1) - (let ((no-values (gen-label))) - (move null-tn (tn-ref-tn values)) - (inst beq count no-values) - (loadw (tn-ref-tn values) start) - (emit-label no-values))) - (t - (collect ((defaults)) - (do ((i 0 (1+ i)) - (tn-ref values (tn-ref-across tn-ref))) - ((null tn-ref)) - (let ((default-lab (gen-label)) - (tn (tn-ref-tn tn-ref))) - (defaults (cons default-lab tn)) - - (inst move count temp) - (inst lda count (fixnumize -1) count) - (inst beq temp default-lab) - (sc-case tn - ((descriptor-reg any-reg) - (loadw tn start i)) - (control-stack - (loadw move-temp start i) - (store-stack-tn tn move-temp))))) - - (let ((defaulting-done (gen-label))) - - (emit-label defaulting-done) - - (assemble (*elsewhere*) - (dolist (def (defaults)) - (emit-label (car def)) - (let ((tn (cdr def))) - (sc-case tn - ((descriptor-reg any-reg) - (move null-tn tn)) - (control-stack - (store-stack-tn tn null-tn))))) - (inst br zero-tn defaulting-done)))))) + ((= nvals 1) + (let ((no-values (gen-label))) + (move null-tn (tn-ref-tn values)) + (inst beq count no-values) + (loadw (tn-ref-tn values) start) + (emit-label no-values))) + (t + (collect ((defaults)) + (do ((i 0 (1+ i)) + (tn-ref values (tn-ref-across tn-ref))) + ((null tn-ref)) + (let ((default-lab (gen-label)) + (tn (tn-ref-tn tn-ref))) + (defaults (cons default-lab tn)) + + (inst move count temp) + (inst lda count (fixnumize -1) count) + (inst beq temp default-lab) + (sc-case tn + ((descriptor-reg any-reg) + (loadw tn start i)) + (control-stack + (loadw move-temp start i) + (store-stack-tn tn move-temp))))) + + (let ((defaulting-done (gen-label))) + + (emit-label defaulting-done) + + (assemble (*elsewhere*) + (dolist (def (defaults)) + (emit-label (car def)) + (let ((tn (cdr def))) + (sc-case tn + ((descriptor-reg any-reg) + (move null-tn tn)) + (control-stack + (store-stack-tn tn null-tn))))) + (inst br zero-tn defaulting-done)))))) (load-stack-tn csp-tn sp))) (define-vop (nlx-entry-multiple) @@ -228,7 +217,7 @@ (emit-return-pc label) (note-this-location vop :non-local-entry) (let ((loop (gen-label)) - (done (gen-label))) + (done (gen-label))) ;; Copy args. (load-stack-tn dst top) @@ -237,20 +226,20 @@ ;; Establish results. (sc-case new-start - (any-reg (move dst new-start)) - (control-stack (store-stack-tn new-start dst))) + (any-reg (move dst new-start)) + (control-stack (store-stack-tn new-start dst))) (sc-case new-count - (any-reg (inst move num new-count)) - (control-stack (store-stack-tn new-count num))) + (any-reg (inst move num new-count)) + (control-stack (store-stack-tn new-count num))) (inst beq num done) ;; Copy stuff on stack. (emit-label loop) (loadw temp src) - (inst lda src sb!vm:n-word-bytes src) + (inst lda src n-word-bytes src) (storew temp dst) (inst lda num (fixnumize -1) num) - (inst lda dst sb!vm:n-word-bytes dst) + (inst lda dst n-word-bytes dst) (inst bne num loop) (emit-label done)