PR#4390: ajout caml_raise_with_args

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@9030 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

3 files changed, 31 insertions, 0 deletions

diff --git a/asmrun/fail.c b/asmrun/fail.c
index 0bc0f4b62..a1ec0fb07 100644
--- a/asmrun/fail.c
+++ b/asmrun/fail.c
@@ -94,6 +94,21 @@ void caml_raise_with_arg(value tag, value arg)
   CAMLnoreturn;
 }
 
+void caml_raise_with_args(value tag, int nargs, value args[])
+{
+  CAMLparam1 (tag);
+  CAMLxparamN (args, nargs);
+  value bucket;
+  int i;
+
+  Assert(1 + nargs <= Max_young_wosize);
+  bucket = caml_alloc_small (1 + nargs, 0);
+  Field(bucket, 0) = tag;
+  for (i = 0; i < nargs; i++) Field(bucket, 1 + i) = args[i];
+  caml_raise(bucket);
+  CAMLnoreturn;
+}
+
 void caml_raise_with_string(value tag, char const *msg)
 {
   caml_raise_with_arg(tag, caml_copy_string(msg));
diff --git a/byterun/fail.c b/byterun/fail.c
index a36b6afb4..b1a08c611 100644
--- a/byterun/fail.c
+++ b/byterun/fail.c
@@ -60,6 +60,21 @@ CAMLexport void caml_raise_with_arg(value tag, value arg)
   CAMLnoreturn;
 }
 
+CAMLexport void caml_raise_with_args(value tag, int nargs, value args[])
+{
+  CAMLparam1 (tag);
+  CAMLxparamN (args, nargs);
+  value bucket;
+  int i;
+
+  Assert(1 + nargs <= Max_young_wosize);
+  bucket = caml_alloc_small (1 + nargs, 0);
+  Field(bucket, 0) = tag;
+  for (i = 0; i < nargs; i++) Field(bucket, 1 + i) = args[i];
+  caml_raise(bucket);
+  CAMLnoreturn;
+}
+
 CAMLexport void caml_raise_with_string(value tag, char const *msg)
 {
   CAMLparam1 (tag);
diff --git a/byterun/fail.h b/byterun/fail.h
index 5a55c57c5..f092c8115 100644
--- a/byterun/fail.h
+++ b/byterun/fail.h
@@ -60,6 +60,7 @@ extern value caml_exn_bucket;
 CAMLextern void caml_raise (value bucket) Noreturn;
 CAMLextern void caml_raise_constant (value tag) Noreturn;
 CAMLextern void caml_raise_with_arg (value tag, value arg) Noreturn;
+CAMLextern void caml_raise_with_args (value tag, int nargs, value arg[]) Noreturn;
 CAMLextern void caml_raise_with_string (value tag, char const * msg) Noreturn;
 CAMLextern void caml_failwith (char const *) Noreturn;
 CAMLextern void caml_invalid_argument (char const *) Noreturn;