0.9.15.24:

	Cosmetic change
	... s/pcl-funcallable-instance/standard-funcallable-instance/
	(where by "STANDARD" we begin to mean CLOS/AMOP-compatible)

diff --git a/src/pcl/boot.lisp b/src/pcl/boot.lisp
index 562ad47..8758d01 100644 (file)
--- a/src/pcl/boot.lisp
+++ b/src/pcl/boot.lisp
@@ -1930,7 +1930,8 @@ bootstrapping.
 
 (defun make-early-gf (spec &optional lambda-list lambda-list-p
                       function argument-precedence-order source-location)
-  (let ((fin (allocate-funcallable-instance *sgf-wrapper* *sgf-slots-init*)))
+  (let ((fin (allocate-standard-funcallable-instance
+              *sgf-wrapper* *sgf-slots-init*)))
     (set-funcallable-instance-function
      fin
      (or function

diff --git a/src/pcl/braid.lisp b/src/pcl/braid.lisp
index 008eb02..5a808ae 100644 (file)
--- a/src/pcl/braid.lisp
+++ b/src/pcl/braid.lisp
@@ -52,28 +52,38 @@
                              :initial-element +slot-unbound+))))
     instance))
 
-(defmacro allocate-funcallable-instance-slots (wrapper &optional
-                                                       slots-init-p slots-init)
+(defmacro allocate-standard-funcallable-instance-slots
+    (wrapper &optional slots-init-p slots-init)
   `(let ((no-of-slots (wrapper-no-of-instance-slots ,wrapper)))
-     ,(if slots-init-p
-          `(if ,slots-init-p
-               (make-array no-of-slots :initial-contents ,slots-init)
-               (make-array no-of-slots :initial-element +slot-unbound+))
-          `(make-array no-of-slots :initial-element +slot-unbound+))))
-
-(defun allocate-funcallable-instance (wrapper &optional
-                                              (slots-init nil slots-init-p))
-  (let ((fin (%make-pcl-funcallable-instance nil nil
-                                             (get-instance-hash-code))))
+    ,(if slots-init-p
+         `(if ,slots-init-p
+           (make-array no-of-slots :initial-contents ,slots-init)
+           (make-array no-of-slots :initial-element +slot-unbound+))
+         `(make-array no-of-slots :initial-element +slot-unbound+))))
+
+(define-condition unset-funcallable-instance-function
+    (reference-condition simple-error)
+  ()
+  (:default-initargs
+   :references (list '(:amop :generic-function allocate-instance)
+                     '(:amop :function set-funcallable-instance-function))))
+
+(defun allocate-standard-funcallable-instance
+    (wrapper &optional (slots-init nil slots-init-p))
+  (let ((fin (%make-standard-funcallable-instance
+              nil nil (get-instance-hash-code))))
     (set-funcallable-instance-function
      fin
      #'(lambda (&rest args)
          (declare (ignore args))
-         (error "The function of the funcallable-instance ~S has not been set."
-                fin)))
+         (error 'unset-funcallable-instance-function
+                :format-control "~@<The function of funcallable instance ~
+                                 ~S has not been set.~@:>"
+                :format-arguments (list fin))))
     (setf (fsc-instance-wrapper fin) wrapper
-          (fsc-instance-slots fin) (allocate-funcallable-instance-slots
-                                    wrapper slots-init-p slots-init))
+          (fsc-instance-slots fin)
+          (allocate-standard-funcallable-instance-slots
+           wrapper slots-init-p slots-init))
     fin))
 
 (defun allocate-structure-instance (wrapper &optional
@@ -197,7 +207,7 @@
                       ()))
 
               (setq proto (if (eq meta 'funcallable-standard-class)
-                              (allocate-funcallable-instance wrapper)
+                              (allocate-standard-funcallable-instance wrapper)
                               (allocate-standard-instance wrapper)))
 
               (setq direct-slots

diff --git a/src/pcl/fsc.lisp b/src/pcl/fsc.lisp
index 8739040..8313078 100644 (file)
--- a/src/pcl/fsc.lisp
+++ b/src/pcl/fsc.lisp
@@ -40,14 +40,14 @@
   'fsc-instance-slots)
 
 (defmethod raw-instance-allocator ((class funcallable-standard-class))
-  'allocate-funcallable-instance)
+  'allocate-standard-funcallable-instance)
 
 (defmethod allocate-instance
            ((class funcallable-standard-class) &rest initargs)
   (declare (ignore initargs))
   (unless (class-finalized-p class)
     (finalize-inheritance class))
-  (allocate-funcallable-instance (class-wrapper class)))
+  (allocate-standard-funcallable-instance (class-wrapper class)))
 
 (defmethod make-reader-method-function ((class funcallable-standard-class)
                                         slot-name)

diff --git a/src/pcl/low.lisp b/src/pcl/low.lisp
index 930dfd9..525f3cc 100644 (file)
--- a/src/pcl/low.lisp
+++ b/src/pcl/low.lisp
@@ -76,12 +76,12 @@
 \f
 ;;;; PCL's view of funcallable instances
 
-(!defstruct-with-alternate-metaclass pcl-funcallable-instance
+(!defstruct-with-alternate-metaclass standard-funcallable-instance
   ;; KLUDGE: Note that neither of these slots is ever accessed by its
   ;; accessor name as of sbcl-0.pre7.63. Presumably everything works
   ;; by puns based on absolute locations. Fun fun fun.. -- WHN 2001-10-30
   :slot-names (clos-slots name hash-code)
-  :boa-constructor %make-pcl-funcallable-instance
+  :boa-constructor %make-standard-funcallable-instance
   :superclass-name function
   :metaclass-name standard-classoid
   :metaclass-constructor make-standard-classoid

diff --git a/version.lisp-expr b/version.lisp-expr
index 75973b1..625c1e7 100644 (file)
--- 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.15.23"
+"0.9.15.24"