From ad1aa2961d81ed8db9dac59068c6861199c29a3a Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Tue, 2 Jul 2002 12:32:42 +0000 Subject: [PATCH] 0.7.5.3: made BUGS entry for the DEFTRANSFORM gotcha referred to below tweak in runtime.c, should still work the same (trying to make 80-char lines:-) put CSR's current diff into the main CVS since he's gone for a while and I want to work with it now without thinking about merging later... ...BUGS entry for FILL problem ...fixed FIXME re. %DATA-VECTOR-AND-INDEX ...defined a DEFTRANSFORM on %DATA-VECTOR-AND-INDEX so things apparently go faster now ...(didn't define another otherwise-reasonable DEFTRANSFORM on %DATA-VECTOR-AND-INDEX, for non-simple VECTORs, because it evidently tickles a bug in the DEFTRANSFORM system, as reported on sbcl-devel) --- BUGS | 67 +++++++++++++++++++++++++++++++++++++ package-data-list.lisp-expr | 3 +- src/code/array.lisp | 5 +++ src/code/cross-misc.lisp | 7 ++-- src/compiler/generic/vm-fndb.lisp | 4 +++ src/compiler/generic/vm-tran.lisp | 54 ++++++++++++++---------------- src/compiler/globaldb.lisp | 14 ++++---- src/runtime/runtime.c | 12 ++++--- version.lisp-expr | 2 +- 9 files changed, 124 insertions(+), 44 deletions(-) diff --git a/BUGS b/BUGS index db74388..874a2af 100644 --- a/BUGS +++ b/BUGS @@ -1376,6 +1376,73 @@ WORKAROUND: however, compiling and loading the same expression in a file works as expected. +186: "Undercautious FILL transform" + Compiling and loading the following code: + (declare (optimize (safety 3) (speed 2) (space 1))) + (defun foo (x) + (fill (make-string 10) x)) + and then running + * (foo 4097) + "@@@@@@@@@@" + This is probably due to insufficient checking in the IR1 + deftransform for FILL + +187: "type inference confusion around DEFTRANSFORM time" + (reported even more verbosely on sbcl-devel 2002-06-28 as "strange + bug in DEFTRANSFORM") + After the file below is compiled and loaded in sbcl-0.7.5, executing + (TCX (MAKE-ARRAY 4 :FILL-POINTER 2) 0) + at the REPL returns an adjustable vector, which is wrong. Presumably + somehow the DERIVE-TYPE information for the output values of %WAD is + being mispropagated as a type constraint on the input values of %WAD, + and so causing the type test to be optimized away. It's unclear how + hand-expanding the DEFTRANSFORM would change this, but it suggests + the DEFTRANSFORM machinery (or at least the way DEFTRANSFORMs are + invoked at a particular phase) is involved. + (cl:in-package :sb-c) + (eval-when (:compile-toplevel) + ;;; standin for %DATA-VECTOR-AND-INDEX + (defknown %dvai (array index) + (values t t) + (foldable flushable)) + (deftransform %dvai ((array index) + (vector t) + * + :important t) + (let* ((atype (continuation-type array)) + (eltype (array-type-specialized-element-type atype))) + (when (eq eltype *wild-type*) + (give-up-ir1-transform + "specialized array element type not known at compile-time")) + (when (not (array-type-complexp atype)) + (give-up-ir1-transform "SIMPLE array!")) + `(if (array-header-p array) + (%wad array index nil) + (values array index)))) + ;;; standin for %WITH-ARRAY-DATA + (defknown %wad (array index (or index null)) + (values (simple-array * (*)) index index index) + (foldable flushable)) + ;;; (Commenting out this optimizer causes the bug to go away.) + (defoptimizer (%wad derive-type) ((array start end)) + (let ((atype (continuation-type array))) + (when (array-type-p atype) + (values-specifier-type + `(values (simple-array ,(type-specifier + (array-type-specialized-element-type atype)) + (*)) + index index index))))) + ) ; EVAL-WHEN + (defun %wad (array start end) + (format t "~&in %WAD~%") + (%with-array-data array start end)) + (cl:in-package :cl-user) + (defun tcx (v i) + (declare (type (vector t) v)) + (declare (notinline sb-kernel::%with-array-data)) + ;; (Hand-expending DEFTRANSFORM %DVAI here also causes the bug to + ;; go away.) + (sb-c::%dvai v i)) DEFUNCT CATEGORIES OF BUGS IR1-#: diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 774f0e8..7be4e32 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -929,7 +929,8 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "%ATAN" "%ATAN2" "%ATANH" "%CALLER-FRAME-AND-PC" "%CHECK-BOUND" "%CLOSURE-FUN" "%CLOSURE-INDEX-REF" "%COS" "%COS-QUICK" - "%COSH" "%DEPOSIT-FIELD" "%DETECT-STACK-EXHAUSTION" + "%COSH" "%DATA-VECTOR-AND-INDEX" + "%DEPOSIT-FIELD" "%DETECT-STACK-EXHAUSTION" "%DOUBLE-FLOAT" "%DPB" "%EXP" "%EXPM1" "%FIND-POSITION" "%FIND-POSITION-VECTOR-MACRO" "%FIND-POSITION-IF" "%FIND-POSITION-IF-VECTOR-MACRO" diff --git a/src/code/array.lisp b/src/code/array.lisp index ddfa44c..360514d 100644 --- a/src/code/array.lisp +++ b/src/code/array.lisp @@ -49,6 +49,11 @@ (defun %with-array-data (array start end) (%with-array-data-macro array start end :fail-inline? t)) +(defun %data-vector-and-index (array index) + (if (array-header-p array) + (%with-array-data array index nil) + (values array index))) + ;;; It'd waste space to expand copies of error handling in every ;;; inline %WITH-ARRAY-DATA, so we have them call this function ;;; instead. This is just a wrapper which is known never to return. diff --git a/src/code/cross-misc.lisp b/src/code/cross-misc.lisp index df93d81..eb57e41 100644 --- a/src/code/cross-misc.lisp +++ b/src/code/cross-misc.lisp @@ -68,10 +68,11 @@ nil)) ;;; This seems to be the portable Common Lisp type test which -;;; corresponds to the effect of the target SBCL implementation test.. +;;; corresponds to the effect of the target SBCL implementation test... (defun sb!kernel:array-header-p (x) - (and (typep x 'simple-array) - (= 1 (array-rank x)))) + (and (typep x 'array) + (or (not (typep x 'simple-array)) + (/= (array-rank x) 1)))) ;;; GENESIS needs these at cross-compile time. The target ;;; implementation of these is reasonably efficient by virtue of its diff --git a/src/compiler/generic/vm-fndb.lisp b/src/compiler/generic/vm-fndb.lisp index 7746eae..12d83fa 100644 --- a/src/compiler/generic/vm-fndb.lisp +++ b/src/compiler/generic/vm-fndb.lisp @@ -306,3 +306,7 @@ ;;;; mutator accessors (defknown mutator-self () system-area-pointer (flushable movable)) + +(defknown %data-vector-and-index (array index) + (values (simple-array * (*)) index) + (foldable flushable)) diff --git a/src/compiler/generic/vm-tran.lisp b/src/compiler/generic/vm-tran.lisp index e155ac2..80b1623 100644 --- a/src/compiler/generic/vm-tran.lisp +++ b/src/compiler/generic/vm-tran.lisp @@ -54,19 +54,7 @@ ;; to hand-expand it ourselves.) (let ((element-type-specifier (type-specifier element-ctype))) `(multiple-value-bind (array index) - ;; FIXME: All this noise should move into a - ;; %DATA-VECTOR-AND-INDEX function, and there should be - ;; DEFTRANSFORMs for %DATA-VECTOR-AND-INDEX to optimize the - ;; function call away when the array is known to be simple, - ;; and to specialize to - ;; %DATA-VECTOR-AND-INDEX-IN-VECTOR-CASE when the array is - ;; known to have only one dimension. - (if (array-header-p array) - (%with-array-data array index nil) - (let ((array array)) - (declare (type (simple-array ,element-type-specifier 1) - array)) - (values array index))) + (%data-vector-and-index array index) (declare (type (simple-array ,element-type-specifier 1) array)) (data-vector-ref array index))))) @@ -99,21 +87,9 @@ "Upgraded element type of array is not known at compile time.")) (let ((element-type-specifier (type-specifier element-ctype))) `(multiple-value-bind (array index) - ;; FIXME: All this noise should move into a - ;; %DATA-VECTOR-AND-INDEX function, and there should be - ;; DEFTRANSFORMs for %DATA-VECTOR-AND-INDEX to optimize the - ;; function call away when the array is known to be simple, - ;; and to specialize to - ;; %DATA-VECTOR-AND-INDEX-IN-VECTOR-CASE when the array is - ;; known to have only one dimension. - (if (array-header-p array) - (%with-array-data array index nil) - (let ((array array)) - (declare (type (simple-array ,element-type-specifier 1) - array)) - (values array index))) - (data-vector-set (truly-the (simple-array ,element-type-specifier 1) - array) + (%data-vector-and-index array index) + (declare (type (simple-array ,element-type-specifier 1) array)) + (data-vector-set array index new-value))))) @@ -135,6 +111,28 @@ index new-value))))) +(defoptimizer (%data-vector-and-index derive-type) ((array index)) + (let ((atype (continuation-type array))) + (when (array-type-p atype) + (values-specifier-type + `(values (simple-array ,(type-specifier + (array-type-specialized-element-type atype)) + (*)) + index))))) + +(deftransform %data-vector-and-index ((array index) + (simple-array t) + * + :important t) + (let* ((atype (continuation-type array)) + (eltype (array-type-specialized-element-type atype))) + (when (eq eltype *wild-type*) + (give-up-ir1-transform + "specialized array element type not known at compile-time")) + `(if (array-header-p array) + (values (%array-data-vector array) index) + (values array index)))) + ;;; transforms for getting at simple arrays of (UNSIGNED-BYTE N) when (< N 8) ;;; ;;; FIXME: In CMU CL, these were commented out with #+NIL. Why? Should diff --git a/src/compiler/globaldb.lisp b/src/compiler/globaldb.lisp index 88e3971..0538c43 100644 --- a/src/compiler/globaldb.lisp +++ b/src/compiler/globaldb.lisp @@ -837,13 +837,13 @@ (let* ((info (type-info-or-lose class type)) (tin (type-info-number info))) (if env-list-p - (set-info-value name - tin - new-value - (get-write-info-env env-list)) - (set-info-value name - tin - new-value))) + (set-info-value name + tin + new-value + (get-write-info-env env-list)) + (set-info-value name + tin + new-value))) new-value) ;;; FIXME: We'd like to do this, but Python doesn't support ;;; compiler macros and it's hard to change it so that it does. diff --git a/src/runtime/runtime.c b/src/runtime/runtime.c index 6c0d544..cfc7cd1 100644 --- a/src/runtime/runtime.c +++ b/src/runtime/runtime.c @@ -198,15 +198,19 @@ main(int argc, char *argv[], char *envp[]) char *sbcl_home = getenv("SBCL_HOME"); if (sbcl_home) { char *lookhere; - lookhere = (char *) calloc(strlen("/sbcl.core") + strlen(sbcl_home) + 1, - sizeof(char)); - sprintf(lookhere, "%s/sbcl.core", sbcl_home); + char *stem = "/sbcl.core"; + lookhere = (char *) calloc(strlen(sbcl_home) + + strlen(stem) + + 1, + sizeof(char)); + sprintf(lookhere, "%s%s", sbcl_home, stem); core = copied_existing_filename_or_null(lookhere); free(lookhere); } else { core = copied_existing_filename_or_null("/usr/lib/sbcl.core"); if (!core) { - core = copied_existing_filename_or_null("/usr/local/lib/sbcl.core"); + core = + copied_existing_filename_or_null("/usr/local/lib/sbcl.core"); } } if (!core) { diff --git a/version.lisp-expr b/version.lisp-expr index 10e4042..500fae4 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.5.2" +"0.7.5.3" -- 1.7.10.4