[Bug-openmcl] ccl::simple-vector-delete bug

[bryan o'connor]

ccl::simple-vector-delete loses with displaced arrays with a
displaced-index-offset > 0.

the second loop (looping through the scratch bit vector) to copy
the items that survive into the new array misuses the offset with
the bit vector.  this causes an array out of bounds error.  instead
it should use the offset with the original array to reference the
item.

the third loop which copies the remaining items that were explicitly
excluded from the test also needs the offset to copy the right items.

patch below.

	...bryan


-------------- next part --------------
Index: lib/sequences.lisp
===================================================================
RCS file: /usr/local/tmpcvs/ccl-0.14-dev/ccl/lib/sequences.lisp,v
retrieving revision 1.3
diff -c -r1.3 sequences.lisp
*** lib/sequences.lisp	27 Jan 2004 01:18:12 -0000	1.3
--- lib/sequences.lisp	9 Dec 2004 23:00:09 -0000
***************
*** 1036,1053 ****
            (%typed-miscset subtype new-vect i (%typed-miscref subtype vector (%i+ offset i)))
            ))
        (setq fill start)
!       (setq pos (%i+ start offset))
        (loop
          (if (eq fill fill-end) (return))
          (if (neq 1 (aref bv pos))
            (progn
!             (%typed-miscset subtype new-vect fill (%typed-miscref subtype vector pos))
              (setq fill (%i+ fill 1))))
          (setq pos (%i+ pos 1)))
        (setq pos end)
        (loop
          (when (eq fill size) (return))
!           (%typed-miscset subtype new-vect fill (%typed-miscref subtype vector pos))
            (setq fill (%i+ fill 1)
                  pos (%i+ pos 1)))
        new-vect)))
--- 1036,1053 ----
            (%typed-miscset subtype new-vect i (%typed-miscref subtype vector (%i+ offset i)))
            ))
        (setq fill start)
!       (setq pos start)
        (loop
          (if (eq fill fill-end) (return))
          (if (neq 1 (aref bv pos))
            (progn
!             (%typed-miscset subtype new-vect fill (%typed-miscref subtype vector (%i+ offset pos)))
              (setq fill (%i+ fill 1))))
          (setq pos (%i+ pos 1)))
        (setq pos end)
        (loop
          (when (eq fill size) (return))
!           (%typed-miscset subtype new-vect fill (%typed-miscref subtype vector (%i+ offset pos)))
            (setq fill (%i+ fill 1)
                  pos (%i+ pos 1)))
        new-vect)))
-------------- next part --------------