X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fboot.lisp;h=e6006942ec8b0bc4b01a83fb4b50a3fc8a5bdb37;hb=6bbc22725d3bf663726ed9adca544e39316364a6;hp=da64a234b5d54956099829830ff0ad16751e16d0;hpb=e5cf6f26b24a3c85bd3258dd9cac9d9a26d510f3;p=sbcl.git

diff --git a/src/pcl/boot.lisp b/src/pcl/boot.lisp
index da64a23..e600694 100644
--- a/src/pcl/boot.lisp
+++ b/src/pcl/boot.lisp
@@ -1015,7 +1015,7 @@ bootstrapping.
 
 (defstruct (fast-method-call (:copier nil))
   (function #'identity :type function)
-  pv-cell
+  pv
   next-method-call
   arg-info)
 (defstruct (constant-fast-method-call
@@ -1032,7 +1032,7 @@ bootstrapping.
 
 (defmacro invoke-fast-method-call (method-call restp &rest required-args+rest-arg)
   `(,(if restp 'apply 'funcall) (fast-method-call-function ,method-call)
-                                (fast-method-call-pv-cell ,method-call)
+                                (fast-method-call-pv ,method-call)
                                 (fast-method-call-next-method-call ,method-call)
                                 ,@required-args+rest-arg))
 
@@ -1042,7 +1042,7 @@ bootstrapping.
                                         &rest required-args)
   (macrolet ((generate-call (n)
                ``(funcall (fast-method-call-function ,method-call)
-                          (fast-method-call-pv-cell ,method-call)
+                          (fast-method-call-pv ,method-call)
                           (fast-method-call-next-method-call ,method-call)
                           ,@required-args
                           ,@(loop for x below ,n
@@ -1056,7 +1056,7 @@ bootstrapping.
        (0 ,(generate-call 0))
        (1 ,(generate-call 1))
        (t (multiple-value-call (fast-method-call-function ,method-call)
-            (values (fast-method-call-pv-cell ,method-call))
+            (values (fast-method-call-pv ,method-call))
             (values (fast-method-call-next-method-call ,method-call))
             ,@required-args
             (sb-c::%more-arg-values ,more-context 0 ,more-count))))))
@@ -1204,7 +1204,7 @@ bootstrapping.
             (nreq (car arg-info)))
        (if restp
            (apply (fast-method-call-function emf)
-                  (fast-method-call-pv-cell emf)
+                  (fast-method-call-pv emf)
                   (fast-method-call-next-method-call emf)
                   args)
            (cond ((null args)
@@ -1227,7 +1227,7 @@ bootstrapping.
                              :format-arguments nil)))
                  (t
                   (apply (fast-method-call-function emf)
-                         (fast-method-call-pv-cell emf)
+                         (fast-method-call-pv emf)
                          (fast-method-call-next-method-call emf)
                          args))))))
     (method-call
@@ -2266,7 +2266,8 @@ bootstrapping.
             arg-info)))
 
 (defun early-make-a-method (class qualifiers arglist specializers initargs doc
-                            &key slot-name object-class method-class-function)
+                            &key slot-name object-class method-class-function
+                            definition-source)
   (let ((parsed ())
         (unparsed ()))
     ;; Figure out whether we got class objects or class names as the
@@ -2307,13 +2308,15 @@ bootstrapping.
                         initargs doc)
                   (when slot-name
                     (list :slot-name slot-name :object-class object-class
-                          :method-class-function method-class-function))))))
+                          :method-class-function method-class-function))
+                  (list :definition-source definition-source)))))
       (initialize-method-function initargs result)
       result)))
 
 (defun real-make-a-method
        (class qualifiers lambda-list specializers initargs doc
-        &rest args &key slot-name object-class method-class-function)
+        &rest args &key slot-name object-class method-class-function
+        definition-source)
   (if method-class-function
       (let* ((object-class (if (classp object-class) object-class
                                (find-class object-class)))
@@ -2329,6 +2332,7 @@ bootstrapping.
           (apply #'make-instance
                  (apply method-class-function object-class slot-definition
                         initargs)
+                 :definition-source definition-source
                  initargs)))
       (apply #'make-instance class :qualifiers qualifiers
              :lambda-list lambda-list :specializers specializers
@@ -2387,7 +2391,9 @@ bootstrapping.
   (setf (fifth (fifth early-method)) new-value))
 
 (defun early-add-named-method (generic-function-name qualifiers
-                               specializers arglist &rest initargs)
+                               specializers arglist &rest initargs
+                               &key documentation definition-source
+                               &allow-other-keys)
   (let* (;; we don't need to deal with the :generic-function-class
          ;; argument here because the default,
          ;; STANDARD-GENERIC-FUNCTION, is right for all early generic
@@ -2401,7 +2407,8 @@ bootstrapping.
     (setf (getf (getf initargs 'plist) :name)
           (make-method-spec gf qualifiers specializers))
     (let ((new (make-a-method 'standard-method qualifiers arglist
-                              specializers initargs (getf initargs :documentation))))
+                              specializers initargs documentation
+                              :definition-source definition-source)))
       (when existing (remove-method gf existing))
       (add-method gf new))))