With 0, 2 or 3 values return with idiomatic "POP EBP; RET".
#+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))
(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)
;; 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))
\f
;;;; TAIL-CALL-VARIABLE
;; 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))
#+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))
(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)
;; 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))
\f
;;;; TAIL-CALL-VARIABLE
;; 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))
;; 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))
(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)))
(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
;; 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)))
(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)
(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.
(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
(: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)))
;; 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)))
;;; 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)))
(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)))
(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)))
;; 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))
(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)))
(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
;; 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)))
(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)
(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.
(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
(: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)))
;; 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)))
;;; 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)))
(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)))
\f
(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)))
(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)))
(move num ecx)
(inst shr ecx word-shift) ; word count for <rep movs>
;; If we got zero, we be done.
- (inst jecxz done)
+ (inst jecxz DONE)
;; Copy them down.
(inst std)
(inst rep)
;;; 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"
projects / sbcl.git / commitdiff