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