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
  317:- if((current_prolog_flag(readline, editline),
  318       exists_source(library(editline)))).  319enable_line_editing(_In, _Out, _Err) :-
  320    current_prolog_flag(readline, editline),
  321    !,
  322    el_wrap.
  323:- endif.  324enable_line_editing(_In, _Out, _Err).
  325
  326:- if(current_predicate(el_unwrap/1)).  327disable_line_editing(_In, _Out, _Err) :-
  328    el_unwrap(user_input).
  329:- endif.  330disable_line_editing(_In, _Out, _Err).
  331
  332
  333%!  detach_console(+ThreadId) is det.
  334%
  335%   Destroy the console for ThreadId.
  336
  337detach_console(Id) :-
  338    (   retract(has_console(Id, In, Out, Err))
  339    ->  disable_line_editing(In, Out, Err),
  340        close(In, [force(true)]),
  341        close(Out, [force(true)]),
  342        close(Err, [force(true)])
  343    ;   true
  344    ).
  345
  346%!  interactor is det.
  347%!  interactor(?Title) is det.
  348%
  349%   Run a Prolog toplevel in another thread   with a new console window.
  350%   If Title is given, this will be used as the window title.
  351
  352interactor :-
  353    interactor(_).
  354
  355interactor(Title) :-
  356    can_open_console,
  357    !,
  358    thread_self(Me),
  359    thread_create(thread_run_interactor(Me, Title), _Id,
  360                  [ detached(true)
  361                  ]),
  362    thread_get_message(Msg),
  363    (   Msg = title(Title0)
  364    ->  Title = Title0
  365    ;   Msg = throw(Error)
  366    ->  throw(Error)
  367    ;   Msg = false
  368    ->  fail
  369    ).
  370interactor(Title) :-
  371    print_message(error, cannot_attach_console(Title)),
  372    fail.
  373
  374thread_run_interactor(Creator, Title) :-
  375    set_prolog_flag(query_debug_settings, debug(false, false)),
  376    Error = error(Formal,_),
  377    (   catch(attach_console(Title), Error, true)
  378    ->  (   var(Formal)
  379        ->  thread_send_message(Creator, title(Title)),
  380            print_message(banner, thread_welcome),
  381            prolog
  382        ;   thread_send_message(Creator, throw(Error))
  383        )
  384    ;   thread_send_message(Creator, false)
  385    ).
  386
  387%!  thread_run_interactor
  388%
  389%   Attach a console and run a Prolog toplevel in the current thread.
  390
  391thread_run_interactor :-
  392    set_prolog_flag(query_debug_settings, debug(false, false)),
  393    attach_console(_Title),
  394    print_message(banner, thread_welcome),
  395    prolog.
  396
  397:- endif.                               % have open_console/4
  398
  399                 /*******************************
  400                 *          DEBUGGING           *
  401                 *******************************/
  402
  403%!  tspy(:Spec) is det.
  404%!  tspy(:Spec, +ThreadId) is det.
  405%
  406%   Trap the graphical debugger on reaching Spec in the specified or
  407%   any thread.
  408
  409tspy(Spec) :-
  410    spy(Spec),
  411    tdebug.
  412
  413tspy(Spec, ThreadID) :-
  414    spy(Spec),
  415    tdebug(ThreadID).
  416
  417
  418%!  tdebug is det.
  419%!  tdebug(+Thread) is det.
  420%
  421%   Enable debug-mode, trapping the graphical debugger on reaching
  422%   spy-points or errors.
  423
  424tdebug :-
  425    forall(debug_target(Id), thread_signal(Id, gdebug)).
  426
  427tdebug(ThreadID) :-
  428    thread_signal(ThreadID, gdebug).
  429
  430%!  tnodebug is det.
  431%!  tnodebug(+Thread) is det.
  432%
  433%   Disable debug-mode in all threads or the specified Thread.
  434
  435tnodebug :-
  436    forall(debug_target(Id), thread_signal(Id, nodebug)).
  437
  438tnodebug(ThreadID) :-
  439    thread_signal(ThreadID, nodebug).
  440
  441
  442debug_target(Thread) :-
  443    thread_property(Thread, status(running)),
  444    thread_property(Thread, debug(true)).
  445
  446%!  tbacktrace(+Thread) is det.
  447%!  tbacktrace(+Thread, +Options) is det.
  448%
  449%   Print a backtrace for  Thread  to   the  stream  `user_error` of the
  450%   calling thread. This is achieved  by   inserting  an  interrupt into
  451%   Thread using call_in_thread/2. Options:
  452%
  453%     - depth(+MaxFrames)
  454%       Number of stack frames to show.  Default is the current Prolog
  455%       flag `backtrace_depth` or 20.
  456%
  457%   Other options are passed to get_prolog_backtrace/3.
  458%
  459%   @bug call_in_thread/2 may not process the event.
  460
  461tbacktrace(Thread) :-
  462    tbacktrace(Thread, []).
  463
  464tbacktrace(Thread, Options) :-
  465    merge_options(Options, [clause_references(false)], Options1),
  466    (   current_prolog_flag(backtrace_depth, Default)
  467    ->  true
  468    ;   Default = 20
  469    ),
  470    option(depth(Depth), Options1, Default),
  471    call_in_thread(Thread, thread_get_prolog_backtrace(Depth, Stack, Options1)),
  472    print_prolog_backtrace(user_error, Stack).
  473
  474%!  thread_get_prolog_backtrace(+Depth, -Stack, +Options)
  475%
  476%   As get_prolog_backtrace/3, but starts above   the C callback, hiding
  477%   the overhead inside call_in_thread/2.
  478
  479thread_get_prolog_backtrace(Depth, Stack, Options) :-
  480    prolog_current_frame(Frame),
  481    signal_frame(Frame, SigFrame),
  482    get_prolog_backtrace(Depth, Stack, [frame(SigFrame)|Options]).
  483
  484signal_frame(Frame, SigFrame) :-
  485    prolog_frame_attribute(Frame, clause, _),
  486    !,
  487    (   prolog_frame_attribute(Frame, parent, Parent)
  488    ->  signal_frame(Parent, SigFrame)
  489    ;   SigFrame = Frame
  490    ).
  491signal_frame(Frame, SigFrame) :-
  492    (   prolog_frame_attribute(Frame, parent, Parent)
  493    ->  SigFrame = Parent
  494    ;   SigFrame = Frame
  495    ).
  496
  497
  498
  499                 /*******************************
  500                 *       REMOTE PROFILING       *
  501                 *******************************/
  502
  503%!  tprofile(+Thread) is det.
  504%
  505%   Profile the operation of Thread until the user hits a key.
  506
  507tprofile(Thread) :-
  508    init_pce,
  509    thread_signal(Thread,
  510                  (   reset_profiler,
  511                      profiler(_, true)
  512                  )),
  513    format('Running profiler in thread ~w (press RET to show results) ...',
  514           [Thread]),
  515    flush_output,
  516    get_code(_),
  517    thread_signal(Thread,
  518                  (   profiler(_, false),
  519                      show_profile([])
  520                  )).
  521
  522
  523%!  init_pce
  524%
  525%   Make sure XPCE is running if it is   attached, so we can use the
  526%   graphical display using in_pce_thread/1.
  527
  528:- if(exists_source(library(pce))).  529init_pce :-
  530    current_prolog_flag(gui, true),
  531    !,
  532    call(send(@(display), open)).   % avoid autoloading
  533:- endif.  534init_pce.
  535
  536
  537                 /*******************************
  538                 *             HOOKS            *
  539                 *******************************/
  540
  541:- multifile
  542    user:message_hook/3.  543
  544user:message_hook(trace_mode(on), _, Lines) :-
  545    \+ thread_has_console,
  546    \+ current_prolog_flag(gui_tracer, true),
  547    catch(attach_console, _, fail),
  548    print_message_lines(user_error, '% ', Lines).
  549
  550:- multifile
  551    prolog:message/3.  552
  553prolog:message(thread_welcome) -->
  554    { thread_self(Self),
  555      human_thread_id(Self, Id)
  556    },
  557    [ 'SWI-Prolog console for thread ~w'-[Id],
  558      nl, nl
  559    ].
  560prolog:message(joined_threads(Threads)) -->
  561    [ 'Joined the following threads'-[], nl ],
  562    thread_list(Threads).
  563prolog:message(threads(Threads)) -->
  564    thread_list(Threads).
  565prolog:message(cannot_attach_console(_Title)) -->
  566    [ 'Cannot attach a console (requires swipl-win or POSIX pty support)' ].
  567
  568thread_list(Threads) -->
  569    { maplist(th_id_len, Threads, Lens),
  570      max_list(Lens, MaxWidth),
  571      LeftColWidth is max(6, MaxWidth),
  572      Threads = [H|_]
  573    },
  574    thread_list_header(H, LeftColWidth),
  575    thread_list(Threads, LeftColWidth).
  576
  577th_id_len(Thread, IdLen) :-
  578    write_length(Thread.id, IdLen, [quoted(true)]).
  579
  580thread_list([], _) --> [].
  581thread_list([H|T], CW) -->
  582    thread_info(H, CW),
  583    (   {T == []}
  584    ->  []
  585    ;   [nl],
  586        thread_list(T, CW)
  587    ).
  588
  589thread_list_header(Thread, CW) -->
  590    { _{id:_, status:_, time:_, stacks:_} :< Thread,
  591      !,
  592      HrWidth is CW+18+13+13
  593    },
  594    [ '~|~tThread~*+ Status~tTime~18+~tStack use~13+~tallocated~13+'-[CW], nl ],
  595    [ '~|~`-t~*+'-[HrWidth], nl ].
  596thread_list_header(Thread, CW) -->
  597    { _{id:_, status:_} :< Thread,
  598      !,
  599      HrWidth is CW+7
  600    },
  601    [ '~|~tThread~*+ Status'-[CW], nl ],
  602    [ '~|~`-t~*+'-[HrWidth], nl ].
  603
  604thread_info(Thread, CW) -->
  605    { _{id:Id, status:Status, time:Time, stacks:Stacks} :< Thread },
  606    !,
  607    [ '~|~t~q~*+ ~w~t~3f~18+~t~D~13+~t~D~13+'-
  608      [ Id, CW, Status, Time.cpu, Stacks.total.usage, Stacks.total.allocated
  609      ]
  610    ].
  611thread_info(Thread, CW) -->
  612    { _{id:Id, status:Status} :< Thread },
  613    !,
  614    [ '~|~t~q~*+ ~w'-
  615      [ Id, CW, Status
  616      ]
  617    ]