View source with raw comments or as raw
    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-2024, 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            thread_has_console/0,       % True if thread has a console
   40            attach_console/0,           % Create a new console for thread.
   41            attach_console/1,           % ?Title
   42
   43            tspy/1,                     % :Spec
   44            tspy/2,                     % :Spec, +ThreadId
   45            tdebug/0,
   46            tdebug/1,                   % +ThreadId
   47            tnodebug/0,
   48            tnodebug/1,                 % +ThreadId
   49            tprofile/1,                 % +ThreadId
   50            tbacktrace/1,               % +ThreadId,
   51            tbacktrace/2                % +ThreadId, +Options
   52          ]).   53:- if((   current_predicate(win_open_console/5)
   54      ;   current_predicate('$open_xterm'/5))).   55:- export(( thread_run_interactor/0,    % interactor main loop
   56            interactor/0,
   57            interactor/1                % ?Title
   58          )).   59:- endif.   60
   61:- autoload(library(apply),[maplist/3]).   62:- autoload(library(backcomp),[thread_at_exit/1]).   63:- autoload(library(edinburgh),[nodebug/0]).   64:- autoload(library(lists),[max_list/2,append/2]).   65:- autoload(library(option),[merge_options/3,option/3]).   66:- autoload(library(prolog_stack),
   67	    [print_prolog_backtrace/2,get_prolog_backtrace/3]).   68:- autoload(library(statistics),[thread_statistics/2]).   69:- autoload(library(prolog_profile), [show_profile/1]).   70:- autoload(library(thread),[call_in_thread/2]).   71
   72:- if((\+current_prolog_flag(xpce,false),exists_source(library(pce)))).   73:- autoload(library(gui_tracer),[gdebug/0]).   74:- autoload(library(pce),[send/2]).   75:- else.   76gdebug :-
   77    debug.
   78:- endif.   79
   80
   81:- set_prolog_flag(generate_debug_info, false).   82
   83:- module_transparent
   84    tspy/1,
   85    tspy/2.

Interactive thread utilities

This library provides utilities that are primarily intended for interactive usage in a threaded Prolog environment. It allows for inspecting threads, manage I/O of background threads (depending on the environment) and manipulating the debug status of threads. */

 threads
List currently known threads with their status.
   99threads :-
  100    threads(Threads),
  101    print_message(information, threads(Threads)).
  102
  103threads(Threads) :-
  104    findall(Thread, thread_statistics(_,Thread), Threads).
 join_threads
Join all terminated threads.
  110join_threads :-
  111    findall(Ripped, rip_thread(Ripped), AllRipped),
  112    (   AllRipped == []
  113    ->  true
  114    ;   print_message(informational, joined_threads(AllRipped))
  115    ).
  116
  117rip_thread(thread{id:id, status:Status}) :-
  118    thread_property(Id, status(Status)),
  119    Status \== running,
  120    \+ thread_self(Id),
  121    thread_join(Id, _).
 thread_has_console is semidet
True when the calling thread has an attached console.
See also
- attach_console/0
  129:- dynamic
  130    has_console/4.                  % Id, In, Out, Err
  131
  132thread_has_console(main) :- !.                  % we assume main has one.
  133thread_has_console(Id) :-
  134    has_console(Id, _, _, _).
  135
  136thread_has_console :-
  137    current_prolog_flag(break_level, _),
  138    !.
  139thread_has_console :-
  140    thread_self(Id),
  141    thread_has_console(Id),
  142    !.
 open_console(+Title, -In, -Out, -Err) is det
Open a new console window and unify In, Out and Err with the input, output and error streams for the new console. This predicate is only available if win_open_console/5 (Windows or Qt swipl-win) or '$open_xterm'/5 (POSIX systems with pseudo terminal support).
  151:- multifile xterm_args/1.  152:- dynamic   xterm_args/1.  153
  154:- if(current_predicate(win_open_console/5)).  155
  156can_open_console.
  157
  158open_console(Title, In, Out, Err) :-
  159    thread_self(Id),
  160    regkey(Id, Key),
  161    win_open_console(Title, In, Out, Err,
  162                     [ registry_key(Key)
  163                     ]).
  164
  165regkey(Key, Key) :-
  166    atom(Key).
  167regkey(_, 'Anonymous').
  168
  169:- elif(current_predicate('$open_xterm'/5)).
 xterm_args(-List) is nondet
