* 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...)
13 files changed:
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.)
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.
424: toplevel closures and *CHECK-CONSISTENCY*
The following breaks under COMPILE-FILE if *CHECK-CONSISTENCY* is true.
* optimization: modular arithmetic for a particular requested width
is implemented using a tagged representation unless a better
representation is available.
* 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)
* bug fix: SB-BSD-SOCKETS:MAKE-INET-ADDRESS checks the input string
for wellformedness and returns a specialized vector. (reported by
Francois-Rene Rideau)
(assert (equal (function-arglist 'cl-user::one)
'(cl-user::a cl-user::b cl-user::c)))
(assert (equal (function-arglist 'the)
(assert (equal (function-arglist 'cl-user::one)
'(cl-user::a cl-user::b cl-user::c)))
(assert (equal (function-arglist 'the)
+ '(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)))
(assert (equal (function-arglist #'(sb-pcl::slow-method cl-user::j (t)))
'(sb-pcl::method-args sb-pcl::next-methods)))
(assert (equal (function-arglist 'cl-user::one)
'(cl-user::a cl-user::b cl-user::c)))
(assert (equal (function-arglist 'the)
(assert (equal (function-arglist 'cl-user::one)
'(cl-user::a cl-user::b cl-user::c)))
(assert (equal (function-arglist 'the)
+ '(sb-c::value-type sb-c::form)))
;;; Check wrt. interplay of generic functions and their methods.
;;; Check wrt. interplay of generic functions and their methods.
(define-vop (alloc-number-stack-space)
(:info amount)
(:results (result :scs (sap-reg any-reg)))
(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)
(:temporary (:scs (unsigned-reg) :to (:result 0)) temp)
(:generator 0
(unless (zerop amount)
(define-vop (alloc-number-stack-space)
(:info amount)
(:results (result :scs (sap-reg any-reg)))
(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)
(:temporary (:scs (unsigned-reg) :to (:result 0)) temp)
(:generator 0
(move nsp-tn result)
;;; 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.
;;; 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.
;;; 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)
- ""
- #-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))
(define-vop (alloc-number-stack-space)
(:info amount)
(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
(:results (result :scs (sap-reg any-reg)))
(:temporary (:scs (unsigned-reg) :to (:result 0)) temp)
(:generator 0
(define-vop (alloc-number-stack-space)
(:info amount)
(:results (result :scs (sap-reg any-reg)))
(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)
(:temporary (:scs (unsigned-reg) :to (:result 0)) temp)
(:generator 0
(unless (zerop amount)
(define-vop (alloc-number-stack-space)
(:info amount)
(:results (result :scs (sap-reg any-reg)))
(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)
(:temporary (:scs (unsigned-reg) :to (:result 0)) temp)
(:generator 0
(unless (zerop amount)
(define-vop (alloc-number-stack-space)
(:info amount)
(:results (result :scs (sap-reg any-reg)))
(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)
(:generator 0
(aver (location= result rsp-tn))
(unless (zerop amount)
(:info amount)
#!+sb-thread (:temporary (:sc unsigned-reg) temp)
(:results (result :scs (sap-reg any-reg)))
(: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)))
#!+sb-thread
(:generator 0
(aver (not (location= result rsp-tn)))
(define-vop (alloc-number-stack-space)
(:info amount)
(:results (result :scs (sap-reg any-reg)))
(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)
(:generator 0
(aver (location= result esp-tn))
(unless (zerop amount)
(:info amount)
#!+sb-thread (:temporary (:sc unsigned-reg) temp)
(:results (result :scs (sap-reg any-reg)))
(: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)))
#!+sb-thread
(:generator 0
(aver (not (location= result esp-tn)))
(declare (fixnum y) (character x))
(sb-sys:with-pinned-objects (x y)
(some-random-function))))
(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))))))
;;; 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".)
;;; 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".)