From 509166541b84cb3518c08058a4f36f1c56393dbe Mon Sep 17 00:00:00 2001
From: Juan Jose Garcia Ripoll <jjgarcia@surfer-30-1-137.surfnet.iacbox>
Date: Sat, 4 Jul 2009 17:17:23 +0200
Subject: [PATCH] New error functions that will be used in compiled code

---
 src/c/array.d    | 23 +++++++++++++++++++++++
 src/h/external.h |  2 ++
 2 files changed, 25 insertions(+)

diff --git a/src/c/array.d b/src/c/array.d
index e82c903e1..98e3b49db 100644
--- a/src/c/array.d
+++ b/src/c/array.d
@@ -94,6 +94,29 @@ out_of_bounds_error(cl_index ndx, cl_object x)
         FEwrong_type_argument(ecl_make_integer(ndx), type);
 }
 
+void
+FEwrong_dimensions(cl_object a, cl_index rank)
+{
+        cl_object list = cl_make_list(rank, @':initial-element', @'*');
+        cl_object type = cl_list(3, @'array', @'*', list);
+        FEwrong_type_argument(type, a);
+}
+
+void
+FEwrong_index(cl_object a, cl_index ndx, cl_index upper)
+{
+        const char *message =
+                "~D is not a valid index into object ~A.~%"
+                "It should be non-negative and < ~D.";
+	cl_object type = cl_list(3, @'integer', MAKE_FIXNUM(0),
+                                 ecl_make_integer(upper));
+        cl_error(5, @'simple-type-error',
+                 @':format-control',
+                 make_constant_base_string(message),
+                 @':format-arguments',
+                 cl_list(3, ecl_make_integer(ndx), a, ecl_make_integer(upper)));
+}
+
 cl_index
 ecl_to_index(cl_object n)
 {
diff --git a/src/h/external.h b/src/h/external.h
index 7adcb6da2..a54b3c18d 100644
--- a/src/h/external.h
+++ b/src/h/external.h
@@ -315,6 +315,8 @@ extern ECL_API cl_object si_aset _ARGS((cl_narg narg, cl_object v, cl_object x,
 extern ECL_API cl_object si_make_pure_array(cl_object etype, cl_object dims, cl_object adj, cl_object fillp, cl_object displ, cl_object disploff);
 extern ECL_API cl_object si_fill_array_with_elt(cl_object array, cl_object elt, cl_object start, cl_object end);
 
+extern ECL_API void FEwrong_dimensions(cl_object a, cl_index rank);
+extern ECL_API void FEwrong_index(cl_object a, cl_index ndx, cl_index upper);
 extern ECL_API cl_index ecl_to_index(cl_object n);
 extern ECL_API cl_object ecl_aref_unsafe(cl_object x, cl_index index);
 extern ECL_API cl_object ecl_aset_unsafe(cl_object x, cl_index index, cl_object value);