0.8.9.6:

        * Fix bug reported by Sean Ross: flush fill pointer from a
          simple array loaded from a FASL;
        * update FOP tracing during loading.

diff --git a/NEWS b/NEWS
index 717ac6d..b0ae2d8 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -2366,6 +2366,8 @@ changes in sbcl-0.8.9 relative to sbcl-0.8.8:
 changes in sbcl-0.8.10 relative to sbcl-0.8.9:
   * bug fix: compiler emitted division in optimized DEREF.  (thanks for
     the test case to Dave Roberts)
+  * bug fix: multidimensional simple arrays loaded from FASLs had fill
+    pointers.  (reported by Sean Ross)
 
 planned incompatible changes in 0.8.x:
   * (not done yet, but planned:) When the profiling interface settles

diff --git a/src/code/fop.lisp b/src/code/fop.lisp
index 6a6b949..2612386 100644 (file)
--- a/src/code/fop.lisp
+++ b/src/code/fop.lisp
@@ -384,7 +384,7 @@
         (res (make-array-header sb!vm:simple-array-widetag rank)))
     (declare (simple-array vec)
             (type (unsigned-byte 24) rank))
-    (set-array-header res vec length length 0
+    (set-array-header res vec length nil 0
                      (do ((i rank (1- i))
                           (dimensions () (cons (pop-stack) dimensions)))
                          ((zerop i) dimensions)

diff --git a/src/code/load.lisp b/src/code/load.lisp
index 02a0293..8562044 100644 (file)
--- a/src/code/load.lisp
+++ b/src/code/load.lisp
@@ -348,31 +348,26 @@
        (loop
          (let ((byte (read-byte stream)))
 
-           ;; stale code from before rewrite of *FOP-STACK* as
-           ;; adjustable vector (probably worth rewriting when next
-           ;; anyone needs to debug FASL stuff)
-           #|
            ;; Do some debugging output.
            #!+sb-show
            (when *show-fops-p*
-             (let ((ptr *fop-stack-pointer*)
-                   (stack *fop-stack*))
-               (fresh-line *trace-output*)
-               ;; The FOP operations are stack based, so it's sorta
-               ;; logical to display the operand before the operator.
-               ;; ("reverse Polish notation")
-               (unless (= ptr (length stack))
-                 (write-char #\space *trace-output*)
-                 (prin1 (svref stack ptr) *trace-output*)
-                 (terpri *trace-output*))
-               ;; Display the operator.
-               (format *trace-output*
-                       "~&~S (#X~X at ~D) (~S)~%"
-                       (svref *fop-names* byte)
-                       byte
-                       (1- (file-position stream))
-                       (svref *fop-funs* byte))))
-            |#
+              (let* ((stack *fop-stack*)
+                     (ptr (1- (fill-pointer *fop-stack*))))
+                (fresh-line *trace-output*)
+                ;; The FOP operations are stack based, so it's sorta
+                ;; logical to display the operand before the operator.
+                ;; ("reverse Polish notation")
+                (unless (= ptr -1)
+                  (write-char #\space *trace-output*)
+                  (prin1 (aref stack ptr) *trace-output*)
+                  (terpri *trace-output*))
+                ;; Display the operator.
+                (format *trace-output*
+                        "~&~S (#X~X at ~D) (~S)~%"
+                        (aref *fop-names* byte)
+                        byte
+                        (1- (file-position stream))
+                        (svref *fop-funs* byte))))
 
            ;; Actually execute the fop.
            (funcall (the function (svref *fop-funs* byte)))))))))

diff --git a/tests/load.impure.lisp b/tests/load.impure.lisp
new file mode 100644 (file)
index 0000000..b54b374
--- /dev/null
+++ b/tests/load.impure.lisp
@@ -0,0 +1,35 @@
+;;;; miscellaneous side-effectful tests of LOAD
+
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; While most of SBCL is derived from the CMU CL system, the test
+;;;; files (like this one) were written from scratch after the fork
+;;;; from CMU CL.
+;;;; 
+;;;; This software is in the public domain and is provided with
+;;;; absolutely no warranty. See the COPYING and CREDITS files for
+;;;; more information.
+
+;;; Bug reported by Sean Ross: FASL loader set fill pointer to loaded
+;;; simple arrays.
+(defvar *array*)
+(defvar *tmp-filename* "load-test.tmp")
+
+(progn
+  (with-open-file (s *tmp-filename*
+                     :direction :output
+                     :if-exists :supersede
+                     :if-does-not-exist :create)
+    (print '(setq *array* #3a(((1 2) (2 1)) ((3 4) (4 3)))) s))
+  (let (tmp-fasl)
+    (unwind-protect
+         (progn
+           (setq tmp-fasl (compile-file *tmp-filename*))
+           (let ((*array* nil))
+             (load tmp-fasl)
+             (assert (arrayp *array*))
+             (assert (= (array-rank *array*) 3))
+             (assert (not (array-has-fill-pointer-p *array*)))))
+      (when tmp-fasl (delete-file tmp-fasl))
+      (delete-file *tmp-filename*))))

diff --git a/version.lisp-expr b/version.lisp-expr
index 2b9a0a8..985be34 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.9.5"
+"0.8.9.6"