From 7ba077bff178bb91408d6a17482944d34401ec2d Mon Sep 17 00:00:00 2001 From: dtc <dtc> Date: Fri, 21 Nov 1997 12:26:52 +0000 Subject: [PATCH] Clean up the NLX entry VOPs so that the argument start is passed in the EBX register rather than in stack slot 0 where it corrupts the OCFP. New vm-support-routine make-nlx-entry-argument-start-location. No longer need to save/restore the OCFP with the dynamic state as it isn't corrupted. --- assembly/x86/assem-rtns.lisp | 29 ++--- compiler/backend.lisp | 3 +- compiler/ir2tran.lisp | 5 +- compiler/x86/nlx.lisp | 204 ++++++----------------------------- 4 files changed, 48 insertions(+), 193 deletions(-) diff --git a/assembly/x86/assem-rtns.lisp b/assembly/x86/assem-rtns.lisp index b7b22eb15..556d22109 100644 --- a/assembly/x86/assem-rtns.lisp +++ b/assembly/x86/assem-rtns.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/x86/assem-rtns.lisp,v 1.2 1997/11/18 10:48:01 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/x86/assem-rtns.lisp,v 1.3 1997/11/21 12:26:48 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -17,6 +17,7 @@ ;;; Written by William Lott ;;; ;;; Debugged by Paul F. Werkowski -- Spring/Summer 1995. +;;; Enhancements/debugging by Douglas T. Crosher 1997. ;;; (in-package :x86) @@ -195,10 +196,6 @@ (pushw ebp-tn -2) ;; And away we go. -; (inst jmp-indirect -; (make-ea :byte :base eax :disp (- (* closure-function-slot word-bytes) -; function-pointer-type))) - ;; -- jrd (inst jmp (make-ea :byte :base eax :disp (- (* closure-function-slot word-bytes) function-pointer-type))) @@ -248,7 +245,7 @@ (:arg start (any-reg descriptor-reg) ebx-offset) (:arg count (any-reg descriptor-reg) ecx-offset) (:temp uwp dword-reg esi-offset)) - (declare (ignore count)) + (declare (ignore start count)) (let ((error (generate-error-code nil invalid-unwind-error))) (inst or block block) ; check for NULL pointer @@ -256,8 +253,9 @@ (load-symbol-value uwp lisp::*current-unwind-protect-block*) - (inst;; does *cuwpb* match value stored in argument cuwp slot? - cmp uwp (make-ea-for-object-slot block unwind-block-current-uwp-slot 0)) + ;; Does *cuwpb* match value stored in argument cuwp slot? + (inst cmp uwp + (make-ea-for-object-slot block unwind-block-current-uwp-slot 0)) ;; If a match, return to context in arg block. (inst jmp :e do-exit) @@ -273,18 +271,9 @@ (loadw ebp-tn block unwind-block-current-cont-slot) - ;; apparently a carefully held secret is that uwp-entry expects - ;; some things in known locations so that they can be saved on - ;; the stack! Jeesh! - - ;;(move edx-tn block) ; gets shoved into 'block' - ;;(move ecx-tn count) ; a noop - - ;; This seems needed to properly save the 'start' value so that the - ;; correct thing gets passed into the various nlx entry points although - ;; I think the compiler really ought to do it. - - (storew start ebp-tn (- (1+ ocfp-save-offset))) + ;; Uwp-entry expects some things in known locations so that they can + ;; be saved on the stack: the block in edx-tn; start in ebx-tn; and + ;; count in ecx-tn (inst jmp (make-ea :byte :base block :disp (* unwind-block-entry-pc-slot word-bytes)))) diff --git a/compiler/backend.lisp b/compiler/backend.lisp index 35082383b..8b3f6ab4b 100644 --- a/compiler/backend.lisp +++ b/compiler/backend.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/backend.lisp,v 1.28 1994/10/31 04:27:28 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/backend.lisp,v 1.29 1997/11/21 12:26:50 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -85,6 +85,7 @@ ;; From NLX.LISP make-nlx-sp-tn make-dynamic-state-tns + #+x86 make-nlx-entry-argument-start-location ;; From SUPPORT.LISP generate-call-sequence diff --git a/compiler/ir2tran.lisp b/compiler/ir2tran.lisp index 3d7fdeaf9..fca74782a 100644 --- a/compiler/ir2tran.lisp +++ b/compiler/ir2tran.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir2tran.lisp,v 1.61 1997/04/16 18:06:20 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir2tran.lisp,v 1.62 1997/11/21 12:26:52 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1601,7 +1601,8 @@ (2cont (continuation-info cont)) (2info (nlx-info-info info)) (top-loc (ir2-nlx-info-save-sp 2info)) - (start-loc (make-old-fp-passing-location t)) + (start-loc #-x86 (make-old-fp-passing-location t) + #+x86 (make-nlx-entry-argument-start-location)) (count-loc (make-argument-count-location)) (target (ir2-nlx-info-target 2info))) diff --git a/compiler/x86/nlx.lisp b/compiler/x86/nlx.lisp index 2d8f334e7..6247c8dd4 100644 --- a/compiler/x86/nlx.lisp +++ b/compiler/x86/nlx.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/nlx.lisp,v 1.7 1997/11/18 10:53:24 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/nlx.lisp,v 1.8 1997/11/21 12:26:46 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -29,6 +29,14 @@ (make-representation-tn *fixnum-primitive-type* any-reg-sc-number) env)) +;;; Make-NLX-Entry-Argument-Start-Location -- Interface +;;; +;;; Make a TN for the argument count passing location for a +;;; non-local entry. +;;; +(def-vm-support-routine make-nlx-entry-argument-start-location () + (make-wired-tn *fixnum-primitive-type* any-reg-sc-number ebx-offset)) + (defun catch-block-ea (tn) (assert (sc-is tn catch-block)) (make-ea :dword :base ebp-tn @@ -37,10 +45,13 @@ ;;; 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 eval -;;; stack pointer. We don't need to save/restore the current unwind-protect, -;;; since unwind-protects are implicitly processed during unwinding. +;;; 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. +;;; +;;; 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. @@ -50,30 +61,25 @@ ;;; use with the Save/Restore-Dynamic-Environment VOPs. ;;; (def-vm-support-routine make-dynamic-state-tns () - (make-n-tns 4 *any-primitive-type*)) + (make-n-tns 3 *any-primitive-type*)) (define-vop (save-dynamic-state) (:results (catch :scs (descriptor-reg)) (eval :scs (descriptor-reg)) - (oldfp :scs (descriptor-reg)) (alien-stack :scs (descriptor-reg))) (:generator 13 (load-symbol-value catch lisp::*current-catch-block*) (load-symbol-value eval lisp::*eval-stack-top*) - (load-symbol-value alien-stack *alien-stack*) - (loadw oldfp ebp-tn (- (1+ ocfp-save-offset))))) + (load-symbol-value alien-stack *alien-stack*))) - (define-vop (restore-dynamic-state) (:args (catch :scs (descriptor-reg)) (eval :scs (descriptor-reg)) - (oldfp :scs (descriptor-reg)) (alien-stack :scs (descriptor-reg))) (:generator 10 (store-symbol-value catch lisp::*current-catch-block*) (store-symbol-value eval lisp::*eval-stack-top*) - (store-symbol-value alien-stack *alien-stack*) - (storew oldfp ebp-tn (- (1+ ocfp-save-offset))))) + (store-symbol-value alien-stack *alien-stack*))) (define-vop (current-stack-pointer) (:results (res :scs (any-reg control-stack))) @@ -160,76 +166,14 @@ ;;;; NLX entry VOPs: -#+nil ;; this is bogus? -(define-vop (nlx-entry) - (:args (sp) ; Note: we can't list an sc-restriction, 'cause any load vops - ; would be inserted before the return-pc label. - (start) - (count)) - (:results (values :more t)) - (:temporary (:sc descriptor-reg) nil-temp move-temp) - (:info label nvals) - (:save-p :force-to-stack) - (:vop-var vop) - (:generator 30 - (emit-label label) - (note-this-location vop :non-local-entry) - (cond ((zerop nvals)) - ((= nvals 1) - (let ((no-values (gen-label))) - ;; (move (tn-ref-tn values) nil-value) -- jrd - (inst mov (tn-ref-tn values) nil-value) - - (inst jecxz no-values) - - ;; jrd rewrote this piece. because we can't issue an sc-restriction, - ;; as above, we generate a bogus EA here (see the expansion of LOADW) - ;; and croak. Do the move by hand. - ;; (loadw (tn-ref-tn values) start -1) - (inst mov move-temp start) - (loadw (tn-ref-tn values) move-temp -1) - - (emit-label no-values))) - (t - (collect ((defaults)) - (inst mov nil-temp nil-value) - (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 (fixnum i)) - (inst jmp :le default-lab) - (sc-case tn - ((descriptor-reg any-reg) - ;; see above -- jrd - ;; (loadw tn start (- (1+ i))) - (inst mov move-temp start) - (loadw tn move-temp (- (1+ i)))) - ((control-stack immediate-stack) - ;; (loadw move-temp start (- (1+ i))) - (inst mov move-temp start) - (loadw move-temp move-temp (- (1+ i))) - (move tn move-temp))))) - (let ((defaulting-done (gen-label))) - (emit-label defaulting-done) - (assemble (*elsewhere*) - (dolist (def (defaults)) - (emit-label (car def)) - (move (cdr def) nil-temp)) - (inst jmp defaulting-done)))))) - (inst mov esp-tn sp))) - -;;; see comments below regarding start arg to nlx-entry-multiple (define-vop (nlx-entry) - (:args (sp) ; Note: we can't list an sc-restriction, 'cause any load vops - ; would be inserted before the return-pc label. + ;; Note: we can't list an sc-restriction, 'cause any load vops would + ;; be inserted before the return-pc label. + (:args (sp) (start) (count)) (:results (values :more t)) - (:temporary (:sc descriptor-reg) nil-temp move-temp) + (:temporary (:sc descriptor-reg) move-temp) (:info label nvals) (:save-p :force-to-stack) (:vop-var vop) @@ -239,18 +183,12 @@ (cond ((zerop nvals)) ((= nvals 1) (let ((no-values (gen-label))) - ;; (move (tn-ref-tn values) nil-value) -- jrd (inst mov (tn-ref-tn values) nil-value) - (inst jecxz no-values) - - (move move-temp start) - (loadw (tn-ref-tn values) move-temp -1) - + (loadw (tn-ref-tn values) start -1) (emit-label no-values))) (t (collect ((defaults)) - (inst mov nil-temp nil-value) (do ((i 0 (1+ i)) (tn-ref values (tn-ref-across tn-ref))) ((null tn-ref)) @@ -262,79 +200,19 @@ (inst jmp :le default-lab) (sc-case tn ((descriptor-reg any-reg) - ;; see above -- jrd - ;; (loadw tn start (- (1+ i))) - (move move-temp start) - (loadw tn move-temp (- (1+ i)))) + (loadw tn start (- (1+ i)))) ((control-stack) - ;; (loadw move-temp start (- (1+ i))) - (move move-temp start) - (loadw move-temp move-temp (- (1+ i))) - (move tn move-temp))))) + (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)) - (move (cdr def) nil-temp)) + (inst mov (cdr def) nil-value)) (inst jmp defaulting-done)))))) (inst mov esp-tn sp))) -#+nil ;;; this is badly broken and just kept here for reference -pw - ;;; actually maybe it's not so broken -- check later -(define-vop (nlx-entry-multiple) - (:args (top) - (source) - (count :target ecx)) - ;; Again, no SC restrictions for the args, 'cause the loading would - ;; happen before the entry label. - (:info label) - ;;(:temporary (:sc dword-reg :offset esi-offset) esi) - (:temporary (:sc dword-reg :offset ecx-offset :from (:argument 2)) ecx) - (:temporary (:sc dword-reg :offset esi-offset) esi) - (:temporary (:sc dword-reg :offset edi-offset) edi) - (:results (result :scs (any-reg) :from (:argument 0)) - (num :scs (any-reg immediate-stack))) - (:save-p :force-to-stack) - (:vop-var vop) - (:generator 30 - #+x86-lra - (progn - (align lowtag-bits #x90) - (inst lra-header-word) - (inst nop) - (inst nop) - (inst nop)) - (emit-label label) - (note-this-location vop :non-local-entry) - - ;; Set up the result values and copy the arguments. - (move result top) - - ;; -- jrd. see comments above. need to do extra moves by hand, to - ;; get the ea's into registers - ;; (inst lea esi (make-ea :dword :base source :disp (- word-bytes))) - (inst lea edi (make-ea :dword :base result :disp (- word-bytes))) - (inst mov esi source) - (inst lea esi (make-ea :dword :base esi :disp (- word-bytes))) - (inst mov edi result) - (inst lea edi (make-ea :dword :base edi :disp (- word-bytes))) - - (move ecx count) ; fixnum words == bytes - (move num ecx) - (inst shr ecx word-shift) ; word count for <rep movs> - ;; If we got zero, we be done. - (inst jecxz done) - - ;; Copy them down. - (inst std) - (inst rep) - (inst movs :dword) - - ;; Reset the CSP. - DONE - (inst lea esp-tn (make-ea :dword :base edi :disp word-bytes)))) - (define-vop (nlx-entry-multiple) (:args (top) (source) @@ -360,26 +238,14 @@ (emit-label label) (note-this-location vop :non-local-entry) - ;; The RISC implementations have ocfp-save wired to a register. - ;; ir2tran calls (make-old-fp-save-location) to retrieve that tn - ;; as the source address for the thrown results. Doing that here - ;; provides the S0 slot as that source which is the wrong end of - ;; the stack. Examination of the throw-catch-unwind process shows - ;; that %ebx is the analog of OCFP here and at least in testing so - ;; far does actually point (1 above) the values. - ;; Actually, now it seems that 'unwind' is supposed to set up - ;; edx and ocfp with certain values so that the compiler can - ;; call these nlx entry points correctly. NOT. - (move esi source) ; ocfp - (inst lea esi (make-ea :dword :base esi :disp (- word-bytes))) - ;; The 'top' arg contains the %esp value saved prior to creating - ;; the catch block and dynamic save structures and points to where - ;; the thrown values should sit. + (inst lea esi (make-ea :dword :base source :disp (- word-bytes))) + ;; The 'top' arg contains the %esp value saved at the time the + ;; catch block was created and and points to where the thrown + ;; values should sit. (move edi top) (move result edi) - ;; not too sure here -- yes! this seems to be correct - (inst lea edi (make-ea :dword :base edi :disp (- word-bytes))) + (inst sub edi word-bytes) (move ecx count) ; fixnum words == bytes (move num ecx) (inst shr ecx word-shift) ; word count for <rep movs> @@ -390,16 +256,14 @@ (inst rep) (inst movs :dword) - ;; Reset the CSP (at last moved arg??) DONE + ;; Reset the CSP at last moved arg. (inst lea esp-tn (make-ea :dword :base edi :disp word-bytes)))) ;;; This VOP is just to force the TNs used in the cleanup onto the stack. ;;; (define-vop (uwp-entry) - #+info-only - (:args (target)(block)(start)(count)) (:info label) (:save-p :force-to-stack) (:results (block) (start) (count)) -- GitLab