[m-dev.] For review: implementation of collect for Opium-M

Erwan Jahier Erwan.Jahier at irisa.fr
Tue Nov 2 21:45:28 AEDT 1999


| On 01-Nov-1999, Erwan Jahier <Erwan.Jahier at irisa.fr> wrote:
| > This change implements the `collect/2' command for opium-M. `collect/2'
| > collects runtime information from Mercury program executions. It is intended to
| > let users easily implement their own monitors with acceptable performances. It
| > looks like the `fold/4' meta-predicate, except:
| > 
| >    (1)	It operates on-the fly on a sequence of events rather than on a
| > 	list.
| >    (2)	The accumulator is initialized and updated via Mercury predicates 
| > 	whose implementation is in a file pass down as the first argument 
| > 	of `collect/2'.
| 
| s/pass/passed/

Ok.

| (Another difference with foldl/4 is that it stops when the filter returns `no'.
| In fact it's a bit more like `std_util__do_while', the only difference is that
| it operators on a sequence of debugger events rather than a sequence of solutions.

But I am not sure that std_util__do_while is as famous as fold/4. Is it?
If it is not the case, I prefer to explain the collect in terms of fold/4.

| Or is that going to be committed as a separate change?)

Yes. I intended to commit that as a separate change.

| > browser/collect_lib.m:
| > 	New module that defines link_collect/7 that is used during a `collect' 
| > 	request: it performs the dynamic linking between collect.so and the
| > 	current execution.
| > 
| > 	Also defines ML_display_close_result() which display the result of
| > 	ML_DL__close() function.
| 
| s/ML_DL__close/ML_DL_close/

I do not use this function anymore; I explain why below.
 
| > browser/debugger_interface.m:
| ...
| > 	Define a new function get_collecting_variable_type/2 that retrieves
| > 	the type of a variable. This type is needed in MR_trace_event_external()
| > 	to be able to call MR_make_permanent() on MR_collecting_variable; we
| > 	need to do that to ensure that the memory allocated for it won't be 
| > 	deallocated on backtracking.
| 
| I think that function should not be needed anymore.

Why? I introduced it in my last change to be able to use MR_make_permanent()!
Do you mean ML_DI_link_collect() should link with the collecting variable type 
rather than a function that is able to retrieve its type?

| > browser/dl.m:
| > 	Move the type definition of the type `handle' to be able to use it in
| > 	the collect_lib module.
| 
| Is that still needed?
| Now that you're calling dl__close, rather than calling dlclose() directly,
| I think you should not need to export that type.

Ok. I've undone that move.
 
| > trace/mercury_trace_external.c:
| > 	Add support to handle the requests `link_collect', `collect' and 
| > 	`current_grade'.
| > 
| > 	Replace the global variable `searching' that was equal to TRUE when 
| > 	searching for a forward matching event and FALSE when reading a request, 
| > 	by a enum that is equal to `searching' when searching for a forward 
| > 	matching event, `reading_request' when reading a request and `collecting'
| > 	when processing a `collect' request.
| 
| You should add `MR_' prefixes here in the log message.

Ok.

| > +++ collect_lib.m	Tue Nov  2 04:14:40 1999
| ...
| > +%	To use it, users just need to define 4 things in a file, using the
| > +%	Mercury syntax:
| > +%		1) a `collected_type' which is the type of the collecting 
| > +%		   variable that will contain the result of the monitoring
| > +%		   activity.
| > +%		2) The predicate initialize/1 which initializes this 
| > +%		   collecting variable. initialize/1 should have the
| > +%		   following declarations:
| > +%			:- pred initialize(collected_type).
| > +%			:- mode initialize(out) is det.
| > +%		3) the predicate filter/3 which updates this collecting 
| > +%		   variable at each execution event. filter/3 should have the 
| > +%		   following declarations:
| > +%			:- pred filter(event, collected_type, collected_type).
| > +%			:- mode filter(in, di, uo) is det.
| > +%		4) and eventually the mode definition of the second and the 
| > +%		   third arguments of filter/3: `acc_in' and `acc_out'. Those
| > +%		   mode have `di' and `uo' respectively as default values.
| > +%
| > +% 	Then, this file is used to generate the Mercury module `collect.m',
| > +% 	which is compiled and dynamically linked with the current execution.
| > +% 	When a `collect' request is made from the external debugger, a variable
| > +% 	of type collected_type is first initialized (with initialize/1) and
| > +% 	then updated (with filter/3) for all the events of the remaining
| > +% 	execution. When the end of the execution is reached, the last value of
| > +% 	the collecting variable is send to the debugger.
| 
| The documentation here will need to be modified for the extra bool argument.

It is done in the parallel thread called "Add an bool argument to filter" that 
I will commit as a separate change.

| > +:- module collect_lib.
| ...
| > +% We need Handle to be able to close the shared object (dlclose) later on.
| > +% When the link failed, we output NULL pointers instead of maybe pointers
| > +% for performance reasons; indeed, filter will be called at every events
| 
| s/events/event/

Ok.

| > Index: browser/debugger_interface.m
| ...
| > +	% responses to collect
| > +	%;	collected(collected_type)
| 
| I think you should have a comment here explaining why that is commented out.
| 
| > +:- pragma export(close(in, out, di, uo), "ML_DL__close").
| 
| s/DL__close/DL_close/

In fact, I redefined my own close (close_collect). One of the reasons to do 
that is because link_collect now returns a dl__result(handle) rather than 
an handle. This was to turn around the need of the implementation of the type 
handle; it also makes the code simpler I found.
 
| > +/*
| > +** Variable generated during the dynamic linking that is needed to close
| > +** this linking properly.
| > +*/
| > +
| > +static	Word	*handle = NULL;
| 
| I think `collect_lib_handle' would be a better name for that variable.

Ok.
But it is now `collect_lib_maybe_handle'

| Why is this declared to have type `Word *' rather than `Word'?
| Why is it initialized to NULL?

