From: Alexey Dejneka Date: Sun, 16 Apr 2006 07:10:20 +0000 (+0000) Subject: 0.9.11.38: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=36a379d746b9eb74ba8c5afff40dc5dcb9f4557a;p=sbcl.git 0.9.11.38: * Fix MISC.555: remove a function from *FREE-FUNS* when it has only local calls. * Null :SLOT-NAMES argument of MAKE-LOAD-FORM-SAVING-SLOTS means no saved slots. --- diff --git a/BUGS b/BUGS index 1960b90..8088a3b 100644 --- a/BUGS +++ b/BUGS @@ -1928,25 +1928,6 @@ WORKAROUND: #.SB-EXT:SINGLE/DOUBLE-FLOAT-POSITIVE-INFINITY. These tests have been disabled on Darwin for now. -375: MISC.555 - (compile nil '(lambda (p1) - (declare (optimize (speed 1) (safety 2) (debug 2) (space 0)) - (type keyword p1)) - (keywordp p1))) - - fails on hairy type check in IR2. - - 1. KEYWORDP is MAYBE-INLINE expanded (before TYPEP-like - transformation could eliminate it). - - 2. From the only call of KEYWORDP the type of its argument is - derived to be KEYWORD. - - 2. Type check for P1 is generated; it uses KEYWORDP to perform the - check, and so references the local function; from the KEYWORDP - argument type new CAST to KEYWORD is generated. The compiler - loops forever. - 377: Memory fault error reporting On those architectures where :C-STACK-IS-CONTROL-STACK is in *FEATURES*, we handle SIG_MEMORY_FAULT (SEGV or BUS) on an altstack, diff --git a/NEWS b/NEWS index f9c286b..0b7236a 100644 --- a/NEWS +++ b/NEWS @@ -32,6 +32,8 @@ changes in sbcl-0.9.12 relative to sbcl-0.9.11: by Utz-Uwe Haus) * bug fix: derivation of float boundaries from numbers outside the appropriate float range (reported by John Wiseman) + * bug fix: MAKE-LOAD-FORM-SAVING-SLOTS accepts en empty slot name + list. * improvements to DOCUMENTATION for TYPE and STRUCTURE doc-types: allow condition class objects as arguments to DOCUMENTATION and (SETF DOCUMENTATION); only find and set documentation for @@ -50,6 +52,8 @@ changes in sbcl-0.9.12 relative to sbcl-0.9.11: directive. ** compiler failure when compiling functions with hairy constant defaults for optional parameters. + ** compiler produces wrong code when MAYBE-INLINE-expanding a + function, which is already optimized. changes in sbcl-0.9.11 relative to sbcl-0.9.10: * new platform: experimental support for SBCL x86/Darwin, including diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp index cd08ee2..7b68ff8 100644 --- a/src/compiler/ir1util.lisp +++ b/src/compiler/ir1util.lisp @@ -1015,6 +1015,17 @@ (values)) +(defun note-local-functional (fun) + (declare (type functional fun)) + (when (and (leaf-has-source-name-p fun) + (eq (leaf-source-name fun) (functional-debug-name fun))) + (let ((name (leaf-source-name fun))) + (let ((defined-fun (gethash name *free-funs*))) + (when (and defined-fun + (defined-fun-p defined-fun) + (eq (defined-fun-functional defined-fun) fun)) + (remhash name *free-funs*)))))) + ;;; Do stuff to delete the semantic attachments of a REF node. When ;;; this leaves zero or one reference, we do a type dispatch off of ;;; the leaf to determine if a special action is appropriate. diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp index ceff522..8d34d60 100644 --- a/src/compiler/locall.lisp +++ b/src/compiler/locall.lisp @@ -274,7 +274,8 @@ ;;; do LET conversion here. (defun locall-analyze-fun-1 (fun) (declare (type functional fun)) - (let ((refs (leaf-refs fun))) + (let ((refs (leaf-refs fun)) + (local-p t)) (dolist (ref refs) (let* ((lvar (node-lvar ref)) (dest (when lvar (lvar-dest lvar)))) @@ -286,9 +287,12 @@ (convert-call-if-possible ref dest) (unless (eq (basic-combination-kind dest) :local) - (reference-entry-point ref))) + (reference-entry-point ref) + (setq local-p nil))) (t - (reference-entry-point ref))))))) + (reference-entry-point ref) + (setq local-p nil)))))) + (when local-p (note-local-functional fun))) (values)) diff --git a/src/pcl/env.lisp b/src/pcl/env.lisp index be5e677..eba61b2 100644 --- a/src/pcl/env.lisp +++ b/src/pcl/env.lisp @@ -157,14 +157,14 @@ (error "~@" object 'make-load-form)) -(defun make-load-form-saving-slots (object &key slot-names environment) +(defun make-load-form-saving-slots (object &key (slot-names nil slot-names-p) environment) (declare (ignore environment)) (let ((class (class-of object))) (collect ((inits)) (dolist (slot (class-slots class)) (let ((slot-name (slot-definition-name slot))) (when (or (memq slot-name slot-names) - (and (null slot-names) + (and (not slot-names-p) (eq :instance (slot-definition-allocation slot)))) (if (slot-boundp-using-class class object slot) (let ((value (slot-value-using-class class object slot))) diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp index d0821f4..4b0af78 100644 --- a/tests/compiler.pure.lisp +++ b/tests/compiler.pure.lisp @@ -2078,3 +2078,11 @@ :bad2)) :good)))) (assert (eq (funcall (compile nil f)) :good))) + +;;; MISC.555: new reference to an already-optimized local function +(let* ((l '(lambda (p1) + (declare (optimize (speed 1) (safety 2) (debug 2) (space 0)) (type keyword p1)) + (keywordp p1))) + (f (compile nil l))) + (assert (funcall f :good)) + (assert (nth-value 1 (ignore-errors (funcall f 42))))) diff --git a/tests/dump.impure-cload.lisp b/tests/dump.impure-cload.lisp index a19094f..28aeb24 100644 --- a/tests/dump.impure-cload.lisp +++ b/tests/dump.impure-cload.lisp @@ -89,6 +89,17 @@ (assert (eql (savable-structure-c *savable-structure*) 1)) (assert (eql (savable-structure-d *savable-structure*) 39)) (assert (eql (savable-structure-e *savable-structure*) 19)) + +;;; null :SLOT-NAMES /= unsupplied +(eval-when (:compile-toplevel :load-toplevel :execute) + (defclass savable-class () + ((a :initform t :initarg :a))) + (defmethod make-load-form ((s savable-class) &optional env) + (make-load-form-saving-slots s :environment env :slot-names '()))) +(defparameter *savable-class* + #.(make-instance 'savable-class :a 3)) +(assert (not (slot-boundp *savable-class* 'a))) + ;;; ensure that we can dump and reload specialized arrays whose element ;;; size is smaller than a byte (caused a few problems circa SBCL diff --git a/version.lisp-expr b/version.lisp-expr index f0b501c..44fc425 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".) -"0.9.11.37" +"0.9.11.38"