#.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,
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
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
(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.
;;; 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))))
(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))
(error "~@<don't know how to dump ~S (default ~S method called).~@>"
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)))
: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)))))
(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)))
+
\f
;;; ensure that we can dump and reload specialized arrays whose element
;;; size is smaller than a byte (caused a few problems circa SBCL
;;; 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"
projects / sbcl.git / commitdiff