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            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_predicate(win_open_console/5)).   55:- export(( thread_run_interactor/0,    % interactor main loop
   56            interactor/0,
   57            interactor/1                % ?Title
   58          )).   59:- endif.   60
   61:- meta_predicate
   62    with_stopped_threads(0, +).   63
   64:- autoload(library(apply),[maplist/3]).   65:- autoload(library(backcomp),[thread_at_exit/1]).   66:- autoload(library(edinburgh),[nodebug/0]).   67:- autoload(library(lists),[max_list/2,append/2]).   68:- autoload(library(option),[merge_options/3,option/3]).   69:- autoload(library(prolog_stack),
   70	    [print_prolog_backtrace/2,get_prolog_backtrace/3]).   71:- autoload(library(statistics),[thread_statistics/2]).   72:- autoload(library(prolog_profile), [show_profile/1]).   73:- autoload(library(thread),[call_in_thread/2]).   74
   75:- set_prolog_flag(generate_debug_info, false).   76
   77:- module_transparent
   78    tspy/1,
   79    tspy/2.   80
   81/** <module> Interactive thread utilities
   82
   83This  library  provides  utilities  that   are  primarily  intended  for
   84interactive usage in a  threaded  Prolog   environment.  It  allows  for
   85inspecting threads, manage I/O of background   threads (depending on the
   86environment) and manipulating the debug status of threads.
   87*/
   88
   89%!  threads
   90%
   91%   List currently known threads with their status.
   92
   93threads :-
   94    threads(Threads),
   95    print_message(information, threads(Threads)).
   96
   97threads(Threads) :-
   98    findall(Thread, thread_statistics(_,Thread), Threads).
   99
  100%!  join_threads
  101%
  102%   Join all terminated threads.
  103
  104join_threads :-
  105    findall(Ripped, rip_thread(Ripped), AllRipped),
  106    (   AllRipped == []
  107    ->  true
  108    ;   print_message(informational, joined_threads(AllRipped))
  109    ).
  110
  111rip_thread(thread{id:id, status:Status}) :-
  112    thread_property(Id, status(Status)),
  113    Status \== running,
  114    \+ thread_self(Id),
  115    thread_join(Id, _).
  116
  117%!  with_stopped_threads(:Goal, Options) is det.
  118%
  119%   Stop all threads except the caller   while  running once(Goal). Note
  120%   that this is in the thread user   utilities as this is not something
  121%   that should be used  by  normal   applications.  Notably,  this  may
  122%   _deadlock_ if the current thread  requires   input  from  some other
  123%   thread to complete Goal or one of   the  stopped threads has a lock.
  124%   Options:
  125%
  126%     - stop_nodebug_threads(+Boolean)
  127%       If `true` (default `false`), also stop threads created with
  128%       the debug(false) option.
  129%     - except(+List)
  130%       Do not stop threads from this list.
  131%
  132%   @bug Note that the threads are stopped when they process signals. As
  133%   signal handling may be  delayed,  this   implies  they  need  not be
  134%   stopped before Goal starts.
  135
  136:- dynamic stopped_except/1.  137
  138with_stopped_threads(_, _) :-
  139    stopped_except(_),
  140    !.
  141with_stopped_threads(Goal, Options) :-
  142    thread_self(Me),
  143    setup_call_cleanup(
  144        asserta(stopped_except(Me), Ref),
  145        ( stop_other_threads(Me, Options),
  146          once(Goal)
  147        ),
  148        erase(Ref)).
  149
  150stop_other_threads(Me, Options) :-
  151    findall(T, stop_thread(Me, T, Options), Stopped),
  152    broadcast(stopped_threads(Stopped)).
  153
  154stop_thread(Me, Thread, Options) :-
  155    option(except(Except), Options, []),
  156    (   option(stop_nodebug_threads(true), Options)
  157    ->  thread_property(Thread, status(running))
  158    ;   debug_target(Thread)
  159    ),
  160    Me \== Thread,
  161    \+ memberchk(Thread, Except),
  162    catch(thread_signal(Thread, stopped_except), error(_,_), fail).
  163
  164stopped_except :-
  165    thread_wait(\+ stopped_except(_),
  166                [ wait_preds([stopped_except/1])
  167                ]).
  168
  169%!  thread_has_console is semidet.
  170%
  171%   True when the calling thread has an attached console.
  172%
  173%   @see attach_console/0
  174
  175:- dynamic
  176    has_console/4.                  % Id, In, Out, Err
  177
  178thread_has_console(main) :- !.                  % we assume main has one.
  179thread_has_console(Id) :-
  180    has_console(Id, _, _, _).
  181
  182thread_has_console :-
  183    current_prolog_flag(break_level, _),
  184    !.
  185thread_has_console :-
  186    thread_self(Id),
  187    thread_has_console(Id),
  188    !.
  189
  190%!  open_console(+Title, -In, -Out, -Err) is det.
  191%
  192%   Open a new console window and unify In,  Out and Err with the input,
  193%   output and error streams for the new console. This predicate is only
  194%   available  if  win_open_console/5  (Windows  or   Qt  swipl-win)  is
  195%   provided.
  196%
  197%   @tbd Port this to Epilog.
  198
  199:- multifile xterm_args/1.  200:- dynamic   xterm_args/1.  201
  202:- if(current_predicate(win_open_console/5)).  203
  204can_open_console.
  205
  206open_console(Title, In, Out, Err) :-
  207    thread_self(Id),
  208    regkey(Id, Key),
  209    win_open_console(Title, In, Out, Err,
  210                     [ registry_key(Key)
  211                     ]).
  212
  213regkey(Key, Key) :-
  214    atom(Key).
  215regkey(_, 'Anonymous').
  216
  217:- endif.  218
  219%!  attach_console is det.
  220%!  attach_console(?Title) is det.
  221%
  222%   Create a new console and make the   standard Prolog streams point to
  223%   it. If not provided, the title is   built  using the thread id. Does
  224%   nothing if the current thread already has a console attached.
  225
  226attach_console :-
  227    attach_console(_).
  228
  229attach_console(_) :-
  230    thread_has_console,
  231    !.
  232:- if(current_predicate(open_console/4)).  233attach_console(Title) :-
  234    can_open_console,
  235    !,
  236    thread_self(Id),
  237    (   var(Title)
  238    ->  console_title(Id, Title)
  239    ;   true
  240    ),
  241    open_console(Title, In, Out, Err),
  242    assert(has_console(Id, In, Out, Err)),
  243    set_stream(In,  alias(user_input)),
  244    set_stream(Out, alias(user_output)),
  245    set_stream(Err, alias(user_error)),
  246    set_stream(In,  alias(current_input)),
  247    set_stream(Out, alias(current_output)),
  248    thread_at_exit(detach_console(Id)).
  249:- endif.  250attach_console(Title) :-
  251    print_message(error, cannot_attach_console(Title)),
  252    fail.
  253
  254:- if(current_predicate(open_console/4)).  255console_title(Thread, Title) :-         % uses tabbed consoles
  256    current_prolog_flag(console_menu_version, qt),
  257    !,
  258    human_thread_id(Thread, Id),
  259    format(atom(Title), 'Thread ~w', [Id]).
  260console_title(Thread, Title) :-
  261    current_prolog_flag(system_thread_id, SysId),
  262    human_thread_id(Thread, Id),
  263    format(atom(Title),
  264           'SWI-Prolog Thread ~w (~d) Interactor',
  265           [Id, SysId]).
  266
  267human_thread_id(Thread, Alias) :-
  268    thread_property(Thread, alias(Alias)),
  269    !.
  270human_thread_id(Thread, Id) :-
  271    thread_property(Thread, id(Id)).
  272
  273%!  detach_console(+ThreadId) is det.
  274%
  275%   Destroy the console for ThreadId.
  276
  277detach_console(Id) :-
  278    (   retract(has_console(Id, In, Out, Err))
  279    ->  disable_line_editing(In, Out, Err),
  280        close(In, [force(true)]),
  281        close(Out, [force(true)]),
  282        close(Err, [force(true)])
  283    ;   true
  284    ).
  285
  286%!  interactor is det.
  287%!  interactor(?Title) is det.
  288%
  289%   Run a Prolog toplevel in another thread   with a new console window.
  290%   If Title is given, this will be used as the window title.
  291
  292interactor :-
  293    interactor(_).
  294
  295interactor(Title) :-
  296    current_prolog_flag(epilog, true),
  297    !,
  298    (   nonvar(Title)
  299    ->  Options = [title(Title)]
  300    ;   Options = []
  301    ),
  302    autoload_call(epilog(Options)).
  303interactor(Title) :-
  304    can_open_console,
  305    !,
  306    thread_self(Me),
  307    thread_create(thread_run_interactor(Me, Title), _Id,
  308                  [ detached(true)
  309                  ]),
  310    thread_get_message(Msg),
  311    (   Msg = title(Title0)
  312    ->  Title = Title0
  313    ;   Msg = throw(Error)
  314    ->  throw(Error)
  315    ;   Msg = false
  316    ->  fail
  317    ).
  318interactor(Title) :-
  319    print_message(error, cannot_attach_console(Title)),
  320    fail.
  321
  322thread_run_interactor(Creator, Title) :-
  323    set_prolog_flag(query_debug_settings, debug(false, false)),
  324    Error = error(Formal,_),
  325    (   catch(attach_console(Title), Error, true)
  326    ->  (   var(Formal)
  327        ->  thread_send_message(Creator, title(Title)),
  328            print_message(banner, thread_welcome),
  329            prolog
  330        ;   thread_send_message(Creator, throw(Error))
  331        )
  332    ;   thread_send_message(Creator, false)
  333    ).
  334
  335%!  thread_run_interactor
  336%
  337%   Attach a console and run a Prolog toplevel in the current thread.
  338
  339thread_run_interactor :-
  340    set_prolog_flag(query_debug_settings, debug(false, false)),
  341    attach_console(_Title),
  342    print_message(banner, thread_welcome),
  343    prolog.
  344
  345:- endif.                               % have open_console/4
  346
  347                 /*******************************
  348                 *          DEBUGGING           *
  349                 *******************************/
  350
  351%!  tspy(:Spec) is det.
  352%!  tspy(:Spec, +ThreadId) is det.
  353%
  354%   Trap the graphical debugger on reaching Spec in the specified or
  355%   any thread.
  356
  357tspy(Spec) :-
  358    spy(Spec),
  359    tdebug.
  360
  361tspy(Spec, ThreadID) :-
  362    spy(Spec),
  363    tdebug(ThreadID).
  364
  365
  366%!  tdebug is det.
  367%!  tdebug(+Thread) is det.
  368%
  369%   Enable debug-mode, trapping the graphical debugger on reaching
  370%   spy-points or errors.
  371
  372tdebug :-
  373    forall(debug_target(Id), thread_signal(Id, debug_thread)).
  374
  375tdebug(ThreadID) :-
  376    thread_signal(ThreadID, debug_thread).
  377
  378debug_thread :-
  379    current_prolog_flag(gui, true),
  380    !,
  381    autoload_call(gdebug).
  382debug_thread :-
  383    debug.
  384
  385
  386%!  tnodebug is det.
  387%!  tnodebug(+Thread) is det.
  388%
  389%   Disable debug-mode in all threads or the specified Thread.
  390
  391tnodebug :-
  392    forall(debug_target(Id), thread_signal(Id, nodebug)).
  393
  394tnodebug(ThreadID) :-
  395    thread_signal(ThreadID, nodebug).
  396
  397
  398debug_target(Thread) :-
  399    thread_property(Thread, status(running)),
  400    thread_property(Thread, debug(true)).
  401
  402%!  tbacktrace(+Thread) is det.
  403%!  tbacktrace(+Thread, +Options) is det.
  404%
  405%   Print a backtrace for  Thread  to   the  stream  `user_error` of the
  406%   calling thread. This is achieved  by   inserting  an  interrupt into
  407%   Thread using call_in_thread/2. Options:
  408%
  409%     - depth(+MaxFrames)
  410%       Number of stack frames to show.  Default is the current Prolog
  411%       flag `backtrace_depth` or 20.
  412%
  413%   Other options are passed to get_prolog_backtrace/3.
  414%
  415%   @bug call_in_thread/2 may not process the event.
  416
  417tbacktrace(Thread) :-
  418    tbacktrace(Thread, []).
  419
  420tbacktrace(Thread, Options) :-
  421    merge_options(Options, [clause_references(false)], Options1),
  422    (   current_prolog_flag(backtrace_depth, Default)
  423    ->  true
  424    ;   Default = 20
  425    ),
  426    option(depth(Depth), Options1, Default),
  427    call_in_thread(Thread, thread_get_prolog_backtrace(Depth, Stack, Options1)),
  428    print_prolog_backtrace(user_error, Stack).
  429
  430%!  thread_get_prolog_backtrace(+Depth, -Stack, +Options)
  431%
  432%   As get_prolog_backtrace/3, but starts above   the C callback, hiding
  433%   the overhead inside call_in_thread/2.
  434
  435thread_get_prolog_backtrace(Depth, Stack, Options) :-
  436    prolog_current_frame(Frame),
  437    signal_frame(Frame, SigFrame),
  438    get_prolog_backtrace(Depth, Stack, [frame(SigFrame)|Options]).
  439
  440signal_frame(Frame, SigFrame) :-
  441    prolog_frame_attribute(Frame, clause, _),
  442    !,
  443    (   prolog_frame_attribute(Frame, parent, Parent)
  444    ->  signal_frame(Parent, SigFrame)
  445    ;   SigFrame = Frame
  446    ).
  447signal_frame(Frame, SigFrame) :-
  448    (   prolog_frame_attribute(Frame, parent, Parent)
  449    ->  SigFrame = Parent
  450    ;   SigFrame = Frame
  451    ).
  452
  453
  454
  455                 /*******************************
  456                 *       REMOTE PROFILING       *
  457                 *******************************/
  458
  459%!  tprofile(+Thread) is det.
  460%
  461%   Profile the operation of Thread until the user hits a key.
  462
  463tprofile(Thread) :-
  464    init_pce,
  465    thread_signal(Thread,
  466                  (   reset_profiler,
  467                      profiler(_, true)
  468                  )),
  469    format('Running profiler in thread ~w (press RET to show results) ...',
  470           [Thread]),
  471    flush_output,
  472    get_code(_),
  473    thread_signal(Thread,
  474                  (   profiler(_, false),
  475                      show_profile([])
  476                  )).
  477
  478
  479%!  init_pce
  480%
  481%   Make sure XPCE is running if it is   attached, so we can use the
  482%   graphical display using in_pce_thread/1.
  483
  484:- if(exists_source(library(pce))).  485init_pce :-
  486    current_prolog_flag(gui, true),
  487    !,
  488    autoload_call(send(@(display), open)).
  489:- endif.  490init_pce.
  491
  492
  493                 /*******************************
  494                 *             HOOKS            *
  495                 *******************************/
  496
  497:- multifile
  498    user:message_hook/3.  499
  500user:message_hook(trace_mode(on), _, Lines) :-
  501    \+ thread_has_console,
  502    \+ current_prolog_flag(gui_tracer, true),
  503    catch(attach_console, _, fail),
  504    print_message_lines(user_error, '% ', Lines).
  505
  506:- multifile
  507    prolog:message/3.  508
  509prolog:message(thread_welcome) -->
  510    { thread_self(Self),
  511      human_thread_id(Self, Id)
  512    },
  513    [ 'SWI-Prolog console for thread ~w'-[Id],
  514      nl, nl
  515    ].
  516prolog:message(joined_threads(Threads)) -->
  517    [ 'Joined the following threads'-[], nl ],
  518    thread_list(Threads).
  519prolog:message(threads(Threads)) -->
  520    thread_list(Threads).
  521prolog:message(cannot_attach_console(_Title)) -->
  522    [ 'Cannot attach a console (requires swipl-win or POSIX pty support)' ].
  523
  524thread_list(Threads) -->
  525    { maplist(th_id_len, Threads, Lens),
  526      max_list(Lens, MaxWidth),
  527      LeftColWidth is max(6, MaxWidth),
  528      Threads = [H|_]
  529    },
  530    thread_list_header(H, LeftColWidth),
  531    thread_list(Threads, LeftColWidth).
  532
  533th_id_len(Thread, IdLen) :-
  534    write_length(Thread.id, IdLen, [quoted(true)]).
  535
  536thread_list([], _) --> [].
  537thread_list([H|T], CW) -->
  538    thread_info(H, CW),
  539    (   {T == []}
  540    ->  []
  541    ;   [nl],
  542        thread_list(T, CW)
  543    ).
  544
  545thread_list_header(Thread, CW) -->
  546    { _{id:_, status:_, time:_, stacks:_} :< Thread,
  547      !,
  548      HrWidth is CW+18+13+13
  549    },
  550    [ '~|~tThread~*+ Status~tTime~18+~tStack use~13+~tallocated~13+'-[CW], nl ],
  551    [ '~|~`-t~*+'-[HrWidth], nl ].
  552thread_list_header(Thread, CW) -->
  553    { _{id:_, status:_} :< Thread,
  554      !,
  555      HrWidth is CW+7
  556    },
  557    [ '~|~tThread~*+ Status'-[CW], nl ],
  558    [ '~|~`-t~*+'-[HrWidth], nl ].
  559
  560thread_info(Thread, CW) -->
  561    { _{id:Id, status:Status, time:Time, stacks:Stacks} :< Thread },
  562    !,
  563    [ '~|~t~q~*+ ~w~t~3f~18+~t~D~13+~t~D~13+'-
  564      [ Id, CW, Status, Time.cpu, Stacks.total.usage, Stacks.total.allocated
  565      ]
  566    ].
  567thread_info(Thread, CW) -->
  568    { _{id:Id, status:Status} :< Thread },
  569    !,
  570    [ '~|~t~q~*+ ~w'-
  571      [ Id, CW, Status
  572      ]
  573    ]