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.
99threads :- 100 threads(Threads), 101 print_message(information, threads(Threads)). 102 103threads(Threads) :- 104 findall(Thread, thread_statistics(_,Thread), Threads).
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, _).
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 !.
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)).
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.
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.
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)).
xterm(1)
based
console if we use the BSD libedit based command line editor.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).
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 ).
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 ).
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 *******************************/
354tspy(Spec) :- 355 spy(Spec), 356 tdebug. 357 358tspy(Spec, ThreadID) :- 359 spy(Spec), 360 tdebug(ThreadID).
369tdebug :- 370 forall(debug_target(Id), thread_signal(Id, gdebug)). 371 372tdebug(ThreadID) :- 373 thread_signal(ThreadID, gdebug).
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)).
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.
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).
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 *******************************/
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 )).
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 498prologmessage(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 ]. 505prologmessage(joined_threads(Threads)) --> 506 [ 'Joined the following threads'-[], nl ], 507 thread_list(Threads). 508prologmessage(threads(Threads)) --> 509 thread_list(Threads). 510prologmessage(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 ]
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. */