It is a bug; I should have changed that when I have replaced the use of dlclose() by 
dl__close.
 
| > +	Word	*close_result;
| > +
| > +	switch(external_debugger_mode) {
| > +		case MR_searching:
| > +			MR_send_message_to_socket("forward_move_match_not_found");
| > +			break;
| > +
| > +		case MR_collecting:
| > +			(*send_collect_result_ptr)(
| > +				(Word) MR_collecting_variable, 
| 
| That cast to (Word) should not be needed.

Removed.

| > +				(Word) &MR_debugger_socket_out);
| > +			#if defined(HAVE_DLFCN_H) && defined(HAVE_DLCLOSE)
| > +		       	ML_DL__close((Word) handle, 
| > +		       		(Word *) &close_result);
| > +		       	ML_display_close_result((Word) close_result);
| > +			#endif
| > +			break;
| 
| s/DL__close/DL_close/
| 
| Declare `close_result' to have type `Word', rather than `Word *',
| and then those last two casts won't be needed.

Ok.

| The `(Word) handle' cast also looks a bit odd.
| Why is handle declared to have type `Word *' rather than `Word'?

Because I used to use handle as a c_pointer (the one inside
`handle(c_pointer)') which is the same bug as the one above.

| Don't those calls need to be inside MR_TRACE_CALL_MERCURY()?

Yes.

| >  Code *
| >  MR_trace_event_external(MR_Trace_Cmd_Info *cmd, MR_Event_Info *event_info)
| >  {
| > -	static bool	searching = FALSE;
| >  	static Word	search_data;
| > +	static void	(*initialize_ptr)(Word *) = NULL;
| > +	static void    	(*filter_ptr)(Integer, Integer, Integer, MR_Trace_Port,
| > +				MR_PredFunc, String, String, String, Integer,
| > +				Integer, Integer, String, Word, Word *) = NULL;
| 
| Why are these pointers initialized to NULL?

It was a paranoid initialization.
Removed.

| The argument types here need to be Word rather than MR_*,
| as discussed in my previous review.

Oops. I have missed an occurrence on that one. Sorry.

| > +			case MR_REQUEST_LINK_COLLECT:
| > +			  {
| > +			        Char	result;
| > +				Word	MR_collecting_variable_type;
| > +
| > +				if (MR_debug_socket) {
| > +					fprintf(stderr, "\nMercury runtime: "
| > +						"REQUEST_LINK_COLLECT\n");
| > +				}
| > +				MR_get_object_file_name(debugger_request,
| > +					    &MR_object_file_name);
| > +				MR_TRACE_CALL_MERCURY(
| > +					ML_DI_link_collect(
| > +			       		    MR_object_file_name,
| > +					    (void *) &filter_ptr,
| > +					    (void *) &initialize_ptr,
| > +					    (void *) &send_collect_result_ptr,
| > +					    (void *) &get_collect_var_type_ptr,
| 
| Those should be cast to (Word *) rather than (void *).

Ok.

| > +					    (Word *) &handle,
| That cast should be unnecessary; instead you should change the
| type of `handle'.

Ok.

| 
| collect.in:
| 
| > :- type declarated_module_name == string.
| 
| s/declarated/declared/

Ok.

| I'd like to see another diff for this -- preferably in both
| relative diff and full diff forms.

%------------------------------------------------------------------------------%
%------------------------------------------------------------------------------%
%------------------------------------------------------------------------------%
Here is both the relative and the full diff:

%------------------------------------------------------------------------------%
The relative diff:

Index: 0.6/debugger_interface.m
--- 0.6/debugger_interface.m Tue, 02 Nov 1999 08:31:18 +0100 jahier (collect/1_debugger_i 1.4 640)
+++ 0.6(w)/debugger_interface.m Tue, 02 Nov 1999 11:13:01 +0100 jahier (collect/1_debugger_i 1.4 640)
@@ -283,6 +283,9 @@
 	;	grade(string)
 	% responses to collect
 	%;	collected(collected_type)
+		% It is commented because collected_type is unknow at compile 
+		% time since it is defined by by users in the dynamically 
+		% linked collect module.
 	.
 
 
Index: 0.6/dl.m
--- 0.6/dl.m Tue, 02 Nov 1999 08:31:18 +0100 jahier (collect/2_dl.m 1.3 640)
+++ 0.6(w)/dl.m Tue, 02 Nov 1999 10:22:16 +0100 jahier (collect/2_dl.m 1.3 640)
@@ -24,7 +24,6 @@
 :- type handle.
 :- type result(T) ---> ok(T) ; error(string).
 :- type result ---> ok ; error(string).
-:- type handle ---> handle(c_pointer).
 
 % interface to the C function dlopen()
 :- pred dl__open(string::in, (mode)::in, scope::in, dl__result(handle)::out,
@@ -64,6 +63,8 @@
 #endif
 ").
 
+:- type handle ---> handle(c_pointer).
+
 :- pred is_null(c_pointer::in) is semidet.
 :- pragma c_code(is_null(Pointer::in),
 		[will_not_call_mercury, thread_safe],
@@ -227,7 +228,6 @@
 	make_aligned_string_copy(ErrorMsg, msg);
 }").
 
-:- pragma export(close(in, out, di, uo), "ML_DL__close").
 close(handle(Handle), Result) -->
 	dlclose(Handle), 
 	dlerror(ErrorMsg),
Index: 0.6/mercury_trace_external.c
--- 0.6/mercury_trace_external.c Tue, 02 Nov 1999 08:31:18 +0100 jahier (collect/3_mercury_tr 1.5 640)
+++ 0.6(w)/mercury_trace_external.c Tue, 02 Nov 1999 11:13:36 +0100 jahier (collect/3_mercury_tr 1.5 640)
@@ -131,7 +131,7 @@
 ** this linking properly.
 */
 
-static	Word	*handle = NULL;
+static	Word	collect_lib_maybe_handle;
 
 /*
 ** Use a GNU C extension to enforce static type checking
@@ -439,12 +439,11 @@
 
 		case MR_collecting:
 			(*send_collect_result_ptr)(
-				(Word) MR_collecting_variable, 
+				MR_collecting_variable, 
 				(Word) &MR_debugger_socket_out);
 			#if defined(HAVE_DLFCN_H) && defined(HAVE_DLCLOSE)
-		       	ML_DL__close((Word) handle, 
-		       		(Word *) &close_result);
-		       	ML_display_close_result((Word) close_result);
+		       	MR_TRACE_CALL_MERCURY(
+				ML_CL_close_collect(collect_lib_maybe_handle));
 			#endif
 			break;
 
@@ -464,10 +463,10 @@
 MR_trace_event_external(MR_Trace_Cmd_Info *cmd, MR_Event_Info *event_info)
 {
 	static Word	search_data;
-	static void	(*initialize_ptr)(Word *) = NULL;
-	static void    	(*filter_ptr)(Integer, Integer, Integer, MR_Trace_Port,
-				MR_PredFunc, String, String, String, Integer,
-				Integer, Integer, String, Word, Word *) = NULL;
+	static void	(*initialize_ptr)(Word *);
+	static void    	(*filter_ptr)(Integer, Integer, Integer, Word,
+				Word, String, String, String, Integer,
+				Integer, Integer, String, Word, Word *);
 	static void	(*get_collect_var_type_ptr)(Word *);
 	static bool    	collect_linked = FALSE;
 	Integer		debugger_request_type;
@@ -771,16 +770,16 @@
 				MR_get_object_file_name(debugger_request,
 					    &MR_object_file_name);
 				MR_TRACE_CALL_MERCURY(
-					ML_DI_link_collect(
+					ML_CL_link_collect(
 			       		    MR_object_file_name,
-					    (void *) &filter_ptr,
-					    (void *) &initialize_ptr,
-					    (void *) &send_collect_result_ptr,
-					    (void *) &get_collect_var_type_ptr,
-					    (Word *) &handle,
+					    (Word *) &filter_ptr,
+					    (Word *) &initialize_ptr,
+					    (Word *) &send_collect_result_ptr,
+					    (Word *) &get_collect_var_type_ptr,
+					    &collect_lib_maybe_handle,
 					    &result
 					    ));
-				collect_linked = (result =  'y');
+				collect_linked = (result = 'y');
 				if (collect_linked) {
 					MR_send_message_to_socket(
 						"link_collect_succeeded");
Index: 0.6/logmsg
--- 0.6/logmsg Tue, 02 Nov 1999 08:31:18 +0100 jahier (collect/4_logmsg 1.2 640)
+++ 0.6(w)/logmsg Tue, 02 Nov 1999 10:53:21 +0100 jahier (collect/4_logmsg 1.2 640)
@@ -10,7 +10,7 @@
    (1)	It operates on-the fly on a sequence of events rather than on a
 	list.
    (2)	The accumulator is initialized and updated via Mercury predicates 
-	whose implementation is in a file pass down as the first argument 
+	whose implementation is in a file passed down as the first argument 
 	of `collect/2'.
 
 
@@ -19,14 +19,13 @@
 	request: it performs the dynamic linking between collect.so and the
 	current execution.
 
- 	Also defines ML_display_close_result() which display the result of
- 	ML_DL__close() function.
+ 	Also defines close_collect/3 which is nearly the same as dl__close 
+	except it takes as dl__result(handle) as argument instead of an handle.
 
 browser/browser_library.m:
 	Add `collect_lib' module in the list of modules that should be part of
 	the browser library.
 
 browser/debugger_interface.m:
 	Add 2 new debugger requests `link_collect' and `collect':
 	(1) `link_collect(ObjectFile)' to dynamically link ObjectFile
@@ -48,10 +47,6 @@
 	necessary to be able to compile collect.m in the same grade as the 
 	the program being monitored.
 
-browser/dl.m:
-	Move the type definition of the type `handle' to be able to use it in
-	the collect_lib module.
-
 
 trace/mercury_trace_external.c:
 	Add support to handle the requests `link_collect', `collect' and 
@@ -59,9 +54,9 @@
 
 	Replace the global variable `searching' that was equal to TRUE when 
 	searching for a forward matching event and FALSE when reading a request, 
-	by a enum that is equal to `searching' when searching for a forward 
-	matching event, `reading_request' when reading a request and `collecting'
-	when processing a `collect' request.
+	by a enum that is equal to `MR_searching' when searching for a forward 
+	matching event, `MR_reading_request' when reading a request and 
+	`MR_collecting' when processing a `collect' request.
 
 
 Opium-M/source/collect.in:
--- collect_lib.m.old	Tue Nov  2 11:05:34 1999
+++ collect_lib.m	Tue Nov  2 11:06:08 1999
@@ -42,28 +42,34 @@
 
 :- module collect_lib.
 :- interface.
-:- import_module io, char.
+:- import_module io, char, dl.
 
 % dynamically link the collect module; 
 :- pred link_collect(string, c_pointer, c_pointer, c_pointer, c_pointer, 
-	handle, char, io__state, io__state).
+	dl__result(handle), char, io__state, io__state).
 :- mode link_collect(in, out, out, out, out, out, out, di, uo) is det.
 
+% interface to the C function dlclose()
+:- pred close_collect(dl__result(handle), io__state, io__state).
+:- mode close_collect(in, di, uo) is det.
+
 %------------------------------------------------------------------------------%
 :- implementation.
 :- import_module int, list, std_util, io, char.
 :- import_module dl.
 
 :- pragma export(link_collect(in, out, out, out, out, out, out, di, uo), 
-	"ML_DI_link_collect").
+	"ML_CL_link_collect").
+
+:- pragma export(close_collect(in, di, uo), "ML_CL_close_collect").
 
-% We need Handle to be able to close the shared object (dlclose) later on.
+% We need Handle to be able to close the shared object (dl__close) later on.
 % When the link failed, we output NULL pointers instead of maybe pointers
-% for performance reasons; indeed, filter will be called at every events
+% for performance reasons; indeed, filter will be called at every event
 % so we don't want to pay the price of the maybe variable de-construction
 % at each event.
 link_collect(ObjectFile, Filter, Initialize, SendResult, GetCollectType, 
-	Handle, Result) -->
+	MaybeHandle, Result) -->
 	%
 	% Link in the object code for the module `collect' from ObjectFile.
 	%
@@ -75,7 +81,6 @@
 		{ set_to_null_pointer(Filter) },
 		{ set_to_null_pointer(SendResult) },
 		{ set_to_null_pointer(GetCollectType) },
-		{ set_to_null_pointer(HandlePtr) },
 		{ Result = 'n' }
 	;
 		{ MaybeHandle = ok(Handle) },
@@ -114,10 +119,20 @@
  
 %------------------------------------------------------------------------------%
 
+close_collect(MaybeHandle) -->
+	(
+		{ MaybeHandle = error(_) }
+		% There is nothing to close since an error(_) here means that 
+		% the dlopen failed.
+	;
+		{ MaybeHandle = ok(Handle) },
+		dl__close(Handle, Result),
+		display_close_result(Result)
+	).
+
+
 :- pred display_close_result(dl__result, io__state, io__state).
 :- mode display_close_result(in, di, uo) is det.
-:- pragma export(display_close_result(in, di, uo), "ML_display_close_result").
-
 display_close_result(ok) --> []. 
 display_close_result(error(String)) -->
 	print(String),

--- collect.in.current	Fri Oct 29 18:05:41 1999
+++ collect.in	Tue Nov  2 08:59:35 1999
@@ -9,7 +9,7 @@
 
 
 :- pred filter(event_number, call_number, depth_number, trace_port_type,
-        pred_or_func, declarated_module_name, defined_module_name, proc_name,
+        pred_or_func, declared_module_name, defined_module_name, proc_name,
         arity, mode_number, determinism, goal_path_string, collected_type,
         collected_type).
 
@@ -69,7 +69,7 @@
 	--->	predicate
 	;	function.
 
-:- type declarated_module_name == string.
+:- type declared_module_name == string.
 :- type defined_module_name == string.
 :- type proc_name == string.
 
@@ -83,7 +83,7 @@
 :- type goal_path_string == string.
 
 :- type procedure ---> 
-	proc(pred_or_func, declarated_module_name, proc_name, arity, mode_number).
+	proc(pred_or_func, declared_module_name, proc_name, arity, mode_number).
 
 :- type event ---> 
 	event(
@@ -92,7 +92,7 @@
 		depth_number,
 		trace_port_type,
 		pred_or_func,
-		declarated_module_name,
+		declared_module_name,
 		defined_module_name,	
 		proc_name,
 		arity,
@@ -105,7 +105,7 @@
 :- func depth(event::in) = (depth_number::out) is det.
 :- func port(event::in) = (trace_port_type::out) is det.
 :- func proc_type(event::in) = (pred_or_func::out) is det.
-:- func decl_module(event::in) = (declarated_module_name::out) is det.
+:- func decl_module(event::in) = (declared_module_name::out) is det.
 :- func def_module(event::in) = (defined_module_name::out) is det.
 :- func proc_name(event::in) = (proc_name::out) is det.
 :- func proc_arity(event::in) = (arity::out) is det.
@@ -187,6 +188,7 @@
 	io__print(OutputStream, ".\n"),
 	io__flush_output(OutputStream).
 
+% This is the type of the debugger response to a collect request.
 :- type collect_result --->
 	collected(collected_type).
 

%------------------------------------------------------------------------------%
%------------------------------------------------------------------------------%
%------------------------------------------------------------------------------%
Here is the full diff:
%------------------------------------------------------------------------------%


Estimated hours taken: 110

This change implements the `collect/2' command for opium-M. `collect/2'
collects runtime information from Mercury program executions. It is intended to
let users easily implement their own monitors with acceptable performances. It
looks like the `fold/4' meta-predicate, except:

   (1)	It operates on-the fly on a sequence of events rather than on a
	list.
   (2)	The accumulator is initialized and updated via Mercury predicates 
	whose implementation is in a file passed down as the first argument 
	of `collect/2'.


browser/collect_lib.m:
	New module that defines link_collect/7 that is used during a `collect' 
	request: it performs the dynamic linking between collect.so and the
	current execution.

 	Also defines close_collect/3 which is nearly the same as dl__close 
	except it takes as dl__result(handle) as argument instead of an handle.

browser/browser_library.m:
	Add `collect_lib' module in the list of modules that should be part of
	the browser library.

browser/debugger_interface.m:
	Add 2 new debugger requests `link_collect' and `collect':
	(1) `link_collect(ObjectFile)' to dynamically link ObjectFile
	with the current execution; (2) `collect' to start the monitoring 
	process.

	Define a new predicate get_object_file_name/2 that let the 
	MR_trace_event_external() retrieve the name of the object file
	available from the `link_collect(string)' request.

	Define a new function get_collecting_variable_type/2 that retrieves
	the type of a variable. This type is needed in MR_trace_event_external()
	to be able to call MR_make_permanent() on MR_collecting_variable; we
	need to do that to ensure that the memory allocated for it won't be 
	deallocated on backtracking.

	Add the new request `current_grade' which lets the external debugger
	know the grade the current execution has been compiled with; it is 
	necessary to be able to compile collect.m in the same grade as the 
	the program being monitored.


trace/mercury_trace_external.c:
	Add support to handle the requests `link_collect', `collect' and 
	`current_grade'.

	Replace the global variable `searching' that was equal to TRUE when 
	searching for a forward matching event and FALSE when reading a request, 
	by a enum that is equal to `MR_searching' when searching for a forward 
	matching event, `MR_reading_request' when reading a request and 
	`MR_collecting' when processing a `collect' request.


Opium-M/source/collect.in:
	File that is used to generate collect.m (together with the file
	provided by the user that contains the definition of collected_type, 
	initialize/1 and filter/3). 


Opium-M/source/collect.op:
	The collect scenario that provides the primitives needed to run
	a collect request from opium-M.


Index: browser/browser_library.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/browser_library.m,v
retrieving revision 1.5
diff -u -r1.5 browser_library.m
--- browser_library.m	1999/08/20 06:47:23	1.5
+++ browser_library.m	1999/11/02 10:14:07
@@ -16,6 +16,7 @@
 :- import_module debugger_interface.
 :- import_module declarative_debugger, declarative_oracle, declarative_user.
 :- import_module interactive_query, dl, name_mangle.
+:- import_module collect_lib.
 
 % See library/library.m for why we implement this predicate this way.
 
Index: browser/collect_lib.m
===================================================================
RCS file: collect_lib.m
diff -N collect_lib.m
--- /dev/null	Wed May 28 10:49:58 1997
+++ collect_lib.m	Tue Nov  2 21:14:07 1999
@@ -0,0 +1,140 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 1999 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+% File: collect_lib.m
+% Author: jahier
+% Purpose:
+%	This module defines functions that are needed to implement the 
+%	`collect' primitive.
+%
+% 	`collect' collects runtime information from Mercury program executions.
+% 	It is intended to let users easily implement their own monitors with 
+% 	acceptable performances. 
+%
+%	To use it, users just need to define 4 things in a file, using the
+%	Mercury syntax:
+%		1) a `collected_type' which is the type of the collecting 
+%		   variable that will contain the result of the monitoring
+%		   activity.
+%		2) The predicate initialize/1 which initializes this 
+%		   collecting variable. initialize/1 should have the
+%		   following declarations:
+%			:- pred initialize(collected_type).
+%			:- mode initialize(out) is det.
+%		3) the predicate filter/3 which updates this collecting 
+%		   variable at each execution event. filter/3 should have the 
+%		   following declarations:
+%			:- pred filter(event, collected_type, collected_type).
+%			:- mode filter(in, di, uo) is det.
+%		4) and eventually the mode definition of the second and the 
+%		   third arguments of filter/3: `acc_in' and `acc_out'. Those
+%		   mode have `di' and `uo' respectively as default values.
+%
+% 	Then, this file is used to generate the Mercury module `collect.m',
+% 	which is compiled and dynamically linked with the current execution.
+% 	When a `collect' request is made from the external debugger, a variable
+% 	of type collected_type is first initialized (with initialize/1) and
+% 	then updated (with filter/3) for all the events of the remaining
+% 	execution. When the end of the execution is reached, the last value of
+% 	the collecting variable is send to the debugger.
+
+:- module collect_lib.
+:- interface.
+:- import_module io, char, dl.
+
+% dynamically link the collect module; 
+:- pred link_collect(string, c_pointer, c_pointer, c_pointer, c_pointer, 
+	dl__result(handle), char, io__state, io__state).
+:- mode link_collect(in, out, out, out, out, out, out, di, uo) is det.
+
+% interface to the C function dlclose()
+:- pred close_collect(dl__result(handle), io__state, io__state).
+:- mode close_collect(in, di, uo) is det.
+
+%------------------------------------------------------------------------------%
+:- implementation.
+:- import_module int, list, std_util, io, char.
+:- import_module dl.
+
+:- pragma export(link_collect(in, out, out, out, out, out, out, di, uo), 
+	"ML_CL_link_collect").
+
+:- pragma export(close_collect(in, di, uo), "ML_CL_close_collect").
+
+% We need Handle to be able to close the shared object (dl__close) later on.
+% When the link failed, we output NULL pointers instead of maybe pointers
+% for performance reasons; indeed, filter will be called at every event
+% so we don't want to pay the price of the maybe variable de-construction
+% at each event.
+link_collect(ObjectFile, Filter, Initialize, SendResult, GetCollectType, 
+	MaybeHandle, Result) -->
+	%
+	% Link in the object code for the module `collect' from ObjectFile.
+	%
+	dl__open(ObjectFile, lazy, local, MaybeHandle),
+	(	
+		{ MaybeHandle = error(Msg) },
+		print("dlopen failed: "), print(Msg), nl,
+		{ set_to_null_pointer(Initialize) },
+		{ set_to_null_pointer(Filter) },
+		{ set_to_null_pointer(SendResult) },
+		{ set_to_null_pointer(GetCollectType) },
+		{ Result = 'n' }
+	;
+		{ MaybeHandle = ok(Handle) },
+ 		%
+ 		% Look up the address of the C functions corresponding to the 
+		% initialize/1 and filter/14 predicates in the collect module.
+ 		%
+		dl__sym(Handle, "ML_COLLECT_initialize", MaybeInitialize),
+		dl__sym(Handle, "ML_COLLECT_filter", MaybeFilter),
+		dl__sym(Handle, "ML_COLLECT_send_collect_result", MaybeSendResult),
+		dl__sym(Handle, "ML_COLLECT_collecting_variable_type", MaybeType),
+		(
+			{ MaybeInitialize = ok(Initialize0) },
+			{ MaybeFilter = ok(Filter0) },
+			{ MaybeSendResult = ok(SendResult0) },
+			{ MaybeType = ok(Type0) }
+		->
+			{ Result = 'y' },
+			{ Initialize = Initialize0 },
+			{ Filter = Filter0 },
+			{ GetCollectType = Type0 },
+			{ SendResult = SendResult0 }
+		;
+			{ set_to_null_pointer(Initialize) },
+			{ set_to_null_pointer(Filter) },
+			{ set_to_null_pointer(SendResult) },
+			{ set_to_null_pointer(GetCollectType) },
+			{ Result = 'n' }
+		)
+	).
+
+:- pred set_to_null_pointer(c_pointer::out) is det.
+:- pragma c_code(set_to_null_pointer(Pointer::out),
+		[will_not_call_mercury, thread_safe],
+		"(Pointer = (Word) NULL)").
+ 
+%------------------------------------------------------------------------------%
+
+close_collect(MaybeHandle) -->
+	(
+		{ MaybeHandle = error(_) }
+		% There is nothing to close since an error(_) here means that 
+		% the dlopen failed.
+	;
+		{ MaybeHandle = ok(Handle) },
+		dl__close(Handle, Result),
+		display_close_result(Result)
+	).
+
+
+:- pred display_close_result(dl__result, io__state, io__state).
+:- mode display_close_result(in, di, uo) is det.
+display_close_result(ok) --> []. 
+display_close_result(error(String)) -->
+	print(String),
+	nl.
+	
Index: browser/debugger_interface.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/debugger_interface.m,v
retrieving revision 1.12
diff -u -r1.12 debugger_interface.m
--- debugger_interface.m	1999/10/20 14:06:51	1.12
+++ debugger_interface.m	1999/11/02 10:14:08
@@ -25,7 +25,7 @@
 %	ML_DI_found_match_user
 %	ML_DI_found_match_comp
 %	ML_DI_read_request_from_socket
-% These are used by runtime/mercury_trace_external.c.
+% These are used by trace/mercury_trace_external.c.
 
 :- pred dummy_pred_to_avoid_warning_about_nothing_exported is det.
 
@@ -175,6 +175,14 @@
 	;	mmc_options(options)
 			% to call the term browser
 	;	browse(string)
+			% dynamically link the collect module with the 
+			% current execution
+	;	link_collect(string)
+			% execute the collect command
+	;	collect
+			% retrieve the grade the current execution has been 
+			% compiled with
+	;	current_grade
 	.
 
 :- type event_number == int.
@@ -264,7 +272,21 @@
 	;	det(string)
 	;	end_stack
 	% responses to stack_regs
-	;	stack_regs(int, int, int).
+	;	stack_regs(int, int, int)
+	% responses to link_collect
+	;	link_collect_succeeded
+	;	link_collect_failed
+	% responses to collect
+	;	collect_linked
+	;	collect_not_linked
+	% responses to current_grade
+	;	grade(string)
+	% responses to collect
+	%;	collected(collected_type)
+		% It is commented because collected_type is unknow at compile 
+		% time since it is defined by by users in the dynamically 
+		% linked collect module.
+	.
 
 
 %-----------------------------------------------------------------------------%
@@ -586,6 +608,23 @@
 	;
 		error("get_mmc_options: not a mmc_options request")
 	).
+%-----------------------------------------------------------------------------%
+
+:- pred get_object_file_name(debugger_request, string).
+:- mode get_object_file_name(in, out) is det.
+
+:- pragma export(get_object_file_name(in, out), "ML_DI_get_object_file_name").
+	% This predicate allows mercury_trace_external.c to retrieve the name 
+	% of the object file to link the current execution with from a 
+	% `link_collect(ObjectFileName)' request.
+get_object_file_name(DebuggerRequest, ObjectFileName) :-
+	(
+		DebuggerRequest = link_collect(ObjectFileName1)
+	->
+		ObjectFileName = ObjectFileName1
+	;
+		error("get_object_file_name: not a link_collect request")
+	).
 
 %-----------------------------------------------------------------------------%
 
@@ -639,6 +678,9 @@
 classify_request(io_query(_),15).
 classify_request(mmc_options(_),16).
 classify_request(browse(_),17).
+classify_request(link_collect(_),18).
+classify_request(collect,19).
+classify_request(current_grade,20).
 
 
 %-----------------------------------------------------------------------------%
Index: trace/mercury_trace_external.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_external.c,v
retrieving revision 1.27
diff -u -r1.27 mercury_trace_external.c
--- mercury_trace_external.c	1999/10/28 20:15:02	1.27
+++ mercury_trace_external.c	1999/11/02 10:14:12
@@ -30,6 +30,9 @@
 #include "mercury_trace_vars.h"
 
 #include "debugger_interface.h"
+#include "collect_lib.h"
+#include "dl.h"
+#include "mercury_deep_copy.h"
 #include "std_util.h"
 
 #include <stdio.h>
@@ -42,6 +45,11 @@
 #include <arpa/inet.h>
 #include <netinet/in.h>
 #include <netdb.h>
+#include <stdlib.h>
+#ifdef HAVE_DLFCN_H
+  #include <dlfcn.h>
+#endif
+
 
 /*
 ** This type must match the definition of classify_request in
@@ -76,7 +84,11 @@
 				 = 15,/* wait for a io interactive query      */
 	MR_REQUEST_MMC_OPTIONS	 = 16,/* pass down new options to compile
 					 queries with			      */
-	MR_REQUEST_BROWSE	 = 17 /* call the term browser	              */
+	MR_REQUEST_BROWSE	 = 17,/* call the term browser	              */
+	MR_REQUEST_LINK_COLLECT	 = 18,/* dynamically link the collect module  */
+	MR_REQUEST_COLLECT	 = 19,/* collecting monitoring informations   */
+	MR_REQUEST_CURRENT_GRADE = 20 /* retrieving the grade of the current
+					 program has been compiled with       */
 
 } MR_debugger_request_type;
 
@@ -86,6 +98,42 @@
 static String	MR_mmc_options;
 
 /*
+** Type of a local variable that indicates in which mode the external 
+** debugger is. When the external debugger is in mode:
+** (1) `MR_searching', it tries to find an event that matches a forward 
+**      move request,
+** (2) `MR_reading_request', it reads a new request on the socket,
+** (3) `MR_collecting', it is collecting information (after a `collect' request).
+*/
+typedef enum {
+	MR_searching, MR_reading_request, MR_collecting
+} MR_external_debugger_mode_type;
+
+static	MR_external_debugger_mode_type 
+	external_debugger_mode = MR_reading_request;
+
+/*
+** Global variable that is used to store the information collected during 
+** a collect request.
+*/
+
+static  Word	MR_collecting_variable;
+
+/*
+** Function pointer used to sent the collecting variable to the external 
+** debugger.
+*/
+
+static	void	(*send_collect_result_ptr)(Word, Word);
+
+/*
+** Variable generated during the dynamic linking that is needed to close
+** this linking properly.
+*/
+
+static	Word	collect_lib_maybe_handle;
+
+/*
 ** Use a GNU C extension to enforce static type checking
 ** for printf-style functions. 
 ** (See the "Function attributes" section of "C extensions"
@@ -130,8 +178,15 @@
 			Integer *modules_list_length_ptr, Word *modules_list_ptr);
 static void	MR_get_mmc_options(Word debugger_request, 
 			String *mmc_options_ptr);
+static void	MR_get_object_file_name(Word debugger_request, 
+			String *objet_file_name_ptr);
 static void	MR_get_variable_name(Word debugger_request, String *var_name_ptr);
 static void	MR_trace_browse_one_external(MR_Var_Spec which_var);
+static void	MR_COLLECT_filter(void (*filter_ptr)(Integer, Integer, Integer, 
+			Word, Word, String, String, String, Integer, Integer, 
+			Integer, String, Word, Word *), Unsigned seqno, 
+			Unsigned depth,	MR_Trace_Port port, 
+			const MR_Stack_Layout_Label *layout, const char *path);
 
 #if 0
 This pseudocode should go in the debugger process:
@@ -209,7 +264,7 @@
 
 	/* 
 	** MR_mmc_options contains the options to pass to mmc when compiling 
-	** queries. We initialise it to the String "".
+	** queries. We initialize it to the String "".
 	*/
 	MR_TRACE_CALL_MERCURY(ML_DI_init_mercury_string(&MR_mmc_options));
 
@@ -281,7 +336,7 @@
 
 		if (MR_debug_socket) {
 			fprintf(stderr, "Mercury runtime: host = %s, port = %d\n",
-				hostname, port);	
+				hostname, port);
 		}
 		inet_address.sin_family = AF_INET;
 		inet_address.sin_addr.s_addr = host_addr;
@@ -369,12 +424,32 @@
 MR_trace_final_external(void)
 {
 	/*
-	** This can only happen during a forward_move(),
-	** in which case we want to tell the debugger that
-	** no match was found.
+	** This can only happen during a forward_move or a 
+	** collect request. In the first case, we want to tell 
+	** the debugger that no match was found; in the second 
+	** one we send the result of the collect activity.
 	*/
-	MR_send_message_to_socket("forward_move_match_not_found");
 
+
+	switch(external_debugger_mode) {
+		case MR_searching:
+			MR_send_message_to_socket("forward_move_match_not_found");
+			break;
+
+		case MR_collecting:
+			(*send_collect_result_ptr)(
+				MR_collecting_variable, 
+				(Word) &MR_debugger_socket_out);
+			#if defined(HAVE_DLFCN_H) && defined(HAVE_DLCLOSE)
+		       	MR_TRACE_CALL_MERCURY(
+				ML_CL_close_collect(collect_lib_maybe_handle));
+			#endif
+			break;
+
+		default:
+			fatal_error("Error in the external debugger");
+	}
 	/*
 	** Maybe we should loop to process requests from the
 	** debugger socket here?  Currently we just return,
@@ -387,8 +462,13 @@
 Code *
 MR_trace_event_external(MR_Trace_Cmd_Info *cmd, MR_Event_Info *event_info)
 {
-	static bool	searching = FALSE;
 	static Word	search_data;
+	static void	(*initialize_ptr)(Word *);
+	static void    	(*filter_ptr)(Integer, Integer, Integer, Word,
+				Word, String, String, String, Integer,
+				Integer, Integer, String, Word, Word *);
+	static void	(*get_collect_var_type_ptr)(Word *);
+	static bool    	collect_linked = FALSE;
 	Integer		debugger_request_type;
 	Integer		live_var_number;
 	Word		debugger_request;
@@ -408,17 +488,18 @@
 	Word		*saved_regs = event_info->MR_saved_regs;
 	Integer		modules_list_length;
 	Word		modules_list;
+	static String	MR_object_file_name;
 
 	MR_trace_enabled = FALSE;
 
-        /*
-        ** These globals can be overwritten when we call Mercury code,
-        ** such as the code in browser/debugger_interface.m.
+	/*
+	** These globals can be overwritten when we call Mercury code,
+	** such as the code in browser/debugger_interface.m.
 	** We therefore save them here and restore them before
 	** exiting from this function.  However, we store the
-        ** saved values in a structure that we pass to MR_trace_debug_cmd,
-        ** to allow them to be modified by MR_trace_retry().
-        */
+	** saved values in a structure that we pass to MR_trace_debug_cmd,
+	** to allow them to be modified by MR_trace_retry().
+	*/
 	event_details.MR_call_seqno = MR_trace_call_seqno;
 	event_details.MR_call_depth = MR_trace_call_depth;
 	event_details.MR_event_number = MR_trace_event_number;
@@ -426,18 +507,48 @@
 	MR_trace_init_point_vars(event_info->MR_event_sll,
 		event_info->MR_saved_regs);
 
-	if (searching) {
-		/* XXX should also pass registers here,
-		   since they're needed for checking for matches with the
-		   arguments */
-		if (MR_found_match(layout, port, seqno, depth,
-			/* XXX registers */ path, search_data))
-		{
-			MR_send_message_to_socket("forward_move_match_found");
-			searching = FALSE;
-		} else {
+
+	switch(external_debugger_mode) {
+		case MR_searching:
+			/* 
+			** XXX should also pass registers here, since they're 
+			** needed for checking for matches with the arguments 
+			*/
+			if (MR_found_match(layout, port, seqno, depth,
+				/* XXX registers, */ path, search_data))
+			{
+				MR_send_message_to_socket(
+					"forward_move_match_found");
+				external_debugger_mode = MR_reading_request;
+			} else {
+				goto done;
+			}
+			break;
+
+		case MR_collecting:
+			/* 
+			** XXX Add a another request that takes 
+			** arguments into account. We need two kinds 
+			** of request in order to not penalize the 
+			** performance of collect in the cases where 
+			** arguments are not used.
+			**  
+			** arguments = MR_make_var_list(layout, saved_regs);
+			*/
+			MR_COLLECT_filter(
+				*filter_ptr, 
+				seqno, 
+				depth, 
+				port,
+				layout, 
+				path);
 			goto done;
-		}
+
+		case MR_reading_request:
+			break;
+
+		default:
+	       		fatal_error("Software error in the debugger.\n");
 	}
 
 	/* loop to process requests read from the debugger socket */
@@ -454,7 +565,7 @@
 						"FORWARD_MOVE\n");
 				}
 				search_data = debugger_request;
-			        searching = TRUE;
+			        external_debugger_mode = MR_searching;
 				goto done;
 
 			case MR_REQUEST_CURRENT_LIVE_VAR_NAMES:
@@ -647,6 +758,92 @@
 				cmd->MR_trace_cmd = MR_CMD_TO_END;
 				goto done;
 
+			case MR_REQUEST_LINK_COLLECT:
+			  {
+			        Char	result;
+				Word	MR_collecting_variable_type;
+
+				if (MR_debug_socket) {
+					fprintf(stderr, "\nMercury runtime: "
+						"REQUEST_LINK_COLLECT\n");
+				}
+				MR_get_object_file_name(debugger_request,
+					    &MR_object_file_name);
+				MR_TRACE_CALL_MERCURY(
+					ML_CL_link_collect(
+			       		    MR_object_file_name,
+					    (Word *) &filter_ptr,
+					    (Word *) &initialize_ptr,
+					    (Word *) &send_collect_result_ptr,
+					    (Word *) &get_collect_var_type_ptr,
+					    &collect_lib_maybe_handle,
+					    &result
+					    ));
+				collect_linked = (result = 'y');
+				if (collect_linked) {
+					MR_send_message_to_socket(
+						"link_collect_succeeded");
+					MR_TRACE_CALL_MERCURY(
+					    (*get_collect_var_type_ptr)(
+						&MR_collecting_variable_type));
+					MR_collecting_variable = 
+					    MR_make_permanent(
+						MR_collecting_variable,
+						(Word *) 
+						MR_collecting_variable_type);
+				} else {
+					MR_send_message_to_socket(
+						"link_collect_failed");
+				}
+				break;
+			  }
+			case MR_REQUEST_COLLECT:
+			  {
+				static char *MERCURY_OPTIONS;
+
+				if (MR_debug_socket) {
+					fprintf(stderr, "\nMercury runtime: "
+						"REQUEST_COLLECT\n");
+				}
+				if (collect_linked) {
+					MR_send_message_to_socket(
+						"collect_linked");
+					external_debugger_mode = MR_collecting;
+					MR_TRACE_CALL_MERCURY(
+					  (*initialize_ptr)(&MR_collecting_variable));
+
+					/*
+					** In order to perform the collect from
+					** the current event, we need to call 
+					** filter once here.
+					*/
+					MR_COLLECT_filter(
+						*filter_ptr, 
+						seqno, 
+						depth, 
+						port,
+						layout, 
+						path);
+					
+					goto done;
+				} else {
+					MR_send_message_to_socket(
+						"collect_not_linked");
+					break;
+				}
+			  }
+
+			case MR_REQUEST_CURRENT_GRADE:
+			  {
+				if (MR_debug_socket) {
+					fprintf(stderr, "\nMercury runtime: "
+						"REQUEST_CURRENT_GRADE\n");
+				}
+				MR_send_message_to_socket_format(
+						"grade(\"%s\").\n", 
+						MR_GRADE_OPT);
+				break;
+			  }
 			default:
 				fatal_error("unexpected request read from "
 					"debugger socket");
@@ -1197,6 +1394,16 @@
 }
 
 static void
