X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-defstruct.lisp;h=ddce36acdc86e5ce637588bfe6157b04c3cb93f6;hb=063e696d6151fd6329677216646e872731e6a85d;hp=7e30c7bf121eca20198238b6a0f7e22a61520903;hpb=f43f136f9b3ff6cae501e850fa67b2183317e212;p=sbcl.git

diff --git a/src/code/target-defstruct.lisp b/src/code/target-defstruct.lisp
index 7e30c7b..ddce36a 100644
--- a/src/code/target-defstruct.lisp
+++ b/src/code/target-defstruct.lisp
@@ -140,7 +140,7 @@
     (setf (%instance-layout result) layout)
     result))
 
-;;;; target-only parts of the DEFSTRUCT top-level code
+;;;; target-only parts of the DEFSTRUCT top level code
 
 ;;; Catch attempts to mess up definitions of symbols in the CL package.
 (defun protect-cl (symbol)
@@ -213,11 +213,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 +298,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.
@@ -444,15 +444,15 @@
 	(*print-pretty*
 	 (%default-structure-pretty-print structure stream))
 	(t
-	 (%default-structure-ugly-print structure-stream))))
+	 (%default-structure-ugly-print structure stream))))
 (def!method print-object ((x structure-object) stream)
-  (default-structure-print x stream *current-level*))
+  (default-structure-print x stream *current-level-in-print*))
 
 (defun make-load-form-saving-slots (object &key slot-names environment)
   (declare (ignore object environment))
   (if slot-names
-    (error "stub: MAKE-LOAD-FORM-SAVING-SLOTS :SLOT-NAMES not implemented") ; KLUDGE
-    :just-dump-it-normally))
+      (error "stub: MAKE-LOAD-FORM-SAVING-SLOTS :SLOT-NAMES not implemented") ; KLUDGE
+      :just-dump-it-normally))
 
 ;;;; testing structure types
 
@@ -461,9 +461,11 @@
 ;;; which have a handle on the type's LAYOUT.
 ;;;
 ;;; FIXME: This is fairly big, so it should probably become
-;;; MAYBE-INLINE instead of INLINE. Or else we could fix things up so
-;;; that the things which call it are all closures, so that it's
-;;; expanded only in a small number of places.
+;;; MAYBE-INLINE instead of INLINE, or its inlineness should become
+;;; conditional (probably through DEFTRANSFORM) on (> SPEED SPACE). Or
+;;; else we could fix things up so that the things which call it are
+;;; all closures, so that it's expanded only in a small number of
+;;; places.
 #!-sb-fluid (declaim (inline typep-to-layout))
 (defun typep-to-layout (obj layout)
   (declare (type layout layout) (optimize (speed 3) (safety 0)))