X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Farray.lisp;h=50f730a43aa87fe3faf9113545a833388543c80c;hb=cf0b72cd4052a09b9a305081524bd44e2948c1e5;hp=65927a130ac8e65695d53219ab3c7f72c39d5dcc;hpb=b28b317b471212e2541190567ac723b6f1ed2aa6;p=sbcl.git

diff --git a/src/code/array.lisp b/src/code/array.lisp
index 65927a1..50f730a 100644
--- a/src/code/array.lisp
+++ b/src/code/array.lisp
@@ -56,6 +56,19 @@
         (values vector index))
       (values array index)))
 
+(declaim (inline simple-vector-compare-and-swap))
+(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)
+                                   old
+                                   new)
+  #!-(or x86 x86-64)
+  (let ((n-old (svref vector index)))
+    (when (eq old n-old)
+      (setf (svref vector index) new))
+    n-old))
+
 ;;; It'd waste space to expand copies of error handling in every
 ;;; inline %WITH-ARRAY-DATA, so we have them call this function
 ;;; instead. This is just a wrapper which is known never to return.
@@ -337,11 +350,7 @@ of specialized arrays is supported."
                             (:little-endian
                              (- sb!vm:other-pointer-lowtag))
                             (:big-endian
-                             ;; I'm not completely sure of what this
-                             ;; 3 represents symbolically. It's
-                             ;; just what all the LOAD-TYPE vops
-                             ;; are doing.
-                             (- 3 sb!vm:other-pointer-lowtag)))))
+                             (- (1- sb!vm:n-word-bytes) sb!vm:other-pointer-lowtag)))))
                    ;; WIDETAG-OF needs extra code to handle
                    ;; LIST and FUNCTION lowtags. We're only
                    ;; dispatching on other pointers, so let's
@@ -444,7 +453,7 @@ of specialized arrays is supported."
                 ,@(loop for widetag in '(sb!vm:complex-vector-widetag
                                          sb!vm:complex-vector-nil-widetag
                                          sb!vm:complex-bit-vector-widetag
-                                         sb!vm:complex-character-string-widetag
+                                         #!+sb-unicode sb!vm:complex-character-string-widetag
                                          sb!vm:complex-base-string-widetag
                                          sb!vm:simple-array-widetag
                                          sb!vm:complex-array-widetag)