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(, ). 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.
93threads :- 94 threads(Threads), 95 print_message(information, threads(Threads)). 96 97threads(Threads) :- 98 findall(Thread, thread_statistics(_,Thread), Threads).
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, _).
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:
true (default false), also stop threads created with
the debug(false) option.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 ]).
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 !.
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.
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)).
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 ).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 ).
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 *******************************/
357tspy(Spec) :- 358 spy(Spec), 359 tdebug. 360 361tspy(Spec, ThreadID) :- 362 spy(Spec), 363 tdebug(ThreadID).
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.
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)).
user_error of the
calling thread. This is achieved by inserting an interrupt into
Thread using call_in_thread/2. Options:
backtrace_depth or 20.Other options are passed to get_prolog_backtrace/3.
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).
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 *******************************/
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 )).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 509prologmessage(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 ]. 516prologmessage(joined_threads(Threads)) --> 517 [ 'Joined the following threads'-[], nl ], 518 thread_list(Threads). 519prologmessage(threads(Threads)) --> 520 thread_list(Threads). 521prologmessage(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 ]
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. */