diff --git a/src/CHANGELOG b/src/CHANGELOG
index 621edf394..1bfb25bf7 100644
--- a/src/CHANGELOG
+++ b/src/CHANGELOG
@@ -1264,8 +1264,8 @@ ECLS 0.9
   - The interpreter now detects syntax errors in function calls: such
     as in (setq a ("foo")).
 
-  - Functions remf() and remprop() removed. Use si_rem_f and cl_remprop
-    instead.
+  - Functions remf(), remprop() and putprop() removed. Use si_rem_f,
+    cl_remprop and cl_putprop instead.
 
 * ANSI compatibility:
 
diff --git a/src/c/assignment.d b/src/c/assignment.d
index e3404ff39..1c6b132ec 100644
--- a/src/c/assignment.d
+++ b/src/c/assignment.d
@@ -70,7 +70,7 @@ si_setf_namep(cl_object arg)
 		if (mflag)
 			FEerror("Cannot define a macro with name (SETF ~S).", 1, fun);
 		fun = CADR(fun);
-		putprop(fun, sym, @'si::setf-symbol');
+		si_putprop(fun, sym, @'si::setf-symbol');
 		cl_remprop(fun, @'si::setf-lambda');
 		cl_remprop(fun, @'si::setf-method');
 		cl_remprop(fun, @'si::setf-update');
@@ -94,8 +94,7 @@ si_setf_namep(cl_object arg)
 	}
 	fun->symbol.mflag = !Null(macro);
 	if (pprint != Cnil)
-		fun->symbol.plist
-		= putf(fun->symbol.plist, pprint, @'si::pretty-print-format');
+		si_putprop(fun, pprint, @'si::pretty-print-format');
 	@(return fun)
 @)
 