Multifile and dynamic hook that provides (additional) arguments for the xterm(1) process opened for additional thread consoles. Each solution must bind List to a list of atomic values. All solutions are concatenated using append/2 to form the final argument list.

The defaults set the colors to black-on-light-yellow, enable a scrollbar, set the font using Xft font pattern and prepares the back-arrow key.

  182xterm_args(['-xrm', '*backarrowKeyIsErase: false']).
  183xterm_args(['-xrm', '*backarrowKey: false']).
  184xterm_args(['-fa', 'Ubuntu Mono', '-fs', 12]).
  185xterm_args(['-fg', '#000000']).
  186xterm_args(['-bg', '#ffffdd']).
  187xterm_args(['-sb', '-sl', 1000, '-rightbar']).
  188
  189can_open_console :-
  190    getenv('DISPLAY', _),
  191    absolute_file_name(path(xterm), _XTerm, [access(execute)]).
  192
  193open_console(Title, In, Out, Err) :-
  194    findall(Arg, xterm_args(Arg), Args),
  195    append(Args, Argv),
  196    '$open_xterm'(Title, In, Out, Err, Argv).
  197
  198:- endif.
 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.
  207attach_console :-
  208    attach_console(_).
  209
  210attach_console(_) :-
  211    thread_has_console,
  212    !.
  213:- if(current_predicate(open_console/4)).  214attach_console(Title) :-
  215    can_open_console,
  216    !,
  217    thread_self(Id),
  218    (   var(Title)
  219    ->  console_title(Id, Title)
  220    ;   true
  221    ),
  222    open_console(Title, In, Out, Err),
  223    assert(has_console(Id, In, Out, Err)),
  224    set_stream(In,  alias(user_input)),
  225    set_stream(Out, alias(user_output)),
  226    set_stream(Err, alias(user_error)),
  227    set_stream(In,  alias(current_input)),
  228    set_stream(Out, alias(current_output)),
  229    enable_line_editing(In,Out,Err),
  230    thread_at_exit(detach_console(Id)).
  231:- endif.  232attach_console(Title) :-
  233    print_message(error, cannot_attach_console(Title)),
  234    fail.
  235
  236:- if(current_predicate(open_console/4)).  237console_title(Thread, Title) :-         % uses tabbed consoles
  238    current_prolog_flag(console_menu_version, qt),
  239    !,
  240    human_thread_id(Thread, Id),
  241    format(atom(Title), 'Thread ~w', [Id]).
  242console_title(Thread, Title) :-
  243    current_prolog_flag(system_thread_id, SysId),
  244    human_thread_id(Thread, Id),
  245    format(atom(Title),
  246           'SWI-Prolog Thread ~w (~d) Interactor',
  247           [Id, SysId]).
  248
  249human_thread_id(Thread, Alias) :-
  250    thread_property(Thread, alias(Alias)),
  251    !.
  252human_thread_id(Thread, Id) :-
  253    thread_property(Thread, id(Id)).
 enable_line_editing(+In, +Out, +Err) is det
Enable line editing for the console. This is by built-in for the Windows console. We can also provide it for the X11 xterm(1) based console if we use the BSD libedit based command line editor.
  261:- if((current_prolog_flag(readline, editline),
  262       exists_source(library(editline)))).  263enable_line_editing(_In, _Out, _Err) :-
  264    current_prolog_flag(readline, editline),
  265    !,
  266    el_wrap.
  267:- endif.  268enable_line_editing(_In, _Out, _Err).
  269
  270:- if(current_predicate(el_unwrap/1)).  271disable_line_editing(_In, _Out, _Err) :-
  272    el_unwrap(user_input).
  273:- endif.  274disable_line_editing(_In, _Out, _Err).
 detach_console(+ThreadId) is det
