From: Nikodemus Siivola Date: Thu, 17 May 2007 20:00:31 +0000 (+0000) Subject: 1.0.5.51: fixed mixed up commit 1.0.5.50 X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=f94339428a65d2002f73086bcc6022885f656c1f;p=sbcl.git 1.0.5.51: fixed mixed up commit 1.0.5.50 * SIMPLE-VECTOR-COMPARE-AND-SWAP, not SAFE-SIMPLE-VECTOR-COMPARE-AND-SWAP. * Missing tests. * Whitespace. * foreign.test.sh jugglery This path breaks foreign.test.sh on x86/Darwin even without touching it, indicative of still lingering Darwin issues. Any number of changes can mask this breakage: adding SAFE- prefix to SIMPLE-VECTOR-COMPARE-AND-SWAP is enough to make foreign.test.sh pass again, but so is adding a sneaky --eval nil in there as well -- among other things. Pain. Hate. Pain. See commentary in foreign.test.sh This time the issue doesn't seem to be foreign stack alignment related, though: forcing the compiler to use the fast call-out path always doesn't make the "small" case pass. --- diff --git a/src/code/array.lisp b/src/code/array.lisp index 873a9b7..f41730b 100644 --- a/src/code/array.lisp +++ b/src/code/array.lisp @@ -56,7 +56,7 @@ (values vector index)) (values array index))) -(defun safe-simple-vector-compare-and-swap (vector index old new) +(defun simple-vector-compare-and-swap (vector index old new) #!+(or x86 x86-64) (%simple-vector-compare-and-swap vector (%check-bound vector (length vector) index) diff --git a/src/runtime/x86-assem.S b/src/runtime/x86-assem.S index db4ee94..9470533 100644 --- a/src/runtime/x86-assem.S +++ b/src/runtime/x86-assem.S @@ -124,7 +124,7 @@ GNAME(call_into_c): cld # clear out DF: Darwin, Solaris and Win32 at # least need this, and it should not hurt others - + call *%eax # normal callout using Lisp stack movl %eax,%ecx # remember integer return value diff --git a/tests/array.pure.lisp b/tests/array.pure.lisp index f8ed9f5..fe9c4f0 100644 --- a/tests/array.pure.lisp +++ b/tests/array.pure.lisp @@ -220,3 +220,26 @@ array) (type-error () :good)))) + +;;; SIMPLE-VECTOR-COMPARE-AND-SWAP + +(let ((v (vector 1))) + ;; basics + (assert (eql 1 (sb-kernel:simple-vector-compare-and-swap v 0 1 2))) + (assert (eql 2 (sb-kernel:simple-vector-compare-and-swap v 0 1 3))) + (assert (eql 2 (svref v 0))) + ;; bounds + (multiple-value-bind (res err) + (ignore-errors (sb-kernel:simple-vector-compare-and-swap v -1 1 2)) + (assert (not res)) + (assert (typep err 'type-error))) + (multiple-value-bind (res err) + (ignore-errors (sb-kernel:simple-vector-compare-and-swap v 1 1 2)) + (assert (not res)) + (assert (typep err 'type-error)))) + +;; type of the first argument +(multiple-value-bind (res err) + (ignore-errors (sb-kernel:simple-vector-compare-and-swap "foo" 1 1 2)) + (assert (not res)) + (assert (typep err 'type-error))) diff --git a/tests/foreign.test.sh b/tests/foreign.test.sh index 59e28cd..6d78488 100644 --- a/tests/foreign.test.sh +++ b/tests/foreign.test.sh @@ -154,9 +154,9 @@ cat > $testfilestem.base.lisp <> $testfilestem.small.lisp # Test code cat > $testfilestem.test.lisp < $testfilestem.test.lisp < $testfilestem.test.lisp <