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 ; current_predicate('$open_xterm'/5))). 56:- export(( thread_run_interactor/0, % interactor main loop 57 interactor/0, 58 interactor/1 % ?Title 59 )). 60:- endif. 61 62:- meta_predicate 63 with_stopped_threads(, ). 64 65:- autoload(library(apply),[maplist/3]). 66:- autoload(library(backcomp),[thread_at_exit/1]). 67:- autoload(library(edinburgh),[nodebug/0]). 68:- autoload(library(lists),[max_list/2,append/2]). 69:- autoload(library(option),[merge_options/3,option/3]). 70:- autoload(library(prolog_stack), 71 [print_prolog_backtrace/2,get_prolog_backtrace/3]). 72:- autoload(library(statistics),[thread_statistics/2]). 73:- autoload(library(prolog_profile), [show_profile/1]). 74:- autoload(library(thread),[call_in_thread/2]). 75 76:- if((\+current_prolog_flag(xpce,false),exists_source(library(pce)))). 77:- autoload(library(gui_tracer),[gdebug/0]). 78:- autoload(library(pce),[send/2]). 79:- else. 80gdebug :- 81 debug. 82:- endif. 83 84 85:- set_prolog_flag(generate_debug_info, false). 86 87:- module_transparent 88 tspy/1, 89 tspy/2.
103threads :- 104 threads(Threads), 105 print_message(information, threads(Threads)). 106 107threads(Threads) :- 108 findall(Thread, thread_statistics(_,Thread), Threads).
114join_threads :- 115 findall(Ripped, rip_thread(Ripped), AllRipped), 116 ( AllRipped == [] 117 -> true 118 ; print_message(informational, joined_threads(AllRipped)) 119 ). 120 121rip_thread(thread{id:id, status:Status}) :- 122 thread_property(Id, status(Status)), 123 Status \== running, 124 \+ thread_self(Id), 125 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.146:- dynamic stopped_except/1. 147 148with_stopped_threads(_, _) :- 149 stopped_except(_), 150 !. 151with_stopped_threads(Goal, Options) :- 152 thread_self(Me), 153 setup_call_cleanup( 154 asserta(stopped_except(Me), Ref), 155 ( stop_other_threads(Me, Options), 156 once(Goal) 157 ), 158 erase(Ref)). 159 160stop_other_threads(Me, Options) :- 161 findall(T, stop_thread(Me, T, Options), Stopped), 162 broadcast(stopped_threads(Stopped)). 163 164stop_thread(Me, Thread, Options) :- 165 option(except(Except), Options, []), 166 ( option(stop_nodebug_threads(true), Options) 167 -> thread_property(Thread, status(running)) 168 ; debug_target(Thread) 169 ), 170 Me \== Thread, 171 \+ memberchk(Thread, Except), 172 catch(thread_signal(Thread, stopped_except), error(_,_), fail). 173 174stopped_except :- 175 thread_wait(\+ stopped_except(_), 176 [ wait_preds([stopped_except/1]) 177 ]).
185:- dynamic 186 has_console/4. % Id, In, Out, Err 187 188thread_has_console(main) :- !. % we assume main has one. 189thread_has_console(Id) :- 190 has_console(Id, _, _, _). 191 192thread_has_console :- 193 current_prolog_flag(break_level, _), 194 !. 195thread_has_console :- 196 thread_self(Id), 197 thread_has_console(Id), 198 !.
207:- multifile xterm_args/1. 208:- dynamic xterm_args/1. 209 210:- if(current_predicate(win_open_console/5)). 211 212can_open_console. 213 214open_console(Title, In, Out, Err) :- 215 thread_self(Id), 216 regkey(Id, Key), 217 win_open_console(Title, In, Out, Err, 218 [ registry_key(Key) 219 ]). 220 221regkey(Key, Key) :- 222 atom(Key). 223regkey(_, 'Anonymous'). 224 225:- elif(current_predicate('$open_xterm'/5)).
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.
238xterm_args(['-xrm', '*backarrowKeyIsErase: false']). 239xterm_args(['-xrm', '*backarrowKey: false']). 240xterm_args(['-fa', 'Ubuntu Mono', '-fs', 12]). 241xterm_args(['-fg', '#000000']). 242xterm_args(['-bg', '#ffffdd']). 243xterm_args(['-sb', '-sl', 1000, '-rightbar']). 244 245can_open_console :- 246 getenv('DISPLAY', _), 247 absolute_file_name(path(xterm), _XTerm, [access(execute)]). 248 249open_console(Title, In, Out, Err) :- 250 findall(Arg, xterm_args(Arg), Args), 251 append(Args, Argv), 252 '$open_xterm'(Title, In, Out, Err, Argv). 253 254:- endif.
263attach_console :- 264 attach_console(_). 265 266attach_console(_) :- 267 thread_has_console, 268 !. 269:- if(current_predicate(open_console/4)). 270attach_console(Title) :- 271 can_open_console, 272 !, 273 thread_self(Id), 274 ( var(Title) 275 -> console_title(Id, Title) 276 ; true 277 ), 278 open_console(Title, In, Out, Err), 279 assert(has_console(Id, In, Out, Err)), 280 set_stream(In, alias(user_input)), 281 set_stream(Out, alias(user_output)), 282 set_stream(Err, alias(user_error)), 283 set_stream(In, alias(current_input)), 284 set_stream(Out, alias(current_output)), 285 enable_line_editing(In,Out,Err), 286 thread_at_exit(detach_console(Id)). 287:- endif. 288attach_console(Title) :- 289 print_message(error, cannot_attach_console(Title)), 290 fail. 291 292:- if(current_predicate(open_console/4)). 293console_title(Thread, Title) :- % uses tabbed consoles 294 current_prolog_flag(console_menu_version, qt), 295 !, 296 human_thread_id(Thread, Id), 297 format(atom(Title), 'Thread ~w', [Id]). 298console_title(Thread, Title) :- 299 current_prolog_flag(system_thread_id, SysId), 300 human_thread_id(Thread, Id), 301 format(atom(Title), 302 'SWI-Prolog Thread ~w (~d) Interactor', 303 [Id, SysId]). 304 305human_thread_id(Thread, Alias) :- 306 thread_property(Thread, alias(Alias)), 307 !. 308human_thread_id(Thread, Id) :- 309 thread_property(Thread, id(Id)).
xterm(1) based
console if we use the BSD libedit based command line editor.317enable_line_editing(_In, _Out, _Err) :- 318 current_prolog_flag(readline, editline), 319 exists_source(library(editline)), 320 use_module(library(editline)), 321 !, 322 call(el_wrap). 323enable_line_editing(_In, _Out, _Err). 324 325disable_line_editing(_In, _Out, _Err) :- 326 current_predicate(el_unwrap/1), 327 !, 328 call(el_unwrap(user_input)). 329disable_line_editing(_In, _Out, _Err).
336detach_console(Id) :-
337 ( retract(has_console(Id, In, Out, Err))
338 -> disable_line_editing(In, Out, Err),
339 close(In, [force(true)]),
340 close(Out, [force(true)]),
341 close(Err, [force(true)])
342 ; true
343 ).351interactor :- 352 interactor(_). 353 354interactor(Title) :- 355 can_open_console, 356 !, 357 thread_self(Me), 358 thread_create(thread_run_interactor(Me, Title), _Id, 359 [ detached(true) 360 ]), 361 thread_get_message(Msg), 362 ( Msg = title(Title0) 363 -> Title = Title0 364 ; Msg = throw(Error) 365 -> throw(Error) 366 ; Msg = false 367 -> fail 368 ). 369interactor(Title) :- 370 print_message(error, cannot_attach_console(Title)), 371 fail. 372 373thread_run_interactor(Creator, Title) :- 374 set_prolog_flag(query_debug_settings, debug(false, false)), 375 Error = error(Formal,_), 376 ( catch(attach_console(Title), Error, true) 377 -> ( var(Formal) 378 -> thread_send_message(Creator, title(Title)), 379 print_message(banner, thread_welcome), 380 prolog 381 ; thread_send_message(Creator, throw(Error)) 382 ) 383 ; thread_send_message(Creator, false) 384 ).
390thread_run_interactor :- 391 set_prolog_flag(query_debug_settings, debug(false, false)), 392 attach_console(_Title), 393 print_message(banner, thread_welcome), 394 prolog. 395 396:- endif. % have open_console/4 397 398 /******************************* 399 * DEBUGGING * 400 *******************************/
408tspy(Spec) :- 409 spy(Spec), 410 tdebug. 411 412tspy(Spec, ThreadID) :- 413 spy(Spec), 414 tdebug(ThreadID).
423tdebug :- 424 forall(debug_target(Id), thread_signal(Id, gdebug)). 425 426tdebug(ThreadID) :- 427 thread_signal(ThreadID, gdebug).
434tnodebug :- 435 forall(debug_target(Id), thread_signal(Id, nodebug)). 436 437tnodebug(ThreadID) :- 438 thread_signal(ThreadID, nodebug). 439 440 441debug_target(Thread) :- 442 thread_property(Thread, status(running)), 443 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.
460tbacktrace(Thread) :- 461 tbacktrace(Thread, []). 462 463tbacktrace(Thread, Options) :- 464 merge_options(Options, [clause_references(false)], Options1), 465 ( current_prolog_flag(backtrace_depth, Default) 466 -> true 467 ; Default = 20 468 ), 469 option(depth(Depth), Options1, Default), 470 call_in_thread(Thread, thread_get_prolog_backtrace(Depth, Stack, Options1)), 471 print_prolog_backtrace(user_error, Stack).
478thread_get_prolog_backtrace(Depth, Stack, Options) :- 479 prolog_current_frame(Frame), 480 signal_frame(Frame, SigFrame), 481 get_prolog_backtrace(Depth, Stack, [frame(SigFrame)|Options]). 482 483signal_frame(Frame, SigFrame) :- 484 prolog_frame_attribute(Frame, clause, _), 485 !, 486 ( prolog_frame_attribute(Frame, parent, Parent) 487 -> signal_frame(Parent, SigFrame) 488 ; SigFrame = Frame 489 ). 490signal_frame(Frame, SigFrame) :- 491 ( prolog_frame_attribute(Frame, parent, Parent) 492 -> SigFrame = Parent 493 ; SigFrame = Frame 494 ). 495 496 497 498 /******************************* 499 * REMOTE PROFILING * 500 *******************************/
506tprofile(Thread) :-
507 init_pce,
508 thread_signal(Thread,
509 ( reset_profiler,
510 profiler(_, true)
511 )),
512 format('Running profiler in thread ~w (press RET to show results) ...',
513 [Thread]),
514 flush_output,
515 get_code(_),
516 thread_signal(Thread,
517 ( profiler(_, false),
518 show_profile([])
519 )).527:- if(exists_source(library(pce))). 528init_pce :- 529 current_prolog_flag(gui, true), 530 !, 531 call(send(@(display), open)). % avoid autoloading 532:- endif. 533init_pce. 534 535 536 /******************************* 537 * HOOKS * 538 *******************************/ 539 540:- multifile 541 user:message_hook/3. 542 543user:message_hook(trace_mode(on), _, Lines) :- 544 \+ thread_has_console, 545 \+ current_prolog_flag(gui_tracer, true), 546 catch(attach_console, _, fail), 547 print_message_lines(user_error, '% ', Lines). 548 549:- multifile 550 prolog:message/3. 551 552prologmessage(thread_welcome) --> 553 { thread_self(Self), 554 human_thread_id(Self, Id) 555 }, 556 [ 'SWI-Prolog console for thread ~w'-[Id], 557 nl, nl 558 ]. 559prologmessage(joined_threads(Threads)) --> 560 [ 'Joined the following threads'-[], nl ], 561 thread_list(Threads). 562prologmessage(threads(Threads)) --> 563 thread_list(Threads). 564prologmessage(cannot_attach_console(_Title)) --> 565 [ 'Cannot attach a console (requires swipl-win or POSIX pty support)' ]. 566 567thread_list(Threads) --> 568 { maplist(th_id_len, Threads, Lens), 569 max_list(Lens, MaxWidth), 570 LeftColWidth is max(6, MaxWidth), 571 Threads = [H|_] 572 }, 573 thread_list_header(H, LeftColWidth), 574 thread_list(Threads, LeftColWidth). 575 576th_id_len(Thread, IdLen) :- 577 write_length(Thread.id, IdLen, [quoted(true)]). 578 579thread_list([], _) --> []. 580thread_list([H|T], CW) --> 581 thread_info(H, CW), 582 ( {T == []} 583 -> [] 584 ; [nl], 585 thread_list(T, CW) 586 ). 587 588thread_list_header(Thread, CW) --> 589 { _{id:_, status:_, time:_, stacks:_} :< Thread, 590 !, 591 HrWidth is CW+18+13+13 592 }, 593 [ '~|~tThread~*+ Status~tTime~18+~tStack use~13+~tallocated~13+'-[CW], nl ], 594 [ '~|~`-t~*+'-[HrWidth], nl ]. 595thread_list_header(Thread, CW) --> 596 { _{id:_, status:_} :< Thread, 597 !, 598 HrWidth is CW+7 599 }, 600 [ '~|~tThread~*+ Status'-[CW], nl ], 601 [ '~|~`-t~*+'-[HrWidth], nl ]. 602 603thread_info(Thread, CW) --> 604 { _{id:Id, status:Status, time:Time, stacks:Stacks} :< Thread }, 605 !, 606 [ '~|~t~q~*+ ~w~t~3f~18+~t~D~13+~t~D~13+'- 607 [ Id, CW, Status, Time.cpu, Stacks.total.usage, Stacks.total.allocated 608 ] 609 ]. 610thread_info(Thread, CW) --> 611 { _{id:Id, status:Status} :< Thread }, 612 !, 613 [ '~|~t~q~*+ ~w'- 614 [ Id, CW, Status 615 ] 616 ]
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. */