X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fassembly%2Fx86-64%2Fassem-rtns.lisp;h=b41c86f71b1b868ddf978eab89dc9284016357f0;hb=dfc9c3a9dde3ae21498ac1a184a6e56fd4e79eb0;hp=bd708897ff279b329da9c151791a251528d7a1ce;hpb=4898ef32c639b1c7f4ee13a5ba566ce6debd03e6;p=sbcl.git diff --git a/src/assembly/x86-64/assem-rtns.lisp b/src/assembly/x86-64/assem-rtns.lisp index bd70889..b41c86f 100644 --- a/src/assembly/x86-64/assem-rtns.lisp +++ b/src/assembly/x86-64/assem-rtns.lisp @@ -20,18 +20,20 @@ #+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)) + (:temp edi unsigned-reg rdi-offset) + (:temp temp unsigned-reg r8-offset) + (:temp loop-index unsigned-reg r9-offset)) ;; Pick off the cases where everything fits in register args. - (inst jecxz ZERO-VALUES) + (inst jrcxz ZERO-VALUES) (inst cmp ecx (fixnumize 1)) (inst jmp :e ONE-VALUE) (inst cmp ecx (fixnumize 2)) @@ -39,27 +41,39 @@ (inst cmp ecx (fixnumize 3)) (inst jmp :e THREE-VALUES) - ;; Save the count, because the loop is going to destroy it. - (inst mov edx ecx) + ;; As per the calling convention EBX is expected to point at the SP + ;; before the stack frame. + (inst lea ebx (make-ea :qword :base rbp-tn + :disp (* sp->fp-offset n-word-bytes))) + ;; Save the count, the return address and restore the frame pointer, + ;; because the loop is going to destroy them. + (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 std) ; count down - (inst sub esi 8) ; ? - (inst lea edi (make-ea :qword :base ebx :disp (- n-word-bytes))) - (inst rep) - (inst movs :qword) - - ;; Restore the count. - (inst mov ecx edx) + ;; smaller addresses. + (zeroize loop-index) + LOOP + (inst sub loop-index n-word-bytes) + (inst mov temp + (make-ea :qword :base esi + :index loop-index)) + (inst mov + (make-ea :qword :base ebx + :index loop-index) + temp) + + (inst sub edx (fixnumize 1)) + (inst jmp :nz LOOP) ;; Set the stack top to the last result. - (inst lea rsp-tn (make-ea :qword :base edi :disp n-word-bytes)) + (inst lea rsp-tn (make-ea :qword :base ebx :index loop-index)) ;; Load the register args. (loadw edx ebx -1) @@ -67,36 +81,52 @@ (loadw esi ebx -3) ;; And back we go. - (inst jmp eax) + (inst stc) + (inst push eax) + (inst ret) ;; Handle the register arg cases. ZERO-VALUES - (move rsp-tn ebx) + (inst lea ebx (make-ea :qword :base rbp-tn + :disp (* sp->fp-offset n-word-bytes))) (inst mov edx nil-value) (inst mov edi edx) (inst mov esi edx) - (inst jmp eax) - - ONE-VALUE ; Note: we can get this, because the return-multiple vop - ; doesn't check for this case when size > speed. + (inst mov rsp-tn rbp-tn) + (inst stc) + (inst pop rbp-tn) + (inst ret) + + ;; 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 add eax 3) - (inst jmp eax) + (inst mov rsp-tn rbp-tn) + (inst clc) + (inst pop rbp-tn) + (inst ret) TWO-VALUES + (inst lea ebx (make-ea :qword :base rbp-tn + :disp (* sp->fp-offset n-word-bytes))) (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 jmp eax) + (inst mov rsp-tn rbp-tn) + (inst stc) + (inst pop rbp-tn) + (inst ret) THREE-VALUES + (inst lea ebx (make-ea :qword :base rbp-tn + :disp (* sp->fp-offset n-word-bytes))) (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 jmp eax)) + (inst mov rsp-tn rbp-tn) + (inst stc) + (inst pop rbp-tn) + (inst ret)) ;;;; TAIL-CALL-VARIABLE @@ -125,50 +155,55 @@ ;; Calculate NARGS (as a fixnum) (move ecx esi) (inst sub ecx rsp-tn) + #!-#.(cl:if (cl:= sb!vm:word-shift sb!vm:n-fixnum-tag-bits) '(and) '(or)) + (inst shr ecx (- word-shift n-fixnum-tag-bits)) - ;; Check for all the args fitting the the registers. - (inst cmp ecx (fixnumize 3)) + ;; Check for all the args fitting the registers. + (inst cmp ecx (fixnumize register-arg-count)) (inst jmp :le REGISTER-ARGS) - ;; Save the OLD-FP and RETURN-PC because the blit it going to trash - ;; those stack locations. Save the ECX, because the loop is going - ;; to trash it. - (pushw rbp-tn -1) - (loadw ebx rbp-tn -2) + ;; Save the OLD-FP and RETURN-PC because the blit is going to trash + ;; those stack locations. Save the ECX, because the loop is going to + ;; trash it. + (pushw rbp-tn (frame-word-offset ocfp-save-offset)) + (loadw ebx rbp-tn (frame-word-offset return-pc-save-offset)) (inst push ecx) ;; 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 n-fixnum-tag-bits) (inst std) ; count down - (inst lea edi (make-ea :qword :base rbp-tn :disp (- n-word-bytes))) - (inst sub esi (fixnumize 1)) + (inst lea edi (make-ea :qword :base rbp-tn :disp (frame-byte-offset 0))) + (inst sub esi n-word-bytes) (inst rep) (inst movs :qword) + (inst cld) ;; Load the register arguments carefully. - (loadw edx rbp-tn -1) + (loadw edx rbp-tn (frame-word-offset ocfp-save-offset)) ;; Restore OLD-FP and ECX. (inst pop ecx) - (popw rbp-tn -1) ; overwrites a0 + ;; Overwrites a1 + (popw rbp-tn (frame-word-offset ocfp-save-offset)) ;; Blow off the stack above the arguments. (inst lea rsp-tn (make-ea :qword :base edi :disp n-word-bytes)) ;; remaining register args - (loadw edi rbp-tn -2) - (loadw esi rbp-tn -3) + (inst mov edi edx) + (loadw edx rbp-tn (frame-word-offset 0)) + (loadw esi rbp-tn (frame-word-offset 2)) ;; Push the (saved) return-pc so it looks like we just called. (inst push ebx) ;; And jump into the function. - (inst jmp - (make-ea :byte :base eax - :disp (- (* closure-fun-slot n-word-bytes) - fun-pointer-lowtag))) + (inst jmp + (make-ea :byte :base eax + :disp (- (* closure-fun-slot n-word-bytes) + fun-pointer-lowtag))) ;; All the arguments fit in registers, so load them. REGISTER-ARGS @@ -178,10 +213,10 @@ ;; Clear most of the stack. (inst lea rsp-tn - (make-ea :qword :base rbp-tn :disp (* -3 n-word-bytes))) + (make-ea :qword :base rbp-tn :disp (* (- sp->fp-offset 3) n-word-bytes))) ;; Push the return-pc so it looks like we just called. - (pushw rbp-tn -2) ; XXX dan ? + (pushw rbp-tn (frame-word-offset return-pc-save-offset)) ;; And away we go. (inst jmp (make-ea :byte :base eax @@ -189,7 +224,7 @@ fun-pointer-lowtag)))) (define-assembly-routine (throw - (:return-style :none)) + (:return-style :raw)) ((:arg target (descriptor-reg any-reg) rdx-offset) (:arg start any-reg rbx-offset) (:arg count any-reg rcx-offset) @@ -201,8 +236,18 @@ LOOP - (let ((error (generate-error-code nil unseen-throw-tag-error target))) - (inst or catch catch) ; check for NULL pointer + (let ((error (gen-label))) + (assemble (*elsewhere*) + (emit-label error) + + ;; Fake up a stack frame so that backtraces come out right. + (inst push rbp-tn) + (inst mov rbp-tn rsp-tn) + + (emit-error-break nil error-trap + (error-number-or-lose 'unseen-throw-tag-error) + (list target))) + (inst test catch catch) ; check for NULL pointer (inst jmp :z error)) (inst cmp target (make-ea-for-object-slot catch catch-block-tag-slot 0)) @@ -228,8 +273,8 @@ (:temp uwp unsigned-reg rsi-offset)) (declare (ignore start count)) - (let ((error (generate-error-code nil invalid-unwind-error))) - (inst or block block) ; check for NULL pointer + (let ((error (generate-error-code nil 'invalid-unwind-error))) + (inst test block block) ; check for NULL pointer (inst jmp :z error)) (load-tl-symbol-value uwp *current-unwind-protect-block*)