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