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