1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        jan@swi-prolog.org
    5    WWW:           https://www.swi-prolog.org
    6    Copyright (c)  1999-2026, 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            thread_alias/1              % +Alias
   54          ]).   55:- if(current_prolog_flag(xpce, true)).   56:- export(( interactor/0,
   57            interactor/1                % ?Title
   58          )).   59:- autoload(library(epilog), [epilog/1, epilog_attach/1, ep_has_console/1]).   60:- endif.   61:- meta_predicate with_stopped_threads(0, +).   62:- autoload(library(apply), [maplist/3, convlist/3]).   63:- autoload(library(backcomp), [thread_at_exit/1]).   64:- autoload(library(edinburgh), [nodebug/0]).   65:- autoload(library(lists), [max_list/2, append/2]).   66:- autoload(library(option), [merge_options/3, option/3, option/2]).   67:- autoload(library(prolog_stack),
   68            [print_prolog_backtrace/2, get_prolog_backtrace/3]).   69:- autoload(library(statistics), [thread_statistics/2]).   70:- autoload(library(prolog_profile), [show_profile/1]).   71:- autoload(library(thread), [call_in_thread/2]).   72:- autoload(library(broadcast), [broadcast/1]).   73:- autoload(library(prolog_debug), [spy/1]).   74:- autoload(library(dcg/high_order), [sequence/5]).   75:- autoload(library(gui_tracer), [guitracer/0, ensure_guitracer/0]).   76
   77:- set_prolog_flag(generate_debug_info, false).   78
   79:- module_transparent
   80    tspy/1,
   81    tspy/2.   82
   83/** <module> Interactive thread utilities
   84
   85This  library  provides  utilities  that   are  primarily  intended  for
   86interactive usage in a  threaded  Prolog   environment.  It  allows  for
   87inspecting threads, manage I/O of background   threads (depending on the
   88environment) and manipulating the debug status of threads.
   89*/
   90
   91%!  threads
   92%
   93%   List currently known threads with their   status. For each thread it
   94%   lists the _id_, _class_, _status_, _debug   status_,  _CPU time_ and
   95%   current _stack usage_. If a thread  is   listed  with _Debug_ set to
   96%   `X', it cannot be debugged. If the  _Debug_   is  show as `V', it is
   97%   running in debug mode (see debug/0) and responds to _spy points_ and
   98%   _break points_.
   99
  100threads :-
  101    threads(Threads),
  102    print_message(information, threads(Threads)).
  103
  104threads(Threads) :-
  105    findall(Thread, thread_data(Thread), Threads).
  106
  107thread_data(Data) :-
  108    thread_statistics(TID, Stats),
  109    thread_property(TID, debug(Debug)),
  110    (   Debug == true
  111    ->  thread_property(TID, debug_mode(DebugMode)),
  112        put_dict(debug, Stats, DebugMode, Stats1)
  113    ;   Stats1 = Stats
  114    ),
  115    (   thread_property(TID, class(Class))
  116    ->  put_dict(class, Stats1, Class, Data)
  117    ;   Data = Stats
  118    ).
  119
  120%!  join_threads
  121%
  122%   Join all terminated threads. For   normal applications, dealing with
  123%   terminated threads must be part  of   the  application logic, either
  124%   detaching the thread before termination or   making  sure it will be
  125%   joined. The predicate join_threads/0  is   intended  for interactive
  126%   sessions to reclaim resources from   threads  that died unexpectedly
  127%   during development.
  128
  129join_threads :-
  130    findall(Ripped, rip_thread(Ripped), AllRipped),
  131    (   AllRipped == []
  132    ->  true
  133    ;   print_message(informational, joined_threads(AllRipped))
  134    ).
  135
  136rip_thread(thread{id:id, status:Status}) :-
  137    thread_property(Id, status(Status)),
  138    Status \== running,
  139    \+ thread_self(Id),
  140    thread_join(Id, _).
  141
  142%!  with_stopped_threads(:Goal, Options) is det.
  143%
  144%   Stop all threads except the caller   while  running once(Goal). Note
  145%   that this is in the thread user   utilities as this is not something
  146%   that should be used  by  normal   applications.  Notably,  this  may
  147%   _deadlock_ if the current thread  requires   input  from  some other
  148%   thread to complete Goal or one of   the  stopped threads has a lock.
  149%   Options:
  150%
  151%     - stop_nodebug_threads(+Boolean)
  152%       If `true` (default `false`), also stop threads created with
  153%       the debug(false) option.
  154%     - except(+List)
  155%       Do not stop threads from this list.
  156%
  157%   @bug Note that the threads are stopped when they process signals. As
  158%   signal handling may be  delayed,  this   implies  they  need  not be
  159%   stopped before Goal starts.
  160
  161:- dynamic stopped_except/1.  162
  163with_stopped_threads(_, _) :-
  164    stopped_except(_),
  165    !.
  166with_stopped_threads(Goal, Options) :-
  167    thread_self(Me),
  168    setup_call_cleanup(
  169        asserta(stopped_except(Me), Ref),
  170        ( stop_other_threads(Me, Options),
  171          once(Goal)
  172        ),
  173        erase(Ref)).
  174
  175stop_other_threads(Me, Options) :-
  176    findall(T, stop_thread(Me, T, Options), Stopped),
  177    broadcast(stopped_threads(Stopped)).
  178
  179stop_thread(Me, Thread, Options) :-
  180    option(except(Except), Options, []),
  181    (   option(stop_nodebug_threads(true), Options)
  182    ->  thread_property(Thread, status(running))
  183    ;   debug_target(Thread)
  184    ),
  185    Me \== Thread,
  186    \+ memberchk(Thread, Except),
  187    catch(thread_signal(Thread, stopped_except), error(_,_), fail).
  188
  189stopped_except :-
  190    thread_wait(\+ stopped_except(_),
  191                [ wait_preds([stopped_except/1])
  192                ]).
  193
  194%!  thread_has_console is semidet.
  195%
  196%   True when the calling thread has an attached console.
  197%
  198%   @see attach_console/0
  199
  200thread_has_console(main) :-
  201    !,
  202    \+ current_prolog_flag(epilog, true).
  203thread_has_console(Id) :-
  204    thread_property(Id, class(console)),
  205    !.
  206:- if(current_predicate(ep_has_console/1)).  207thread_has_console(Id) :-
  208    ep_has_console(Id).
  209:- endif.  210
  211
  212thread_has_console :-
  213    current_prolog_flag(break_level, _),
  214    !.
  215thread_has_console :-
  216    thread_self(Id),
  217    thread_has_console(Id),
  218    !.
  219
  220%!  attach_console is det.
  221%!  attach_console(+Title) is det.
  222%
  223%   Create a new console and make the   standard Prolog streams point to
  224%   it. If not provided, the title is   built  using the thread id. Does
  225%   nothing if the current thread already has a console attached.
  226
  227attach_console :-
  228    attach_console(_).
  229
  230attach_console(_) :-
  231    thread_has_console,
  232    !.
  233:- if(current_predicate(epilog_attach/1)).  234attach_console(Title) :-
  235    thread_self(Me),
  236    console_title(Me, Title),
  237    epilog_attach([ title(Title)
  238                  ]).
  239:- endif.  240attach_console(Title) :-
  241    print_message(error, cannot_attach_console(Title)),
  242    fail.
  243
  244console_title(Thread, Title) :-
  245    current_prolog_flag(system_thread_id, SysId),
  246    human_thread_id(Thread, Id),
  247    format(atom(Title),
  248           'SWI-Prolog Thread ~w (~d) Interactor',
  249           [Id, SysId]).
  250
  251human_thread_id(Thread, Alias) :-
  252    thread_property(Thread, alias(Alias)),
  253    !.
  254human_thread_id(Thread, Id) :-
  255    thread_property(Thread, id(Id)).
  256
  257%!  interactor is det.
  258%!  interactor(+Title) is det.
  259%
  260%   Run a Prolog toplevel in another thread   with a new console window.
  261%   If Title is given, this will be  used   as  the  window title. As of
  262%   SWI-Prolog version 10, the console is  provided by the XPCE graphics
  263%   library using library(epilog).
  264
  265interactor :-
  266    interactor(_).
  267
  268:- if(current_predicate(epilog/1)).  269interactor(Title) :-
  270    !,
  271    (   nonvar(Title)
  272    ->  Options = [title(Title)]
  273    ;   Options = []
  274    ),
  275    epilog([ init(true)
  276           | Options
  277           ]).
  278:- endif.  279interactor(Title) :-
  280    print_message(error, cannot_attach_console(Title)),
  281    fail.
  282
  283
  284                 /*******************************
  285                 *          DEBUGGING           *
  286                 *******************************/
  287
  288%!  tspy(:Spec) is det.
  289%!  tspy(:Spec, +ThreadOrClass) is det.
  290%
  291%   Trap the graphical debugger on reaching   Spec. The predicate tspy/0
  292%   enabled debug mode in  all  threads   using  tdebug/0  while  tspy/1
  293%   enables debug mode using tdebug/1.
  294
  295tspy(Spec) :-
  296    spy(Spec),
  297    tdebug.
  298
  299tspy(Spec, ThreadID) :-
  300    spy(Spec),
  301    tdebug(ThreadID).
  302
  303
  304%!  tdebug is det.
  305%!  tdebug(+ThreadOrClass) is det.
  306%!  tnodebug is det.
  307%!  tnodebug(+ThreadOrClass) is det.
  308%
  309%   Enable or disable a thread or group   of threads for debugging using
  310%   the graphical tracer. A group of threads   is addressed based on the
  311%   `class` property of a thread set by thread_create/3 or set_thread/2.
  312%   This implies loading the graphical tracer   and switching the thread
  313%   to debug mode using debug/0. New threads created inherit their debug
  314%   mode from the thread that created them.
  315%
  316%   Thread classes have been  introduced   in  SWI-Prolog 10.0.2/10.1.5.
  317%   This allows for  more  selective  debugging   as  well  as  ensuring
  318%   debugging works in newly created  threads.   For  example,  the HTTP
  319%   server creates all its _worker threads_   in the class `http`. Using
  320%   query below, we reliable make sure spy   points  are trapped in HTTP
  321%   handler threads, regardless of whether  the   worker  existed  or is
  322%   lazily created and regardless  of  whether   the  user  switched  to
  323%   _nodebug_   mode   while   tracing    a     previous    event   (see
  324%   debug_reset_from_class/0).
  325%
  326%       ?- tdebug(http).
  327
  328tdebug :-
  329    guitracer,
  330    forall(debug_target(Id), set_thread(Id, debug_mode(true))).
  331
  332tdebug(ThreadOrClass) :-
  333    ensure_guitracer,
  334    tdebug_(ThreadOrClass, true).
  335
  336tdebug_(ThreadID, Mode),
  337    is_thread(ThreadID) =>
  338    set_thread(ThreadID, debug_mode(Mode)).
  339tdebug_(Class, Mode),
  340    atom(Class) =>
  341    '$debug_thread_class'(Class, Mode, Matching, Set),
  342    print_message(informational, tdebug(Class, Mode, Matching, Set)).
  343
  344tnodebug :-
  345    forall(debug_target(Id), set_thread(Id, set_thread(false))).
  346
  347tnodebug(ThreadOrClass) :-
  348    tdebug_(ThreadOrClass, false).
  349
  350debug_target(Thread) :-
  351    thread_property(Thread, status(running)),
  352    thread_property(Thread, debug(true)).
  353
  354%!  tbacktrace(+Thread) is det.
  355%!  tbacktrace(+Thread, +Options) is det.
  356%
  357%   Print a backtrace for  Thread  to   the  stream  `user_error` of the
  358%   calling thread. This is achieved  by   inserting  an  interrupt into
  359%   Thread using call_in_thread/2. Options:
  360%
  361%     - depth(+MaxFrames)
  362%       Number of stack frames to show.  Default is the current Prolog
  363%       flag `backtrace_depth` or 20.
  364%
  365%   Other options are passed to get_prolog_backtrace/3.
  366%
  367%   @bug call_in_thread/2 may not process the event.
  368
  369tbacktrace(Thread) :-
  370    tbacktrace(Thread, []).
  371
  372tbacktrace(Thread, Options) :-
  373    merge_options(Options, [clause_references(false)], Options1),
  374    (   current_prolog_flag(backtrace_depth, Default)
  375    ->  true
  376    ;   Default = 20
  377    ),
  378    option(depth(Depth), Options1, Default),
  379    call_in_thread(Thread, thread_get_prolog_backtrace(Depth, Stack, Options1)),
  380    print_prolog_backtrace(user_error, Stack).
  381
  382%!  thread_get_prolog_backtrace(+Depth, -Stack, +Options)
  383%
  384%   As get_prolog_backtrace/3, but starts above   the C callback, hiding
  385%   the overhead inside call_in_thread/2.
  386
  387thread_get_prolog_backtrace(Depth, Stack, Options) :-
  388    prolog_current_frame(Frame),
  389    signal_frame(Frame, SigFrame),
  390    get_prolog_backtrace(Depth, Stack, [frame(SigFrame)|Options]).
  391
  392signal_frame(Frame, SigFrame) :-
  393    prolog_frame_attribute(Frame, clause, _),
  394    !,
  395    (   prolog_frame_attribute(Frame, parent, Parent)
  396    ->  signal_frame(Parent, SigFrame)
  397    ;   SigFrame = Frame
  398    ).
  399signal_frame(Frame, SigFrame) :-
  400    (   prolog_frame_attribute(Frame, parent, Parent)
  401    ->  SigFrame = Parent
  402    ;   SigFrame = Frame
  403    ).
  404
  405
  406
  407                 /*******************************
  408                 *       REMOTE PROFILING       *
  409                 *******************************/
  410
  411%!  tprofile(+Thread) is det.
  412%
  413%   Profile the operation of Thread until the user hits a key.
  414
  415tprofile(Thread) :-
  416    init_pce,
  417    thread_signal(Thread,
  418                  (   reset_profiler,
  419                      profiler(_, true)
  420                  )),
  421    format('Running profiler in thread ~w (press RET to show results) ...',
  422           [Thread]),
  423    flush_output,
  424    get_code(_),
  425    thread_signal(Thread,
  426                  (   profiler(_, false),
  427                      show_profile([])
  428                  )).
  429
  430
  431%!  init_pce
  432%
  433%   Make sure XPCE is running if it is   attached, so we can use the
  434%   graphical display using in_pce_thread/1.
  435
  436:- if(exists_source(library(pce))).  437init_pce :-
  438    current_prolog_flag(gui, true),
  439    !,
  440    autoload_call(send(@(display), open)).
  441:- endif.  442init_pce.
  443
  444
  445                /*******************************
  446                *        COMPATIBILITY         *
  447                *******************************/
  448
  449%!  thread_alias(+Alias) is det.
  450%
  451%   Set the alias for a thread.
  452%
  453%   @deprecated Use set_thread/2 using alias(Alias).
  454
  455thread_alias(Alias) :-
  456    thread_self(Me),
  457    set_thread(Me, alias(Alias)).
  458
  459
  460                 /*******************************
  461                 *             HOOKS            *
  462                 *******************************/
  463
  464:- multifile
  465    prolog:message_action/2.  466
  467prolog:message_action(trace_mode(on), _Level) :-
  468    \+ thread_has_console,
  469    \+ current_prolog_flag(gui_tracer, true),
  470    catch(attach_console, error(_,_), fail).
  471
  472:- multifile
  473    prolog:message/3.  474
  475prolog:message(thread_welcome) -->
  476    { thread_self(Self),
  477      human_thread_id(Self, Id)
  478    },
  479    [ 'SWI-Prolog console for thread ~w'-[Id],
  480      nl, nl
  481    ].
  482prolog:message(joined_threads(Threads)) -->
  483    [ 'Joined the following threads'-[], nl ],
  484    thread_list(Threads).
  485prolog:message(threads(Threads)) -->
  486    thread_list(Threads).
  487prolog:message(cannot_attach_console(_Title)) -->
  488    [ 'Cannot attach a console (requires xpce package)' ].
  489prolog:message(tdebug(Class, Enable, Matched, Set)) -->
  490    (   { var(Matched) }
  491    ->  [ 'Debug for threads in class '], thread_class(Class), [' was already ' ],
  492        enabled(Enable)
  493    ;   'Enabled'(Enable),
  494        [ ' debug mode in ' ], change_counts(Matched, Set), [' threads in class ' ],
  495        thread_class(Class)
  496    ).
  497
  498enabled(true)  ==> ['enabled'].
  499enabled(false) ==> ['disabled'].
  500
  501'Enabled'(true)  ==> ['Enabled'].
  502'Enabled'(false) ==> ['Disabled'].
  503
  504thread_class(Class) -->
  505    [ ansi(code, '~q', [Class]) ].
  506
  507change_counts(Set, Set) ==>
  508    [ 'all ~D'-[Set] ].
  509change_counts(Matched, Set) ==>
  510    [ '~D out of ~D'-[Set, Matched] ].
  511
  512thread_list(Threads) -->
  513    { maplist(th_id_len, Threads, Lens),
  514      convlist(th_class_len, Threads, CLens),
  515      max_list(Lens, MaxWidth0),
  516      max_list(CLens, MaxWidth1),
  517      LeftColWidth is max(6, MaxWidth0),
  518      ClassColWidth is max(6, MaxWidth1+2),
  519      Threads = [H|_]
  520    },
  521    thread_list_header(H, LeftColWidth, ClassColWidth),
  522    sequence(thread_info(LeftColWidth, ClassColWidth), [nl], Threads).
  523
  524th_id_len(Thread, IdLen) :-
  525    write_length(Thread.id, IdLen, [quoted(true)]).
  526th_class_len(Thread, ClassLen) :-
  527    write_length(Thread.get(class,''), ClassLen, [quoted(true)]).
  528
  529thread_list_header(Thread, NW, CW) -->
  530    { _{id:_, status:_, time:_, stacks:_} :< Thread,
  531      !,
  532      HrWidth is NW+CW+6+10+10+13
  533    },
  534    [ '~|~tThread~*+~tClass~*+~tStatus~10+~tDebug~6+~tTime~10+~tStack use~13+'-
  535      [NW,CW], nl ],
  536    [ '~|~`\u2015t~*+'-[HrWidth], nl ].
  537thread_list_header(Thread, NW, _CW) -->
  538    { _{id:_, status:_} :< Thread,
  539      !,
  540      HrWidth is NW+7
  541    },
  542    [ '~|~tThread~*+ Status'-[NW], nl ],
  543    [ '~|~`-t~*+'-[HrWidth], nl ].
  544
  545thread_info(NW, CW, Thread) -->
  546    { _{id:Id, status:Status, time:Time, stacks:Stacks} :< Thread,
  547      Class = Thread.get(class, -),
  548      debug_flag(Thread, Flag)
  549    },
  550    !,
  551    [ '~|~t~q~*+~t~q~*+~t~w~10+ ~t~w~t~6+~t~3f~10+~t~D~13+'-
  552      [ Id, NW, Class, CW, Status, Flag, Time.cpu, Stacks.total.usage
  553      ]
  554    ].
  555thread_info(NW, _CW, Thread) -->
  556    { _{id:Id, status:Status} :< Thread },
  557    !,
  558    [ '~|~t~q~*+ ~w'-
  559      [ Id, NW, Status
  560      ]
  561    ].
  562
  563debug_flag(Thread, Flag) :-
  564    get_dict(class, Thread, console),
  565    !,
  566    Flag = ''.
  567debug_flag(Thread, Flag) :-
  568    get_dict(debug, Thread, Debug),
  569    !,
  570    (   Debug == true
  571    ->  Flag = '\u2714'                         % V
  572    ;   Flag = ''
  573    ).
  574debug_flag(_, '\u2718').                        % X