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.

 threads

List currently known threads with their status.

   97threads :-
   98    threads(Threads),
   99    print_message(information, threads(Threads)).
  100
  101threads(Threads) :-
  102    findall(Thread, thread_statistics(_,Thread), Threads).

 join_threads

Join all terminated threads.

  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, _).

 with_stopped_threads(:Goal, Options) is det

Stop all threads except the caller while running once(Goal). Note that this is in the thread user utilities as this is not something that should be used by normal applications. Notably, this may deadlock if the current thread requires input from some other thread to complete Goal or one of the stopped threads has a lock. Options:

stop_nodebug_threads(+Boolean)

If true (default false), also stop threads created with the debug(false) option.

except(+List)

Do not stop threads from this list.

bug

- Note that the threads are stopped when they process signals. As signal handling may be delayed, this implies they need not be stopped before Goal starts.

  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                ]).

 thread_has_console is semidet

True when the calling thread has an attached console.

See also

- attach_console/0

  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    !.

 attach_console is det

 attach_console(?Title) is det

Create a new console and make the standard Prolog streams point to it. If not provided, the title is built using the thread id. Does nothing if the current thread already has a console attached.

  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)).

 interactor is det

 interactor(?Title) is det

Run a Prolog toplevel in another thread with a new console window. If Title is given, this will be used as the window title.

  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                 *******************************/

 tspy(:Spec) is det

 tspy(:Spec, +ThreadId) is det

Trap the graphical debugger on reaching Spec in the specified or any thread.

  267tspy(Spec) :-
  268    spy(Spec),
  269    tdebug.
  270
  271tspy(Spec, ThreadID) :-
  272    spy(Spec),
  273    tdebug(ThreadID).

 tdebug is det

 tdebug(+Thread) is det

Enable debug-mode, trapping the graphical debugger on reaching spy-points or errors.

  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.

 tnodebug is det

 tnodebug(+Thread) is det

Disable debug-mode in all threads or the specified Thread.

  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)).

 tbacktrace(+Thread) is det

 tbacktrace(+Thread, +Options) is det

Print a backtrace for Thread to the stream user_error of the calling thread. This is achieved by inserting an interrupt into Thread using call_in_thread/2. Options:

depth(+MaxFrames)

Number of stack frames to show. Default is the current Prolog flag backtrace_depth or 20.

Other options are passed to get_prolog_backtrace/3.

bug

- call_in_thread/2 may not process the event.

  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).

 thread_get_prolog_backtrace(+Depth, -Stack, +Options)

As get_prolog_backtrace/3, but starts above the C callback, hiding the overhead inside call_in_thread/2.

  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                 *******************************/

 tprofile(+Thread) is det

Profile the operation of Thread until the user hits a key.

  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                  )).

 init_pce

Make sure XPCE is running if it is attached, so we can use the graphical display using in_pce_thread/1.

  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    ]