Index: /trunk/ccl/level-1/l1-clos-boot.lisp
===================================================================
--- /trunk/ccl/level-1/l1-clos-boot.lisp	(revision 241)
+++ /trunk/ccl/level-1/l1-clos-boot.lisp	(revision 242)
@@ -2235,5 +2235,8 @@
     (unless (or (eq new (%slot-unbound-marker))
 		(funcall type-predicate new))
-      (setq new (require-type new type)))
+      (error 'bad-slot-type
+	     :instance (slot-vector.instance slot-vector)
+	     :datum new :expected-type type
+	     :slot-definition slotd))
     (typecase loc
       (fixnum
Index: /trunk/ccl/level-1/l1-clos.lisp
===================================================================
--- /trunk/ccl/level-1/l1-clos.lisp	(revision 241)
+++ /trunk/ccl/level-1/l1-clos.lisp	(revision 242)
@@ -74,5 +74,10 @@
 	    (progn
 	      (unless (funcall (standard-effective-slot-definition.type-predicate slotd) new-value)
-		(report-bad-arg new-value (%slot-definition-type slotd)))
+		(error 'bad-slot-type-from-initarg
+		       :slot-definition slotd
+		       :instance instance
+		       :datum new-value
+		       :expected-type  (%slot-definition-type slotd)
+		       :initarg-name (car foundp)))
 	      (if (consp loc)
 		(rplacd loc new-value)
@@ -92,5 +97,9 @@
                       (let* ((newval (funcall initfunction)))
 			(unless (funcall (standard-effective-slot-definition.type-predicate slotd) newval)
-			  (report-bad-arg newval (%slot-definition-type slotd)))
+			  (error 'bad-slot-type-from-initform
+				 :slot-definition slotd
+				 :expected-type (%slot-definition-type slotd)
+				 :datum newval
+				 :instance instance))
                         (if (consp loc)
                           (rplacd loc newval)