From a9cac95ee124f8e71a31554964d308f74da9c866 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Mon, 17 Dec 2007 13:34:26 +0000 Subject: [PATCH] 1.0.12.35: more safety -- less weakening of type checks * Weaken type check only if SAFETY < 2, and SAFETY < SPEED. Thus SAFETY 2 becomes a "always full type checks". * Delete a stale comment above MAYBE-NEGATE-CHECK about weakening checks there -- this has not been the case since 0.7.9.41. * Fix type errors in target-sxhash.lisp that was masked by the weakening that used happen there. * Update commentary re. PROBABLE-TYPE-CHECK-P as per Alexey's email on sbcl-devel. Delete some other stale comments re. weakening. * Update the manual re. weakened type checks. --- NEWS | 3 ++ doc/manual/compiler.texinfo | 8 +++-- src/code/target-sxhash.lisp | 18 +++++----- src/compiler/checkgen.lisp | 83 ++++++++++++++++++--------------------------- src/compiler/policies.lisp | 14 ++++---- version.lisp-expr | 2 +- 6 files changed, 58 insertions(+), 70 deletions(-) diff --git a/NEWS b/NEWS index 29b257fe5..10f07f0ef 100644 --- a/NEWS +++ b/NEWS @@ -1,5 +1,8 @@ ;;;; -*- coding: utf-8; -*- changes in sbcl-1.0.13 relative to sbcl-1.0.12: + * minor incompatible change: compiler policy re. weakening type + checks has changed: now type checks are weakened on if SAFETY < 2 + and SAFETY < SPEED. * SB-EXT:NATIVE-NAMESTRING takes a new keyword AS-FILE, forcing unparsing of directory pathnames as files. Analogously, SB-EXT:PARSE-NATIVE-NAMESTRING takes an AS-DIRECTORY, forcing a diff --git a/doc/manual/compiler.texinfo b/doc/manual/compiler.texinfo index c23af6ad4..d2d974608 100644 --- a/doc/manual/compiler.texinfo +++ b/doc/manual/compiler.texinfo @@ -515,14 +515,16 @@ selectable via @code{optimize} declarations. All declarations are considered assertions to be checked at runtime, and all type checks are precise. -Used when @code{(>= safety (max speed space compilation-speed)}. The +Used when @code{(and (< 0 safety) (or (>= safety 2) (>= safety speed)))}. The default compilation policy provides full type checks. @item Weak Type Checks Any or all type declarations may be believed without runtime -assertions, and assertions that are done may be imprecise. +assertions, and assertions that are done may be imprecise. It should +be noted that it is relatively easy to corrupt the heap when weak type +checks are used, and type-errors are introduced into the program. -Used when @code{(< 0 safety (max speed space compilation-speed)}. +Used when @code{(and (< safety 2) (< safety speed))} @item No Type Checks All declarations are believed without assertions. Also disables diff --git a/src/code/target-sxhash.lisp b/src/code/target-sxhash.lisp index 5ddbd212d..2e0e06ab9 100644 --- a/src/code/target-sxhash.lisp +++ b/src/code/target-sxhash.lisp @@ -250,12 +250,13 @@ '(let ((result 572539)) (declare (type fixnum result)) (mixf result (length key)) - (dotimes (i (length key)) + (when (plusp depthoid) + (decf depthoid) + (dotimes (i (length key)) (declare (type fixnum i)) (mixf result - (psxhash (aref key i) - (- depthoid 1 i)))) - result)) + (psxhash (aref key i) depthoid)))) + result)) (make-dispatch (types) `(typecase key ,@(loop for type in types @@ -274,10 +275,11 @@ (declare (type fixnum result)) (dotimes (i (array-rank key)) (mixf result (array-dimension key i))) - (dotimes (i (array-total-size key)) - (mixf result - (psxhash (row-major-aref key i) - (- depthoid 1 i)))) + (when (plusp depthoid) + (decf depthoid) + (dotimes (i (array-total-size key)) + (mixf result + (psxhash (row-major-aref key i) depthoid)))) result)))) (defun structure-object-psxhash (key depthoid) diff --git a/src/compiler/checkgen.lisp b/src/compiler/checkgen.lisp index 0a932453d..5bcdee08c 100644 --- a/src/compiler/checkgen.lisp +++ b/src/compiler/checkgen.lisp @@ -160,17 +160,6 @@ ;;; for a :HAIRY check with that test negated. Otherwise, we try to do ;;; a simple test, and if that is impossible, we do a hairy test with ;;; non-negated types. If true, FORCE-HAIRY forces a hairy type check. -;;; -;;; When doing a non-negated check, we call MAYBE-WEAKEN-CHECK to -;;; weaken the test to a convenient supertype (conditional on policy.) -;;; If SPEED is 3, or DEBUG-INFO is not particularly important (DEBUG -;;; <= 1), then we allow weakened checks to be simple, resulting in -;;; less informative error messages, but saving space and possibly -;;; time. -;;; -;;; FIXME: I don't quite understand this, but it looks as though -;;; that means type checks are weakened when SPEED=3 regardless of -;;; the SAFETY level, which is not the right thing to do. (defun maybe-negate-check (lvar types original-types force-hairy n-required) (declare (type lvar lvar) (list types original-types)) (let ((ptypes (values-type-out (lvar-derived-type lvar) (length types)))) @@ -320,51 +309,45 @@ (cast-type-to-check cast))))) ;;; Return true if CAST's value is an lvar whose type the back end is -;;; likely to want to check. Since we don't know what template the -;;; back end is going to choose to implement the continuation's DEST, -;;; we use a heuristic. We always return T unless: -;;; -- nobody uses the value, or -;;; -- safety is totally unimportant, or -;;; -- the lvar is an argument to an unknown function, or -;;; -- the lvar is an argument to a known function that has +;;; likely to be able to check (see GENERATE-TYPE-CHECKS). Since we +;;; don't know what template the back end is going to choose to +;;; implement the continuation's DEST, we use a heuristic. +;;; +;;; We always return T unless nobody uses the value (the backend +;;; cannot check unused LVAR chains). +;;; +;;; The logic used to be more complex, but most of the cases that used +;;; to be checked here are now dealt with differently . FIXME: but +;;; here's one we used to do, don't anymore, but could still benefit +;;; from, if we reimplemented it (elsewhere): +;;; +;;; -- If the lvar is an argument to a known function that has ;;; no IR2-CONVERT method or :FAST-SAFE templates that are -;;; compatible with the call's type. +;;; compatible with the call's type: return NIL. +;;; +;;; The code used to look like something like this: +;;; ... +;;; (:known +;;; (let ((info (basic-combination-fun-info dest))) +;;; (if (fun-info-ir2-convert info) +;;; t +;;; (dolist (template (fun-info-templates info) nil) +;;; (when (eq (template-ltn-policy template) +;;; :fast-safe) +;;; (multiple-value-bind (val win) +;;; (valid-fun-use dest (template-type template)) +;;; (when (or val (not win)) (return t))))))))))))) +;;; +;;; ADP says: It is still interesting. When we have a :SAFE template +;;; and the type assertion is derived from the destination function +;;; type, the check is unneccessary. We cannot return NIL here (the +;;; whole function has changed its meaning, and here NIL *forces* +;;; hairy check), but the functionality is interesting. (defun probable-type-check-p (cast) (declare (type cast cast)) (let* ((lvar (node-lvar cast)) (dest (and lvar (lvar-dest lvar)))) (cond ((not dest) nil) - (t t)) - #+nil - (cond ((or (not dest) - (policy dest (zerop safety))) - nil) - ((basic-combination-p dest) - (let ((kind (basic-combination-kind dest))) - (cond - ((eq cont (basic-combination-fun dest)) t) - (t - (ecase kind - (:local t) - (:full - (and (combination-p dest) - (not (values-subtypep ; explicit THE - (continuation-externally-checkable-type cont) - (continuation-type-to-check cont))))) - ;; :ERROR means that we have an invalid syntax of - ;; the call and the callee will detect it before - ;; thinking about types. - (:error nil) - (:known - (let ((info (basic-combination-fun-info dest))) - (if (fun-info-ir2-convert info) - t - (dolist (template (fun-info-templates info) nil) - (when (eq (template-ltn-policy template) - :fast-safe) - (multiple-value-bind (val win) - (valid-fun-use dest (template-type template)) - (when (or val (not win)) (return t))))))))))))) (t t)))) ;;; Return a lambda form that we can convert to do a hairy type check diff --git a/src/compiler/policies.lisp b/src/compiler/policies.lisp index dc31e4f25..f5c417dc5 100644 --- a/src/compiler/policies.lisp +++ b/src/compiler/policies.lisp @@ -12,15 +12,13 @@ (in-package "SB!C") (define-optimization-quality type-check + ;; FIXME: grepping the tree for "policy.*safety" yields some + ;; places which might want to use this instead -- or + ;; some other derived policy. (cond ((= safety 0) 0) - ;; FIXME: It is duplicated in PROBABLE-TYPE-CHECK-P and in - ;; some other places. - ((and (<= speed safety) - (<= space safety) - (<= compilation-speed safety)) - 3) - (t 2)) - ("no" "maybe" "fast" "full")) + ((and (< safety 2) (< safety speed)) 2) + (t 3)) + ("no" "maybe" "weak" "full")) (define-optimization-quality check-tag-existence (cond ((= safety 0) 0) diff --git a/version.lisp-expr b/version.lisp-expr index eec166335..98b50b615 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.12.34" +"1.0.12.35" -- 2.11.4.GIT