diff --git a/pl/boot.yap b/pl/boot.yap index 6e17e9987..702c5c4d5 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -95,7 +95,8 @@ true :- true. '$db_clean_queues'(0), '$startup_reconsult', '$startup_goals', - '$set_input'(user_input),'$set_output'(user). + '$set_input'(user_input),'$set_output'(user), + '$run_at_thread_start'. '$init_consult' :- nb_setval('$lf_verbose',informational), @@ -673,6 +674,12 @@ true :- true. write_term(user_error,G,Opts) ; format(user_error,'~w',[G]) ). +'$write_goal_output'(_M:G, First, [G|NG], next, NG) :- + ( First = first -> true ; format(user_error,',~n',[]) ), + ( recorded('$print_options','$toplevel'(Opts),_) -> + write_term(user_error,G,Opts) ; + format(user_error,'~w',[G]) + ). '$name_vars_in_goals'(G, VL0, NG) :- copy_term_nat(G+VL0, NG+NVL0), @@ -1189,3 +1196,11 @@ throw(Ball) :- '$oncenotrace'(M:G) :- '$execute_nonstop'(G, M), !. + +'$run_at_thread_start' :- + recorded('$thread_initialization',M:D,_), + '$notrace'(M:D), + fail. +'$run_at_thread_start'. + + diff --git a/pl/directives.yap b/pl/directives.yap index 525859971..8a1c29e7e 100644 --- a/pl/directives.yap +++ b/pl/directives.yap @@ -53,6 +53,7 @@ '$directive'(reexport(_,_)). '$directive'(sequential). '$directive'(sequential(_)). +'$directive'(thread_initialization(_)). '$directive'(thread_local(_)). '$directive'(uncutable(_)). '$directive'(use_module(_)). @@ -74,6 +75,8 @@ '$discontiguous'(D,M). '$exec_directive'(initialization(D), _, M) :- '$initialization'(M:D). +'$exec_directive'(thread_initialization(D), _, M) :- + '$thread_initialization'(M:D). '$exec_directive'(expects_dialect(D), _, _) :- '$expects_dialect'(D). '$exec_directive'(encoding(Enc), _, _) :- @@ -1101,3 +1104,11 @@ user_defined_flag(Atom) :- eraseall('$dialect'), recorda('$dialect',yap,_). +'$thread_initialization'(M:D) :- + eraseall('$thread_initialization'), + recorda('$thread_initialization',M:D,_), + fail. +'$thread_initialization'(M:D) :- + '$initialization'(M:D). + + diff --git a/pl/threads.yap b/pl/threads.yap index 1782a9a7a..97293aeb9 100644 --- a/pl/threads.yap +++ b/pl/threads.yap @@ -38,6 +38,7 @@ '$thread_self'(Id), (Detached == true -> '$detach_thread'(Id) ; true), '$current_module'(Module), + '$run_at_thread_start', % always finish with a throw to make sure we clean stacks. '$system_catch'((G -> throw('$thread_finished'(true)) ; throw('$thread_finished'(false))),Module,Exception,'$close_thread'(Exception,Detached)), % force backtracking and handling exceptions