mercury/extras/morphine/source/coprocess.op

%------------------------------------------------------------------------------%
% Copyright (C) 1999-2001 INRIA/INSA de Rennes/IFSIC.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file License in the Morphine distribution.
%
% Author : Erwan Jahier <jahier@irisa.fr>
% 
%  Morphine built-ins, primitives and commands related to coprocessing
%  in the Morphine process (part of scenario morphine_kernel.op).



%------------------------------------------------------------------------------%
%:- pred start_connection(atom, atom, atom).
%:- mode start_connection(in, out) is det.
% To start the connection with the Mercury process
start_connection(ProgramName, SockId2) :-
	write("Start debugging "),
	write(ProgramName),
	write(" program.\n"),
	get_parameter(socket_domain, [SocketDomain]),
	( (SocketDomain = unix) ->
		% construct the socket address (ex: /tmp/soc1233)
		construct_socket_address(SockAddPidStr),
		atom_string(SockId, SockAddPidStr),
		socket(unix, stream, sock)
	;
		% socket_type = inet
		socket(internet, stream, sock)
	),

	% clean up unused socket addresses 
	kill_all_socket_address,	

	% Bind the socket name to the socket
	bind(sock, SockId),
	( (SocketDomain = unix) ->
		SockId2 = SockId
	;
		SockId = _ / SockId2
	),
	listen(sock, 1).

construct_socket_address(Addr) :-
	mercury_morphine_socket_address(Addr0),
	append_strings(Addr0, "soc", Addr1),

	% We add the pid to the socket path name to make sure that 2 users on 
	% the same machine can use Morphine simultaneously.
	get_flag(pid, Pid),
	number_string(Pid, PidStr),
	append_strings(Addr1, PidStr, Addr),

	% Record the socket address to be able to delete it later
	setval(socket_address_str, SockAddPidStr).


%------------------------------------------------------------------------------%
opium_primitive(
	name		: end_connection,
	arg_list	: [],
	arg_type_list	: [],
	abbrev		: ec,	
	implementation	: end_connection_Op,
	message		:
'Ends the connection with the traced program.'
	).

% :- pred end_connection is det.
end_connection_Op :-
	kill_all_socket_address,
	setval(state_of_morphine, not_running),
	close(sock),
	close(newsock),
	write("End of connection with the traced program\n").

kill_all_socket_address :-
	get_flag(pid, Pid),
	number_string(Pid, PidStr),
	append_strings("*", PidStr, StarPidStr),
	mercury_morphine_socket_address(AddressStr),
	append_strings("rm -f ", AddressStr, C),
	append_strings(C, StarPidStr, Command),
	morphine_write_debug(user, Command),
	morphine_write_debug(user, "\n"),
	sh(Command).
	% I should rather use exec(Command, []) here but for
	% unknown reason, it does not remove the socket file.

%------------------------------------------------------------------------------%
%:- pred send_message_to_socket(atom).
%:- mode send_message_to_socket(in) is det.
	% low level primitive to send message to the Mercury process via a
	% socket.

send_message_to_socket(Query) :-
	getval(state_of_morphine, State),
	( 
		State == running 
	->
		printf(newsock, "%w. \n%b", [Query]),
		morphine_printf_debug("SEND    : +%w. +\n", [Query])
	;
		State == not_running
	->
		printf(stderr,"No program is running\n", [])
	;
		% State == eot
		write(stderr,"You are at the end of the trace.\n")
	).


%------------------------------------------------------------------------------%
%:- pred read_message_from_socket(atom).
%:- mode read_message_from_socket(out) is det.
	% low level primitive to read message from the Mercury process via a
	% socket.
read_message_from_socket(Message) :-
	read(newsock, Message),
	morphine_printf_debug("RECEIVE : +%w+\n\n", Message).


%------------------------------------------------------------------------------%
opium_parameter(
	name		: mercury_morphine_socket_address,
	arg_list	: [SocketAdress],
	arg_type_list	: [string],
	parameter_type	: single,
	default		: ["/tmp/"],
	commands	: [],
	message		: 
"Parameter which gives the directory that will be used to create the temporary \
socket file in (file that is used for socket communication between the two \
process)."
	).


%------------------------------------------------------------------------------%
opium_parameter(
	name		: debug_morphine,
	arg_list	: [OnOff],
	arg_type_list	: [is_member([on, off])],
	parameter_type	: single,
	default		: [off],
	commands	: [morphine_write_debug, morphine_printf_debug],
	message		: 
'Prints additional information in the trace to debug Morphine.'
	).


%------------------------------------------------------------------------------%
opium_procedure(
	name		: morphine_write_debug,
	arg_list	: [X],
	implementation	: morphine_write_debug_Op,
	parameters	: [debug_morphine],
	message		:
'Prints additional information to debug Morphine.'
	).

morphine_write_debug_Op(X) :-
	(debug_morphine(on) ->
		write(X)
	;
		true
	).


opium_procedure(
	name		: morphine_write_debug,
	arg_list	: [Stream, X],
	implementation	: morphine_write_debug_Op,
	parameters	: [debug_morphine],
	message		:
'Prints additional information to debug Morphine.'
	).

morphine_write_debug_Op(Stream, X) :-
	(debug_morphine(on) ->
		write(Stream, X)
	;
		true
	),
	flush(Stream).


opium_procedure(
	name		: morphine_printf_debug,
	arg_list	: [Format, X],
	implementation	: morphine_printf_debug_Op,
	parameters	: [debug_morphine],
	message		:
'Prints additional information to debug Morphine.'
	).

morphine_printf_debug_Op(Format, X) :-
	(debug_morphine(on) ->
		printf(Format, X)
	;
		true
	).


opium_procedure(
	name		: morphine_printf_debug,
	arg_list	: [Stream, Format, X],
	implementation	: morphine_printf_debug_Op,
	parameters	: [debug_morphine],
	message		:
'Prints additional information to debug Morphine.'
	).

morphine_printf_debug_Op(Stream, Format, X) :-
	(debug_morphine(on) ->
		printf(Stream, Format, X)
	;
		true
	).