[m-rev.] diff: --num-output-args

[Fergus Henderson]

I needed this for benchmarking the hlc.gc grade...

Estimated hours taken: 1
Branches: main

runtime/mercury_wrapper.c:
	Add a new runtime option `--num-output-args', to support
	entry points with output arguments for the MLDS back-end.
	(For the LLDS back-end, no special handling is needed, since
	the output arguments are returned by value, but for the MLDS
	back-end, the output arguments are passed by reference, and so
	we need to pass the right number of pointers.)
	Note that model_non entry points are still not supported.

Workspace: /home/earth/fjh/ws-earth4/mercury
Index: runtime/mercury_wrapper.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_wrapper.c,v
retrieving revision 1.96
diff -u -d -r1.96 mercury_wrapper.c
--- runtime/mercury_wrapper.c	30 Jan 2002 05:09:03 -0000	1.96
+++ runtime/mercury_wrapper.c	5 Feb 2002 09:46:52 -0000
@@ -101,6 +101,8 @@
 static	bool	use_own_timer = FALSE;
 static	int	repeats = 1;
 
+static	int	MR_num_output_args = 0;
+
 unsigned	MR_num_threads = 1;
 
 /* timing */
@@ -735,7 +737,8 @@
 	MR_MDB_TTY,
 	MR_MDB_IN,
 	MR_MDB_OUT,
-	MR_MDB_ERR
+	MR_MDB_ERR,
+	MR_NUM_OUTPUT_ARGS
 };
 
 struct MR_option MR_long_opts[] = {
@@ -752,7 +755,8 @@
 	{ "mdb-tty", 			1, 0, MR_MDB_TTY },
 	{ "mdb-in", 			1, 0, MR_MDB_IN },
 	{ "mdb-out", 			1, 0, MR_MDB_OUT },
-	{ "mdb-err", 			1, 0, MR_MDB_ERR }
+	{ "mdb-err", 			1, 0, MR_MDB_ERR },
+	{ "num-output-args", 		1, 0, MR_NUM_OUTPUT_ARGS }
 };
 
 static void
@@ -762,7 +766,7 @@
 	int		c;
 	int		long_index;
 
-	while ((c = MR_getopt_long(argc, argv, "acC:d:D:e:i:m:o:pP:r:sStT:x",
+	while ((c = MR_getopt_long(argc, argv, "acC:d:D:e:i:m:n:o:pP:r:sStT:x",
 		MR_long_opts, &long_index)) != EOF)
 	{
 		switch (c)
@@ -860,6 +864,14 @@
 			MR_mdb_err_filename = MR_copy_string(MR_optarg);
 			break;
 
+		case 'n':
+		case MR_NUM_OUTPUT_ARGS:
+			if (sscanf(MR_optarg, "%lu", &size) != 1)
+				usage();
+
+			MR_num_output_args = size;
+			break;
+
 		case 'a':
 			benchmark_all_solns = TRUE;
 			break;
@@ -1413,8 +1425,41 @@
 	}
   #endif
 
-	/* call the Mercury predicate main/2 */
-	(*MR_program_entry_point)();
+	/* call the entry point (normally the Mercury predicate main/2) */
+	{ 
+		MR_Word outputs[4];
+		typedef void MR_CALL (*EntryPoint1)(MR_Word *);
+		typedef void MR_CALL (*EntryPoint2)(MR_Word *, MR_Word *);
+		typedef void MR_CALL (*EntryPoint3)(MR_Word *, MR_Word *,
+					MR_Word *);
+		typedef void MR_CALL (*EntryPoint4)(MR_Word *, MR_Word *,
+					MR_Word *, MR_Word *);
+		switch (MR_num_output_args) {
+			case 0:
+				(*MR_program_entry_point)();
+				break;
+			case 1:
+				(*(EntryPoint1)MR_program_entry_point)(
+					&outputs[0]);
+				break;
+			case 2:
+				(*(EntryPoint2)MR_program_entry_point)(
+					&outputs[0], &outputs[1]);
+				break;
+			case 3:
+				(*(EntryPoint3)MR_program_entry_point)(
+					&outputs[0], &outputs[1], &outputs[2]);
+				break;
+			case 4:
+				(*(EntryPoint4)MR_program_entry_point)(
+					&outputs[0], &outputs[1], &outputs[2],
+					&outputs[3]);
+				break;
+			default:
+				MR_fatal_error("sorry, not implemented: "
+					"--num-output-args > 4");
+		}
+	}
 
   #ifdef  MR_MPROF_PROFILE_TIME
 	if (MR_profiling)  {

-- 
Fergus Henderson <fjh at cs.mu.oz.au>  |  "I have always known that the pursuit
The University of Melbourne         |  of excellence is a lethal habit"
WWW: <http://www.cs.mu.oz.au/~fjh>  |     -- the last words of T. S. Garp.
--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------