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            thread_has_console/0,       % Test whether calling thread has a console
  42            attach_console/0,           % Create an xterm-console for thread.
  43
  44            tspy/1,                     % :Spec
  45            tspy/2,                     % :Spec, +ThreadId
  46            tdebug/0,
  47            tdebug/1,                   % +ThreadId
  48            tnodebug/0,
  49            tnodebug/1,                 % +ThreadId
  50            tprofile/1                  % +ThreadId
  51          ]).
  52:- use_module(library(apply)).
  53:- use_module(library(lists)).
  54:- set_prolog_flag(generate_debug_info, false).
  55
  56:- module_transparent
  57    tspy/1,
  58    tspy/2.
  59
  60/** <module> Interactive thread utilities
  61
  62This  library  provides  utilities  that   are  primarily  intended  for
  63interactive usage in a  threaded  Prolog   environment.  It  allows  for
  64inspecting threads, manage I/O of background   threads (depending on the
  65environment) and manipulating the debug status of threads.
  66*/
  67
  68%!  threads
  69%
  70%   List currently known threads with their status.
  71
  72threads :-
  73    threads(Threads),
  74    print_message(information, threads(Threads)).
  75
  76threads(Threads) :-
  77    findall(Thread, thread_statistics(_,Thread), Threads).
  78
  79%!  join_threads
  80%
  81%   Join all terminated threads.
  82
  83join_threads :-
  84    findall(Ripped, rip_thread(Ripped), AllRipped),
  85    (   AllRipped == []
  86    ->  true
  87    ;   print_message(informational, joined_threads(AllRipped))
  88    ).
  89
  90rip_thread(thread{id:id, status:Status}) :-
  91    thread_property(Id, status(Status)),
  92    Status \== running,
  93    \+ thread_self(Id),
  94    thread_join(Id, _).
  95
  96%!  interactor
  97%
  98%   Run a Prolog toplevel in another thread with a new console window.
  99
 100interactor :-
 101    thread_create(thread_run_interactor, _Id,
 102                  [ detached(true),
 103                    debug(false)
 104                  ]).
 105
 106thread_run_interactor :-
 107    set_prolog_flag(query_debug_settings, debug(false, false)),
 108    attach_console,
 109    print_message(banner, thread_welcome),
 110    prolog.
 111
 112%!  thread_has_console is semidet.
 113%
 114%   True when the calling thread has an attached console.
 115%
 116%   @see attach_console/0
 117
 118:- dynamic
 119    has_console/4.                  % Id, In, Out, Err
 120
 121thread_has_console(main) :- !.                  % we assume main has one.
 122thread_has_console(Id) :-
 123    has_console(Id, _, _, _).
 124
 125thread_has_console :-
 126    current_prolog_flag(break_level, _),
 127    !.
 128thread_has_console :-
 129    thread_self(Id),
 130    thread_has_console(Id),
 131    !.
 132
 133%!  attach_console is det.
 134%
 135%   Create an xterm-console and make the standard Prolog streams point to
 136%   it.
 137
 138attach_console :-
 139    thread_has_console,
 140    !.
 141attach_console :-
 142    thread_self(Id),
 143    console_title(Id, Title),
 144    open_console(Title, In, Out, Err),
 145    assert(has_console(Id, In, Out, Err)),
 146    set_stream(In,  alias(user_input)),
 147    set_stream(Out, alias(user_output)),
 148    set_stream(Err, alias(user_error)),
 149    set_stream(In,  alias(current_input)),
 150    set_stream(Out, alias(current_output)),
 151    enable_line_editing(In,Out,Err),
 152    thread_at_exit(detach_console(Id)).
 153
 154console_title(Thread, Title) :-         % uses tabbed consoles
 155    current_prolog_flag(console_menu_version, qt),
 156    !,
 157    human_thread_id(Thread, Id),
 158    format(atom(Title), 'Thread ~w', [Id]).
 159console_title(Thread, Title) :-
 160    current_prolog_flag(system_thread_id, SysId),
 161    human_thread_id(Thread, Id),
 162    format(atom(Title),
 163           'SWI-Prolog Thread ~w (~d) Interactor',
 164           [Id, SysId]).
 165
 166human_thread_id(Thread, Alias) :-
 167    thread_property(Thread, alias(Alias)),
 168    !.
 169human_thread_id(Thread, Id) :-
 170    thread_property(Thread, id(Id)).
 171
 172%!  open_console(+Title, -In, -Out, -Err) is det.
 173%
 174%   Open a new console window and unify In,  Out and Err with the input,
 175%   output and error streams for the new console.
 176
 177:- multifile xterm_args/1.
 178:- dynamic   xterm_args/1.
 179
 180:- if(current_predicate(win_open_console/5)).
 181
 182open_console(Title, In, Out, Err) :-
 183    thread_self(Id),
 184    regkey(Id, Key),
 185    win_open_console(Title, In, Out, Err,
 186                     [ registry_key(Key)
 187                     ]).
 188
 189regkey(Key, Key) :-
 190    atom(Key).
 191regkey(_, 'Anonymous').
 192
 193:- else.
 194
 195%!  xterm_args(-List) is nondet.
 196%
 197%   Multifile and dynamic hook that  provides (additional) arguments for
 198%   the xterm(1) process opened  for   additional  thread consoles. Each
 199%   solution must bind List to a list   of  atomic values. All solutions
 200%   are concatenated using append/2 to form the final argument list.
 201%
 202%   The defaults set  the  colors   to  black-on-light-yellow,  enable a
 203%   scrollbar, set the font using  Xft   font  pattern  and prepares the
 204%   back-arrow key.
 205
 206xterm_args(['-xrm', '*backarrowKeyIsErase: false']).
 207xterm_args(['-xrm', '*backarrowKey: false']).
 208xterm_args(['-fa', 'monospace;pixelsize=11;regular']).
 209xterm_args(['-fg', '#000000']).
 210xterm_args(['-bg', '#ffffdd']).
 211xterm_args(['-sb', '-sl', 1000, '-rightbar']).
 212
 213open_console(Title, In, Out, Err) :-
 214    findall(Arg, xterm_args(Arg), Args),
 215    append(Args, Argv),
 216    open_xterm(Title, In, Out, Err, Argv).
 217
 218:- endif.
 219
 220%!  enable_line_editing(+In, +Out, +Err) is det.
 221%
 222%   Enable line editing for the console.  This   is  by built-in for the
 223%   Windows console. We can also provide it   for the X11 xterm(1) based
 224%   console if we use the BSD libedit based command line editor.
 225
 226:- if((current_prolog_flag(readline, editline),
 227       exists_source(library(editline)))).
 228:- use_module(library(editline)).
 229enable_line_editing(_In, _Out, _Err) :-
 230    current_prolog_flag(readline, editline),
 231    !,
 232    el_wrap.
 233:- endif.
 234enable_line_editing(_In, _Out, _Err).
 235
 236:- if(current_predicate(el_unwrap/1)).
 237disable_line_editing(_In, _Out, _Err) :-
 238    el_unwrap(user_input).
 239:- endif.
 240disable_line_editing(_In, _Out, _Err).
 241
 242
 243%!  detach_console(+ThreadId) is det.
 244%
 245%   Destroy the console for ThreadId.
 246
 247detach_console(Id) :-
 248    (   retract(has_console(Id, In, Out, Err))
 249    ->  disable_line_editing(In, Out, Err),
 250        close(In, [force(true)]),
 251        close(Out, [force(true)]),
 252        close(Err, [force(true)])
 253    ;   true
 254    ).
 255
 256
 257                 /*******************************
 258                 *          DEBUGGING           *
 259                 *******************************/
 260
 261%!  tspy(:Spec) is det.
 262%!  tspy(:Spec, +ThreadId) is det.
 263%
 264%   Trap the graphical debugger on reaching Spec in the specified or
 265%   any thread.
 266
 267tspy(Spec) :-
 268    spy(Spec),
 269    tdebug.
 270
 271tspy(Spec, ThreadID) :-
 272    spy(Spec),
 273    tdebug(ThreadID).
 274
 275
 276%!  tdebug is det.
 277%!  tdebug(+Thread) is det.
 278%
 279%   Enable debug-mode, trapping the graphical debugger on reaching
 280%   spy-points or errors.
 281
 282tdebug :-
 283    forall(debug_target(Id), thread_signal(Id, gdebug)).
 284
 285tdebug(ThreadID) :-
 286    thread_signal(ThreadID, gdebug).
 287
 288%!  tnodebug is det.
 289%!  tnodebug(+Thread) is det.
 290%
 291%   Disable debug-mode in all threads or the specified Thread.
 292
 293tnodebug :-
 294    forall(debug_target(Id), thread_signal(Id, nodebug)).
 295
 296tnodebug(ThreadID) :-
 297    thread_signal(ThreadID, nodebug).
 298
 299
 300debug_target(Thread) :-
 301    thread_property(Thread, status(running)),
 302    thread_property(Thread, debug(true)).
 303
 304
 305                 /*******************************
 306                 *       REMOTE PROFILING       *
 307                 *******************************/
 308
 309%!  tprofile(+Thread) is det.
 310%
 311%   Profile the operation of Thread until the user hits a key.
 312
 313tprofile(Thread) :-
 314    init_pce,
 315    thread_signal(Thread,
 316                  (   reset_profiler,
 317                      profiler(_, true)
 318                  )),
 319    format('Running profiler in thread ~w (press RET to show results) ...',
 320           [Thread]),
 321    flush_output,
 322    get0(_),
 323    thread_signal(Thread,
 324                  (   profiler(_, false),
 325                      show_profile([])
 326                  )).
 327
 328
 329%!  init_pce
 330%
 331%   Make sure XPCE is running if it is   attached, so we can use the
 332%   graphical display using in_pce_thread/1.
 333
 334init_pce :-
 335    current_prolog_flag(gui, true),
 336    !,
 337    call(send(@(display), open)).   % avoid autoloading
 338init_pce.
 339
 340
 341                 /*******************************
 342                 *             HOOKS            *
 343                 *******************************/
 344
 345:- multifile
 346    user:message_hook/3.
 347
 348user:message_hook(trace_mode(on), _, Lines) :-
 349    \+ thread_has_console,
 350    \+ current_prolog_flag(gui_tracer, true),
 351    catch(attach_console, _, fail),
 352    print_message_lines(user_error, '% ', Lines).
 353
 354:- multifile
 355    prolog:message/3.
 356
 357prolog:message(thread_welcome) -->
 358    { thread_self(Self),
 359      human_thread_id(Self, Id)
 360    },
 361    [ 'SWI-Prolog console for thread ~w'-[Id],
 362      nl, nl
 363    ].
 364prolog:message(joined_threads(Threads)) -->
 365    [ 'Joined the following threads'-[], nl ],
 366    thread_list(Threads).
 367prolog:message(threads(Threads)) -->
 368    thread_list(Threads).
 369
 370thread_list(Threads) -->
 371    { maplist(th_id_len, Threads, Lens),
 372      max_list(Lens, MaxWidth),
 373      LeftColWidth is max(6, MaxWidth),
 374      Threads = [H|_]
 375    },
 376    thread_list_header(H, LeftColWidth),
 377    thread_list(Threads, LeftColWidth).
 378
 379th_id_len(Thread, IdLen) :-
 380    write_length(Thread.id, IdLen, [quoted(true)]).
 381
 382thread_list([], _) --> [].
 383thread_list([H|T], CW) -->
 384    thread_info(H, CW),
 385    (   {T == []}
 386    ->  []
 387    ;   [nl],
 388        thread_list(T, CW)
 389    ).
 390
 391thread_list_header(Thread, CW) -->
 392    { _{id:_, status:_, time:_, stacks:_} :< Thread,
 393      !,
 394      HrWidth is CW+18+13+13
 395    },
 396    [ '~|~tThread~*+ Status~tTime~18+~tStack use~13+~tallocated~13+'-[CW], nl ],
 397    [ '~|~`-t~*+'-[HrWidth], nl ].
 398thread_list_header(Thread, CW) -->
 399    { _{id:_, status:_} :< Thread,
 400      !,
 401      HrWidth is CW+7
 402    },
 403    [ '~|~tThread~*+ Status'-[CW], nl ],
 404    [ '~|~`-t~*+'-[HrWidth], nl ].
 405
 406thread_info(Thread, CW) -->
 407    { _{id:Id, status:Status, time:Time, stacks:Stacks} :< Thread },
 408    !,
 409    [ '~|~t~q~*+ ~w~t~3f~18+~t~D~13+~t~D~13+'-
 410      [ Id, CW, Status, Time.cpu, Stacks.total.usage, Stacks.total.allocated
 411      ]
 412    ].
 413thread_info(Thread, CW) -->
 414    { _{id:Id, status:Status} :< Thread },
 415    !,
 416    [ '~|~t~q~*+ ~w'-
 417      [ Id, CW, Status
 418      ]
 419    ].