0.8.21.7:

        * Fix infinite looping of ALIEN-FUNCALL, compiled with (DEBUG
          3) as reported by Baughn on #lisp.
        * Replace BIT-BASH-COPY in CONCATENATE transformation for
          strings with UB8-BASH-COPY.

diff --git a/NEWS b/NEWS
index 427b4c0..bb7eb06 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -8,6 +8,8 @@ changes in sbcl-0.8.22 relative to sbcl-0.8.21:
   * fixed inference of the upper bound of an iteration variable.
     (reported by Rajat Datta).
   * fixed bug 376: CONJUGATE type deriver.
   * fixed inference of the upper bound of an iteration variable.
     (reported by Rajat Datta).
   * fixed bug 376: CONJUGATE type deriver.

+  * fixed infinite looping of ALIEN-FUNCALL, compiled with high DEBUG.
+    (reported by Baughn on #lisp)

   * fixed some bugs revealed by Paul Dietz' test suite:
     ** MISC.549 and similar: late transformation of unsafe type
        assertions into derived types caused unexpected code
   * fixed some bugs revealed by Paul Dietz' test suite:
     ** MISC.549 and similar: late transformation of unsafe type
        assertions into derived types caused unexpected code

diff --git a/src/code/target-alieneval.lisp b/src/code/target-alieneval.lisp
index 2f62bfc..63f7f2c 100644 (file)
--- a/src/code/target-alieneval.lisp
+++ b/src/code/target-alieneval.lisp
@@ -580,6 +580,7 @@
                       (parms (make-gensym-list (length args))))
                   (compile nil
                            `(lambda (,fun ,@parms)
                       (parms (make-gensym-list (length args))))
                   (compile nil
                            `(lambda (,fun ,@parms)

+                               (declare (optimize (sb!c::insert-step-conditions 0)))

                               (declare (type (alien ,type) ,fun))
                               (alien-funcall ,fun ,@parms)))))
           (setf (alien-fun-type-stub type) stub))
                               (declare (type (alien ,type) ,fun))
                               (alien-funcall ,fun ,@parms)))))
           (setf (alien-fun-type-stub type) stub))

diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp
index 5694a74..5c1874d 100644 (file)
--- a/src/compiler/seqtran.lisp
+++ b/src/compiler/seqtran.lisp
@@ -812,17 +812,21 @@
   (loop for rest-seqs on sequences
         for n-seq = (gensym "N-SEQ")
         for n-length = (gensym "N-LENGTH")
   (loop for rest-seqs on sequences
         for n-seq = (gensym "N-SEQ")
         for n-length = (gensym "N-LENGTH")

-        for start = vector-data-bit-offset then next-start
+        for start = 0 then next-start

         for next-start = (gensym "NEXT-START")
         collect n-seq into args
         for next-start = (gensym "NEXT-START")
         collect n-seq into args

-        collect `(,n-length (* (length ,n-seq) sb!vm:n-byte-bits)) into lets
+        collect `(,n-length (length ,n-seq)) into lets

         collect n-length into all-lengths
         collect next-start into starts
         collect `(if (and (typep ,n-seq '(simple-array nil (*)))
                          (> ,n-length 0))
                     (error 'nil-array-accessed-error)
         collect n-length into all-lengths
         collect next-start into starts
         collect `(if (and (typep ,n-seq '(simple-array nil (*)))
                          (> ,n-length 0))
                     (error 'nil-array-accessed-error)

-                    (bit-bash-copy ,n-seq ,vector-data-bit-offset
-                                   res ,start ,n-length))
+                     (#.(let* ((i (position 'character sb!kernel::*specialized-array-element-types*))
+                               (saetp (aref sb!vm:*specialized-array-element-type-properties* i))
+                               (n-bits (sb!vm:saetp-n-bits saetp)))
+                          (intern (format nil "UB~D-BASH-COPY" n-bits)
+                                  "SB!KERNEL"))
+                        ,n-seq 0 res ,start ,n-length))

                 into forms
         collect `(setq ,next-start (+ ,start ,n-length)) into forms
         finally
                 into forms
         collect `(setq ,next-start (+ ,start ,n-length)) into forms
         finally

@@ -830,9 +834,8 @@
           `(lambda (rtype ,@args)
              (declare (ignore rtype))
              (let* (,@lets
           `(lambda (rtype ,@args)
              (declare (ignore rtype))
              (let* (,@lets

-                      (res (make-string (truncate (the index (+ ,@all-lengths))
-                                                  sb!vm:n-byte-bits)
-                                        :element-type 'base-char)))
+                    (res (make-string (the index (+ ,@all-lengths))
+                                      :element-type 'base-char)))

                (declare (type index ,@all-lengths))
                (let (,@(mapcar (lambda (name) `(,name 0)) starts))
                  (declare (type index ,@starts))
                (declare (type index ,@all-lengths))
                (let (,@(mapcar (lambda (name) `(,name 0)) starts))
                  (declare (type index ,@starts))

diff --git a/tests/alien.impure.lisp b/tests/alien.impure.lisp
index d4365d3..c800e80 100644 (file)
--- a/tests/alien.impure.lisp
+++ b/tests/alien.impure.lisp
@@ -115,5 +115,15 @@
                                      (deref integer-array 1)))
     (assert (eql (deref enum-array 2) 'k-two))))
 
                                      (deref integer-array 1)))
     (assert (eql (deref enum-array 2) 'k-two))))
 

+;;; As reported by Baughn on #lisp, ALIEN-FUNCALL loops forever when
+;;; compiled with (DEBUG 3).
+(sb-kernel::values-specifier-type-cache-clear)
+(proclaim '(optimize (debug 3)))
+(let ((f (compile nil '(lambda (v)
+                        (sb-alien:alien-funcall (sb-alien:extern-alien "getenv"
+                                                 (function (c-string) c-string))
+                         v)))))
+  (assert (typep (funcall f "HOME") '(or string null))))
+

 ;;; success
 (quit :unix-status 104)
 ;;; success
 (quit :unix-status 104)

diff --git a/version.lisp-expr b/version.lisp-expr
index cc26343..c7ce455 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".)
 ;;; 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.21.6"
+"0.8.21.7"