From e664971e4231c9720c420fbcd4cf88a928060d13 Mon Sep 17 00:00:00 2001
From: Juan Jose Garcia Ripoll <jjgarcia@jjgr-2.local>
Date: Thu, 25 Feb 2010 21:50:32 +0100
Subject: [PATCH] Moved assert_type_readtable() to read.d and added more
 information to the error message.

---
 src/c/read.d     | 28 ++++++++++++++++++----------
 src/c/typespec.d |  7 -------
 src/h/external.h |  1 -
 3 files changed, 18 insertions(+), 18 deletions(-)

diff --git a/src/c/read.d b/src/c/read.d
index 57908134e..c0a392456 100644
--- a/src/c/read.d
+++ b/src/c/read.d
@@ -1424,6 +1424,14 @@ sharp_dollar_reader(cl_object in, cl_object c, cl_object d)
 	readtable routines
 */
 
+static void
+assert_type_readtable(cl_object function, cl_narg narg, cl_object p)
+{
+	if (type_of(p) != t_readtable)
+		FEwrong_type_nth_arg(function, narg, p, @'readtable');
+}
+
+
 cl_object
 ecl_copy_readtable(cl_object from, cl_object to)
 {
@@ -1433,7 +1441,7 @@ ecl_copy_readtable(cl_object from, cl_object to)
 	size_t total_bytes = entry_bytes * RTABSIZE;
 	cl_object output;
 
-	assert_type_readtable(from);
+	assert_type_readtable(@'copy-readtable', 1, from);
 	/* For the sake of garbage collector and thread safety we
 	 * create an incomplete object and only copy to the destination
 	 * at the end in a more or less "atomic" (meaning "fast") way.
@@ -1460,7 +1468,7 @@ ecl_copy_readtable(cl_object from, cl_object to)
 	}
 #endif
 	if (!Null(to)) {
-		assert_type_readtable(to);
+                assert_type_readtable(@'copy-readtable', 2, to);
 		to->readtable = output->readtable;
 		output = to;
 	}
@@ -1869,7 +1877,7 @@ CANNOT_PARSE:		FEparse_error("Cannot parse an integer in the string ~S.",
 cl_object
 cl_readtable_case(cl_object r)
 {
-	assert_type_readtable(r);
+        assert_type_readtable(@'readtable-case', 1, r);
 	switch (r->readtable.read_case) {
 	case ecl_case_upcase: r = @':upcase'; break;
 	case ecl_case_downcase: r = @':downcase'; break;
@@ -1891,7 +1899,7 @@ error_locked_readtable(cl_object r)
 cl_object
 si_readtable_case_set(cl_object r, cl_object mode)
 {
-	assert_type_readtable(r);
+        assert_type_readtable(@'readtable-case', 1, r);
         if (r->readtable.locked) {
                 error_locked_readtable(r);
         }
@@ -1994,8 +2002,8 @@ ecl_invalid_character_p(int c)
         }
 	if (Null(fromrdtbl))
 		fromrdtbl = cl_core.standard_readtable;
-	assert_type_readtable(fromrdtbl);
-	assert_type_readtable(tordtbl);
+        assert_type_readtable(@'readtable-case', 1, tochr);
+        assert_type_readtable(@'readtable-case', 2, fromchr);
 	fc = ecl_char_code(fromchr);
 	tc = ecl_char_code(tochr);
 
@@ -2036,7 +2044,7 @@ ecl_invalid_character_p(int c)
 	cl_object table;
 	int c;
 @
-	assert_type_readtable(readtable);
+        assert_type_readtable(@'make-dispatch-macro-character', 3, readtable);
 	c = ecl_char_code(chr);
 	cat = Null(non_terminating_p)? cat_terminating : cat_non_terminating;
 	table = cl__make_hash_table(@'eql', MAKE_FIXNUM(128),
@@ -2052,7 +2060,7 @@ ecl_invalid_character_p(int c)
 	cl_object table;
 	cl_fixnum subcode;
 @
-	assert_type_readtable(readtable);
+        assert_type_readtable(@'set-dispatch-macro-character', 4, readtable);
 	ecl_readtable_get(readtable, ecl_char_code(dspchr), &table);
         if (readtable->readtable.locked) {
                 error_locked_readtable(readtable);
@@ -2087,7 +2095,7 @@ ecl_invalid_character_p(int c)
 	if (Null(readtable)) {
 		readtable = cl_core.standard_readtable;
 	}
-	assert_type_readtable(readtable);
+        assert_type_readtable(@'get-dispatch-macro-character', 3, readtable);
 	c = ecl_char_code(dspchr);
 	ecl_readtable_get(readtable, c, &table);
 	if (type_of(table) != t_hashtable) {
@@ -2111,7 +2119,7 @@ si_standard_readtable()
 @(defun ext::readtable-lock (r &optional yesno)
 	cl_object output;
 @
-	assert_type_readtable(r);
+	assert_type_readtable(@'ext::readtable-lock', 1, r);
         output = (r->readtable.locked)? Ct : Cnil;
 	if (narg > 1) {
                 r->readtable.locked = !Null(yesno);
diff --git a/src/c/typespec.d b/src/c/typespec.d
index a28f928e1..8340ca111 100644
--- a/src/c/typespec.d
+++ b/src/c/typespec.d
@@ -231,13 +231,6 @@ assert_type_proper_list(cl_object p)
 		FEcircular_list(p);
 }
 
-void
-assert_type_readtable(cl_object p)
-{
-	if (type_of(p) != t_readtable)
-		FEwrong_type_argument(@'readtable', p);
-}
-
 void
 assert_type_hash_table(cl_object p)
 {
diff --git a/src/h/external.h b/src/h/external.h
index 46cd877fe..f853618ea 100755
--- a/src/h/external.h
+++ b/src/h/external.h
@@ -1686,7 +1686,6 @@ extern ECL_API cl_object cl_get_universal_time(void);
 
 extern ECL_API void assert_type_integer(cl_object p);
 extern ECL_API void assert_type_non_negative_integer(cl_object p);
-extern ECL_API void assert_type_readtable(cl_object p);
 extern ECL_API void assert_type_hash_table(cl_object p);
 extern ECL_API void assert_type_proper_list(cl_object p);
 extern ECL_API cl_object cl_type_of(cl_object x);