From 878638b5b594ec6c3e8b2310f7d31435c5935ef2 Mon Sep 17 00:00:00 2001 From: Gabor Melis Date: Tue, 21 Apr 2009 10:26:05 +0000 Subject: [PATCH] 1.0.27.13: more RET on x86oids With 0, 2 or 3 values return with idiomatic "POP EBP; RET". --- src/assembly/x86-64/assem-rtns.lisp | 59 ++++++++++++++++-------- src/assembly/x86/assem-rtns.lisp | 59 ++++++++++++++++-------- src/compiler/x86-64/call.lisp | 85 +++++++++++++++++++---------------- src/compiler/x86-64/nlx.lisp | 22 +++++---- src/compiler/x86/call.lisp | 83 +++++++++++++++++++--------------- src/compiler/x86/nlx.lisp | 20 ++++++--- version.lisp-expr | 2 +- 7 files changed, 201 insertions(+), 129 deletions(-) diff --git a/src/assembly/x86-64/assem-rtns.lisp b/src/assembly/x86-64/assem-rtns.lisp index 7270802..5b51eef 100644 --- a/src/assembly/x86-64/assem-rtns.lisp +++ b/src/assembly/x86-64/assem-rtns.lisp @@ -20,13 +20,13 @@ #+sb-assembling ;; We don't want a vop for this one. (define-assembly-routine (return-multiple (:return-style :none)) - (;; These four are really arguments. - (:temp eax unsigned-reg rax-offset) - (:temp ebx unsigned-reg rbx-offset) + (;; These are really arguments. (:temp ecx unsigned-reg rcx-offset) (:temp esi unsigned-reg rsi-offset) ;; These we need as temporaries. + (:temp eax unsigned-reg rax-offset) + (:temp ebx unsigned-reg rbx-offset) (:temp edx unsigned-reg rdx-offset) (:temp edi unsigned-reg rdi-offset)) @@ -39,18 +39,22 @@ (inst cmp ecx (fixnumize 3)) (inst jmp :e THREE-VALUES) + (inst mov ebx rbp-tn) ;; Save the count, because the loop is going to destroy it. (inst mov edx ecx) - + (inst mov eax (make-ea :qword :base rbp-tn + :disp (frame-byte-offset return-pc-save-offset))) + (inst mov rbp-tn (make-ea :qword :base rbp-tn + :disp (frame-byte-offset ocfp-save-offset))) ;; Blit the values down the stack. Note: there might be overlap, so ;; we have to be careful not to clobber values before we've read - ;; them. Because the stack builds down, we are coping to a larger + ;; them. Because the stack builds down, we are copying to a larger ;; address. Therefore, we need to iterate from larger addresses to ;; smaller addresses. pfw-this says copy ecx words from esi to edi ;; counting down. - (inst shr ecx 3) ; fixnum to raw word count + (inst shr ecx (1- n-lowtag-bits)) (inst std) ; count down - (inst sub esi 8) ; ? + (inst sub esi n-word-bytes) (inst lea edi (make-ea :qword :base ebx :disp (- n-word-bytes))) (inst rep) (inst movs :qword) @@ -69,39 +73,56 @@ ;; And back we go. (inst stc) - (inst jmp eax) + (inst push eax) + (inst ret) ;; Handle the register arg cases. ZERO-VALUES - (move rsp-tn ebx) + (inst mov ebx rbp-tn) (inst mov edx nil-value) (inst mov edi edx) (inst mov esi edx) + (inst lea rsp-tn + (make-ea :qword :base ebx + :disp (frame-byte-offset ocfp-save-offset))) (inst stc) - (inst jmp eax) + (inst pop rbp-tn) + (inst ret) - ONE-VALUE ; Note: we can get this, because the return-multiple vop - ; doesn't check for this case when size > speed. + ;; Note: we can get this, because the return-multiple vop doesn't + ;; check for this case when size > speed. + ONE-VALUE (loadw edx esi -1) - (inst mov rsp-tn ebx) + (inst lea rsp-tn + (make-ea :qword :base rbp-tn + :disp (frame-byte-offset ocfp-save-offset))) (inst clc) - (inst jmp eax) + (inst pop rbp-tn) + (inst ret) TWO-VALUES + (inst mov ebx rbp-tn) (loadw edx esi -1) (loadw edi esi -2) (inst mov esi nil-value) - (inst lea rsp-tn (make-ea :qword :base ebx :disp (* -2 n-word-bytes))) + (inst lea rsp-tn + (make-ea :qword :base ebx + :disp (frame-byte-offset ocfp-save-offset))) (inst stc) - (inst jmp eax) + (inst pop rbp-tn) + (inst ret) THREE-VALUES + (inst mov ebx rbp-tn) (loadw edx esi -1) (loadw edi esi -2) (loadw esi esi -3) - (inst lea rsp-tn (make-ea :qword :base ebx :disp (* -3 n-word-bytes))) + (inst lea rsp-tn + (make-ea :qword :base ebx + :disp (frame-byte-offset ocfp-save-offset))) (inst stc) - (inst jmp eax)) + (inst pop rbp-tn) + (inst ret)) ;;;; TAIL-CALL-VARIABLE @@ -145,7 +166,7 @@ ;; Do the blit. Because we are coping from smaller addresses to ;; larger addresses, we have to start at the largest pair and work ;; our way down. - (inst shr ecx 3) ; fixnum to raw words + (inst shr ecx (1- n-lowtag-bits)) (inst std) ; count down (inst lea edi (make-ea :qword :base rbp-tn :disp (frame-byte-offset 0))) (inst sub esi (fixnumize 1)) diff --git a/src/assembly/x86/assem-rtns.lisp b/src/assembly/x86/assem-rtns.lisp index 36152cd..ee8a506 100644 --- a/src/assembly/x86/assem-rtns.lisp +++ b/src/assembly/x86/assem-rtns.lisp @@ -20,13 +20,13 @@ #+sb-assembling ;; We don't want a vop for this one. (define-assembly-routine (return-multiple (:return-style :none)) - (;; These four are really arguments. - (:temp eax unsigned-reg eax-offset) - (:temp ebx unsigned-reg ebx-offset) + (;; These are really arguments. (:temp ecx unsigned-reg ecx-offset) (:temp esi unsigned-reg esi-offset) ;; These we need as temporaries. + (:temp eax unsigned-reg eax-offset) + (:temp ebx unsigned-reg ebx-offset) (:temp edx unsigned-reg edx-offset) (:temp edi unsigned-reg edi-offset)) @@ -39,18 +39,22 @@ (inst cmp ecx (fixnumize 3)) (inst jmp :e THREE-VALUES) + (inst mov ebx ebp-tn) ;; Save the count, because the loop is going to destroy it. (inst mov edx ecx) - + (inst mov eax (make-ea :dword :base ebp-tn + :disp (frame-byte-offset return-pc-save-offset))) + (inst mov ebp-tn (make-ea :dword :base ebp-tn + :disp (frame-byte-offset ocfp-save-offset))) ;; Blit the values down the stack. Note: there might be overlap, so ;; we have to be careful not to clobber values before we've read - ;; them. Because the stack builds down, we are coping to a larger + ;; them. Because the stack builds down, we are copying to a larger ;; address. Therefore, we need to iterate from larger addresses to ;; smaller addresses. pfw-this says copy ecx words from esi to edi ;; counting down. - (inst shr ecx 2) ; fixnum to raw word count + (inst shr ecx (1- n-lowtag-bits)) (inst std) ; count down - (inst sub esi 4) ; ? + (inst sub esi n-word-bytes) (inst lea edi (make-ea :dword :base ebx :disp (- n-word-bytes))) (inst rep) (inst movs :dword) @@ -69,39 +73,56 @@ ;; And back we go. (inst stc) - (inst jmp eax) + (inst push eax) + (inst ret) ;; Handle the register arg cases. ZERO-VALUES - (move esp-tn ebx) + (inst mov ebx ebp-tn) (inst mov edx nil-value) (inst mov edi edx) (inst mov esi edx) + (inst lea esp-tn + (make-ea :dword :base ebx + :disp (frame-byte-offset ocfp-save-offset))) (inst stc) - (inst jmp eax) + (inst pop ebp-tn) + (inst ret) - ONE-VALUE ; Note: we can get this, because the return-multiple vop - ; doesn't check for this case when size > speed. + ;; Note: we can get this, because the return-multiple vop doesn't + ;; check for this case when size > speed. + ONE-VALUE (loadw edx esi -1) - (inst mov esp-tn ebx) + (inst lea esp-tn + (make-ea :dword :base ebp-tn + :disp (frame-byte-offset ocfp-save-offset))) (inst clc) - (inst jmp eax) + (inst pop ebp-tn) + (inst ret) TWO-VALUES + (inst mov ebx ebp-tn) (loadw edx esi -1) (loadw edi esi -2) (inst mov esi nil-value) - (inst lea esp-tn (make-ea :dword :base ebx :disp (* -2 n-word-bytes))) + (inst lea esp-tn + (make-ea :dword :base ebx + :disp (frame-byte-offset ocfp-save-offset))) (inst stc) - (inst jmp eax) + (inst pop ebp-tn) + (inst ret) THREE-VALUES + (inst mov ebx ebp-tn) (loadw edx esi -1) (loadw edi esi -2) (loadw esi esi -3) - (inst lea esp-tn (make-ea :dword :base ebx :disp (* -3 n-word-bytes))) + (inst lea esp-tn + (make-ea :dword :base ebx + :disp (frame-byte-offset ocfp-save-offset))) (inst stc) - (inst jmp eax)) + (inst pop ebp-tn) + (inst ret)) ;;;; TAIL-CALL-VARIABLE @@ -145,7 +166,7 @@ ;; Do the blit. Because we are coping from smaller addresses to ;; larger addresses, we have to start at the largest pair and work ;; our way down. - (inst shr ecx 2) ; fixnum to raw words + (inst shr ecx (1- n-lowtag-bits)) (inst std) ; count down (inst lea edi (make-ea :dword :base ebp-tn :disp (frame-byte-offset 0))) (inst sub esi (fixnumize 1)) diff --git a/src/compiler/x86-64/call.lisp b/src/compiler/x86-64/call.lisp index db0848e..13a4511 100644 --- a/src/compiler/x86-64/call.lisp +++ b/src/compiler/x86-64/call.lisp @@ -234,13 +234,11 @@ ;; Fake other registers so it looks like we returned with all the ;; registers filled in. (move rbx-tn rsp-tn) - (inst push rdx-tn) (inst jmp default-stack-slots) (emit-label regs-defaulted) (inst mov rax-tn nil-value) - (storew rdx-tn rbx-tn -1) (collect ((defaults)) (do ((i register-arg-count (1+ i)) (val (do ((i 0 (1+ i)) @@ -249,11 +247,16 @@ (tn-ref-across val))) ((null val)) (let ((default-lab (gen-label)) - (tn (tn-ref-tn val))) - (defaults (cons default-lab tn)) + (tn (tn-ref-tn val)) + (first-stack-arg-p (= i register-arg-count))) + (defaults (cons default-lab (cons tn first-stack-arg-p))) (inst cmp rcx-tn (fixnumize i)) (inst jmp :be default-lab) + (when first-stack-arg-p + ;; There are stack args so the frame of the callee is + ;; still there, save RDX in its first slot temporalily. + (storew rdx-tn rbx-tn -1)) (loadw rdx-tn rbx-tn (frame-word-offset i)) (inst mov tn rdx-tn))) @@ -268,7 +271,14 @@ (emit-label default-stack-slots) (dolist (default defaults) (emit-label (car default)) - (inst mov (cdr default) rax-tn)) + (when (cddr default) + ;; We are setting the first stack argument to NIL. + ;; The callee's stack frame is dead, save RDX by + ;; pushing it to the stack, it will end up at same + ;; place as in the (STOREW RDX-TN RBX-TN -1) case + ;; above. + (inst push rdx-tn)) + (inst mov (second default) rax-tn)) (inst jmp defaulting-done) (trace-table-entry trace-table-normal))))))) (t @@ -284,12 +294,12 @@ ;; Default the register args, and set up the stack as if we ;; entered the MV return point. (inst mov rbx-tn rsp-tn) - (inst push rdx-tn) (inst mov rdi-tn nil-value) - (inst push rdi-tn) (inst mov rsi-tn rdi-tn) ;; Compute a pointer to where to put the [defaulted] stack values. (emit-label no-stack-args) + (inst push rdx-tn) + (inst push rdi-tn) (inst lea rdi-tn (make-ea :qword :base rbp-tn :disp (frame-byte-offset register-arg-count))) @@ -376,6 +386,7 @@ (defun receive-unknown-values (args nargs start count) (declare (type tn args nargs start count)) (let ((variable-values (gen-label)) + (stack-values (gen-label)) (done (gen-label))) (inst jmp :c variable-values) @@ -388,6 +399,12 @@ (inst jmp done) (emit-label variable-values) + ;; The stack frame is burnt and RETurned from if there are no + ;; stack values. In this case quickly reallocate sufficient space. + (inst cmp nargs (fixnumize register-arg-count)) + (inst jmp :g stack-values) + (inst sub rsp-tn nargs) + (emit-label stack-values) ;; dtc: this writes the registers onto the stack even if they are ;; not needed, only the number specified in rcx are used and have ;; stack allocated to them. No harm is done. @@ -888,7 +905,7 @@ (inst clc) ;; Restore the old frame pointer (inst pop rbp-tn) - ;; And return, dropping the rest of the stack as we go. + ;; And return. (inst ret))) ;;; Do unknown-values return of a fixed (other than 1) number of @@ -920,20 +937,23 @@ (:generator 6 (check-ocfp-and-return-pc old-fp return-pc) + (when (= nvals 1) + ;; This is handled in RETURN-SINGLE. + (error "nvalues is 1")) (trace-table-entry trace-table-fun-epilogue) ;; Establish the values pointer and values count. (move rbx rbp-tn) (if (zerop nvals) (zeroize rcx) ; smaller - (inst mov rcx (fixnumize nvals))) - ;; Restore the frame pointer. - (move rbp-tn old-fp) - ;; Clear as much of the stack as possible, but not past the return - ;; address. + (inst mov rcx (fixnumize nvals))) + ;; Clear as much of the stack as possible, but not past the old + ;; frame address. (inst lea rsp-tn (make-ea :qword :base rbx - :disp (frame-byte-offset (max (1- nvals) - return-pc-save-offset)))) + :disp (frame-byte-offset + (if (< register-arg-count nvals) + (1- nvals) + ocfp-save-offset)))) ;; Pre-default any argument register that need it. (when (< nvals register-arg-count) (let* ((arg-tns (nthcdr nvals (list a0 a1 a2))) @@ -946,15 +966,14 @@ ;; And away we go. Except that return-pc is still on the ;; stack and we've changed the stack pointer. So we have to ;; tell it to index off of RBX instead of RBP. - (cond ((zerop nvals) - ;; Return popping the return address and what's earlier in - ;; the frame. - (inst ret (* return-pc-save-offset n-word-bytes))) - ((= nvals 1) - ;; This is handled in RETURN-SINGLE. - (error "nvalues is 1")) + (cond ((<= nvals register-arg-count) + (inst pop rbp-tn) + (inst ret)) (t - ;; Thou shalt not JMP unto thy return address. + ;; Some values are on the stack after RETURN-PC and OLD-FP, + ;; can't return normally and some slots of the frame will + ;; be used as temporaries by the receiver. + (move rbp-tn old-fp) (inst push (make-ea :qword :base rbx :disp (frame-byte-offset (tn-offset return-pc)))) (inst ret))) @@ -973,24 +992,19 @@ ;;; RCX -- number of values to find there. ;;; RSI -- pointer to where to find the values. (define-vop (return-multiple) - (:args (old-fp :to (:eval 1) :target old-fp-temp) - (return-pc :target rax) + (:args (old-fp) + (return-pc) (vals :scs (any-reg) :target rsi) (nvals :scs (any-reg) :target rcx)) - (:temporary (:sc unsigned-reg :offset rax-offset :from (:argument 1)) rax) (:temporary (:sc unsigned-reg :offset rsi-offset :from (:argument 2)) rsi) (:temporary (:sc unsigned-reg :offset rcx-offset :from (:argument 3)) rcx) - (:temporary (:sc unsigned-reg :offset rbx-offset :from (:eval 0)) rbx) (:temporary (:sc unsigned-reg) return-asm) (:temporary (:sc descriptor-reg :offset (first *register-arg-offsets*) :from (:eval 0)) a0) - (:temporary (:sc unsigned-reg :from (:eval 1)) old-fp-temp) (:node-var node) (:generator 13 (check-ocfp-and-return-pc old-fp return-pc) (trace-table-entry trace-table-fun-epilogue) - ;; Load the return-pc. - (move rax return-pc) (unless (policy node (> space speed)) ;; Check for the single case. (let ((not-single (gen-label))) @@ -998,22 +1012,17 @@ (inst jmp :ne not-single) ;; Return with one value. (loadw a0 vals -1) - ;; Clear the stack. We load old-fp into a register before clearing - ;; the stack. - (move old-fp-temp old-fp) - (move rsp-tn rbp-tn) - (move rbp-tn old-fp-temp) + (inst lea rsp-tn (make-ea :qword :base rbp-tn + :disp (frame-byte-offset ocfp-save-offset))) ;; clear the multiple-value return flag (inst clc) ;; Out of here. - (inst push rax) + (inst pop rbp-tn) (inst ret) ;; Nope, not the single case. Jump to the assembly routine. (emit-label not-single))) (move rsi vals) (move rcx nvals) - (move rbx rbp-tn) - (move rbp-tn old-fp) (inst lea return-asm (make-ea :qword :disp (make-fixup 'return-multiple :assembly-routine))) diff --git a/src/compiler/x86-64/nlx.lisp b/src/compiler/x86-64/nlx.lisp index a277afa..dd31d2a 100644 --- a/src/compiler/x86-64/nlx.lisp +++ b/src/compiler/x86-64/nlx.lisp @@ -152,28 +152,34 @@ (loadw (tn-ref-tn values) start -1) (emit-label no-values))) (t + ;; FIXME: this is mostly copied from + ;; DEFAULT-UNKNOWN-VALUES. (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)) - + (tn (tn-ref-tn tn-ref)) + (first-stack-arg-p (= i register-arg-count))) + (defaults (cons default-lab (cons tn first-stack-arg-p))) (inst cmp count (fixnumize i)) (inst jmp :le default-lab) + (when first-stack-arg-p + (storew rdx-tn rbx-tn -1)) (sc-case tn ((descriptor-reg any-reg) - (loadw tn start (- (1+ i)))) + (loadw tn start (frame-word-offset i))) ((control-stack) - (loadw move-temp start (- (1+ i))) + (loadw move-temp start (frame-word-offset 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)) + (dolist (default (defaults)) + (emit-label (car default)) + (when (cddr default) + (inst push rdx-tn)) + (inst mov (second default) nil-value)) (inst jmp defaulting-done)))))) (inst mov rsp-tn sp))) diff --git a/src/compiler/x86/call.lisp b/src/compiler/x86/call.lisp index a2b3302..7fcbed2 100644 --- a/src/compiler/x86/call.lisp +++ b/src/compiler/x86/call.lisp @@ -241,13 +241,11 @@ ;; Fake other registers so it looks like we returned with all the ;; registers filled in. (move ebx-tn esp-tn) - (inst push edx-tn) (inst jmp default-stack-slots) (emit-label regs-defaulted) (inst mov eax-tn nil-value) - (storew edx-tn ebx-tn -1) (collect ((defaults)) (do ((i register-arg-count (1+ i)) (val (do ((i 0 (1+ i)) @@ -256,11 +254,16 @@ (tn-ref-across val))) ((null val)) (let ((default-lab (gen-label)) - (tn (tn-ref-tn val))) - (defaults (cons default-lab tn)) + (tn (tn-ref-tn val)) + (first-stack-arg-p (= i register-arg-count))) + (defaults (cons default-lab (cons tn first-stack-arg-p))) (inst cmp ecx-tn (fixnumize i)) (inst jmp :be default-lab) + (when first-stack-arg-p + ;; There are stack args so the frame of the callee is + ;; still there, save EDX in its first slot temporalily. + (storew edx-tn ebx-tn -1)) (loadw edx-tn ebx-tn (frame-word-offset i)) (inst mov tn edx-tn))) @@ -275,7 +278,14 @@ (emit-label default-stack-slots) (dolist (default defaults) (emit-label (car default)) - (inst mov (cdr default) eax-tn)) + (when (cddr default) + ;; We are setting the first stack argument to NIL. + ;; The callee's stack frame is dead, save EDX by + ;; pushing it to the stack, it will end up at same + ;; place as in the (STOREW EDX-TN EBX-TN -1) case + ;; above. + (inst push edx-tn)) + (inst mov (second default) eax-tn)) (inst jmp defaulting-done) (trace-table-entry trace-table-normal))))))) (t @@ -292,12 +302,12 @@ ;; Default the register args, and set up the stack as if we ;; entered the MV return point. (inst mov ebx-tn esp-tn) - (inst push edx-tn) (inst mov edi-tn nil-value) - (inst push edi-tn) (inst mov esi-tn edi-tn) ;; Compute a pointer to where to put the [defaulted] stack values. (emit-label no-stack-args) + (inst push edx-tn) + (inst push edi-tn) (inst lea edi-tn (make-ea :dword :base ebp-tn :disp (frame-byte-offset register-arg-count))) @@ -384,6 +394,7 @@ (defun receive-unknown-values (args nargs start count) (declare (type tn args nargs start count)) (let ((variable-values (gen-label)) + (stack-values (gen-label)) (done (gen-label))) (inst jmp :c variable-values) @@ -396,6 +407,12 @@ (inst jmp done) (emit-label variable-values) + ;; The stack frame is burnt and RETurned from if there are no + ;; stack values. In this case quickly reallocate sufficient space. + (inst cmp nargs (fixnumize register-arg-count)) + (inst jmp :g stack-values) + (inst sub esp-tn nargs) + (emit-label stack-values) ;; dtc: this writes the registers onto the stack even if they are ;; not needed, only the number specified in ecx are used and have ;; stack allocated to them. No harm is done. @@ -887,7 +904,7 @@ (inst clc) ;; Restore the old frame pointer (inst pop ebp-tn) - ;; And return, dropping the rest of the stack as we go. + ;; And return. (inst ret))) ;;; Do unknown-values return of a fixed (other than 1) number of @@ -919,20 +936,23 @@ (:generator 6 (check-ocfp-and-return-pc old-fp return-pc) + (when (= nvals 1) + ;; This is handled in RETURN-SINGLE. + (error "nvalues is 1")) (trace-table-entry trace-table-fun-epilogue) ;; Establish the values pointer and values count. (move ebx ebp-tn) (if (zerop nvals) (inst xor ecx ecx) ; smaller (inst mov ecx (fixnumize nvals))) - ;; Restore the frame pointer. - (move ebp-tn old-fp) - ;; Clear as much of the stack as possible, but not past the return - ;; address. + ;; Clear as much of the stack as possible, but not past the old + ;; frame address. (inst lea esp-tn (make-ea :dword :base ebx - :disp (frame-byte-offset (max (1- nvals) - return-pc-save-offset)))) + :disp (frame-byte-offset + (if (< register-arg-count nvals) + (1- nvals) + ocfp-save-offset)))) ;; Pre-default any argument register that need it. (when (< nvals register-arg-count) (let* ((arg-tns (nthcdr nvals (list a0 a1 a2))) @@ -945,15 +965,14 @@ ;; And away we go. Except that return-pc is still on the ;; stack and we've changed the stack pointer. So we have to ;; tell it to index off of EBX instead of EBP. - (cond ((zerop nvals) - ;; Return popping the return address and what's earlier in - ;; the frame. - (inst ret (* return-pc-save-offset n-word-bytes))) - ((= nvals 1) - ;; This is handled in RETURN-SINGLE. - (error "nvalues is 1")) + (cond ((<= nvals register-arg-count) + (inst pop ebp-tn) + (inst ret)) (t - ;; Thou shalt not JMP unto thy return address. + ;; Some values are on the stack after RETURN-PC and OLD-FP, + ;; can't return normally and some slots of the frame will + ;; be used as temporaries by the receiver. + (move ebp-tn old-fp) (inst push (make-ea :dword :base ebx :disp (frame-byte-offset (tn-offset return-pc)))) (inst ret))) @@ -972,23 +991,18 @@ ;;; ECX -- number of values to find there. ;;; ESI -- pointer to where to find the values. (define-vop (return-multiple) - (:args (old-fp :to (:eval 1) :target old-fp-temp) - (return-pc :target eax) + (:args (old-fp) + (return-pc) (vals :scs (any-reg) :target esi) (nvals :scs (any-reg) :target ecx)) - (:temporary (:sc unsigned-reg :offset eax-offset :from (:argument 1)) eax) (:temporary (:sc unsigned-reg :offset esi-offset :from (:argument 2)) esi) (:temporary (:sc unsigned-reg :offset ecx-offset :from (:argument 3)) ecx) - (:temporary (:sc unsigned-reg :offset ebx-offset :from (:eval 0)) ebx) (:temporary (:sc descriptor-reg :offset (first *register-arg-offsets*) :from (:eval 0)) a0) - (:temporary (:sc unsigned-reg :from (:eval 1)) old-fp-temp) (:node-var node) (:generator 13 (check-ocfp-and-return-pc old-fp return-pc) (trace-table-entry trace-table-fun-epilogue) - ;; Load the return-pc. - (move eax return-pc) (unless (policy node (> space speed)) ;; Check for the single case. (let ((not-single (gen-label))) @@ -996,22 +1010,17 @@ (inst jmp :ne not-single) ;; Return with one value. (loadw a0 vals -1) - ;; Clear the stack. We load old-fp into a register before clearing - ;; the stack. - (move old-fp-temp old-fp) - (move esp-tn ebp-tn) - (move ebp-tn old-fp-temp) + (inst lea esp-tn (make-ea :dword :base ebp-tn + :disp (frame-byte-offset ocfp-save-offset))) ;; clear the multiple-value return flag (inst clc) ;; Out of here. - (inst push eax) + (inst pop ebp-tn) (inst ret) ;; Nope, not the single case. Jump to the assembly routine. (emit-label not-single))) (move esi vals) (move ecx nvals) - (move ebx ebp-tn) - (move ebp-tn old-fp) (inst jmp (make-fixup 'return-multiple :assembly-routine)) (trace-table-entry trace-table-normal))) diff --git a/src/compiler/x86/nlx.lisp b/src/compiler/x86/nlx.lisp index 7a910a1..07d4032 100644 --- a/src/compiler/x86/nlx.lisp +++ b/src/compiler/x86/nlx.lisp @@ -173,16 +173,20 @@ (loadw (tn-ref-tn values) start -1) (emit-label no-values))) (t + ;; FIXME: this is mostly copied from + ;; DEFAULT-UNKNOWN-VALUES. (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)) - + (tn (tn-ref-tn tn-ref)) + (first-stack-arg-p (= i register-arg-count))) + (defaults (cons default-lab (cons tn first-stack-arg-p))) (inst cmp count (fixnumize i)) (inst jmp :le default-lab) + (when first-stack-arg-p + (storew edx-tn ebx-tn -1)) (sc-case tn ((descriptor-reg any-reg) (loadw tn start (frame-word-offset i))) @@ -192,9 +196,11 @@ (let ((defaulting-done (gen-label))) (emit-label defaulting-done) (assemble (*elsewhere*) - (dolist (def (defaults)) - (emit-label (car def)) - (inst mov (cdr def) nil-value)) + (dolist (default (defaults)) + (emit-label (car default)) + (when (cddr default) + (inst push edx-tn)) + (inst mov (second default) nil-value)) (inst jmp defaulting-done)))))) (inst mov esp-tn sp))) @@ -228,7 +234,7 @@ (move num ecx) (inst shr ecx word-shift) ; word count for ;; If we got zero, we be done. - (inst jecxz done) + (inst jecxz DONE) ;; Copy them down. (inst std) (inst rep) diff --git a/version.lisp-expr b/version.lisp-expr index cd41ba7..c670ede 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"1.0.27.12" +"1.0.27.13" -- 1.7.10.4