X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Fnlx.lisp;h=470e90582cbeaefeea308706865c5fa243c70e38;hb=942e45e3bb73fd55786e4a0ab4590324063c0c89;hp=42dd9062ced1a73eb63b08e896ab8bf8f9bebdb9;hpb=104ee7ee303efa16e415f5e75df635ac54dba733;p=sbcl.git diff --git a/src/compiler/x86/nlx.lisp b/src/compiler/x86/nlx.lisp index 42dd906..470e905 100644 --- a/src/compiler/x86/nlx.lisp +++ b/src/compiler/x86/nlx.lisp @@ -24,43 +24,36 @@ (defun catch-block-ea (tn) (aver (sc-is tn catch-block)) (make-ea :dword :base ebp-tn - :disp (- (* (+ (tn-offset tn) catch-block-size) n-word-bytes)))) + :disp (- (* (+ (tn-offset tn) catch-block-size) n-word-bytes)))) ;;;; 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, the eval stack pointer, and the alien stack -;;;; pointer. +;;;; Current-Catch and the alien stack pointer. (Before sbcl-0.7.0, +;;;; when there were IR1 and byte interpreters, we had to save +;;;; the interpreter "eval stack" too.) ;;;; -;;;; We don't need to save/restore the current unwind-protect, since -;;;; unwind-protects are implicitly processed during unwinding. +;;;; We don't need to save/restore the current UNWIND-PROTECT, since +;;;; UNWIND-PROTECTs are implicitly processed during unwinding. ;;;; ;;;; We don't need to save the BSP, because that is handled automatically. -;;; 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 3 *backend-t-primitive-type*)) - (define-vop (save-dynamic-state) (:results (catch :scs (descriptor-reg)) - (eval :scs (descriptor-reg)) - (alien-stack :scs (descriptor-reg))) + (alien-stack :scs (descriptor-reg))) (:generator 13 - (load-symbol-value catch *current-catch-block*) - (load-symbol-value eval *eval-stack-top*) - (load-symbol-value alien-stack *alien-stack*))) + (load-tl-symbol-value catch *current-catch-block*) + (load-tl-symbol-value alien-stack *alien-stack*))) (define-vop (restore-dynamic-state) (:args (catch :scs (descriptor-reg)) - (eval :scs (descriptor-reg)) - (alien-stack :scs (descriptor-reg))) + (alien-stack :scs (descriptor-reg))) + #!+sb-thread (:temporary (:sc unsigned-reg) temp) (:generator 10 - (store-symbol-value catch *current-catch-block*) - (store-symbol-value eval *eval-stack-top*) - (store-symbol-value alien-stack *alien-stack*))) + (store-tl-symbol-value catch *current-catch-block* temp) + (store-tl-symbol-value alien-stack *alien-stack* temp))) (define-vop (current-stack-pointer) (:results (res :scs (any-reg control-stack))) @@ -70,7 +63,7 @@ (define-vop (current-binding-pointer) (:results (res :scs (any-reg descriptor-reg))) (:generator 1 - (load-symbol-value res *binding-stack-pointer*))) + (load-binding-stack-pointer res))) ;;;; unwind block hackery @@ -83,66 +76,66 @@ (:results (block :scs (any-reg))) (:generator 22 (inst lea block (catch-block-ea tn)) - (load-symbol-value temp *current-unwind-protect-block*) + (load-tl-symbol-value temp *current-unwind-protect-block*) (storew temp block unwind-block-current-uwp-slot) (storew ebp-tn block unwind-block-current-cont-slot) (storew (make-fixup nil :code-object entry-label) - block catch-block-entry-pc-slot))) + block 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. +;;; 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) :to (:result 1))) + (tag :scs (any-reg descriptor-reg) :to (:result 1))) (:info entry-label) (:results (block :scs (any-reg))) (:temporary (:sc descriptor-reg) temp) (:generator 44 (inst lea block (catch-block-ea tn)) - (load-symbol-value temp *current-unwind-protect-block*) + (load-tl-symbol-value temp *current-unwind-protect-block*) (storew temp block unwind-block-current-uwp-slot) (storew ebp-tn block unwind-block-current-cont-slot) (storew (make-fixup nil :code-object entry-label) - block catch-block-entry-pc-slot) + block catch-block-entry-pc-slot) (storew tag block catch-block-tag-slot) - (load-symbol-value temp *current-catch-block*) + (load-tl-symbol-value temp *current-catch-block*) (storew temp block catch-block-previous-catch-slot) - (store-symbol-value block *current-catch-block*))) + (store-tl-symbol-value block *current-catch-block* temp))) ;;; 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 (:sc unsigned-reg) new-uwp) + (:temporary (:sc unsigned-reg) new-uwp #!+sb-thread tls) (:generator 7 (inst lea new-uwp (catch-block-ea tn)) - (store-symbol-value new-uwp *current-unwind-protect-block*))) + (store-tl-symbol-value new-uwp *current-unwind-protect-block* tls))) (define-vop (unlink-catch-block) - (:temporary (:sc unsigned-reg) block) + (:temporary (:sc unsigned-reg) #!+sb-thread tls block) (:policy :fast-safe) (:translate %catch-breakup) (:generator 17 - (load-symbol-value block *current-catch-block*) + (load-tl-symbol-value block *current-catch-block*) (loadw block block catch-block-previous-catch-slot) - (store-symbol-value block *current-catch-block*))) + (store-tl-symbol-value block *current-catch-block* tls))) (define-vop (unlink-unwind-protect) - (:temporary (:sc unsigned-reg) block) + (:temporary (:sc unsigned-reg) block #!+sb-thread tls) (:policy :fast-safe) (:translate %unwind-protect-breakup) (:generator 17 - (load-symbol-value block *current-unwind-protect-block*) + (load-tl-symbol-value block *current-unwind-protect-block*) (loadw block block unwind-block-current-uwp-slot) - (store-symbol-value block *current-unwind-protect-block*))) + (store-tl-symbol-value block *current-unwind-protect-block* tls))) ;;;; NLX entry VOPs (define-vop (nlx-entry) ;; Note: we can't list an sc-restriction, 'cause any load vops would ;; be inserted before the return-pc label. (:args (sp) - (start) - (count)) + (start) + (count)) (:results (values :more t)) (:temporary (:sc descriptor-reg) move-temp) (:info label nvals) @@ -152,42 +145,42 @@ (emit-label label) (note-this-location vop :non-local-entry) (cond ((zerop nvals)) - ((= nvals 1) - (let ((no-values (gen-label))) - (inst mov (tn-ref-tn values) nil-value) - (inst jecxz no-values) - (loadw (tn-ref-tn values) start -1) - (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 cmp count (fixnumize i)) - (inst jmp :le default-lab) - (sc-case tn - ((descriptor-reg any-reg) - (loadw tn start (- (1+ i)))) - ((control-stack) - (loadw move-temp start (- (1+ i))) - (inst mov tn move-temp))))) - (let ((defaulting-done (gen-label))) - (emit-label defaulting-done) - (assemble (*elsewhere*) - (dolist (def (defaults)) - (emit-label (car def)) - (inst mov (cdr def) nil-value)) - (inst jmp defaulting-done)))))) + ((= nvals 1) + (let ((no-values (gen-label))) + (inst mov (tn-ref-tn values) nil-value) + (inst jecxz no-values) + (loadw (tn-ref-tn values) start -1) + (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 cmp count (fixnumize i)) + (inst jmp :le default-lab) + (sc-case tn + ((descriptor-reg any-reg) + (loadw tn start (- (1+ i)))) + ((control-stack) + (loadw move-temp start (- (1+ i))) + (inst mov tn move-temp))))) + (let ((defaulting-done (gen-label))) + (emit-label defaulting-done) + (assemble (*elsewhere*) + (dolist (def (defaults)) + (emit-label (car def)) + (inst mov (cdr def) nil-value)) + (inst jmp defaulting-done)))))) (inst mov esp-tn sp))) (define-vop (nlx-entry-multiple) (:args (top) - (source) - (count :target ecx)) + (source) + (count :target ecx)) ;; Again, no SC restrictions for the args, 'cause the loading would ;; happen before the entry label. (:info label) @@ -195,7 +188,7 @@ (:temporary (:sc unsigned-reg :offset esi-offset) esi) (:temporary (:sc unsigned-reg :offset edi-offset) edi) (:results (result :scs (any-reg) :from (:argument 0)) - (num :scs (any-reg control-stack))) + (num :scs (any-reg control-stack))) (:save-p :force-to-stack) (:vop-var vop) (:generator 30 @@ -210,9 +203,9 @@ (move result edi) (inst sub edi n-word-bytes) - (move ecx count) ; fixnum words == bytes + (move ecx count) ; fixnum words == bytes (move num ecx) - (inst shr ecx word-shift) ; word count for + (inst shr ecx word-shift) ; word count for ;; If we got zero, we be done. (inst jecxz done) ;; Copy them down. @@ -221,6 +214,8 @@ (inst movs :dword) DONE + ;; solaris requires DF being zero. + #!+sunos (inst cld) ;; Reset the CSP at last moved arg. (inst lea esp-tn (make-ea :dword :base edi :disp n-word-bytes))))