From: Nikodemus Siivola Date: Mon, 17 Mar 2008 17:13:40 +0000 (+0000) Subject: 1.0.15.36: fix bug 423 X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=e119a2f79cf36039a39996f5490934b4d927529a;p=sbcl.git 1.0.15.36: fix bug 423 * TRULY-THE no longer eagerly annotates the LVAR, but rather acts like THE in unsafe code. (Inserts a cast for which no type-check is generated.) * ALLOC-NUMBER-STACK-SPACE and ALLOC-ALIEN-STACK-SPACE were missing :RESULT-TYPES, which was masked by the old TRULY-THE implementation. (Tested on x86, x86-64, PPC, but all backends updated -- hopefully correctly.) * Docstrings for THE and TRULY-THE. FWIW, this patch seems to make PPC+GENCGC build happy once again: but I don't know if that means the problems there were/are related to bug 423 -- or if the exact memory layout just happens to change subtly so that whatever corruption occurs, just happens to occur in a place where the GC doesn't see it anymore. (Or if the exact point at which GC runs is now just slightly different so that the problem pointers are not live anymore, or...) --- diff --git a/BUGS b/BUGS index 0c152ac..0ec868e 100644 --- a/BUGS +++ b/BUGS @@ -1889,26 +1889,6 @@ behaves ...erratically. Reported by Kevin Reid on sbcl-devel 2007-07-06. (We don't _have_ to check things like this, but we generally try to check returns in safe code, so we should here too.) -423: TRULY-THE and *CHECK-CONSISTENCY* - - The following signals errors due to TRULY-THEs in dead code: - - (let ((sb-c::*check-consistency* t)) - (handler-bind ((warning #'error)) - (flet ((make-lambda (type) - `(lambda (x) - ((lambda (z) - (if (listp z) - (let ((q (truly-the list z))) - (length q)) - (if (arrayp z) - (let ((q (truly-the vector z))) - (length q)) - (error "oops")))) - (the ,type x))))) - (compile nil (make-lambda 'list)) - (compile nil (make-lambda 'vector))))) - 424: toplevel closures and *CHECK-CONSISTENCY* The following breaks under COMPILE-FILE if *CHECK-CONSISTENCY* is true. diff --git a/NEWS b/NEWS index 6752da1..ccab6c5 100644 --- a/NEWS +++ b/NEWS @@ -15,6 +15,7 @@ changes in sbcl-1.0.16 relative to 1.0.15: * optimization: modular arithmetic for a particular requested width is implemented using a tagged representation unless a better representation is available. + * fixed bug 423: TRULY-THE and *CHECK-CONSISTENCY* interaction. * bug fix: SB-BSD-SOCKETS:MAKE-INET-ADDRESS checks the input string for wellformedness and returns a specialized vector. (reported by Francois-Rene Rideau) diff --git a/contrib/sb-introspect/test-driver.lisp b/contrib/sb-introspect/test-driver.lisp index 15e7ccc..e5d7cd1 100644 --- a/contrib/sb-introspect/test-driver.lisp +++ b/contrib/sb-introspect/test-driver.lisp @@ -10,7 +10,7 @@ (assert (equal (function-arglist 'cl-user::one) '(cl-user::a cl-user::b cl-user::c))) (assert (equal (function-arglist 'the) - '(type sb-c::value))) + '(sb-c::value-type sb-c::form))) (assert (equal (function-arglist #'(sb-pcl::slow-method cl-user::j (t))) '(sb-pcl::method-args sb-pcl::next-methods))) @@ -81,7 +81,7 @@ (assert (equal (function-arglist 'cl-user::one) '(cl-user::a cl-user::b cl-user::c))) (assert (equal (function-arglist 'the) - '(type sb-c::value))) + '(sb-c::value-type sb-c::form))) ;;; Check wrt. interplay of generic functions and their methods. diff --git a/src/compiler/alpha/c-call.lisp b/src/compiler/alpha/c-call.lisp index c49fd6c..f56225d 100644 --- a/src/compiler/alpha/c-call.lisp +++ b/src/compiler/alpha/c-call.lisp @@ -142,6 +142,7 @@ (define-vop (alloc-number-stack-space) (:info amount) (:results (result :scs (sap-reg any-reg))) + (:result-types system-area-pointer) (:temporary (:scs (unsigned-reg) :to (:result 0)) temp) (:generator 0 (unless (zerop amount) diff --git a/src/compiler/hppa/c-call.lisp b/src/compiler/hppa/c-call.lisp index 69a5d31..088393a 100644 --- a/src/compiler/hppa/c-call.lisp +++ b/src/compiler/hppa/c-call.lisp @@ -149,6 +149,7 @@ (define-vop (alloc-number-stack-space) (:info amount) (:results (result :scs (sap-reg any-reg))) + (:result-types system-area-pointer) (:temporary (:scs (unsigned-reg) :to (:result 0)) temp) (:generator 0 (move nsp-tn result) diff --git a/src/compiler/ir1-translators.lisp b/src/compiler/ir1-translators.lisp index d68a632..a6a6f64 100644 --- a/src/compiler/ir1-translators.lisp +++ b/src/compiler/ir1-translators.lisp @@ -860,26 +860,34 @@ other." ;;; Assert that FORM evaluates to the specified type (which may be a ;;; VALUES type). TYPE may be a type specifier or (as a hack) a CTYPE. -(def-ir1-translator the ((type value) start next result) - (the-in-policy type value (lexenv-policy *lexenv*) start next result)) +(def-ir1-translator the ((value-type form) start next result) + #!+sb-doc + "Specifies that the values returned by FORM conform to the VALUE-TYPE. + +CLHS specifies that the consequences are undefined if any result is +not of the declared type, but SBCL treats declarations as assertions +as long as SAFETY is at least 2, in which case incorrect type +information will result in a runtime type-error instead of leading to +eg. heap corruption. This is however expressly non-portable: use +CHECK-TYPE instead of THE to catch type-errors at runtime. THE is best +considered an optimization tool to inform the compiler about types it +is unable to derive from other declared types." + (the-in-policy value-type form (lexenv-policy *lexenv*) start next result)) ;;; This is like the THE special form, except that it believes ;;; whatever you tell it. It will never generate a type check, but ;;; will cause a warning if the compiler can prove the assertion is ;;; wrong. -(def-ir1-translator truly-the ((type value) start next result) +(def-ir1-translator truly-the ((value-type form) start next result) #!+sb-doc - "" - #-nil - (let ((type (coerce-to-values (compiler-values-specifier-type type))) - (old (when result (find-uses result)))) - (ir1-convert start next result value) - (when result - (do-uses (use result) - (unless (memq use old) - (derive-node-type use type))))) - #+nil - (the-in-policy type value '((type-check . 0)) start cont)) + "Specifies that the values returned by FORM conform to the +VALUE-TYPE, and causes the compiler to trust this information +unconditionally. + +Consequences are undefined if any result is not of the declared type +-- typical symptoms including memory corruptions. Use with great +care." + (the-in-policy value-type form '((type-check . 0)) start next result)) ;;;; SETQ diff --git a/src/compiler/mips/c-call.lisp b/src/compiler/mips/c-call.lisp index 32c8f1d..eae4850 100644 --- a/src/compiler/mips/c-call.lisp +++ b/src/compiler/mips/c-call.lisp @@ -271,6 +271,7 @@ (define-vop (alloc-number-stack-space) (:info amount) + (:result-types system-area-pointer) (:results (result :scs (sap-reg any-reg))) (:temporary (:scs (unsigned-reg) :to (:result 0)) temp) (:generator 0 diff --git a/src/compiler/ppc/c-call.lisp b/src/compiler/ppc/c-call.lisp index 52db97f..1d75529 100644 --- a/src/compiler/ppc/c-call.lisp +++ b/src/compiler/ppc/c-call.lisp @@ -428,6 +428,7 @@ (define-vop (alloc-number-stack-space) (:info amount) (:results (result :scs (sap-reg any-reg))) + (:result-types system-area-pointer) (:temporary (:scs (unsigned-reg) :to (:result 0)) temp) (:generator 0 (unless (zerop amount) diff --git a/src/compiler/sparc/c-call.lisp b/src/compiler/sparc/c-call.lisp index 03ff1c9..87f3a00 100644 --- a/src/compiler/sparc/c-call.lisp +++ b/src/compiler/sparc/c-call.lisp @@ -235,6 +235,7 @@ (define-vop (alloc-number-stack-space) (:info amount) (:results (result :scs (sap-reg any-reg))) + (:result-types system-area-pointer) (:temporary (:scs (unsigned-reg) :to (:result 0)) temp) (:generator 0 (unless (zerop amount) diff --git a/src/compiler/x86-64/c-call.lisp b/src/compiler/x86-64/c-call.lisp index 04814f4..c9d4861 100644 --- a/src/compiler/x86-64/c-call.lisp +++ b/src/compiler/x86-64/c-call.lisp @@ -269,6 +269,7 @@ (define-vop (alloc-number-stack-space) (:info amount) (:results (result :scs (sap-reg any-reg))) + (:result-types system-area-pointer) (:generator 0 (aver (location= result rsp-tn)) (unless (zerop amount) @@ -289,6 +290,7 @@ (:info amount) #!+sb-thread (:temporary (:sc unsigned-reg) temp) (:results (result :scs (sap-reg any-reg))) + (:result-types system-area-pointer) #!+sb-thread (:generator 0 (aver (not (location= result rsp-tn))) diff --git a/src/compiler/x86/c-call.lisp b/src/compiler/x86/c-call.lisp index 023c99b..ae98e18 100644 --- a/src/compiler/x86/c-call.lisp +++ b/src/compiler/x86/c-call.lisp @@ -279,6 +279,7 @@ (define-vop (alloc-number-stack-space) (:info amount) (:results (result :scs (sap-reg any-reg))) + (:result-types system-area-pointer) (:generator 0 (aver (location= result esp-tn)) (unless (zerop amount) @@ -291,6 +292,7 @@ (:info amount) #!+sb-thread (:temporary (:sc unsigned-reg) temp) (:results (result :scs (sap-reg any-reg))) + (:result-types system-area-pointer) #!+sb-thread (:generator 0 (aver (not (location= result esp-tn))) diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp index ce69513..88463e1 100644 --- a/tests/compiler.pure.lisp +++ b/tests/compiler.pure.lisp @@ -2323,3 +2323,22 @@ (declare (fixnum y) (character x)) (sb-sys:with-pinned-objects (x y) (some-random-function)))) + +;;; *CHECK-CONSISTENCY* and TRULY-THE + +(with-test (:name :bug-423) + (let ((sb-c::*check-consistency* t)) + (handler-bind ((warning #'error)) + (flet ((make-lambda (type) + `(lambda (x) + ((lambda (z) + (if (listp z) + (let ((q (truly-the list z))) + (length q)) + (if (arrayp z) + (let ((q (truly-the vector z))) + (length q)) + (error "oops")))) + (the ,type x))))) + (compile nil (make-lambda 'list)) + (compile nil (make-lambda 'vector)))))) diff --git a/version.lisp-expr b/version.lisp-expr index 7c3cd9a..954d985 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".) -"1.0.15.35" +"1.0.15.36"