X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fenv.lisp;h=fadcb9366678cc2be153dd0c56751ee82cc30827;hb=bb756e3d4b19c30d4a9cd4250b606c5969613ad9;hp=d793f9a528c9928d7057198cc4f6d7c86f4a3c97;hpb=9719063b661a99d2cc2a1d9b2ea7dd81145ded59;p=sbcl.git

diff --git a/src/pcl/env.lisp b/src/pcl/env.lisp
index d793f9a..fadcb93 100644
--- a/src/pcl/env.lisp
+++ b/src/pcl/env.lisp
@@ -108,6 +108,16 @@
   (fdefinition name))
 |#
 
+;;;; Helper for slightly newer trace implementation, based on
+;;;; breakpoint stuff.  The above is potentially still useful, so it's
+;;;; left in, commented.
+(defun list-all-maybe-method-names (gf)
+  (let (result)
+    (dolist (method (generic-function-methods gf) (nreverse result))
+      (let ((spec (nth-value 2 (parse-method-or-spec method))))
+        (push spec result)
+        (push (list* 'fast-method (cdr spec)) result)))))
+
 ;;;; MAKE-LOAD-FORM
 
 ;; Overwrite the old bootstrap non-generic MAKE-LOAD-FORM function with a
@@ -158,7 +168,14 @@
                          (eq :instance (slot-definition-allocation slot))))
             (if (slot-boundp-using-class class object slot)
                 (let ((value (slot-value-using-class class object slot)))
-                  (inits `(setf (slot-value ,object ',slot-name) ',value)))
+		  (if (typep object 'structure-object)
+		      ;; low-level but less noisy initializer form
+		      (let* ((dd (get-structure-dd (class-name class)))
+			     (dsd (find slot-name (dd-slots dd)
+					:key #'dsd-name)))
+			(inits `(,(slot-setter-lambda-form dd dsd)
+				 ',value ,object)))
+		      (inits `(setf (slot-value ,object ',slot-name) ',value))))
                 (inits `(slot-makunbound ,object ',slot-name))))))
       (values `(allocate-instance (find-class ',(class-name class)))
               `(progn ,@(inits))))))