X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fmips%2Fnlx.lisp;h=18d65528364d5de81b906df1ea910aa5979cc6a9;hb=f6b2e375747a54a1bfa34ead9f9af2d4e8b5aa38;hp=45286b1c59df8d31b689713cd1857fd3764a6022;hpb=4ae1b794a5d6a90794468cf8017f5307f2c30dfe;p=sbcl.git diff --git a/src/compiler/mips/nlx.lisp b/src/compiler/mips/nlx.lisp index 45286b1..18d6552 100644 --- a/src/compiler/mips/nlx.lisp +++ b/src/compiler/mips/nlx.lisp @@ -1,63 +1,48 @@ (in-package "SB!VM") -;;; MAKE-NLX-SP-TN -- Interface -;;; -;;; Make an environment-live stack TN for saving the SP for NLX entry. -;;; -(!def-vm-support-routine make-nlx-sp-tn (env) +;;; Make an environment-live stack TN for saving the SP for NLX entry. +(defun make-nlx-sp-tn (env) (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-arg-start-location () +(defun 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 +;;; 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 -;;; use with the Save/Restore-Dynamic-Environment VOPs. -;;; -(!def-vm-support-routine make-dynamic-state-tns () - (make-n-tns 4 *backend-t-primitive-type*)) - (define-vop (save-dynamic-state) (:results (catch :scs (descriptor-reg)) - (nfp :scs (descriptor-reg)) - (nsp :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 - (move nfp cur-nfp))) + (move nfp cur-nfp))) (move nsp nsp-tn))) (define-vop (restore-dynamic-state) (:args (catch :scs (descriptor-reg)) - (nfp :scs (descriptor-reg)) - (nsp :scs (descriptor-reg))) + (nfp :scs (descriptor-reg)) + (nsp :scs (descriptor-reg))) (:vop-var vop) (:generator 10 (store-symbol-value catch *current-catch-block*) (let ((cur-nfp (current-nfp-tn vop))) (when cur-nfp - (move cur-nfp nfp))) + (move cur-nfp nfp))) (move nsp-tn nsp))) (define-vop (current-stack-pointer) @@ -98,7 +83,7 @@ ;;; (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) @@ -156,9 +141,9 @@ (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) (:info label nvals) @@ -168,45 +153,45 @@ (emit-return-pc label) (note-this-location vop :non-local-entry) (cond ((zerop nvals)) - ((= nvals 1) - (let ((no-values (gen-label))) - (inst beq count zero-tn no-values) - (move (tn-ref-tn values) null-tn) - (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 beq count zero-tn default-lab) - (inst addu count count (fixnumize -1)) - (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 tn null-tn)) - (control-stack - (store-stack-tn tn null-tn))))) - (inst b defaulting-done) - (inst nop)))))) + ((= nvals 1) + (let ((no-values (gen-label))) + (inst beq count no-values) + (move (tn-ref-tn values) null-tn t) + (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 beq count default-lab) + (inst addu count count (fixnumize -1)) + (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 tn null-tn)) + (control-stack + (store-stack-tn tn null-tn))))) + (inst b defaulting-done) + (inst nop)))))) (load-stack-tn csp-tn sp))) @@ -226,7 +211,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) @@ -235,24 +220,25 @@ ;; Establish results. (sc-case new-start - (any-reg (move new-start dst)) - (control-stack (store-stack-tn new-start dst))) - (inst beq num zero-tn done) + (any-reg (move new-start dst)) + (control-stack (store-stack-tn new-start dst))) + (inst beq num done) + (inst nop) (sc-case new-count - (any-reg (inst move new-count num)) - (control-stack (store-stack-tn new-count num))) + (any-reg (move new-count num)) + (control-stack (store-stack-tn new-count num))) ;; Copy stuff on stack. (emit-label loop) (loadw temp src) (inst addu src src n-word-bytes) - (storew temp dst) (inst addu num num (fixnumize -1)) - (inst bne num zero-tn loop) + (storew temp dst) + (inst bne num loop) (inst addu dst dst n-word-bytes) (emit-label done) - (inst move csp-tn dst)))) + (move csp-tn dst)))) ;;; This VOP is just to force the TNs used in the cleanup onto the stack.