From e9840c3696d663a186df1a7e20d15b6caf4aec86 Mon Sep 17 00:00:00 2001 From: Alexey Dejneka Date: Sat, 27 Mar 2004 07:58:16 +0000 Subject: [PATCH] 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. --- NEWS | 2 ++ src/code/fop.lisp | 2 +- src/code/load.lisp | 39 +++++++++++++++++---------------------- tests/load.impure.lisp | 35 +++++++++++++++++++++++++++++++++++ version.lisp-expr | 2 +- 5 files changed, 56 insertions(+), 24 deletions(-) create mode 100644 tests/load.impure.lisp diff --git a/NEWS b/NEWS index 717ac6d..b0ae2d8 100644 --- 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 --- 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 --- 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 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 --- 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" -- 1.7.10.4