[Sbcl-commits] CVS: sbcl/src/compiler/generic objdef.lisp, 1.62, 1.63

[Nikodemus S. <de...@us...>]

Update of /cvsroot/sbcl/sbcl/src/compiler/generic
In directory fdv4jf1.ch3.sourceforge.com:/tmp/cvs-serv9079/src/compiler/generic

Modified Files:
	objdef.lisp 
Log Message:
1.0.28.24: better %ARRAY-DISPLACED-FROM handling

   James Knight pointed out that signalling an error at ADJUST-ARRAY
   time is not quite right, since the other array may be otherwise
   unreachable already -- we're following a weak pointer after all.

   Oops. Enter the twilight zone between clever by half and slightly
   horrible:

   When a potentially bogus ADJUST-ARRAY is detected, walk the chain
   of backpointers, and set FILL-POINTER, AVAILABLE-ELEMENTS, and
   all dimensions of the too-large displaced-from arrays to zero.

   This in turn causes any typecheck involving the array dimensions
   to trap, as well as any bounds-checked access.

   To make these errors more understandable, save the original
   dimensions of the array, punning them to the ARRAY-DISPLACED-P
   slot, and identify the bogus arrays in INVALID-ARRAY-INDEX-ERROR
   function, and the OBJECT-NOT-TYPE-ERROR internal error handler;
   signal an INVALID-ARRAY-ERROR instead, which explains what is going
   on.

   Whew.

   Oh, and a BIG THREAD SAFETY NOTE regarding the fundamental nature
   of our ADJUST-ARRAY implementation. It is not thread safe in
   parallel with accesses to the array being adjusted. Tentative
   idea is to add one more level of indirection to array headers,
   so that we can get atomic updates without locking.


Index: objdef.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/generic/objdef.lisp,v
retrieving revision 1.62
retrieving revision 1.63
diff -u -d -r1.62 -r1.63
--- objdef.lisp	6 May 2009 16:28:03 -0000	1.62
+++ objdef.lisp	7 May 2009 11:11:05 -0000	1.63
@@ -126,7 +126,7 @@
                 :ref-known (flushable foldable)
                 :set-trans (setf %array-displacement)
                 :set-known (unsafe))
-  (displaced-p :type (member t nil)
+  (displaced-p :type t
                :ref-trans %array-displaced-p
                :ref-known (flushable foldable)
                :set-trans (setf %array-displaced-p)
@@ -135,9 +135,7 @@
                   :ref-trans %array-displaced-from
                   :ref-known (flushable)
                   :set-trans (setf %array-displaced-from)
-                  :set-known (unsafe)
-                  :cas-trans %compare-and-swap-array-displaced-from
-                  :cas-known (unsafe))
+                  :set-known (unsafe))
   (dimensions :rest-p t))
 
 (define-primitive-object (vector :type vector