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-2025, 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_prolog_flag(xpce, true)).   55:- export(( interactor/0,
   56            interactor/1                % ?Title
   57          )).   58:- autoload(library(epilog),
   59            [ epilog/1,
   60              epilog_attach/1,
   61              ep_has_console/1
   62            ]).   63:- endif.   64
   65:- meta_predicate
   66    with_stopped_threads(0, +).   67
   68:- autoload(library(apply),[maplist/3]).   69:- autoload(library(backcomp),[thread_at_exit/1]).   70:- autoload(library(edinburgh),[nodebug/0]).   71:- autoload(library(lists),[max_list/2,append/2]).   72:- autoload(library(option),[merge_options/3,option/3]).   73:- autoload(library(prolog_stack),
   74	    [print_prolog_backtrace/2,get_prolog_backtrace/3]).   75:- autoload(library(statistics),[thread_statistics/2]).   76:- autoload(library(prolog_profile), [show_profile/1]).   77:- autoload(library(thread),[call_in_thread/2]).   78
   79:- set_prolog_flag(generate_debug_info, false).   80
   81:- module_transparent
   82    tspy/1,
   83    tspy/2.   84
   85/** <module> Interactive thread utilities
   86
   87This  library  provides  utilities  that   are  primarily  intended  for
   88interactive usage in a  threaded  Prolog   environment.  It  allows  for
   89inspecting threads, manage I/O of background   threads (depending on the
   90environment) and manipulating the debug status of threads.
   91*/
   92
   93%!  threads
   94%
   95%   List currently known threads with their status.
   96
   97threads :-
   98    threads(Threads),
   99    print_message(information, threads(Threads)).
  100
  101threads(Threads) :-
  102    findall(Thread, thread_statistics(_,Thread), Threads).
  103
  104%!  join_threads
  105%
  106%   Join all terminated threads.
  107
  108join_threads :-
  109    findall(Ripped, rip_thread(Ripped), AllRipped),
  110    (   AllRipped == []
  111    ->  true
  112    ;   print_message(informational, joined_threads(AllRipped))
  113    ).
  114
  115rip_thread(thread{id:id, status:Status}) :-
  116    thread_property(Id, status(Status)),
  117    Status \== running,
  118    \+ thread_self(Id),
  119    thread_join(Id, _).
  120
  121%!  with_stopped_threads(:Goal, Options) is det.
  122%
  123%   Stop all threads except the caller   while  running once(Goal). Note
  124%   that this is in the thread user   utilities as this is not something
  125%   that should be used  by  normal   applications.  Notably,  this  may
  126%   _deadlock_ if the current thread  requires   input  from  some other
  127%   thread to complete Goal or one of   the  stopped threads has a lock.
  128%   Options:
  129%
  130%     - stop_nodebug_threads(+Boolean)
  131%       If `true` (default `false`), also stop threads created with
  132%       the debug(false) option.
  133%     - except(+List)
  134%       Do not stop threads from this list.
  135%
  136%   @bug Note that the threads are stopped when they process signals. As
  137%   signal handling may be  delayed,  this   implies  they  need  not be
  138%   stopped before Goal starts.
  139
  140:- dynamic stopped_except/1.  141
  142with_stopped_threads(_, _) :-
  143    stopped_except(_),
  144    !.
  145with_stopped_threads(Goal, Options) :-
  146    thread_self(Me),
  147    setup_call_cleanup(
  148        asserta(stopped_except(Me), Ref),
  149        ( stop_other_threads(Me, Options),
  150          once(Goal)
  151        ),
  152        erase(Ref)).
  153
  154stop_other_threads(Me, Options) :-
  155    findall(T, stop_thread(Me, T, Options), Stopped),
  156    broadcast(stopped_threads(Stopped)).
  157
  158stop_thread(Me, Thread, Options) :-
  159    option(except(Except), Options, []),
  160    (   option(stop_nodebug_threads(true), Options)
  161    ->  thread_property(Thread, status(running))
  162    ;   debug_target(Thread)
  163    ),
  164    Me \== Thread,
  165    \+ memberchk(Thread, Except),
  166    catch(thread_signal(Thread, stopped_except), error(_,_), fail).
  167
  168stopped_except :-
  169    thread_wait(\+ stopped_except(_),
  170                [ wait_preds([stopped_except/1])
  171                ]).
  172
  173%!  thread_has_console is semidet.
  174%
  175%   True when the calling thread has an attached console.
  176%
  177%   @see attach_console/0
  178
  179thread_has_console(main) :-
  180    !,
  181    \+ current_prolog_flag(epilog, true).
  182thread_has_console(Id) :-
  183    ep_has_console(Id).
  184
  185thread_has_console :-
  186    current_prolog_flag(break_level, _),
  187    !.
  188thread_has_console :-
  189    thread_self(Id),
  190    thread_has_console(Id),
  191    !.
  192
  193%!  attach_console is det.
  194%!  attach_console(?Title) is det.
  195%
  196%   Create a new console and make the   standard Prolog streams point to
  197%   it. If not provided, the title is   built  using the thread id. Does
  198%   nothing if the current thread already has a console attached.
  199
  200attach_console :-
  201    attach_console(_).
  202
  203attach_console(_) :-
  204    thread_has_console,
  205    !.
  206:- if(current_predicate(epilog_attach/1)).  207attach_console(Title) :-
  208    thread_self(Me),
  209    console_title(Me, Title),
  210    epilog_attach([ title(Title)
  211                  ]).
  212:- endif.  213attach_console(Title) :-
  214    print_message(error, cannot_attach_console(Title)),
  215    fail.
  216
  217console_title(Thread, Title) :-
  218    current_prolog_flag(system_thread_id, SysId),
  219    human_thread_id(Thread, Id),
  220    format(atom(Title),
  221           'SWI-Prolog Thread ~w (~d) Interactor',
  222           [Id, SysId]).
  223
  224human_thread_id(Thread, Alias) :-
  225    thread_property(Thread, alias(Alias)),
  226    !.
  227human_thread_id(Thread, Id) :-
  228    thread_property(Thread, id(Id)).
  229
  230%!  interactor is det.
  231%!  interactor(?Title) is det.
  232%
  233%   Run a Prolog toplevel in another thread   with a new console window.
  234%   If Title is given, this will be used as the window title.
  235
  236interactor :-
  237    interactor(_).
  238
  239:- if(current_predicate(epilog/1)).  240interactor(Title) :-
  241    !,
  242    (   nonvar(Title)
  243    ->  Options = [title(Title)]
  244    ;   Options = []
  245    ),
  246    epilog([ init(true)
  247           | Options
  248           ]).
  249:- endif.  250interactor(Title) :-
  251    print_message(error, cannot_attach_console(Title)),
  252    fail.
  253
  254
  255                 /*******************************
  256                 *          DEBUGGING           *
  257                 *******************************/
  258
  259%!  tspy(:Spec) is det.
  260%!  tspy(:Spec, +ThreadId) is det.
  261%
  262%   Trap the graphical debugger on reaching Spec in the specified or
  263%   any thread.
  264
  265tspy(Spec) :-
  266    spy(Spec),
  267    tdebug.
  268
  269tspy(Spec, ThreadID) :-
  270    spy(Spec),
  271    tdebug(ThreadID).
  272
  273
  274%!  tdebug is det.
  275%!  tdebug(+Thread) is det.
  276%
  277%   Enable debug-mode, trapping the graphical debugger on reaching
  278%   spy-points or errors.
  279
  280tdebug :-
  281    forall(debug_target(Id), thread_signal(Id, debug_thread)).
  282
  283tdebug(ThreadID) :-
  284    thread_signal(ThreadID, debug_thread).
  285
  286debug_thread :-
  287    current_prolog_flag(gui, true),
  288    !,
  289    autoload_call(gdebug).
  290debug_thread :-
  291    debug.
  292
  293
  294%!  tnodebug is det.
  295%!  tnodebug(+Thread) is det.
  296%
  297%   Disable debug-mode in all threads or the specified Thread.
  298
  299tnodebug :-
  300    forall(debug_target(Id), thread_signal(Id, nodebug)).
  301
  302tnodebug(ThreadID) :-
  303    thread_signal(ThreadID, nodebug).
  304
  305
  306debug_target(Thread) :-
  307    thread_property(Thread, status(running)),
  308    thread_property(Thread, debug(true)).
  309
  310%!  tbacktrace(+Thread) is det.
  311%!  tbacktrace(+Thread, +Options) is det.
  312%
  313%   Print a backtrace for  Thread  to   the  stream  `user_error` of the
  314%   calling thread. This is achieved  by   inserting  an  interrupt into
  315%   Thread using call_in_thread/2. Options:
  316%
  317%     - depth(+MaxFrames)
  318%       Number of stack frames to show.  Default is the current Prolog
  319%       flag `backtrace_depth` or 20.
  320%
  321%   Other options are passed to get_prolog_backtrace/3.
  322%
  323%   @bug call_in_thread/2 may not process the event.
  324
  325tbacktrace(Thread) :-
  326    tbacktrace(Thread, []).
  327
  328tbacktrace(Thread, Options) :-
  329    merge_options(Options, [clause_references(false)], Options1),
  330    (   current_prolog_flag(backtrace_depth, Default)
  331    ->  true
  332    ;   Default = 20
  333    ),
  334    option(depth(Depth), Options1, Default),
  335    call_in_thread(Thread, thread_get_prolog_backtrace(Depth, Stack, Options1)),
  336    print_prolog_backtrace(user_error, Stack).
  337
  338%!  thread_get_prolog_backtrace(+Depth, -Stack, +Options)
  339%
  340%   As get_prolog_backtrace/3, but starts above   the C callback, hiding
  341%   the overhead inside call_in_thread/2.
  342
  343thread_get_prolog_backtrace(Depth, Stack, Options) :-
  344    prolog_current_frame(Frame),
  345    signal_frame(Frame, SigFrame),
  346    get_prolog_backtrace(Depth, Stack, [frame(SigFrame)|Options]).
  347
  348signal_frame(Frame, SigFrame) :-
  349    prolog_frame_attribute(Frame, clause, _),
  350    !,
  351    (   prolog_frame_attribute(Frame, parent, Parent)
  352    ->  signal_frame(Parent, SigFrame)
  353    ;   SigFrame = Frame
  354    ).
  355signal_frame(Frame, SigFrame) :-
  356    (   prolog_frame_attribute(Frame, parent, Parent)
  357    ->  SigFrame = Parent
  358    ;   SigFrame = Frame
  359    ).
  360
  361
  362
  363                 /*******************************
  364                 *       REMOTE PROFILING       *
  365                 *******************************/
  366
  367%!  tprofile(+Thread) is det.
  368%
  369%   Profile the operation of Thread until the user hits a key.
  370
  371tprofile(Thread) :-
  372    init_pce,
  373    thread_signal(Thread,
  374                  (   reset_profiler,
  375                      profiler(_, true)
  376                  )),
  377    format('Running profiler in thread ~w (press RET to show results) ...',
  378           [Thread]),
  379    flush_output,
  380    get_code(_),
  381    thread_signal(Thread,
  382                  (   profiler(_, false),
  383                      show_profile([])
  384                  )).
  385
  386
  387%!  init_pce
  388%
  389%   Make sure XPCE is running if it is   attached, so we can use the
  390%   graphical display using in_pce_thread/1.
  391
  392:- if(exists_source(library(pce))).  393init_pce :-
  394    current_prolog_flag(gui, true),
  395    !,
  396    autoload_call(send(@(display), open)).
  397:- endif.  398init_pce.
  399
  400
  401                 /*******************************
  402                 *             HOOKS            *
  403                 *******************************/
  404
  405:- multifile
  406    user:message_hook/3.  407
  408user:message_hook(trace_mode(on), _, Lines) :-
  409    \+ thread_has_console,
  410    \+ current_prolog_flag(gui_tracer, true),
  411    catch(attach_console, _, fail),
  412    print_message_lines(user_error, '% ', Lines).
  413
  414:- multifile
  415    prolog:message/3.  416
  417prolog:message(thread_welcome) -->
  418    { thread_self(Self),
  419      human_thread_id(Self, Id)
  420    },
  421    [ 'SWI-Prolog console for thread ~w'-[Id],
  422      nl, nl
  423    ].
  424prolog:message(joined_threads(Threads)) -->
  425    [ 'Joined the following threads'-[], nl ],
  426    thread_list(Threads).
  427prolog:message(threads(Threads)) -->
  428    thread_list(Threads).
  429prolog:message(cannot_attach_console(_Title)) -->
  430    [ 'Cannot attach a console (requires xpce package)' ].
  431
  432thread_list(Threads) -->
  433    { maplist(th_id_len, Threads, Lens),
  434      max_list(Lens, MaxWidth),
  435      LeftColWidth is max(6, MaxWidth),
  436      Threads = [H|_]
  437    },
  438    thread_list_header(H, LeftColWidth),
  439    thread_list(Threads, LeftColWidth).
  440
  441th_id_len(Thread, IdLen) :-
  442    write_length(Thread.id, IdLen, [quoted(true)]).
  443
  444thread_list([], _) --> [].
  445thread_list([H|T], CW) -->
  446    thread_info(H, CW),
  447    (   {T == []}
  448    ->  []
  449    ;   [nl],
  450        thread_list(T, CW)
  451    ).
  452
  453thread_list_header(Thread, CW) -->
  454    { _{id:_, status:_, time:_, stacks:_} :< Thread,
  455      !,
  456      HrWidth is CW+18+13+13
  457    },
  458    [ '~|~tThread~*+ Status~tTime~18+~tStack use~13+~tallocated~13+'-[CW], nl ],
  459    [ '~|~`-t~*+'-[HrWidth], nl ].
  460thread_list_header(Thread, CW) -->
  461    { _{id:_, status:_} :< Thread,
  462      !,
  463      HrWidth is CW+7
  464    },
  465    [ '~|~tThread~*+ Status'-[CW], nl ],
  466    [ '~|~`-t~*+'-[HrWidth], nl ].
  467
  468thread_info(Thread, CW) -->
  469    { _{id:Id, status:Status, time:Time, stacks:Stacks} :< Thread },
  470    !,
  471    [ '~|~t~q~*+ ~w~t~3f~18+~t~D~13+~t~D~13+'-
  472      [ Id, CW, Status, Time.cpu, Stacks.total.usage, Stacks.total.allocated
  473      ]
  474    ].
  475thread_info(Thread, CW) -->
  476    { _{id:Id, status:Status} :< Thread },
  477    !,
  478    [ '~|~t~q~*+ ~w'-
  479      [ Id, CW, Status
  480      ]
  481    ]