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.317:- if((current_prolog_flag(readline, editline), 318 exists_source(library(editline)))). 319enable_line_editing(_In, _Out, _Err) :- 320 current_prolog_flag(readline, editline), 321 !, 322 el_wrap. 323:- endif. 324enable_line_editing(_In, _Out, _Err). 325 326:- if(current_predicate(el_unwrap/1)). 327disable_line_editing(_In, _Out, _Err) :- 328 el_unwrap(user_input). 329:- endif. 330disable_line_editing(_In, _Out, _Err).
337detach_console(Id) :-
338 ( retract(has_console(Id, In, Out, Err))
339 -> disable_line_editing(In, Out, Err),
340 close(In, [force(true)]),
341 close(Out, [force(true)]),
342 close(Err, [force(true)])
343 ; true
344 ).352interactor :- 353 interactor(_). 354 355interactor(Title) :- 356 can_open_console, 357 !, 358 thread_self(Me), 359 thread_create(thread_run_interactor(Me, Title), _Id, 360 [ detached(true) 361 ]), 362 thread_get_message(Msg), 363 ( Msg = title(Title0) 364 -> Title = Title0 365 ; Msg = throw(Error) 366 -> throw(Error) 367 ; Msg = false 368 -> fail 369 ). 370interactor(Title) :- 371 print_message(error, cannot_attach_console(Title)), 372 fail. 373 374thread_run_interactor(Creator, Title) :- 375 set_prolog_flag(query_debug_settings, debug(false, false)), 376 Error = error(Formal,_), 377 ( catch(attach_console(Title), Error, true) 378 -> ( var(Formal) 379 -> thread_send_message(Creator, title(Title)), 380 print_message(banner, thread_welcome), 381 prolog 382 ; thread_send_message(Creator, throw(Error)) 383 ) 384 ; thread_send_message(Creator, false) 385 ).
391thread_run_interactor :- 392 set_prolog_flag(query_debug_settings, debug(false, false)), 393 attach_console(_Title), 394 print_message(banner, thread_welcome), 395 prolog. 396 397:- endif. % have open_console/4 398 399 /******************************* 400 * DEBUGGING * 401 *******************************/
409tspy(Spec) :- 410 spy(Spec), 411 tdebug. 412 413tspy(Spec, ThreadID) :- 414 spy(Spec), 415 tdebug(ThreadID).
424tdebug :- 425 forall(debug_target(Id), thread_signal(Id, gdebug)). 426 427tdebug(ThreadID) :- 428 thread_signal(ThreadID, gdebug).
435tnodebug :- 436 forall(debug_target(Id), thread_signal(Id, nodebug)). 437 438tnodebug(ThreadID) :- 439 thread_signal(ThreadID, nodebug). 440 441 442debug_target(Thread) :- 443 thread_property(Thread, status(running)), 444 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.
461tbacktrace(Thread) :- 462 tbacktrace(Thread, []). 463 464tbacktrace(Thread, Options) :- 465 merge_options(Options, [clause_references(false)], Options1), 466 ( current_prolog_flag(backtrace_depth, Default) 467 -> true 468 ; Default = 20 469 ), 470 option(depth(Depth), Options1, Default), 471 call_in_thread(Thread, thread_get_prolog_backtrace(Depth, Stack, Options1)), 472 print_prolog_backtrace(user_error, Stack).
479thread_get_prolog_backtrace(Depth, Stack, Options) :- 480 prolog_current_frame(Frame), 481 signal_frame(Frame, SigFrame), 482 get_prolog_backtrace(Depth, Stack, [frame(SigFrame)|Options]). 483 484signal_frame(Frame, SigFrame) :- 485 prolog_frame_attribute(Frame, clause, _), 486 !, 487 ( prolog_frame_attribute(Frame, parent, Parent) 488 -> signal_frame(Parent, SigFrame) 489 ; SigFrame = Frame 490 ). 491signal_frame(Frame, SigFrame) :- 492 ( prolog_frame_attribute(Frame, parent, Parent) 493 -> SigFrame = Parent 494 ; SigFrame = Frame 495 ). 496 497 498 499 /******************************* 500 * REMOTE PROFILING * 501 *******************************/
507tprofile(Thread) :-
508 init_pce,
509 thread_signal(Thread,
510 ( reset_profiler,
511 profiler(_, true)
512 )),
513 format('Running profiler in thread ~w (press RET to show results) ...',
514 [Thread]),
515 flush_output,
516 get_code(_),
517 thread_signal(Thread,
518 ( profiler(_, false),
519 show_profile([])
520 )).528:- if(exists_source(library(pce))). 529init_pce :- 530 current_prolog_flag(gui, true), 531 !, 532 call(send(@(display), open)). % avoid autoloading 533:- endif. 534init_pce. 535 536 537 /******************************* 538 * HOOKS * 539 *******************************/ 540 541:- multifile 542 user:message_hook/3. 543 544user:message_hook(trace_mode(on), _, Lines) :- 545 \+ thread_has_console, 546 \+ current_prolog_flag(gui_tracer, true), 547 catch(attach_console, _, fail), 548 print_message_lines(user_error, '% ', Lines). 549 550:- multifile 551 prolog:message/3. 552 553prologmessage(thread_welcome) --> 554 { thread_self(Self), 555 human_thread_id(Self, Id) 556 }, 557 [ 'SWI-Prolog console for thread ~w'-[Id], 558 nl, nl 559 ]. 560prologmessage(joined_threads(Threads)) --> 561 [ 'Joined the following threads'-[], nl ], 562 thread_list(Threads). 563prologmessage(threads(Threads)) --> 564 thread_list(Threads). 565prologmessage(cannot_attach_console(_Title)) --> 566 [ 'Cannot attach a console (requires swipl-win or POSIX pty support)' ]. 567 568thread_list(Threads) --> 569 { maplist(th_id_len, Threads, Lens), 570 max_list(Lens, MaxWidth), 571 LeftColWidth is max(6, MaxWidth), 572 Threads = [H|_] 573 }, 574 thread_list_header(H, LeftColWidth), 575 thread_list(Threads, LeftColWidth). 576 577th_id_len(Thread, IdLen) :- 578 write_length(Thread.id, IdLen, [quoted(true)]). 579 580thread_list([], _) --> []. 581thread_list([H|T], CW) --> 582 thread_info(H, CW), 583 ( {T == []} 584 -> [] 585 ; [nl], 586 thread_list(T, CW) 587 ). 588 589thread_list_header(Thread, CW) --> 590 { _{id:_, status:_, time:_, stacks:_} :< Thread, 591 !, 592 HrWidth is CW+18+13+13 593 }, 594 [ '~|~tThread~*+ Status~tTime~18+~tStack use~13+~tallocated~13+'-[CW], nl ], 595 [ '~|~`-t~*+'-[HrWidth], nl ]. 596thread_list_header(Thread, CW) --> 597 { _{id:_, status:_} :< Thread, 598 !, 599 HrWidth is CW+7 600 }, 601 [ '~|~tThread~*+ Status'-[CW], nl ], 602 [ '~|~`-t~*+'-[HrWidth], nl ]. 603 604thread_info(Thread, CW) --> 605 { _{id:Id, status:Status, time:Time, stacks:Stacks} :< Thread }, 606 !, 607 [ '~|~t~q~*+ ~w~t~3f~18+~t~D~13+~t~D~13+'- 608 [ Id, CW, Status, Time.cpu, Stacks.total.usage, Stacks.total.allocated 609 ] 610 ]. 611thread_info(Thread, CW) --> 612 { _{id:Id, status:Status} :< Thread }, 613 !, 614 [ '~|~t~q~*+ ~w'- 615 [ Id, CW, Status 616 ] 617 ]
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. */