Menu
▾
▴
[Sbcl-commits] master: Fix copy-more-arg on x86 and x86-64
|
From: Paul K. <pk...@us...> - 2013-09-22 00:32:29
|
The branch "master" has been updated in SBCL:
via 20102d9bd3c62691cc2c27725ff7ffdcab54ab2b (commit)
from 2cfc78cdd55a4641b16e0eb7f277286e520fc959 (commit)
- Log -----------------------------------------------------------------
commit 20102d9bd3c62691cc2c27725ff7ffdcab54ab2b
Author: Paul Khuong <pv...@pv...>
Date: Sat Sep 21 15:11:49 2013 -0400
Fix copy-more-arg on x86 and x86-64
Parsing of non-fixed (&optional, &key and &rest) arguments used to
fail when there were more fixed arguments than slots in the stack
frame. Fix this on x86oids by copying non-fixed arguments in the
correct direction, depending on whether there are more fixed args
or stack frame slots.
This bug is more visible on x86oids since 3b98d3 (Smaller stack
frames on x86oids), but may still plague other platforms. These
platforms still have larger initial stack frame size (8 slots), so
the issue remains as hard to trigger as it's been for more than a
decade.
Reported by Jan Moringen, and reduced by Stas Boukarev.
Also add a test, marked as failing on !x86oids.
---
NEWS | 6 ++-
src/compiler/x86-64/call.lisp | 72 +++++++++++++++++++++---------
src/compiler/x86/call.lisp | 99 +++++++++++++++++++++++++++--------------
tests/compiler.pure.lisp | 24 ++++++++++
4 files changed, 145 insertions(+), 56 deletions(-)
diff --git a/NEWS b/NEWS
index 382464a..c5bc134 100644
--- a/NEWS
+++ b/NEWS
@@ -36,7 +36,11 @@ changes relative to sbcl-1.1.11:
* bug fix: getting the order of arguments to
SB-MOP:SET-FUNCALLABLE-INSTANCE-FUNCTION wrong produces a sensible error
rather than a failed AVER. (reported by Paul Nathan)
-
+ * bug fix: Parsing of &optional/&key/&rest arguments now never overwrites
+ arguments during copying on x86 and x86-64; it may still happen on other
+ platforms when there are more fixed arguments than stack slots.
+ (reported by Jan Moringen)
+
changes in sbcl-1.1.11 relative to sbcl-1.1.10:
* enhancement: support building the manual under texinfo version 5.
(lp#1189146)
diff --git a/src/compiler/x86-64/call.lisp b/src/compiler/x86-64/call.lisp
index 645f745..c1fa08e 100644
--- a/src/compiler/x86-64/call.lisp
+++ b/src/compiler/x86-64/call.lisp
@@ -1132,12 +1132,15 @@
;; Allocate the space on the stack.
;; stack = rbp + sp->fp-offset - (max 3 frame-size) - (nargs - fixed)
- (inst lea rsp-tn
+ ;; if we'd move SP backward, swap the meaning of rsp and source
+ (inst lea (if (<= fixed (max 3 (sb-allocated-size 'stack)))
+ rsp-tn
+ source)
(make-ea :qword :base rbp-tn
- :index temp :scale (ash 1 (- word-shift n-fixnum-tag-bits))
- :disp (* n-word-bytes
- (- (+ sp->fp-offset fixed)
- (max 3 (sb-allocated-size 'stack))))))
+ :index temp :scale (ash 1 (- word-shift n-fixnum-tag-bits))
+ :disp (* n-word-bytes
+ (- (+ sp->fp-offset fixed)
+ (max 3 (sb-allocated-size 'stack))))))
;; Now: nargs>=1 && nargs>fixed
@@ -1145,6 +1148,12 @@
(inst mov rbx-tn rcx-tn)
(cond ((< fixed register-arg-count)
+ ;; the code above only moves the final value of rsp in
+ ;; rsp directly if that condition is satisfied. Currently,
+ ;; r-a-c is 3, so the aver is OK. If the calling convention
+ ;; ever changes, the logic above with LEA will have to be
+ ;; adjusted.
+ (aver (<= fixed (max 3 (sb-allocated-size 'stack))))
;; We must stop when we run out of stack args, not when we
;; run out of more args.
;; Number to copy = nargs-3
@@ -1156,24 +1165,45 @@
(inst sub rbx-tn (fixnumize fixed))))
;; Initialize R8 to be the end of args.
- (inst lea source (make-ea :qword :base rbp-tn
- :index temp :scale (ash 1 (- word-shift n-fixnum-tag-bits))
- :disp (* sp->fp-offset n-word-bytes)))
+ ;; Swap with SP if necessary to mirror the previous condition
+ (inst lea (if (<= fixed (max 3 (sb-allocated-size 'stack)))
+ source
+ rsp-tn)
+ (make-ea :qword :base rbp-tn
+ :index temp :scale (ash 1 (- word-shift n-fixnum-tag-bits))
+ :disp (* sp->fp-offset n-word-bytes)))
- ;; We need to copy from downwards up to avoid overwriting some of
- ;; the yet uncopied args. So we need to use R9 as the copy index
- ;; and RBX as the loop counter, rather than using RBX for both.
- (zeroize copy-index)
-
- ;; We used to use REP MOVS here, but on modern x86 it performs
- ;; much worse than an explicit loop for small blocks.
- COPY-LOOP
- (inst mov temp (make-ea :qword :base source :index copy-index))
- (inst mov (make-ea :qword :base rsp-tn :index copy-index) temp)
- (inst add copy-index n-word-bytes)
- (inst sub rbx-tn (fixnumize 1))
- (inst jmp :nz COPY-LOOP)
+ ;; src: rbp + temp + sp->fp
+ ;; dst: rbp + temp + sp->fp + (fixed - (max 3 [stack-size]))
+ (let ((delta (- fixed (max 3 (sb-allocated-size 'stack))))
+ (loop (gen-label))
+ (fixnum->word (ash 1 (- word-shift n-fixnum-tag-bits))))
+ (cond ((zerop delta)) ; no-op move
+ ((minusp delta)
+ ;; dst is lower than src, copy forward
+ (zeroize copy-index)
+ ;; We used to use REP MOVS here, but on modern x86 it performs
+ ;; much worse than an explicit loop for small blocks.
+ (emit-label loop)
+ (inst mov temp (make-ea :qword :base source :index copy-index))
+ (inst mov (make-ea :qword :base rsp-tn :index copy-index) temp)
+ (inst add copy-index n-word-bytes)
+ (inst sub rbx-tn (fixnumize 1))
+ (inst jmp :nz loop))
+ ((plusp delta)
+ ;; dst is higher than src; copy backward
+ (emit-label loop)
+ (inst sub rbx-tn (fixnumize 1))
+ (inst mov temp (make-ea :qword :base rsp-tn
+ :index rbx-tn :scale fixnum->word))
+ (inst mov (make-ea :qword :base source
+ :index rbx-tn :scale fixnum->word)
+ temp)
+ (inst jmp :nz loop)
+ ;; done with the stack--stack copy. Reset RSP to its final
+ ;; value
+ (inst mov rsp-tn source))))
DO-REGS
;; Here: nargs>=1 && nargs>fixed
diff --git a/src/compiler/x86/call.lisp b/src/compiler/x86/call.lisp
index e060921..58100b7 100644
--- a/src/compiler/x86/call.lisp
+++ b/src/compiler/x86/call.lisp
@@ -1198,12 +1198,19 @@
;; Allocate the space on the stack.
;; stack = ebp + sp->fp-offset - (max 3 frame-size) - (nargs - fixed)
+ ;;
+ ;; Problem: this might leave some &more args outside esp, so
+ ;; clamp the movement for now. If fixed > frame-size, reset
+ ;; esp to the end of the current &more args (which *should*
+ ;; be a noop?)
(inst lea ebx-tn
(make-ea :dword :base ebp-tn
- :disp (* n-word-bytes
- (- (+ sp->fp-offset fixed)
- (max 3 (sb-allocated-size 'stack))))))
- (inst sub ebx-tn ecx-tn) ; Got the new stack in ebx
+ :disp (* n-word-bytes
+ (- sp->fp-offset
+ (max 0
+ (- (max 3 (sb-allocated-size 'stack))
+ fixed))))))
+ (inst sub ebx-tn ecx-tn) ; Got the new stack in ebx
(inst mov esp-tn ebx-tn)
;; Now: nargs>=1 && nargs>fixed
@@ -1222,41 +1229,65 @@
;; Number to copy = nargs-fixed
(inst sub ecx-tn (fixnumize fixed))))
- ;; Save edi and esi register args.
- (inst push edi-tn)
- (inst push esi-tn)
- (inst push ebx-tn)
- ;; Okay, we have pushed the register args. We can trash them
- ;; now.
+ (let ((delta (* n-word-bytes
+ (- (max 3 (sb-allocated-size 'stack))
+ fixed)))
+ (LOOP (gen-label)))
+ (cond ((zerop delta)
+ ;; nothing to move!
+ )
+ ((minusp delta)
+ ;; stack frame smaller than fixed; moving args to higher
+ ;; addresses (stack grows downard), so copy from the
+ ;; end. Moreover, because we'd have to shrink the frame,
+ ;; esp currently points at the end of the source args.
+ (inst push ebx-tn)
- ;; Initialize src to be end of args.
- (inst lea esi-tn (make-ea :dword :base ebp-tn
- :disp (* sp->fp-offset n-word-bytes)))
- (inst sub esi-tn ebx-tn)
+ (emit-label LOOP)
+ (inst sub ecx-tn n-word-bytes)
+ (inst mov ebx-tn (make-ea :dword
+ :base esp-tn :index ecx-tn
+ ;; compensate for PUSH above
+ :disp n-word-bytes))
+ (inst mov (make-ea :dword
+ :base esp-tn :index ecx-tn
+ ;; compensate for PUSH, and
+ ;; add (abs delta)
+ :disp (- n-word-bytes delta))
+ ebx-tn)
+ (inst jmp :nz LOOP)
- ;; We need to copy from downwards up to avoid overwriting some of
- ;; the yet uncopied args. So we need to use EBX as the copy index
- ;; and ECX as the loop counter, rather than using ECX for both.
- (inst xor ebx-tn ebx-tn)
+ (inst pop ebx-tn))
+ ((plusp delta)
+ ;; stack frame larger than fixed. Moving args to lower
+ ;; addresses, so copy from the lowest address. esp
+ ;; already points to the lowest address of the destination.
+ (inst push ebx-tn)
+ (inst push esi-tn)
- ;; We used to use REP MOVS here, but on modern x86 it performs
- ;; much worse than an explicit loop for small blocks.
- COPY-LOOP
- (inst mov edi-tn (make-ea :dword :base esi-tn :index ebx-tn))
- ;; The :DISP is to account for the registers saved on the stack
- (inst mov (make-ea :dword :base esp-tn :disp (* 3 n-word-bytes)
- :index ebx-tn)
- edi-tn)
- (inst add ebx-tn n-word-bytes)
- (inst sub ecx-tn n-word-bytes)
- (inst jmp :nz COPY-LOOP)
-
- ;; So now we need to restore EDI and ESI.
- (inst pop ebx-tn)
- (inst pop esi-tn)
- (inst pop edi-tn)
+ (inst xor ebx-tn ebx-tn)
+ (emit-label LOOP)
+ (inst mov esi-tn (make-ea :dword
+ :base esp-tn :index ebx-tn
+ ;; PUSHed 2 words
+ :disp (+ (* 2 n-word-bytes)
+ delta)))
+ (inst mov (make-ea :dword
+ :base esp-tn :index ebx-tn
+ :disp (* 2 n-word-bytes))
+ esi-tn)
+ (inst add ebx-tn n-word-bytes)
+ (inst sub ecx-tn n-word-bytes)
+ (inst jmp :nz LOOP)
+ (inst pop esi-tn)
+ (inst pop ebx-tn))))
DO-REGS
+ ;; stack can now be set to its final size
+ (when (< (max 3 (sb-allocated-size 'stack)) fixed)
+ (inst add esp-tn (* n-word-bytes
+ (- fixed
+ (max 3 (sb-allocated-size 'stack))))))
;; Restore ECX
(inst mov ecx-tn ebx-tn)
diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 40f4bef..ee6905e 100644
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -4835,3 +4835,27 @@
(c ()))
x)))))
+(with-test (:name :copy-more-arg
+ :fails-on '(not (or :x86 :x86-64)))
+ ;; copy-more-arg might not copy in the right direction
+ ;; when there are more fixed args than stack frame slots,
+ ;; and thus end up splatting a single argument everywhere.
+ ;; Fixed on x86oids only, but other platforms still start
+ ;; their stack frames at 8 slots, so this is less likely
+ ;; to happen.
+ (labels ((iota (n)
+ (loop for i below n collect i))
+ (test-function (function skip)
+ ;; function should just be (subseq x skip)
+ (loop for i from skip below (+ skip 16) do
+ (let* ((values (iota i))
+ (f (apply function values))
+ (subseq (subseq values skip)))
+ (assert (equal f subseq)))))
+ (make-function (n)
+ (let ((gensyms (loop for i below n collect (gensym))))
+ (compile nil `(lambda (,@gensyms &rest rest)
+ (declare (ignore ,@gensyms))
+ rest)))))
+ (dotimes (i 16)
+ (test-function (make-function i) i))))
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL
|