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.   86
   87/** <module> Interactive thread utilities
   88
   89This  library  provides  utilities  that   are  primarily  intended  for
   90interactive usage in a  threaded  Prolog   environment.  It  allows  for
   91inspecting threads, manage I/O of background   threads (depending on the
   92environment) and manipulating the debug status of threads.
   93*/
   94
   95%!  threads
   96%
   97%   List currently known threads with their status.
   98
   99threads :-
  100    threads(Threads),
  101    print_message(information, threads(Threads)).
  102
  103threads(Threads) :-
  104    findall(Thread, thread_statistics(_,Thread), Threads).
  105
  106%!  join_threads
  107%
  108%   Join all terminated threads.
  109
  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, _).
  122
  123%!  thread_has_console is semidet.
  124%
  125%   True when the calling thread has an attached console.
  126%
  127%   @see attach_console/0
  128
  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    !.
  143
  144%!  open_console(+Title, -In, -Out, -Err) is det.
  145%
  146%   Open a new console window and unify In,  Out and Err with the input,
  147%   output and error streams for the new console. This predicate is only
  148%   available  if  win_open_console/5  (Windows  or   Qt  swipl-win)  or
  149%   '$open_xterm'/5 (POSIX systems with pseudo terminal support).
  150
  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)).  170
  171%!  xterm_args(-List) is nondet.
  172%
  173%   Multifile and dynamic hook that  provides (additional) arguments for
  174%   the xterm(1) process opened  for   additional  thread consoles. Each
  175%   solution must bind List to a list   of  atomic values. All solutions
  176%   are concatenated using append/2 to form the final argument list.
  177%
  178%   The defaults set  the  colors   to  black-on-light-yellow,  enable a
  179%   scrollbar, set the font using  Xft   font  pattern  and prepares the
  180%   back-arrow key.
  181
  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.  199
  200%!  attach_console is det.
  201%!  attach_console(?Title) is det.
  202%
  203%   Create a new console and make the   standard Prolog streams point to
  204%   it. If not provided, the title is   built  using the thread id. Does
  205%   nothing if the current thread already has a console attached.
  206
  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)).
  254
  255%!  enable_line_editing(+In, +Out, +Err) is det.
  256%
  257%   Enable line editing for the console.  This   is  by built-in for the
  258%   Windows console. We can also provide it   for the X11 xterm(1) based
  259%   console if we use the BSD libedit based command line editor.
  260
  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).
  275
  276
  277%!  detach_console(+ThreadId) is det.
  278%
  279%   Destroy the console for ThreadId.
  280
  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    ).
  289
  290%!  interactor is det.
  291%!  interactor(?Title) is det.
  292%
  293%   Run a Prolog toplevel in another thread   with a new console window.
  294%   If Title is given, this will be used as the window title.
  295
  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    ).
  331
  332%!  thread_run_interactor
  333%
  334%   Attach a console and run a Prolog toplevel in the current thread.
  335
  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                 *******************************/
  347
  348%!  tspy(:Spec) is det.
  349%!  tspy(:Spec, +ThreadId) is det.
  350%
  351%   Trap the graphical debugger on reaching Spec in the specified or
  352%   any thread.
  353
  354tspy(Spec) :-
  355    spy(Spec),
  356    tdebug.
  357
  358tspy(Spec, ThreadID) :-
  359    spy(Spec),
  360    tdebug(ThreadID).
  361
  362
  363%!  tdebug is det.
  364%!  tdebug(+Thread) is det.
  365%
  366%   Enable debug-mode, trapping the graphical debugger on reaching
  367%   spy-points or errors.
  368
  369tdebug :-
  370    forall(debug_target(Id), thread_signal(Id, gdebug)).
  371
  372tdebug(ThreadID) :-
  373    thread_signal(ThreadID, gdebug).
  374
  375%!  tnodebug is det.
  376%!  tnodebug(+Thread) is det.
  377%
  378%   Disable debug-mode in all threads or the specified Thread.
  379
  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)).
  390
  391%!  tbacktrace(+Thread) is det.
  392%!  tbacktrace(+Thread, +Options) is det.
  393%
  394%   Print a backtrace for  Thread  to   the  stream  `user_error` of the
  395%   calling thread. This is achieved  by   inserting  an  interrupt into
  396%   Thread using call_in_thread/2. Options:
  397%
  398%     - depth(+MaxFrames)
  399%       Number of stack frames to show.  Default is the current Prolog
  400%       flag `backtrace_depth` or 20.
  401%
  402%   Other options are passed to get_prolog_backtrace/3.
  403%
  404%   @bug call_in_thread/2 may not process the event.
  405
  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).
  418
  419%!  thread_get_prolog_backtrace(+Depth, -Stack, +Options)
  420%
  421%   As get_prolog_backtrace/3, but starts above   the C callback, hiding
  422%   the overhead inside call_in_thread/2.
  423
  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                 *******************************/
  447
  448%!  tprofile(+Thread) is det.
  449%
  450%   Profile the operation of Thread until the user hits a key.
  451
  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                  )).
  466
  467
  468%!  init_pce
  469%
  470%   Make sure XPCE is running if it is   attached, so we can use the
  471%   graphical display using in_pce_thread/1.
  472
  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    ]