1/*  Part of SWI-Prolog
2
3    Author:        Jan Wielemaker
4    E-mail:        J.Wielemaker@vu.nl
5    WWW:           http://www.swi-prolog.org
6    Copyright (c)  1999-2017, University of Amsterdam
7                              VU University Amsterdam
8    All rights reserved.
9
10    Redistribution and use in source and binary forms, with or without
11    modification, are permitted provided that the following conditions
12    are met:
13
14    1. Redistributions of source code must retain the above copyright
15       notice, this list of conditions and the following disclaimer.
16
17    2. Redistributions in binary form must reproduce the above copyright
18       notice, this list of conditions and the following disclaimer in
19       the documentation and/or other materials provided with the
20       distribution.
21
22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
33    POSSIBILITY OF SUCH DAMAGE.
34*/
35
36:- module(thread_util,
37          [ thread_run_interactor/0,    % interactor main loop
38            threads/0,                  % List available threads
39            join_threads/0,             % Join all terminated threads
40            interactor/0,               % Create a new interactor
41            interactor/1,               % ?Title
42            thread_has_console/0,       % True if thread has a console
43            attach_console/0,           % Create a new console for thread.
44            attach_console/1,           % ?Title
45
46            tspy/1,                     % :Spec
47            tspy/2,                     % :Spec, +ThreadId
48            tdebug/0,
49            tdebug/1,                   % +ThreadId
50            tnodebug/0,
51            tnodebug/1,                 % +ThreadId
52            tprofile/1,                 % +ThreadId
53            tbacktrace/1,               % +ThreadId,
54            tbacktrace/2                % +ThreadId, +Options
55          ]).
56:- autoload(library(apply),[maplist/3]).
57:- autoload(library(backcomp),[thread_at_exit/1]).
58:- autoload(library(edinburgh),[nodebug/0]).
59:- autoload(library(gui_tracer),[gdebug/0]).
60:- autoload(library(lists),[max_list/2]).
61:- autoload(library(option),[merge_options/3,option/3]).
62:- autoload(library(pce),[send/2]).
63:- autoload(library(prolog_stack),
64	    [print_prolog_backtrace/2,get_prolog_backtrace/3]).
65:- autoload(library(statistics),[thread_statistics/2,show_profile/1]).
66:- autoload(library(thread),[call_in_thread/2]).
67
68
69:- set_prolog_flag(generate_debug_info, false).
70
71:- module_transparent
72    tspy/1,
73    tspy/2.
74
75/** <module> Interactive thread utilities
76
77This  library  provides  utilities  that   are  primarily  intended  for
78interactive usage in a  threaded  Prolog   environment.  It  allows  for
79inspecting threads, manage I/O of background   threads (depending on the
80environment) and manipulating the debug status of threads.
81*/
82
83%!  threads
84%
85%   List currently known threads with their status.
86
87threads :-
88    threads(Threads),
89    print_message(information, threads(Threads)).
90
91threads(Threads) :-
92    findall(Thread, thread_statistics(_,Thread), Threads).
93
94%!  join_threads
95%
96%   Join all terminated threads.
97
98join_threads :-
99    findall(Ripped, rip_thread(Ripped), AllRipped),
100    (   AllRipped == []
101    ->  true
102    ;   print_message(informational, joined_threads(AllRipped))
103    ).
104
105rip_thread(thread{id:id, status:Status}) :-
106    thread_property(Id, status(Status)),
107    Status \== running,
108    \+ thread_self(Id),
109    thread_join(Id, _).
110
111%!  interactor is det.
112%!  interactor(?Title) is det.
113%
114%   Run a Prolog toplevel in another thread   with a new console window.
115%   If Title is given, this will be used as the window title.
116
117interactor :-
118    interactor(_).
119
120interactor(Title) :-
121    thread_self(Me),
122    thread_create(thread_run_interactor(Me, Title), _Id,
123                  [ detached(true),
124                    debug(false)
125                  ]),
126    thread_get_message(title(Title)).
127
128thread_run_interactor(Creator, Title) :-
129    set_prolog_flag(query_debug_settings, debug(false, false)),
130    attach_console(Title),
131    thread_send_message(Creator, title(Title)),
132    print_message(banner, thread_welcome),
133    prolog.
134
135%!  thread_run_interactor
136%
137%   Attach a console and run a Prolog toplevel in the current thread.
138
139thread_run_interactor :-
140    set_prolog_flag(query_debug_settings, debug(false, false)),
141    attach_console(_Title),
142    print_message(banner, thread_welcome),
143    prolog.
144
145%!  thread_has_console is semidet.
146%
147%   True when the calling thread has an attached console.
148%
149%   @see attach_console/0
150
151:- dynamic
152    has_console/4.                  % Id, In, Out, Err
153
154thread_has_console(main) :- !.                  % we assume main has one.
155thread_has_console(Id) :-
156    has_console(Id, _, _, _).
157
158thread_has_console :-
159    current_prolog_flag(break_level, _),
160    !.
161thread_has_console :-
162    thread_self(Id),
163    thread_has_console(Id),
164    !.
165
166%!  attach_console is det.
167%!  attach_console(?Title) is det.
168%
169%   Create a new console and make the   standard Prolog streams point to
170%   it. If not provided, the title is   built  using the thread id. Does
171%   nothing if the current thread already has a console attached.
172
173attach_console :-
174    attach_console(_).
175
176attach_console(_) :-
177    thread_has_console,
178    !.
179attach_console(Title) :-
180    thread_self(Id),
181    (   var(Title)
182    ->  console_title(Id, Title)
183    ;   true
184    ),
185    open_console(Title, In, Out, Err),
186    assert(has_console(Id, In, Out, Err)),
187    set_stream(In,  alias(user_input)),
188    set_stream(Out, alias(user_output)),
189    set_stream(Err, alias(user_error)),
190    set_stream(In,  alias(current_input)),
191    set_stream(Out, alias(current_output)),
192    enable_line_editing(In,Out,Err),
193    thread_at_exit(detach_console(Id)).
194
195console_title(Thread, Title) :-         % uses tabbed consoles
196    current_prolog_flag(console_menu_version, qt),
197    !,
198    human_thread_id(Thread, Id),
199    format(atom(Title), 'Thread ~w', [Id]).
200console_title(Thread, Title) :-
201    current_prolog_flag(system_thread_id, SysId),
202    human_thread_id(Thread, Id),
203    format(atom(Title),
204           'SWI-Prolog Thread ~w (~d) Interactor',
205           [Id, SysId]).
206
207human_thread_id(Thread, Alias) :-
208    thread_property(Thread, alias(Alias)),
209    !.
210human_thread_id(Thread, Id) :-
211    thread_property(Thread, id(Id)).
212
213%!  open_console(+Title, -In, -Out, -Err) is det.
214%
215%   Open a new console window and unify In,  Out and Err with the input,
216%   output and error streams for the new console.
217
218:- multifile xterm_args/1.
219:- dynamic   xterm_args/1.
220
221:- if(current_predicate(win_open_console/5)).
222
223open_console(Title, In, Out, Err) :-
224    thread_self(Id),
225    regkey(Id, Key),
226    win_open_console(Title, In, Out, Err,
227                     [ registry_key(Key)
228                     ]).
229
230regkey(Key, Key) :-
231    atom(Key).
232regkey(_, 'Anonymous').
233
234:- else.
235
236%!  xterm_args(-List) is nondet.
237%
238%   Multifile and dynamic hook that  provides (additional) arguments for
239%   the xterm(1) process opened  for   additional  thread consoles. Each
240%   solution must bind List to a list   of  atomic values. All solutions
241%   are concatenated using append/2 to form the final argument list.
242%
243%   The defaults set  the  colors   to  black-on-light-yellow,  enable a
244%   scrollbar, set the font using  Xft   font  pattern  and prepares the
245%   back-arrow key.
246
247xterm_args(['-xrm', '*backarrowKeyIsErase: false']).
248xterm_args(['-xrm', '*backarrowKey: false']).
249xterm_args(['-fa', 'monospace;pixelsize=11;regular']).
250xterm_args(['-fg', '#000000']).
251xterm_args(['-bg', '#ffffdd']).
252xterm_args(['-sb', '-sl', 1000, '-rightbar']).
253
254open_console(Title, In, Out, Err) :-
255    findall(Arg, xterm_args(Arg), Args),
256    append(Args, Argv),
257    open_xterm(Title, In, Out, Err, Argv).
258
259:- endif.
260
261%!  enable_line_editing(+In, +Out, +Err) is det.
262%
263%   Enable line editing for the console.  This   is  by built-in for the
264%   Windows console. We can also provide it   for the X11 xterm(1) based
265%   console if we use the BSD libedit based command line editor.
266
267:- if((current_prolog_flag(readline, editline),
268       exists_source(library(editline)))).
269enable_line_editing(_In, _Out, _Err) :-
270    current_prolog_flag(readline, editline),
271    !,
272    el_wrap.
273:- endif.
274enable_line_editing(_In, _Out, _Err).
275
276:- if(current_predicate(el_unwrap/1)).
277disable_line_editing(_In, _Out, _Err) :-
278    el_unwrap(user_input).
279:- endif.
280disable_line_editing(_In, _Out, _Err).
281
282
283%!  detach_console(+ThreadId) is det.
284%
285%   Destroy the console for ThreadId.
286
287detach_console(Id) :-
288    (   retract(has_console(Id, In, Out, Err))
289    ->  disable_line_editing(In, Out, Err),
290        close(In, [force(true)]),
291        close(Out, [force(true)]),
292        close(Err, [force(true)])
293    ;   true
294    ).
295
296
297                 /*******************************
298                 *          DEBUGGING           *
299                 *******************************/
300
301%!  tspy(:Spec) is det.
302%!  tspy(:Spec, +ThreadId) is det.
303%
304%   Trap the graphical debugger on reaching Spec in the specified or
305%   any thread.
306
307tspy(Spec) :-
308    spy(Spec),
309    tdebug.
310
311tspy(Spec, ThreadID) :-
312    spy(Spec),
313    tdebug(ThreadID).
314
315
316%!  tdebug is det.
317%!  tdebug(+Thread) is det.
318%
319%   Enable debug-mode, trapping the graphical debugger on reaching
320%   spy-points or errors.
321
322tdebug :-
323    forall(debug_target(Id), thread_signal(Id, gdebug)).
324
325tdebug(ThreadID) :-
326    thread_signal(ThreadID, gdebug).
327
328%!  tnodebug is det.
329%!  tnodebug(+Thread) is det.
330%
331%   Disable debug-mode in all threads or the specified Thread.
332
333tnodebug :-
334    forall(debug_target(Id), thread_signal(Id, nodebug)).
335
336tnodebug(ThreadID) :-
337    thread_signal(ThreadID, nodebug).
338
339
340debug_target(Thread) :-
341    thread_property(Thread, status(running)),
342    thread_property(Thread, debug(true)).
343
344%!  tbacktrace(+Thread) is det.
345%!  tbacktrace(+Thread, +Options) is det.
346%
347%   Print a backtrace for  Thread  to   the  stream  `user_error` of the
348%   calling thread. This is achieved  by   inserting  an  interrupt into
349%   Thread using call_in_thread/2. Options:
350%
351%     - depth(+MaxFrames)
352%       Number of stack frames to show.  Default is the current Prolog
353%       flag `backtrace_depth` or 20.
354%
355%   Other options are passed to get_prolog_backtrace/3.
356%
357%   @bug call_in_thread/2 may not process the event.
358
359tbacktrace(Thread) :-
360    tbacktrace(Thread, []).
361
362tbacktrace(Thread, Options) :-
363    merge_options(Options, [clause_references(false)], Options1),
364    (   current_prolog_flag(backtrace_depth, Default)
365    ->  true
366    ;   Default = 20
367    ),
368    option(depth(Depth), Options1, Default),
369    call_in_thread(Thread, thread_get_prolog_backtrace(Depth, Stack, Options1)),
370    print_prolog_backtrace(user_error, Stack).
371
372%!  thread_get_prolog_backtrace(+Depth, -Stack, +Options)
373%
374%   As get_prolog_backtrace/3, but starts above   the C callback, hiding
375%   the overhead inside call_in_thread/2.
376
377thread_get_prolog_backtrace(Depth, Stack, Options) :-
378    prolog_current_frame(Frame),
379    signal_frame(Frame, SigFrame),
380    get_prolog_backtrace(Depth, Stack, [frame(SigFrame)|Options]).
381
382signal_frame(Frame, SigFrame) :-
383    prolog_frame_attribute(Frame, clause, _),
384    !,
385    (   prolog_frame_attribute(Frame, parent, Parent)
386    ->  signal_frame(Parent, SigFrame)
387    ;   SigFrame = Frame
388    ).
389signal_frame(Frame, SigFrame) :-
390    (   prolog_frame_attribute(Frame, parent, Parent)
391    ->  SigFrame = Parent
392    ;   SigFrame = Frame
393    ).
394
395
396
397                 /*******************************
398                 *       REMOTE PROFILING       *
399                 *******************************/
400
401%!  tprofile(+Thread) is det.
402%
403%   Profile the operation of Thread until the user hits a key.
404
405tprofile(Thread) :-
406    init_pce,
407    thread_signal(Thread,
408                  (   reset_profiler,
409                      profiler(_, true)
410                  )),
411    format('Running profiler in thread ~w (press RET to show results) ...',
412           [Thread]),
413    flush_output,
414    get_code(_),
415    thread_signal(Thread,
416                  (   profiler(_, false),
417                      show_profile([])
418                  )).
419
420
421%!  init_pce
422%
423%   Make sure XPCE is running if it is   attached, so we can use the
424%   graphical display using in_pce_thread/1.
425
426init_pce :-
427    current_prolog_flag(gui, true),
428    !,
429    call(send(@(display), open)).   % avoid autoloading
430init_pce.
431
432
433                 /*******************************
434                 *             HOOKS            *
435                 *******************************/
436
437:- multifile
438    user:message_hook/3.
439
440user:message_hook(trace_mode(on), _, Lines) :-
441    \+ thread_has_console,
442    \+ current_prolog_flag(gui_tracer, true),
443    catch(attach_console, _, fail),
444    print_message_lines(user_error, '% ', Lines).
445
446:- multifile
447    prolog:message/3.
448
449prolog:message(thread_welcome) -->
450    { thread_self(Self),
451      human_thread_id(Self, Id)
452    },
453    [ 'SWI-Prolog console for thread ~w'-[Id],
454      nl, nl
455    ].
456prolog:message(joined_threads(Threads)) -->
457    [ 'Joined the following threads'-[], nl ],
458    thread_list(Threads).
459prolog:message(threads(Threads)) -->
460    thread_list(Threads).
461
462thread_list(Threads) -->
463    { maplist(th_id_len, Threads, Lens),
464      max_list(Lens, MaxWidth),
465      LeftColWidth is max(6, MaxWidth),
466      Threads = [H|_]
467    },
468    thread_list_header(H, LeftColWidth),
469    thread_list(Threads, LeftColWidth).
470
471th_id_len(Thread, IdLen) :-
472    write_length(Thread.id, IdLen, [quoted(true)]).
473
474thread_list([], _) --> [].
475thread_list([H|T], CW) -->
476    thread_info(H, CW),
477    (   {T == []}
478    ->  []
479    ;   [nl],
480        thread_list(T, CW)
481    ).
482
483thread_list_header(Thread, CW) -->
484    { _{id:_, status:_, time:_, stacks:_} :< Thread,
485      !,
486      HrWidth is CW+18+13+13
487    },
488    [ '~|~tThread~*+ Status~tTime~18+~tStack use~13+~tallocated~13+'-[CW], nl ],
489    [ '~|~`-t~*+'-[HrWidth], nl ].
490thread_list_header(Thread, CW) -->
491    { _{id:_, status:_} :< Thread,
492      !,
493      HrWidth is CW+7
494    },
495    [ '~|~tThread~*+ Status'-[CW], nl ],
496    [ '~|~`-t~*+'-[HrWidth], nl ].
497
498thread_info(Thread, CW) -->
499    { _{id:Id, status:Status, time:Time, stacks:Stacks} :< Thread },
500    !,
501    [ '~|~t~q~*+ ~w~t~3f~18+~t~D~13+~t~D~13+'-
502      [ Id, CW, Status, Time.cpu, Stacks.total.usage, Stacks.total.allocated
503      ]
504    ].
505thread_info(Thread, CW) -->
506    { _{id:Id, status:Status} :< Thread },
507    !,
508    [ '~|~t~q~*+ ~w'-
509      [ Id, CW, Status
510      ]
511    ].
512
513