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

 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.

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

 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.

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

 tspy(:Spec) is det

 tspy(:Spec, +ThreadId) is det

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

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

 tdebug is det

 tdebug(+Thread) is det

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

  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.

 tnodebug is det

 tnodebug(+Thread) is det

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

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

 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.

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

 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.

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

 tprofile(+Thread) is det

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

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

 init_pce

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

  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    ]