diff --git a/src/c/eval.d b/src/c/eval.d
index 1a04eaa4c..08c86e227 100644
--- a/src/c/eval.d
+++ b/src/c/eval.d
@@ -127,10 +127,10 @@ link_call(cl_object sym, cl_objectfn *pLK, int narg, cl_va_list args)
 			out = APPLY_fixed(narg, fun->cfun.entry, cl_stack_top - narg);
 		} else {
 			if (pLK) {
-				putprop(sym, CONS(CONS(make_unsigned_integer((cl_index)pLK),
-						       make_unsigned_integer((cl_index)*pLK)),
-						  getf(sym->symbol.plist, @'si::link-from', Cnil)),
-					@'si::link-from');
+				si_putprop(sym, CONS(CONS(make_unsigned_integer((cl_index)pLK),
+							  make_unsigned_integer((cl_index)*pLK)),
+						     ecl_get(sym, @'si::link-from', Cnil)),
+					   @'si::link-from');
 				*pLK = fun->cfun.entry;
 			}
 			out = APPLY(narg, fun->cfun.entry, cl_stack + sp);
@@ -165,7 +165,7 @@ si_unlink_symbol(cl_object s)
 
 	if (!SYMBOLP(s))
 		FEtype_error_symbol(s);
-	pl = getf(s->symbol.plist, @'si::link-from', Cnil);
+	pl = ecl_get(s, @'si::link-from', Cnil);
 	if (!endp(pl)) {
 		for (; !endp(pl); pl = CDR(pl))
 			*(void **)(fixnnint(CAAR(pl))) = (void *)fixnnint(CDAR(pl));
diff --git a/src/c/macros.d b/src/c/macros.d
index 28fd56b09..2e029e98c 100644
--- a/src/c/macros.d
+++ b/src/c/macros.d
@@ -32,11 +32,11 @@ search_symbol_macro(cl_object name, cl_object env)
 {
 	cl_object record = assq(name, CAR(env));
 	if (Null(record))
-	  return get(name, @'si::symbol-macro', Cnil);
+		return ecl_get(name, @'si::symbol-macro', Cnil);
 	else if (CADR(record) == @'si::symbol-macro')
-	  return CADDR(record);
+		return CADDR(record);
 	else
-	  return Cnil;
+		return Cnil;
 }
 
 cl_object
diff --git a/src/c/print.d b/src/c/print.d
index f3db7d825..9103f0648 100644
--- a/src/c/print.d
+++ b/src/c/print.d
@@ -527,9 +527,8 @@ call_structure_print_function(cl_object x, int level)
 #ifdef CLOS
 		funcall(3, @'print-object', x, PRINTstream);
 #else
-		funcall(4, getf(x->str.name->symbol.plist,
-		       @'si::structure-print-function', Cnil),
-			  x, PRINTstream, MAKE_FIXNUM(level));
+		funcall(4, ecl_get(x->str.name, @'si::structure-print-function', Cnil),
+			x, PRINTstream, MAKE_FIXNUM(level));
 #endif
 		bds_unwind_n(10);
 	} CL_UNWIND_PROTECT_EXIT {
@@ -979,8 +978,7 @@ _write_object(cl_object x, int level)
 		write_ch(SET_INDENT);
 		if (PRINTpretty && CAR(x) != OBJNULL &&
 		    type_of(CAR(x)) == t_symbol &&
-		    (r = getf(CAR(x)->symbol.plist,
-		              @'si::pretty-print-format', Cnil)) != Cnil)
+		    (r = ecl_get(CAR(x), @'si::pretty-print-format', Cnil)) != Cnil)
 			goto PRETTY_PRINT_FORMAT;
 		for (i = 0;  ;  i++) {
 			if (!PRINTreadably && PRINTlength >= 0 && i >= PRINTlength) {
@@ -1146,8 +1144,8 @@ _write_object(cl_object x, int level)
 		if (type_of(x->str.name) != t_symbol)
 			FEwrong_type_argument(@'symbol', x->str.name);
 		if (PRINTstructure ||
-		    Null(getf(x->str.name->symbol.plist,
-			      @'si::structure-print-function', Cnil))) {
+		    Null(ecl_get(x->str.name, @'si::structure-print-function', Cnil)))
+		{
 			write_str("#S");
 /* structure_to_list conses slot names and values into a list to be printed.
  * print shouldn't allocate memory - Beppe
diff --git a/src/c/structure.d b/src/c/structure.d
index 15a75d0bc..d348a3bab 100644
--- a/src/c/structure.d
+++ b/src/c/structure.d
@@ -41,7 +41,7 @@ structure_subtypep(cl_object x, cl_object y)
 			return(FALSE);
 		if (x == y)
 			return(TRUE);
-		x = get(x, @'si::structure-include', Cnil);
+		x = ecl_get(x, @'si::structure-include', Cnil);
 	} while (x != Cnil);
 	return(FALSE);
 }
@@ -62,8 +62,7 @@ structure_to_list(cl_object x)
 	cl_object *p, r, s;
 	int i, n;
 
-	s = getf(SNAME(x)->symbol.plist,
-	         @'si::structure-slot-descriptions', Cnil);
+	s = ecl_get(SNAME(x), @'si::structure-slot-descriptions', Cnil);
 	p = &CDR(r = CONS(SNAME(x), Cnil));
 	for (i=0, n=SLENGTH(x);  !endp(s) && i<n;  s=CDR(s), i++) {
 		p = &(CDR(*p = CONS(cl_car(CAR(s)), Cnil)));
diff --git a/src/c/symbol.d b/src/c/symbol.d
index f9d569571..36c7ad114 100644
--- a/src/c/symbol.d
+++ b/src/c/symbol.d
@@ -27,6 +27,8 @@ cl_object cl_token;
 static cl_object gensym_prefix;
 static cl_object gentemp_prefix;
 static cl_object gentemp_counter;
+static void FEtype_error_plist(cl_object x) __attribute__((noreturn,regparm(2)));
+
 
 cl_object
 cl_make_symbol(cl_object str)
@@ -98,23 +100,31 @@ symbol_value(cl_object s)
 	return(SYM_VAL(s));
 }
 
-cl_object
-getf(cl_object place, cl_object indicator, cl_object deflt)
+static void
+FEtype_error_plist(cl_object x)
 {
-	cl_object slow, l;
+	cl_error(9, @'simple-type-error', @':format-control',
+		 make_simple_string("Not a valid property list ~D"),
+		 @':format-arguments', cl_list(1, x),
+		 @':expected-type', @'list',
+		 @':datum', x);
+}
 
-	/* This loop guarantees finishing for circular lists */
-	slow = l = place;
-	while (CONSP(l)) {
+cl_object
+ecl_getf(cl_object place, cl_object indicator, cl_object deflt)
+{
+	cl_object l;
+
+#ifdef ECL_SAFE
+	assert_type_proper_list(place);
+#endif
+	for (l = place; CONSP(l); ) {
 		cl_object cdr_l = CDR(l);
 		if (!CONSP(cdr_l))
-			FEtype_error_plist(place);
+			break;
 		if (CAR(l) == indicator)
 			return CAR(cdr_l);
 		l = CDR(cdr_l);
-		slow = CDR(slow);
-		if (l == slow)
-			FEcircular_list(place);
 	}
 	if (l != Cnil)
 		FEtype_error_plist(place);
@@ -122,50 +132,41 @@ getf(cl_object place, cl_object indicator, cl_object deflt)
 }
 
 cl_object
-get(cl_object s, cl_object p, cl_object d)
+ecl_get(cl_object s, cl_object p, cl_object d)
 {
 	if (!SYMBOLP(s))
 		FEtype_error_symbol(s);
-	return(getf(s->symbol.plist, p, d));
+	return ecl_getf(s->symbol.plist, p, d);
 }
 
 /*
-	Putf(p, v, i) puts value v for property i to property list p
-	and returns the resulting property list.
+	(SI:PUT-F plist value indicator)
+	returns the new property list with value for property indicator.
+	It will be used in SETF for GETF.
 */
 cl_object
-putf(cl_object place, cl_object value, cl_object indicator)
+si_put_f(cl_object place, cl_object value, cl_object indicator)
 {
-	cl_object slow, l;
+	cl_object l;
 
+#ifdef ECL_SAFE
+	assert_type_proper_list(place);
+#endif
 	/* This loop guarantees finishing for circular lists */
-	slow = l = place;
-	while (CONSP(l)) {
+	for (l = place; CONSP(l); ) {
 		cl_object cdr_l = CDR(l);
 		if (!CONSP(cdr_l))
-			FEtype_error_plist(place);
+			break;
 		if (CAR(l) == indicator) {
 			CAR(cdr_l) = value;
-			return place;
+			@(return place);
 		}
 		l = CDR(cdr_l);
-		slow = CDR(slow);
-		if (l == slow)
-			FEcircular_list(place);
 	}
 	if (l != Cnil)
 		FEtype_error_plist(place);
 	place = CONS(value, place);
-	return CONS(indicator, place);
-}
-
-cl_object
-putprop(cl_object s, cl_object v, cl_object p)
-{
-	if (!SYMBOLP(s))
-		FEtype_error_symbol(s);
-	s->symbol.plist = putf(s->symbol.plist, v, p);
-	return(v);
+	@(return CONS(indicator, place));
 }
 
 /*
@@ -180,22 +181,20 @@ putprop(cl_object s, cl_object v, cl_object p)
 static bool
 remf(cl_object *place, cl_object indicator)
 {
-	cl_object *slow, *l;
+	cl_object *l;
 
-	/* This loop guarantees finishing for circular lists */
-	slow = l = place;
-	while (CONSP(*l)) {
+#ifdef ECL_SAFE
+	assert_type_proper_list(*place);
+#endif
+	for (l = place; CONSP(*l); ) {
 		cl_object cdr_l = CDR(*l);
 		if (!CONSP(cdr_l))
-			FEtype_error_plist(*place);
+			break;
 		if (CAR(*l) == indicator) {
 			*l = CDR(cdr_l);
 			return TRUE;
 		}
 		l = &CDR(cdr_l);
-		slow = &CDR(*slow);
-		if (l == slow)
-			FEcircular_list(*place);
 	}
 	if (*l != Cnil)
 		FEtype_error_plist(*place);
@@ -211,7 +210,7 @@ keywordp(cl_object s)
 @(defun get (sym indicator &optional deflt)
 @
 	assert_type_symbol(sym);
-	@(return getf(sym->symbol.plist, indicator, deflt))
+	@(return ecl_getf(sym->symbol.plist, indicator, deflt))
 @)
 
 cl_object
@@ -230,25 +229,24 @@ cl_symbol_plist(cl_object sym)
 
 @(defun getf (place indicator &optional deflt)
 @
-	@(return getf(place, indicator, deflt))
+	@(return ecl_getf(place, indicator, deflt))
 @)
 
 cl_object
 cl_get_properties(cl_object place, cl_object indicator_list)
 {
-	cl_object slow, cdr_l, l;
+	cl_object l;
 
-	/* This loop guarantees finishing for circular lists */
-	for (slow = l = place;  CONSP(l); ) {
-		cdr_l = CDR(l);
+#ifdef ECL_SAFE
+	assert_type_proper_list(place);
+#endif
+	for (l = place;  CONSP(l); ) {
+		cl_object cdr_l = CDR(l);
 		if (!CONSP(cdr_l))
-			FEtype_error_plist(place);
+			break;
 		if (member_eq(CAR(l), indicator_list))
 			@(return CAR(l) CADR(l) l)
 		l = CDR(cdr_l);
-		slow = CDR(slow);
-		if (l == slow)
-			FEcircular_list(place);
 	}
 	if (l != Cnil)
 		FEtype_error_plist(place);
@@ -339,17 +337,6 @@ cl_keywordp(cl_object sym)
 	@(return ((SYMBOLP(sym) && keywordp(sym))? Ct: Cnil))
 }
 
-/*
-	(SI:PUT-F plist value indicator)
-	returns the new property list with value for property indicator.
-	It will be used in SETF for GETF.
-*/
-cl_object
-si_put_f(cl_object plist, cl_object value, cl_object indicator)
-{
-	@(return putf(plist, value, indicator))
-}
-
 /*
 	(SI:REM-F plist indicator) returns two values:
 
@@ -380,18 +367,17 @@ cl_object
 si_putprop(cl_object sym, cl_object value, cl_object indicator)
 {
 	assert_type_symbol(sym);
-	sym->symbol.plist = putf(sym->symbol.plist, value, indicator);
+	sym->symbol.plist = si_put_f(sym->symbol.plist, value, indicator);
 	@(return value)
 }
 
 /* Added for defstruct. Beppe */
 @(defun si::put_properties (sym &rest ind_values)
-	cl_object prop;
 @
 	while (--narg >= 2) {
-	  prop = cl_va_arg(ind_values);
-	  putprop(sym, cl_va_arg(ind_values), prop);
-	  narg--;
+		cl_object prop = cl_va_arg(ind_values);
+		si_putprop(sym, cl_va_arg(ind_values), prop);
+		narg--;
 	}
 	@(return sym)
 @)
diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h
index f4fa65ec0..d48d2efbf 100644
--- a/src/c/symbols_list.h
+++ b/src/c/symbols_list.h
@@ -630,6 +630,7 @@ cl_symbols[] = {
 {"PRINC-TO-STRING", CL_ORDINARY, NULL, -1},
 {"PRINT", CL_ORDINARY, cl_print, -1},
 {"PRINT-NOT-READABLE", CL_ORDINARY, NULL, -1},
+{"PRINT-NOT-READABLE-OBJECT", CL_ORDINARY, NULL, -1},
 {"PROBE-FILE", CL_ORDINARY, cl_probe_file, 1},
 {"PROCLAIM", CL_ORDINARY, NULL, -1},
 {"PROG", FORM_ORDINARY, NULL, -1},
diff --git a/src/c/typespec.d b/src/c/typespec.d
index ce2dd9c94..1b515da94 100644
--- a/src/c/typespec.d
+++ b/src/c/typespec.d
@@ -77,16 +77,6 @@ FEtype_error_alist(cl_object x)
 		    @':datum', x);
 }
 
-void
-FEtype_error_plist(cl_object x)
-{
-	cl_error(9, @'simple-type-error', @':format-control',
-		    make_simple_string("Not a valid property list ~D"),
-		    @':format-arguments', cl_list(1, x),
-		    @':expected-type', @'list',
-		    @':datum', x);
-}
-
 void
 FEcircular_list(cl_object x)
 {
diff --git a/src/clos/conditions.lsp b/src/clos/conditions.lsp
index f6dd65d46..d074e1b28 100644
--- a/src/clos/conditions.lsp
+++ b/src/clos/conditions.lsp
@@ -352,72 +352,6 @@ strings."
 |#
 
 
-(defun assert-report (names stream)
-  (format stream "Retry assertion")
-  (if names
-      (format stream " with new value~P for ~{~S~^, ~}."
-	      (length names) names)
-      (format stream ".")))
-
-(defun assert-prompt (name value)
-  (cond ((y-or-n-p "The old value of ~S is ~S.~
-		  ~%Do you want to supply a new value? "
-		   name value)
-	 (format *query-io* "~&type a form to be evaluated:~%")
-	 (flet ((read-it () (eval (read *query-io*))))
-	   (if (symbolp name) ;Help user debug lexical variables
-	       (progv (list name) (list value) (read-it))
-	       (read-it))))
-	(t value)))
-
-(defun simple-assertion-failure (assertion)
-  (error 'SIMPLE-TYPE-ERROR
-	 :DATUM assertion
-	 :EXPECTED-TYPE nil		; This needs some work in next revision. -kmp
-	 :FORMAT-CONTROL "The assertion ~S failed."
-	 :FORMAT-ARGUMENTS (list assertion)))
-
-(defmacro assert (test-form &optional places datum &rest arguments)
-  (let ((tag (gensym)))
-    `(tagbody ,tag
-       (unless ,test-form
-	 (restart-case ,(if datum
-			    `(error ,datum ,@arguments)
-			    `(simple-assertion-failure ',test-form))
-	   (continue ()
-	       :REPORT (lambda (stream) (assert-report ',places stream))
-	     ,@(mapcar #'(lambda (place)
-			   `(setf ,place (assert-prompt ',place ,place)))
-		       places)
-             (go ,tag)))))))
-
-
-
-(defun read-evaluated-form ()
-  (format *query-io* "~&Type a form to be evaluated:~%")
-  (list (eval (read *query-io*))))
-
-(defmacro check-type (place type &optional type-string)
-  (let* ((tag1 (gensym))
-	 (tag2 (gensym)))
-    `(block ,tag1
-       (tagbody ,tag2
-	 (if (typep ,place ',type) (return-from ,tag1 nil))
-	 (restart-case ,(if type-string
-			    `(error "The value of ~S is ~S, ~
-				     which is not ~A."
-				    ',place ,place ,type-string)
-			    `(error "The value of ~S is ~S, ~
-				     which is not of type ~S."
-				    ',place ,place ',type))
-	   (store-value (value)
-	       :REPORT (lambda (stream)
-			 (format stream "Supply a new value of ~S."
-				 ',place))
-	       :INTERACTIVE read-evaluated-form
-	     (setf ,place value)
-	     (go ,tag2)))))))
-
 (defvar *handler-clusters* nil)
 
 (defmacro handler-bind (bindings &body forms)
@@ -604,9 +538,9 @@ returns with NIL."
 
 (define-condition print-not-readable (error)
   ((object :INITARG :OBJECT :READER print-not-readable-object))
-  (:REPORT (lambda (c s)
-		   (format s "Cannot print object ~A readably."
-			   (print-not-readable-object c)))))
+  (:REPORT (lambda (condition stream)
+	     (format stream "Cannot print object ~A readably."
+		     (print-not-readable-object condition)))))
 
 #+nil
 (defun simple-condition-class-p (type)
diff --git a/src/cmp/cmplam.lsp b/src/cmp/cmplam.lsp
index 8f2c8075e..8bfd90eb1 100644
--- a/src/cmp/cmplam.lsp
+++ b/src/cmp/cmplam.lsp
@@ -747,7 +747,7 @@
 		      (loc1 `(LCL ,lcl1)))
 		 (wt-nl "{cl_object " loc1 ";")
 		 (dolist (kwd keywords)
-		   (wt-nl loc1 "=getf(") (wt-lcl lcl)
+		   (wt-nl loc1 "=ecl_getf(") (wt-lcl lcl)
 		   (wt "," (add-symbol (car kwd)) ",OBJNULL);")
 		   (wt-nl "if(" loc1 "==OBJNULL){")
 		   (let ((*env* *env*)
diff --git a/src/cmp/cmptop.lsp b/src/cmp/cmptop.lsp
index 839281419..cbfc346eb 100644
--- a/src/cmp/cmptop.lsp
+++ b/src/cmp/cmptop.lsp
@@ -583,7 +583,7 @@
   (declare (ignore macro-lambda sp))
   (when (< *space* 3)
     (when ppn
-      (wt-nl "(void)putprop(" vv "," ppn "," (add-symbol 'si::pretty-print-format) ");")
+      (wt-nl "si_putprop(" vv "," ppn "," (add-symbol 'si::pretty-print-format) ");")
       (wt-nl)))
   (wt-h "static cl_object L" cfun "();")
   (wt-nl "cl_def_c_macro_va(" vv ",(cl_objectfn)L" cfun ");"))
diff --git a/src/cmp/sysfun.lsp b/src/cmp/sysfun.lsp
index 8cff6dae8..333d1431e 100644
--- a/src/cmp/sysfun.lsp
+++ b/src/cmp/sysfun.lsp
@@ -953,10 +953,8 @@ type_of(#0)==t_bitvector"))
 
 ; file symbol.d
 (GET (symbol t *) T nil nil
-	:inline-always ((t t t) t nil nil "get(#0,#1,#2)")
-	:inline-always ((t t) t nil nil "get(#0,#1,Cnil)")
-	:inline-unsafe ((t t t) t nil nil "getf((#0)->symbol.plist,#1,#2)")
-	:inline-unsafe ((t t) t nil nil "getf((#0)->symbol.plist,#1,Cnil)"))
+	:inline-always ((t t t) t nil nil "ecl_get(#0,#1,#2)")
+	:inline-always ((t t) t nil nil "ecl_get(#0,#1,Cnil)"))
 (REMPROP (symbol t) T nil nil)
 (SYMBOL-PLIST (symbol) T nil T
 	:inline-always ((t) t nil nil "((#0)->symbol.plist)"))
@@ -978,8 +976,7 @@ type_of(#0)==t_bitvector"))
 (SI::PUT-F NIL (T T))
 (SI::REM-F NIL (T T))
 (si::SET-SYMBOL-PLIST (symbol t) T)
-(SI::PUTPROP (T T T) T NIL NIL
-	:inline-always ((t t t) t t nil "putprop(#0,#1,#2)"))
+(SI::PUTPROP (T T T) T NIL NIL)
 
 ; file tcp.c
 (si::OPEN-TCP-STREAM (T T) T)
diff --git a/src/h/external.h b/src/h/external.h
index 0ef5b5297..9448f9139 100644
--- a/src/h/external.h
+++ b/src/h/external.h
@@ -1188,12 +1188,9 @@ extern void cl_defparameter(cl_object s, cl_object v);
 extern cl_object make_symbol(cl_object st);
 extern cl_object make_keyword(const char *s);
 extern cl_object symbol_value(cl_object s);
-extern cl_object getf(cl_object place, cl_object indicator, cl_object deflt);
-extern cl_object get(cl_object s, cl_object p, cl_object d);
-extern cl_object putf(cl_object p, cl_object v, cl_object i);
-extern cl_object putprop(cl_object s, cl_object v, cl_object p);
+extern cl_object ecl_getf(cl_object place, cl_object indicator, cl_object deflt);
+extern cl_object ecl_get(cl_object s, cl_object p, cl_object d);
 extern bool keywordp(cl_object s);
-extern cl_object symbol_name(cl_object x);
 extern void init_symbol(void);
 
 
@@ -1301,7 +1298,6 @@ extern void FEtype_error_float(cl_object x) __attribute__((noreturn,regparm(2)))
 extern void FEtype_error_integer(cl_object x) __attribute__((noreturn,regparm(1)));
 extern void FEtype_error_list(cl_object x) __attribute__((noreturn,regparm(2)));
 extern void FEtype_error_proper_list(cl_object x) __attribute__((noreturn,regparm(2)));
-extern void FEtype_error_plist(cl_object x) __attribute__((noreturn,regparm(2)));
 extern void FEtype_error_alist(cl_object x) __attribute__((noreturn,regparm(2)));
 extern void FEtype_error_stream(cl_object x) __attribute__((noreturn,regparm(2)));
 extern void FEcircular_list(cl_object x) __attribute__((noreturn,regparm(2)));
diff --git a/src/lsp/assert.lsp b/src/lsp/assert.lsp
index bddd110f3..2319dfc79 100644
--- a/src/lsp/assert.lsp
+++ b/src/lsp/assert.lsp
@@ -10,54 +10,80 @@
 
 (in-package "SYSTEM")
 
-(defmacro check-type (place typespec &optional (string nil s))
+(defun read-evaluated-form ()
+  (format *query-io* "~&Type a form to be evaluated:~%")
+  (list (eval (read *query-io*))))
+
+(defmacro check-type (place type &optional type-string)
   "Args: (check-type place typespec [string-form])
 Signals a continuable error, if the value of PLACE is not of the specified
 type.  Before continuing, receives a new value of PLACE from the user and
 checks the type again.  Repeats this process until the value of PLACE becomes
 of the specified type.  STRING-FORM, if given, is evaluated only once and the
 value is used to indicate the expected type in the error message."
-  `(do ((*print-level* 4)
-        (*print-length* 4))
-       ((typep ,place ',typespec) nil)
-       (cerror ""
-               "The value of ~:@(~S~), ~:@(~S~), is not ~A."
-               ',place ,place
-               ,(if s string `',typespec))
-       (setf ,place (si::ask-for-form2 ',place))))
+  (let* ((tag1 (gensym))
+	 (tag2 (gensym)))
+    `(block ,tag1
+       (tagbody ,tag2
+	 (if (typep ,place ',type) (return-from ,tag1 nil))
+	 (restart-case ,(if type-string
+			    `(error "The value of ~S is ~S, ~
+				     which is not ~A."
+				    ',place ,place ,type-string)
+			    `(error "The value of ~S is ~S, ~
+				     which is not of type ~S."
+				    ',place ,place ',type))
+	   (store-value (value)
+	       :REPORT (lambda (stream)
+			 (format stream "Supply a new value of ~S."
+				 ',place))
+	       :INTERACTIVE read-evaluated-form
+	     (setf ,place value)
+	     (go ,tag2)))))))
 
+(defun assert-report (names stream)
+  (format stream "Retry assertion")
+  (if names
+      (format stream " with new value~P for ~{~S~^, ~}."
+	      (length names) names)
+      (format stream ".")))
 
-(defmacro assert (test-form &optional places string &rest args)
+(defun assert-prompt (name value)
+  (cond ((y-or-n-p "The old value of ~S is ~S.~
+		  ~%Do you want to supply a new value? "
+		   name value)
+	 (format *query-io* "~&type a form to be evaluated:~%")
+	 (flet ((read-it () (eval (read *query-io*))))
+	   (if (symbolp name) ;Help user debug lexical variables
+	       (progv (list name) (list value) (read-it))
+	       (read-it))))
+	(t value)))
+
+(defun simple-assertion-failure (assertion)
+  (error 'SIMPLE-TYPE-ERROR
+	 :DATUM assertion
+	 :EXPECTED-TYPE nil		; This needs some work in next revision. -kmp
+	 :FORMAT-CONTROL "The assertion ~S failed."
+	 :FORMAT-ARGUMENTS (list assertion)))
+
+(defmacro assert (test-form &optional places datum &rest arguments)
   "Args: (assert form [({place}*) [string {arg}*]])
 Evaluates FORM and signals a continuable error if the value is NIL.  Before
 continuing, receives new values of PLACEs from user.  Repeats this process
 until FORM returns a non-NIL value.  Returns NIL.  STRING is the format string
 for the error message and ARGs are arguments to the format string."
-  `(do ((*print-level* 4)
-        (*print-length* 4))
-       (,test-form nil)
-       ,(if string
-            `(cerror "" ,string ,@args)
-            `(cerror "" "The assertion ~:@(~S~) is failed." ',test-form))
-       ,@(mapcar #'ask-for-form places)
-       (format *error-output* "Now continuing ...~%")))
-
-
-(defun ask-for-form (place)
-  (declare (si::c-local))
-  `(progn (format  *error-output*
-                   "Please input the new value for the place ~:@(~S~): "
-                   ',place)
-          (finish-output *error-output*)
-          (setf ,place (read))))
-
-(defun ask-for-form2 (place)
-  (format  *error-output*
-	   "Please input the new value for the place ~:@(~S~): "
-	   place)
-  (finish-output *error-output*)
-  (prog1 (read)
-    (format *error-output* "Now continuing ...~%")))
+  (let ((tag (gensym)))
+    `(tagbody ,tag
+       (unless ,test-form
+	 (restart-case ,(if datum
+			    `(error ,datum ,@arguments)
+			    `(simple-assertion-failure ',test-form))
+	   (continue ()
+	       :REPORT (lambda (stream) (assert-report ',places stream))
+	     ,@(mapcar #'(lambda (place)
+			   `(setf ,place (assert-prompt ',place ,place)))
+		       places)
+             (go ,tag)))))))
 
 (defun accumulate-cases (macro-name cases list-is-atom-p)
   (do ((c cases (cdr c))