0.8.1.11:

        * Index argument of NTH and NTHCDR may be a bignum (bug
          reported by Adam Warner on c.l.l).

diff --git a/NEWS b/NEWS
index 300e284..807f3d4 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1901,6 +1901,8 @@ changes in sbcl-0.8.2 relative to sbcl-0.8.1:
   * declared types of functions from the "Conditions"
     chapter. (reported by Paul Dietz)
   * bug fix: CERROR accepts a function as its first argument.
+  * bug fix: NTH an NTHCDR accept a bignum as index
+    arguments. (reported by Adam Warner)
 
 planned incompatible changes in 0.8.x:
   * (not done yet, but planned:) When the profiling interface settles

diff --git a/contrib/sb-bsd-sockets/tests.lisp b/contrib/sb-bsd-sockets/tests.lisp
index 0d6f3fc..0959a00 100644 (file)
--- a/contrib/sb-bsd-sockets/tests.lisp
+++ b/contrib/sb-bsd-sockets/tests.lisp
@@ -135,7 +135,7 @@ Tests are in the file <tt>tests.lisp</tt> and also make good examples.
 
 #-sunos
 (deftest simple-local-client
-    (let ((s (make-instance 'local-socket :type :datagram)))
+    (let ((s (make-instance 'local-socket :type :stream)))
       (format t "~A~%" s)
       (socket-connect s "/dev/log")
       (let ((stream (socket-make-stream s :input t :output t :buffering :none)))

diff --git a/make.sh b/make.sh
index 8626c85..64a565b 100755 (executable)
--- a/make.sh
+++ b/make.sh
@@ -113,9 +113,9 @@ sh make-config.sh || exit 1
 # Or, if you can set up the files somewhere shared (with NFS, AFS, or
 # whatever) between the host machine and the target machine, the basic
 # procedure above should still work, but you can skip the "copy" steps.
-sh make-host-1.sh   || exit 1
-sh make-target-1.sh || exit 1
-sh make-host-2.sh   || exit 1
-sh make-target-2.sh || exit 1
-sh make-target-contrib.sh || exit 1
+time sh make-host-1.sh   || exit 1
+time sh make-target-1.sh || exit 1
+time sh make-host-2.sh   || exit 1
+time sh make-target-2.sh || exit 1
+time sh make-target-contrib.sh || exit 1
 date

diff --git a/src/code/list.lisp b/src/code/list.lisp
index 47e476a..dee3790 100644 (file)
--- a/src/code/list.lisp
+++ b/src/code/list.lisp
@@ -211,13 +211,22 @@
   (cdr list))
 
 (defun nthcdr (n list)
-  (declare (type index n))
   #!+sb-doc
   "Performs the cdr function n times on a list."
-  (do ((i n (1- i))
-       (result list (cdr result)))
-      ((not (plusp i)) result)
-      (declare (type index i))))
+  (flet ((fast-nthcdr (n list)
+           (declare (type index n))
+           (do ((i n (1- i))
+                (result list (cdr result)))
+               ((not (plusp i)) result)
+             (declare (type index i)))))
+    (typecase n
+      (index (fast-nthcdr n list))
+      (t (do ((i 0 (1+ i))
+              (r-i list (cdr r-i))
+              (r-2i list (cddr r-2i)))
+             ((and (eq r-i r-2i) (not (zerop i)))
+              (fast-nthcdr (mod n i) r-i))
+           (declare (type index i)))))))
 
 (defun last (list &optional (n 1))
   #!+sb-doc
@@ -468,15 +477,21 @@
 
 ;;; Set the Nth element of LIST to NEWVAL.
 (defun %setnth (n list newval)
-  (declare (type index n))
-  (do ((count n (1- count))
-       (list list (cdr list)))
-      ((endp list)
-       (error "~S is too large an index for SETF of NTH." n))
-    (declare (type fixnum count))
-    (when (<= count 0)
-      (rplaca list newval)
-      (return newval))))
+  (typecase n
+    (index
+     (do ((count n (1- count))
+          (list list (cdr list)))
+         ((endp list)
+          (error "~S is too large an index for SETF of NTH." n))
+       (declare (type fixnum count))
+       (when (<= count 0)
+         (rplaca list newval)
+         (return newval))))
+    (t (let ((cons (nthcdr n list)))
+         (when (endp cons)
+           (error "~S is too large an index for SETF of NTH." n))
+         (rplaca cons newval)
+         newval))))
 \f
 ;;;; :KEY arg optimization to save funcall of IDENTITY
 

diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp
index e48440d..23a156e 100644 (file)
--- a/src/compiler/fndb.lisp
+++ b/src/compiler/fndb.lisp
@@ -684,8 +684,8 @@
   (foldable flushable call))
 (defknown endp (list) boolean (foldable flushable movable))
 (defknown list-length (list) (or index null) (foldable unsafely-flushable))
-(defknown nth (index list) t (foldable flushable))
-(defknown nthcdr (index list) t (foldable unsafely-flushable))
+(defknown nth (unsigned-byte list) t (foldable flushable))
+(defknown nthcdr (unsigned-byte list) t (foldable unsafely-flushable))
 (defknown last (list &optional index) t (foldable flushable))
 (defknown list (&rest t) list (movable flushable unsafe))
 (defknown list* (t &rest t) t (movable flushable unsafe))
@@ -1413,7 +1413,7 @@
 (defknown (setf fdocumentation) ((or string null) t symbol)
   (or string null)
   ())
-(defknown %setnth (index list t) t (unsafe))
+(defknown %setnth (unsigned-byte list t) t (unsafe))
 (defknown %set-fill-pointer (vector index) index (unsafe))
 \f
 ;;;; miscellaneous internal utilities

diff --git a/tests/list.pure.lisp b/tests/list.pure.lisp
index 9bf32a8..3a2894c 100644 (file)
--- a/tests/list.pure.lisp
+++ b/tests/list.pure.lisp
@@ -117,3 +117,10 @@
                                                            (list 4 1 3 3))
                                         #'<))
                '(2 4)))
+
+;;; Bug reported by Adam Warner: valid list index designator is not
+;;; necessary a fixnum
+(let ((s (read-from-string "(a . #1=(b c . #1#))")))
+  (assert (eq (nth (* 1440 most-positive-fixnum) s) 'c))
+  (setf (nth (* 1440 most-positive-fixnum) s) 14)
+  (assert (eq (nth (* 1440 most-positive-fixnum) s) 14)))

diff --git a/version.lisp-expr b/version.lisp-expr
index a37bc1b..2965c2a 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.1.10"
+"0.8.1.11"