Destroy the console for ThreadId.
  281detach_console(Id) :-
  282    (   retract(has_console(Id, In, Out, Err))
  283    ->  disable_line_editing(In, Out, Err),
  284        close(In, [force(true)]),
  285        close(Out, [force(true)]),
  286        close(Err, [force(true)])
  287    ;   true
  288    ).
 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.
  296interactor :-
  297    interactor(_).
  298
  299interactor(Title) :-
  300    can_open_console,
  301    !,
  302    thread_self(Me),
  303    thread_create(thread_run_interactor(Me, Title), _Id,
  304                  [ detached(true),
  305                    debug(false)
  306                  ]),
  307    thread_get_message(Msg),
  308    (   Msg = title(Title0)
  309    ->  Title = Title0
  310    ;   Msg = throw(Error)
  311    ->  throw(Error)
  312    ;   Msg = false
  313    ->  fail
  314    ).
  315interactor(Title) :-
  316    print_message(error, cannot_attach_console(Title)),
  317    fail.
  318
  319thread_run_interactor(Creator, Title) :-
  320    set_prolog_flag(query_debug_settings, debug(false, false)),
  321    Error = error(Formal,_),
  322    (   catch(attach_console(Title), Error, true)
  323    ->  (   var(Formal)
  324        ->  thread_send_message(Creator, title(Title)),
  325            print_message(banner, thread_welcome),
  326            prolog
  327        ;   thread_send_message(Creator, throw(Error))
  328        )
  329    ;   thread_send_message(Creator, false)
  330    ).
 thread_run_interactor
Attach a console and run a Prolog toplevel in the current thread.
  336thread_run_interactor :-
  337    set_prolog_flag(query_debug_settings, debug(false, false)),
  338    attach_console(_Title),
  339    print_message(banner, thread_welcome),
  340    prolog.
  341
  342:- endif.                               % have open_console/4
  343
  344                 /*******************************
  345                 *          DEBUGGING           *
  346                 *******************************/
 tspy(:Spec) is det
 tspy(:Spec, +ThreadId) is det
Trap the graphical debugger on reaching Spec in the specified or any thread.
  354tspy(Spec) :-
  355    spy(Spec),
  356    tdebug.
  357
  358tspy(Spec, ThreadID) :-
  359    spy(Spec),
  360    tdebug(ThreadID).
 tdebug is det
 tdebug(+Thread) is det
Enable debug-mode, trapping the graphical debugger on reaching spy-points or errors.
  369tdebug :-
  370    forall(debug_target(Id), thread_signal(Id, gdebug)).
  371
  372tdebug(ThreadID) :-
  373    thread_signal(ThreadID, gdebug).
 tnodebug is det
 tnodebug(+Thread) is det
Disable debug-mode in all threads or the specified Thread.
  380tnodebug :-
  381    forall(debug_target(Id), thread_signal(Id, nodebug)).
  382
  383tnodebug(ThreadID) :-
  384    thread_signal(ThreadID, nodebug).
  385
  386
  387debug_target(Thread) :-
  388    thread_property(Thread, status(running)),
  389    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.
  406tbacktrace(Thread) :-
  407    tbacktrace(Thread, []).
  408
  409tbacktrace(Thread, Options) :-
  410    merge_options(Options, [clause_references(false)], Options1),
  411    (   current_prolog_flag(backtrace_depth, Default)
  412    ->  true
  413    ;   Default = 20
  414    ),
  415    option(depth(Depth), Options1, Default),
  416    call_in_thread(Thread, thread_get_prolog_backtrace(Depth, Stack, Options1)),
  417    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.
  424thread_get_prolog_backtrace(Depth, Stack, Options) :-
  425    prolog_current_frame(Frame),
  426    signal_frame(Frame, SigFrame),
  427    get_prolog_backtrace(Depth, Stack, [frame(SigFrame)|Options]).
  428
  429signal_frame(Frame, SigFrame) :-
  430    prolog_frame_attribute(Frame, clause, _),
  431    !,
  432    (   prolog_frame_attribute(Frame, parent, Parent)
  433    ->  signal_frame(Parent, SigFrame)
  434    ;   SigFrame = Frame
  435    ).
  436signal_frame(Frame, SigFrame) :-
  437    (   prolog_frame_attribute(Frame, parent, Parent)
  438    ->  SigFrame = Parent
  439    ;   SigFrame = Frame
  440    ).
  441
  442
  443
  444                 /*******************************
  445                 *       REMOTE PROFILING       *
  446                 *******************************/
 tprofile(+Thread) is det
