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).
  182:- if(current_predicate(ep_has_console/1)).  183thread_has_console(Id) :-
  184    ep_has_console(Id).
  185:- endif.  186
  187thread_has_console :-
  188    current_prolog_flag(break_level, _),
  189    !.
  190thread_has_console :-
  191    thread_self(Id),
  192    thread_has_console(Id),
  193    !.
  194
  195%!  attach_console is det.
  196%!  attach_console(?Title) is det.
  197%
  198%   Create a new console and make the   standard Prolog streams point to
  199%   it. If not provided, the title is   built  using the thread id. Does
  200%   nothing if the current thread already has a console attached.
  201
  202attach_console :-
  203    attach_console(_).
  204
  205attach_console(_) :-
  206    thread_has_console,
  207    !.
  208:- if(current_predicate(epilog_attach/1)).  209attach_console(Title) :-
  210    thread_self(Me),
  211    console_title(Me, Title),
  212    epilog_attach([ title(Title)
  213                  ]).
  214:- endif.  215attach_console(Title) :-
  216    print_message(error, cannot_attach_console(Title)),
  217    fail.
  218
  219console_title(Thread, Title) :-
  220    current_prolog_flag(system_thread_id, SysId),
  221    human_thread_id(Thread, Id),
  222    format(atom(Title),
  223           'SWI-Prolog Thread ~w (~d) Interactor',
  224           [Id, SysId]).
  225
  226human_thread_id(Thread, Alias) :-
  227    thread_property(Thread, alias(Alias)),
  228    !.
  229human_thread_id(Thread, Id) :-
  230    thread_property(Thread, id(Id)).
  231
  232%!  interactor is det.
  233%!  interactor(?Title) is det.
  234%
  235%   Run a Prolog toplevel in another thread   with a new console window.
  236%   If Title is given, this will be used as the window title.
  237
  238interactor :-
  239    interactor(_).
  240
  241:- if(current_predicate(epilog/1)).  242interactor(Title) :-
  243    !,
  244    (   nonvar(Title)
  245    ->  Options = [title(Title)]
  246    ;   Options = []
  247    ),
  248    epilog([ init(true)
  249           | Options
  250           ]).
  251:- endif.  252interactor(Title) :-
  253    print_message(error, cannot_attach_console(Title)),
  254    fail.
  255
  256
  257                 /*******************************
  258                 *          DEBUGGING           *
  259                 *******************************/
  260
  261%!  tspy(:Spec) is det.
  262%!  tspy(:Spec, +ThreadId) is det.
  263%
  264%   Trap the graphical debugger on reaching Spec in the specified or
  265%   any thread.
  266
  267tspy(Spec) :-
  268    spy(Spec),
  269    tdebug.
  270
  271tspy(Spec, ThreadID) :-
  272    spy(Spec),
  273    tdebug(ThreadID).
  274
  275
  276%!  tdebug is det.
  277%!  tdebug(+Thread) is det.
  278%
  279%   Enable debug-mode, trapping the graphical debugger on reaching
  280%   spy-points or errors.
  281
  282tdebug :-
  283    forall(debug_target(Id), thread_signal(Id, debug_thread)).
  284
  285tdebug(ThreadID) :-
  286    thread_signal(ThreadID, debug_thread).
  287
  288debug_thread :-
  289    current_prolog_flag(gui, true),
  290    !,
  291    autoload_call(gdebug).
  292debug_thread :-
  293    debug.
  294
  295
  296%!  tnodebug is det.
  297%!  tnodebug(+Thread) is det.
  298%
  299%   Disable debug-mode in all threads or the specified Thread.
  300
  301tnodebug :-
  302    forall(debug_target(Id), thread_signal(Id, nodebug)).
  303
  304tnodebug(ThreadID) :-
  305    thread_signal(ThreadID, nodebug).
  306
  307
  308debug_target(Thread) :-
  309    thread_property(Thread, status(running)),
  310    thread_property(Thread, debug(true)).
  311
  312%!  tbacktrace(+Thread) is det.
  313%!  tbacktrace(+Thread, +Options) is det.
  314%
  315%   Print a backtrace for  Thread  to   the  stream  `user_error` of the
  316%   calling thread. This is achieved  by   inserting  an  interrupt into
  317%   Thread using call_in_thread/2. Options:
  318%
  319%     - depth(+MaxFrames)
  320%       Number of stack frames to show.  Default is the current Prolog
  321%       flag `backtrace_depth` or 20.
  322%
  323%   Other options are passed to get_prolog_backtrace/3.
  324%
  325%   @bug call_in_thread/2 may not process the event.
  326
  327tbacktrace(Thread) :-
  328    tbacktrace(Thread, []).
  329
  330tbacktrace(Thread, Options) :-
  331    merge_options(Options, [clause_references(false)], Options1),
  332    (   current_prolog_flag(backtrace_depth, Default)
  333    ->  true
  334    ;   Default = 20
  335    ),
  336    option(depth(Depth), Options1, Default),
  337    call_in_thread(Thread, thread_get_prolog_backtrace(Depth, Stack, Options1)),
  338    print_prolog_backtrace(user_error, Stack).
  339
  340%!  thread_get_prolog_backtrace(+Depth, -Stack, +Options)
  341%
  342%   As get_prolog_backtrace/3, but starts above   the C callback, hiding
  343%   the overhead inside call_in_thread/2.
  344
  345thread_get_prolog_backtrace(Depth, Stack, Options) :-
  346    prolog_current_frame(Frame),
  347    signal_frame(Frame, SigFrame),
  348    get_prolog_backtrace(Depth, Stack, [frame(SigFrame)|Options]).
  349
  350signal_frame(Frame, SigFrame) :-
  351    prolog_frame_attribute(Frame, clause, _),
  352    !,
  353    (   prolog_frame_attribute(Frame, parent, Parent)
  354    ->  signal_frame(Parent, SigFrame)
  355    ;   SigFrame = Frame
  356    ).
  357signal_frame(Frame, SigFrame) :-
  358    (   prolog_frame_attribute(Frame, parent, Parent)
  359    ->  SigFrame = Parent
  360    ;   SigFrame = Frame
  361    ).
  362
  363
  364
  365                 /*******************************
  366                 *       REMOTE PROFILING       *
  367                 *******************************/
  368
  369%!  tprofile(+Thread) is det.
  370%
  371%   Profile the operation of Thread until the user hits a key.
  372
  373tprofile(Thread) :-
  374    init_pce,
  375    thread_signal(Thread,
  376                  (   reset_profiler,
  377                      profiler(_, true)
  378                  )),
  379    format('Running profiler in thread ~w (press RET to show results) ...',
  380           [Thread]),
  381    flush_output,
  382    get_code(_),
  383    thread_signal(Thread,
  384                  (   profiler(_, false),
  385                      show_profile([])
  386                  )).
  387
  388
  389%!  init_pce
  390%
  391%   Make sure XPCE is running if it is   attached, so we can use the
  392%   graphical display using in_pce_thread/1.
  393
  394:- if(exists_source(library(pce))).  395init_pce :-
  396    current_prolog_flag(gui, true),
  397    !,
  398    autoload_call(send(@(display), open)).
  399:- endif.  400init_pce.
  401
  402
  403                 /*******************************
  404                 *             HOOKS            *
  405                 *******************************/
  406
  407:- multifile
  408    prolog:message_action/2.  409
  410prolog:message_action(trace_mode(on), _Level) :-
  411    \+ thread_has_console,
  412    \+ current_prolog_flag(gui_tracer, true),
  413    catch(attach_console, error(_,_), fail).
  414
  415:- multifile
  416    prolog:message/3.  417
  418prolog:message(thread_welcome) -->
  419    { thread_self(Self),
  420      human_thread_id(Self, Id)
  421    },
  422    [ 'SWI-Prolog console for thread ~w'-[Id],
  423      nl, nl
  424    ].
  425prolog:message(joined_threads(Threads)) -->
  426    [ 'Joined the following threads'-[], nl ],
  427    thread_list(Threads).
  428prolog:message(threads(Threads)) -->
  429    thread_list(Threads).
  430prolog:message(cannot_attach_console(_Title)) -->
  431    [ 'Cannot attach a console (requires xpce package)' ].
  432
  433thread_list(Threads) -->
  434    { maplist(th_id_len, Threads, Lens),
  435      max_list(Lens, MaxWidth),
  436      LeftColWidth is max(6, MaxWidth),
  437      Threads = [H|_]
  438    },
  439    thread_list_header(H, LeftColWidth),
  440    thread_list(Threads, LeftColWidth).
  441
  442th_id_len(Thread, IdLen) :-
  443    write_length(Thread.id, IdLen, [quoted(true)]).
  444
  445thread_list([], _) --> [].
  446thread_list([H|T], CW) -->
  447    thread_info(H, CW),
  448    (   {T == []}
  449    ->  []
  450    ;   [nl],
  451        thread_list(T, CW)
  452    ).
  453
  454thread_list_header(Thread, CW) -->
  455    { _{id:_, status:_, time:_, stacks:_} :< Thread,
  456      !,
  457      HrWidth is CW+18+13+13
  458    },
  459    [ '~|~tThread~*+ Status~tTime~18+~tStack use~13+~tallocated~13+'-[CW], nl ],
  460    [ '~|~`-t~*+'-[HrWidth], nl ].
  461thread_list_header(Thread, CW) -->
  462    { _{id:_, status:_} :< Thread,
  463      !,
  464      HrWidth is CW+7
  465    },
  466    [ '~|~tThread~*+ Status'-[CW], nl ],
  467    [ '~|~`-t~*+'-[HrWidth], nl ].
  468
  469thread_info(Thread, CW) -->
  470    { _{id:Id, status:Status, time:Time, stacks:Stacks} :< Thread },
  471    !,
  472    [ '~|~t~q~*+ ~w~t~3f~18+~t~D~13+~t~D~13+'-
  473      [ Id, CW, Status, Time.cpu, Stacks.total.usage, Stacks.total.allocated
  474      ]
  475    ].
  476thread_info(Thread, CW) -->
  477    { _{id:Id, status:Status} :< Thread },
  478    !,
  479    [ '~|~t~q~*+ ~w'-
  480      [ Id, CW, Status
  481      ]
  482    ]