X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-defstruct.lisp;h=8f35d3ccfaf408f733457cbf40259a8b6247bf69;hb=2db3b6b4cb740d5b6512459c223859f747807b09;hp=4e2061c92982c3ea5764d5f6d083c103236e142a;hpb=ec6d4bd97d9adc6f4003747d8ca92fad7766ccfd;p=sbcl.git

diff --git a/src/code/target-defstruct.lisp b/src/code/target-defstruct.lisp
index 4e2061c..8f35d3c 100644
--- a/src/code/target-defstruct.lisp
+++ b/src/code/target-defstruct.lisp
@@ -177,19 +177,22 @@
   (dolist (dsd (dd-slots dd))
     (/show0 "doing FDEFINITION for slot accessor")
     (let ((accessor-name (dsd-accessor-name dsd)))
-      (/show0 "ACCESSOR-NAME=..")
-      (/hexstr accessor-name)
-      (protect-cl accessor-name)
-      (/hexstr "getting READER-FUN and WRITER-FUN")
-      (multiple-value-bind (reader-fun writer-fun) (slot-accessor-funs dd dsd)
-	(declare (type function reader-fun writer-fun))
-	(/show0 "got READER-FUN and WRITER-FUN=..")
-	(/hexstr reader-fun)
-	(setf (symbol-function accessor-name) reader-fun)
-	(unless (dsd-read-only dsd)
-	  (/show0 "setting FDEFINITION for WRITER-FUN=..")
-	  (/hexstr writer-fun)
-	  (setf (fdefinition `(setf ,accessor-name)) writer-fun)))))
+      ;; We mustn't step on any inherited accessors
+      (unless (accessor-inherited-data accessor-name dd)
+	(/show0 "ACCESSOR-NAME=..")
+	(/hexstr accessor-name)
+	(protect-cl accessor-name)
+	(/hexstr "getting READER-FUN and WRITER-FUN")
+	(multiple-value-bind (reader-fun writer-fun)
+	    (slot-accessor-funs dd dsd)
+	  (declare (type function reader-fun writer-fun))
+	  (/show0 "got READER-FUN and WRITER-FUN=..")
+	  (/hexstr reader-fun)
+	  (setf (symbol-function accessor-name) reader-fun)
+	  (unless (dsd-read-only dsd)
+	    (/show0 "setting FDEFINITION for WRITER-FUN=..")
+	    (/hexstr writer-fun)
+	    (setf (fdefinition `(setf ,accessor-name)) writer-fun))))))
 
   ;; Set FDEFINITION for copier.
   (when (dd-copier-name dd)
@@ -213,11 +216,12 @@
 	    ((structure funcallable-structure)
 	     (/show0 "with-LAYOUT case")
 	     (lambda (object)
-	       (declare (optimize (speed 3) (safety 0)))
-	       (/noshow0 "in with-LAYOUT structure predicate closure, OBJECT,LAYOUT=..")
-	       (/nohexstr object)
-	       (/nohexstr layout)
-	       (typep-to-layout object layout)))
+	       (locally ; <- to keep SAFETY 0 from affecting arg count checking
+		 (declare (optimize (speed 3) (safety 0)))
+		 (/noshow0 "in with-LAYOUT structure predicate closure, OBJECT,LAYOUT=..")
+		 (/nohexstr object)
+		 (/nohexstr layout)
+		 (typep-to-layout object layout))))
 	    ;; structures with no LAYOUT (i.e. :TYPE VECTOR or :TYPE LIST)
 	    ;;
 	    ;; FIXME: should handle the :NAMED T case in these cases
@@ -297,8 +301,7 @@
 			       *raw-slot-data-list*)
 		     ;; oops
 		     (t
-		      (error "internal error: unexpected DSD-RAW-TYPE ~S"
-			     dsd-raw-type))))))
+		      (bug "unexpected DSD-RAW-TYPE ~S" dsd-raw-type))))))
 	     ;; code shared between DEFSTRUCT :TYPE LIST and
 	     ;; DEFSTRUCT :TYPE VECTOR cases: Handle the "typed
 	     ;; structure" case, with no LAYOUTs and no raw slots.
@@ -387,7 +390,7 @@
 
 (defun %default-structure-pretty-print (structure stream)
   (let* ((layout (%instance-layout structure))
-	 (name (sb!xc:class-name (layout-class layout)))
+	 (name (class-name (layout-class layout)))
 	 (dd (layout-info layout)))
     (pprint-logical-block (stream nil :prefix "#S(" :suffix ")")
       (prin1 name stream)
@@ -413,7 +416,7 @@
 	     (pprint-newline :linear stream))))))))
 (defun %default-structure-ugly-print (structure stream)
   (let* ((layout (%instance-layout structure))
-	 (name (sb!xc:class-name (layout-class layout)))
+	 (name (class-name (layout-class layout)))
 	 (dd (layout-info layout)))
     (descend-into (stream)
       (write-string "#S(" stream)
@@ -452,7 +455,7 @@
   (declare (ignore object environment))
   (if slot-names
       (error "stub: MAKE-LOAD-FORM-SAVING-SLOTS :SLOT-NAMES not implemented") ; KLUDGE
-      :just-dump-it-normally))
+      :sb-just-dump-it-normally))
 
 ;;;; testing structure types