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,append/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', 'Ubuntu Mono', '-fs', 12]).
  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    ]