+MR_get_object_file_name(Word debugger_request, String *object_file_name_ptr)
+{
+	MR_TRACE_CALL_MERCURY(
+		ML_DI_get_object_file_name(
+			debugger_request, 
+			object_file_name_ptr);
+		);
+}
+
+static void
 MR_get_variable_name(Word debugger_request, String *var_name_ptr)
 {
 	MR_TRACE_CALL_MERCURY(
@@ -1224,6 +1431,34 @@
 	if (problem != NULL) {
 		MR_send_message_to_socket_format("error(\"%s\").\n", problem);
 	}
+}
+
+
+/*
+** This function calls the collect filtering predicate defined by the user
+** and dynamically link with the execution.
+*/
+static void
+MR_COLLECT_filter(void (*filter_ptr)(Integer, Integer, Integer, Word, Word, 
+	String, String, String, Integer, Integer, Integer, String, Word, Word *), 
+       	Unsigned seqno, Unsigned depth, MR_Trace_Port port, 
+	const MR_Stack_Layout_Label *layout, const char *path)
+{		
+	MR_TRACE_CALL_MERCURY((*filter_ptr)(
+		MR_trace_event_number,
+		seqno,
+		depth,
+		port,
+		layout->MR_sll_entry->MR_sle_user.MR_user_pred_or_func,
+		(String) layout->MR_sll_entry->MR_sle_user.MR_user_decl_module,
+		(String) layout->MR_sll_entry->MR_sle_user.MR_user_def_module,
+		(String) layout->MR_sll_entry->MR_sle_user.MR_user_name,
+		layout->MR_sll_entry->MR_sle_user.MR_user_arity,
+		layout->MR_sll_entry->MR_sle_user.MR_user_mode,
+		layout->MR_sll_entry->MR_sle_detism,
+		(String) path,
+		MR_collecting_variable,
+		&MR_collecting_variable));
 }
 
 #endif /* MR_USE_EXTERNAL_DEBUGGER */


-- 
R1.


--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to:       mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions:          mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------



More information about the developers mailing list