Profile the operation of Thread until the user hits a key.
  452tprofile(Thread) :-
  453    init_pce,
  454    thread_signal(Thread,
  455                  (   reset_profiler,
  456                      profiler(_, true)
  457                  )),
  458    format('Running profiler in thread ~w (press RET to show results) ...',
  459           [Thread]),
  460    flush_output,
  461    get_code(_),
  462    thread_signal(Thread,
  463                  (   profiler(_, false),
  464                      show_profile([])
  465                  )).
 init_pce
Make sure XPCE is running if it is attached, so we can use the graphical display using in_pce_thread/1.
  473:- if(exists_source(library(pce))).  474init_pce :-
  475    current_prolog_flag(gui, true),
  476    !,
  477    call(send(@(display), open)).   % avoid autoloading
  478:- endif.  479init_pce.
  480
  481
  482                 /*******************************
  483                 *             HOOKS            *
  484                 *******************************/
  485
  486:- multifile
  487    user:message_hook/3.  488
  489user:message_hook(trace_mode(on), _, Lines) :-
  490    \+ thread_has_console,
  491    \+ current_prolog_flag(gui_tracer, true),
  492    catch(attach_console, _, fail),
  493    print_message_lines(user_error, '% ', Lines).
  494
  495:- multifile
  496    prolog:message/3.  497
  498prolog:message(thread_welcome) -->
  499    { thread_self(Self),
  500      human_thread_id(Self, Id)
  501    },
  502    [ 'SWI-Prolog console for thread ~w'-[Id],
  503      nl, nl
  504    ].
  505prolog:message(joined_threads(Threads)) -->
  506    [ 'Joined the following threads'-[], nl ],
  507    thread_list(Threads).
  508prolog:message(threads(Threads)) -->
  509    thread_list(Threads).
  510prolog:message(cannot_attach_console(_Title)) -->
  511    [ 'Cannot attach a console (requires swipl-win or POSIX pty support)' ].
  512
  513thread_list(Threads) -->
  514    { maplist(th_id_len, Threads, Lens),
  515      max_list(Lens, MaxWidth),
  516      LeftColWidth is max(6, MaxWidth),
  517      Threads = [H|_]
  518    },
  519    thread_list_header(H, LeftColWidth),
  520    thread_list(Threads, LeftColWidth).
  521
  522th_id_len(Thread, IdLen) :-
  523    write_length(Thread.id, IdLen, [quoted(true)]).
  524
  525thread_list([], _) --> [].
  526thread_list([H|T], CW) -->
  527    thread_info(H, CW),
  528    (   {T == []}
  529    ->  []
  530    ;   [nl],
  531        thread_list(T, CW)
  532    ).
  533
  534thread_list_header(Thread, CW) -->
  535    { _{id:_, status:_, time:_, stacks:_} :< Thread,
  536      !,
  537      HrWidth is CW+18+13+13
  538    },
  539    [ '~|~tThread~*+ Status~tTime~18+~tStack use~13+~tallocated~13+'-[CW], nl ],
  540    [ '~|~`-t~*+'-[HrWidth], nl ].
  541thread_list_header(Thread, CW) -->
  542    { _{id:_, status:_} :< Thread,
  543      !,
  544      HrWidth is CW+7
  545    },
  546    [ '~|~tThread~*+ Status'-[CW], nl ],
  547    [ '~|~`-t~*+'-[HrWidth], nl ].
  548
  549thread_info(Thread, CW) -->
  550    { _{id:Id, status:Status, time:Time, stacks:Stacks} :< Thread },
  551    !,
  552    [ '~|~t~q~*+ ~w~t~3f~18+~t~D~13+~t~D~13+'-
  553      [ Id, CW, Status, Time.cpu, Stacks.total.usage, Stacks.total.allocated
  554      ]
  555    ].
  556thread_info(Thread, CW) -->
  557    { _{id:Id, status:Status} :< Thread },
  558    !,
  559    [ '~|~t~q~*+ ~w'-
  560      [ Id, CW, Status
  561      ]
  562    ]