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