mercury/browser/collect_lib.m

%-----------------------------------------------------------------------------%
% Copyright (C) 1999-2000 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 the 
%		   collecting variable. initialize/1 should have the
%		   following declarations:
%			:- pred initialize(collected_type).
%			:- mode initialize(out) is det.
%		3) The predicate filter/4 which updates the collecting  
%		   variable at each execution event. filter/4 also outputs  
%		   a variable that indicates whether to stop collecting.  
%		   If this variable is set to `stop', the collect process  
%		   stops; if it is set to `continue', it continues. If this  
%		   variable is always set to `continue', the collecting will 
%		   process until the last event is reached. filter/4 should 
%		   follow the following declarations:
%			:- pred filter(event, collected_type, collected_type,
%				stop_or_continue).
%			:- mode filter(in, di, uo, out) is det.
%		4) And eventually the mode definition of the second and the 
%		   third arguments of filter/4: `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/4) 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 mdb__collect_lib.
:- interface.

:- pred dummy_pred_to_avoid_warning_about_nothing_exported is det.

%------------------------------------------------------------------------------%
:- implementation.
:- import_module int, list, std_util, io, char.
:- import_module mdb__dl.

dummy_pred_to_avoid_warning_about_nothing_exported.

:- pragma export(link_collect(in, out, out, out, out, out, out, di, uo), 
	"ML_CL_link_collect").

:- pragma export(unlink_collect(in, di, uo), "ML_CL_unlink_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.

% 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.
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 = (MR_Word) NULL)").
 
%------------------------------------------------------------------------------%

:- pred unlink_collect(dl__result(handle), io__state, io__state).
:- mode unlink_collect(in, di, uo) is det.
 	% Dynamically unlink a module that was dynamically linked in
 	% using `link_collect'.
unlink_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.