From ce3935c80e46e3f5fbaeab82eb1ccabe82cb44f9 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Fri, 3 May 2002 14:59:14 +0000 Subject: [PATCH] 0.7.3.8: Fix bug 31, mostly by s/array-type-element-type/array-type-specialized-element-type/ (though not in all uses -- only those where the return value of an access is in question) Things motivated by building under OpenMCL ... add another yucky #+ for *host-obj-suffix* ... delete dead *backend-fasl-file-type* variable --- BUGS | 36 +++++++++++++++++++---------------- src/cold/shared.lisp | 1 + src/compiler/array-tran.lisp | 14 +++----------- src/compiler/generic/vm-tran.lisp | 4 ++-- src/compiler/ppc/backend-parms.lisp | 1 - tests/compiler-1.impure-cload.lisp | 17 +++++++++++++---- version.lisp-expr | 2 +- 7 files changed, 40 insertions(+), 35 deletions(-) diff --git a/BUGS b/BUGS index fc576e0..4286531 100644 --- a/BUGS +++ b/BUGS @@ -157,22 +157,6 @@ WORKAROUND: Process inferior-lisp exited abnormally with code 1 I haven't noticed a repeatable case of this yet. -31: - In some cases the compiler believes type declarations on array - elements without checking them, e.g. - (DECLAIM (OPTIMIZE (SAFETY 3) (SPEED 1) (SPACE 1))) - (DEFSTRUCT FOO A B) - (DEFUN BAR (X) - (DECLARE (TYPE (SIMPLE-ARRAY CONS 1) X)) - (WHEN (CONSP (AREF X 0)) - (PRINT (AREF X 0)))) - (BAR (VECTOR (MAKE-FOO :A 11 :B 12))) - prints - #S(FOO :A 11 :B 12) - in SBCL 0.6.5 (and also in CMU CL 18b). This does not happen for - all cases, e.g. the type assumption *is* checked if the array - elements are declared to be of some structure type instead of CONS. - 32: The printer doesn't report closures very well. This is true in CMU CL 18b as well: @@ -1247,6 +1231,26 @@ WORKAROUND: 7) (real 4 8)) is a HAIRY-TYPE rather than that which would be hoped for, viz: '(real 4 7). +165: + Array types with element-types of some unknown type are falsely being + assumed to be of type (ARRAY T) by the compiler in some cases. The + following code demonstrates the problem: + + (defun foo (x) + (declare (type (vector bar) x)) + (aref x 1)) + (deftype bar () 'single-float) + (foo (make-array 3 :element-type 'bar)) + -> TYPE-ERROR "The value #(0.0 0.0 0.0) is not of type (VECTOR BAR)." + (typep (make-array 3 :element-type 'bar) '(vector bar)) + -> T + + The easy solution is to make the functions which depend on knowing + the upgraded-array-element-type (in compiler/array-tran and + compiler/generic/vm-tran as of sbcl-0.7.3.x) be slightly smarter about + unknown types; an alternative is to have the + specialized-element-type slot in the ARRAY-TYPE structure be + *WILD-TYPE* for UNKNOWN-TYPE element types. DEFUNCT CATEGORIES OF BUGS IR1-#: diff --git a/src/cold/shared.lisp b/src/cold/shared.lisp index 1dd3ddd..3bcf508 100644 --- a/src/cold/shared.lisp +++ b/src/cold/shared.lisp @@ -46,6 +46,7 @@ ;; that we never explicitly refer to host object file suffixes, ;; only to the result of CL:COMPILE-FILE-PATHNAME. #+lispworks ".ufsl" ; as per Lieven Marchand sbcl-devel 2002-02-01 + #+openmcl ".pfsl" ;; On most xc hosts, any old extension works, so we use an ;; arbitrary one. ".lisp-obj")) diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp index 2f3585a..1cb1a64 100644 --- a/src/compiler/array-tran.lisp +++ b/src/compiler/array-tran.lisp @@ -25,14 +25,6 @@ element-type-specifier))) ;;; Array access functions return an object from the array, hence its -;;; type will be asserted to be array element type. -(defun extract-element-type (array) - (let ((type (continuation-type array))) - (if (array-type-p type) - (array-type-element-type type) - *universal-type*))) - -;;; Array access functions return an object from the array, hence its ;;; type is going to be the array upgraded element type. (defun extract-upgraded-element-type (array) (let ((type (continuation-type array))) @@ -46,7 +38,7 @@ (defun assert-new-value-type (new-value array) (let ((type (continuation-type array))) (when (array-type-p type) - (assert-continuation-type new-value (array-type-element-type type)))) + (assert-continuation-type new-value (array-type-specialized-element-type type)))) (continuation-type new-value)) ;;; Return true if Arg is NIL, or is a constant-continuation whose @@ -75,7 +67,7 @@ ;; If the node continuation has a single use then assert its type. (let ((cont (node-cont node))) (when (= (length (find-uses cont)) 1) - (assert-continuation-type cont (extract-element-type array)))) + (assert-continuation-type cont (extract-upgraded-element-type array)))) (extract-upgraded-element-type array)) (defoptimizer (%aset derive-type) ((array &rest stuff)) @@ -99,7 +91,7 @@ (when (array-type-p atype) (values-specifier-type `(values (simple-array ,(type-specifier - (array-type-element-type atype)) + (array-type-specialized-element-type atype)) (*)) index index index))))) diff --git a/src/compiler/generic/vm-tran.lisp b/src/compiler/generic/vm-tran.lisp index feba317..9f22eb0 100644 --- a/src/compiler/generic/vm-tran.lisp +++ b/src/compiler/generic/vm-tran.lisp @@ -79,7 +79,7 @@ (let ((dims (array-type-dimensions array-type))) (when (or (atom dims) (= (length dims) 1)) (give-up-ir1-transform)) - (let ((el-type (array-type-element-type array-type)) + (let ((el-type (array-type-specialized-element-type array-type)) (total-size (if (member '* dims) '* (reduce #'* dims)))) @@ -127,7 +127,7 @@ (let ((dims (array-type-dimensions array-type))) (when (or (atom dims) (= (length dims) 1)) (give-up-ir1-transform)) - (let ((el-type (array-type-element-type array-type)) + (let ((el-type (array-type-specialized-element-type array-type)) (total-size (if (member '* dims) '* (reduce #'* dims)))) diff --git a/src/compiler/ppc/backend-parms.lisp b/src/compiler/ppc/backend-parms.lisp index 30f38e4..71f5771 100644 --- a/src/compiler/ppc/backend-parms.lisp +++ b/src/compiler/ppc/backend-parms.lisp @@ -1,6 +1,5 @@ (in-package "SB!VM") -(setf *backend-fasl-file-type* "fasl") (defconstant +backend-fasl-file-implementation+ :ppc) (setf *backend-register-save-penalty* 3) (setf *backend-byte-order* :big-endian) diff --git a/tests/compiler-1.impure-cload.lisp b/tests/compiler-1.impure-cload.lisp index e50cf6f..e062958 100644 --- a/tests/compiler-1.impure-cload.lisp +++ b/tests/compiler-1.impure-cload.lisp @@ -52,10 +52,9 @@ (declaim (ftype function i-am-just-a-function)) (defun i-am-just-a-function (x y) (+ x y 1)) -;;; Stig E SandPHI (where PHI is some phi-like character not -;;; representable in ASCII) reported in cclan-Bugs-431263 that SBCL -;;; couldn't compile this. sbcl-0.6.12.26 died in CIRCULAR-LIST-P with -;;; "The value \"EST\" is not of type LIST." Dan Barlow fixed it. +;;; Stig E Sandoe reported in cclan-Bugs-431263 that SBCL couldn't +;;; compile this. sbcl-0.6.12.26 died in CIRCULAR-LIST-P with "The +;;; value \"EST\" is not of type LIST." Dan Barlow fixed it. (defvar +time-zones+ '((5 "EDT" . "EST") (6 "CDT" . "CST") (7 "MDT" . "MST") (8 "PDT" . "PST") @@ -97,4 +96,14 @@ (error "Invalid pixarray: ~S." pixarray))))) (assert (eql 1 (pixarray-element-size #*110))) +;;; bug 31 turned out to be a manifestation of non-ANSI array type +;;; handling, fixed by CSR in sbcl-0.7.3.8. +(defun array-element-type-handling (x) + (declare (type (vector cons) x)) + (when (consp (aref x 0)) + (aref x 0))) +(assert (eq (array-element-type-handling + (make-array 3 :element-type t :initial-element 0)) + nil)) + (sb-ext:quit :unix-status 104) ; success diff --git a/version.lisp-expr b/version.lisp-expr index 7c79f5e..f40050a 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; for internal versions, especially for internal versions off the ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.7.3.7" +"0.7.3.8" -- 1.7.10.4