File: coprocess.op

package info (click to toggle)
mercury 0.9-1
  • links: PTS
  • area: main
  • in suites: potato
  • size: 18,488 kB
  • ctags: 9,800
  • sloc: objc: 146,680; ansic: 51,418; sh: 6,436; lisp: 1,567; cpp: 1,040; perl: 854; makefile: 450; asm: 232; awk: 203; exp: 32; fortran: 3; csh: 1
file content (219 lines) | stat: -rw-r--r-- 5,598 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
%------------------------------------------------------------------------------%
% Copyright (C) 1999 INRIA/INSA.
%
% Author : Erwan Jahier <jahier@irisa.fr>
% 
%  Opium-M built-ins, primitives and commands related to coprocessing
%  in the Opium-M process (part of scenario opium_kernel-M.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_opium_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 Opium-M 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_opium, 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_opium_socket_address(AddressStr),
	append_strings("rm -f ", AddressStr, C),
	append_strings(C, StarPidStr, Command),
	opium_write_debug(user, Command),
	opium_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_opium, State),
	( 
		State == running 
	->
		printf(newsock, "%w. \n%b", [Query]),
		opium_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),
	opium_printf_debug("RECEIVE : +%w+\n\n", Message).


%------------------------------------------------------------------------------%
opium_parameter(
	name		: mercury_opium_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_opium,
	arg_list	: [OnOff],
	arg_type_list	: [is_member([on, off])],
	parameter_type	: single,
	default		: [off],
	commands	: [opium_write_debug, opium_printf_debug],
	message		: 
'Prints additional information in the trace to debug Opium.'
	).


%------------------------------------------------------------------------------%
opium_procedure(
	name		: opium_write_debug,
	arg_list	: [X],
	implementation	: opium_write_debug_Op,
	parameters	: [debug_opium],
	message		:
'This procedure is used to print information to debug Opium.'
	).

opium_write_debug_Op(X) :-
	(debug_opium(on) ->
		write(X)
	;
		true
	).


opium_procedure(
	name		: opium_write_debug,
	arg_list	: [Stream, X],
	implementation	: opium_write_debug_Op,
	parameters	: [debug_opium],
	message		:
'This procedure is used to print information to debug Opium.'
	).

opium_write_debug_Op(Stream, X) :-
	(debug_opium(on) ->
		write(Stream, X)
	;
		true
	),
	flush(Stream).


opium_procedure(
	name		: opium_printf_debug,
	arg_list	: [Format, X],
	implementation	: opium_printf_debug_Op,
	parameters	: [debug_opium],
	message		:
'This procedure is used to print information to debug Opium.'
	).

opium_printf_debug_Op(Format, X) :-
	(debug_opium(on) ->
		printf(Format, X)
	;
		true
	).


opium_procedure(
	name		: opium_printf_debug,
	arg_list	: [Stream, Format, X],
	implementation	: opium_printf_debug_Op,
	parameters	: [debug_opium],
	message		:
'This procedure is used to print information to debug Opium.'
	).

opium_printf_debug_Op(Stream, Format, X) :-
	(debug_opium(on) ->
		printf(Stream, Format, X)
	;
		true
	).