diff --git a/C/absmi.c b/C/absmi.c index 76f9cfc73..666b6f727 100755 --- a/C/absmi.c +++ b/C/absmi.c @@ -751,7 +751,7 @@ static int interrupt_cut_e(USES_REGS1) { if ((v = check_alarm_fail_int(2 PASS_REGS)) >= 0) { return v; } - if (!Yap_only_has_signals(YAP_CDOVF_SIGNAL, YAP_CREEP_SIGNAL)) { + if (Yap_only_has_signals(YAP_CDOVF_SIGNAL, YAP_CREEP_SIGNAL)) { return 2; } /* find something to fool S */ diff --git a/C/arith0.c b/C/arith0.c index 132b09d93..deb085c8a 100644 --- a/C/arith0.c +++ b/C/arith0.c @@ -186,18 +186,6 @@ eval0(Int fi) { RINT((Int)ASP); #else RINT(LCL0 - ASP); -#endif - case op_b: - /// - $b - /// current choicepoint - /// -#if YAPOR_SBA - RINT((Int)B); -#else - if (B) - RINT(LCL0 - (CELL *)B); - else - RINT(0); #endif case op_env: /// - $env @@ -257,7 +245,6 @@ static InitConstEntry InitConstTab[] = { {"heapused", op_heapused}, {"local_sp", op_localsp}, {"global_sp", op_globalsp}, - {"$last_choice_pt", op_b}, {"$env", op_env}, {"$tr", op_tr}, {"stackfree", op_stackfree}, diff --git a/C/stack.c b/C/stack.c index ec841968d..d99bf2090 100644 --- a/C/stack.c +++ b/C/stack.c @@ -1776,9 +1776,9 @@ void Yap_dump_stack(void) { int max_count = 200; /* check if handled */ - if (handled_exception(PASS_REGS1)) - return; -#if DEBU + //if (handled_exception(PASS_REGS1)) + // return; +#if DEBUG fprintf(stderr, "%% YAP regs: P=%p, CP=%p, ASP=%p, H=%p, TR=%p, HeapTop=%p\n", P, CP, ASP, HR, TR, HeapTop); #endif diff --git a/C/tracer.c b/C/tracer.c index 38bd6e2a1..31ac498a4 100644 --- a/C/tracer.c +++ b/C/tracer.c @@ -98,11 +98,9 @@ static char *send_tracer_message(char *start, char *name, arity_t arity, if (max <= sz) { min = sz + 1024; expand = true; - free((void*)sn); continue; } strcpy(s, sn); - free((void*)sn); sn = NULL; s += sz; max -= sz; diff --git a/pl/absf.yap b/pl/absf.yap index df1967057..781b71b48 100755 --- a/pl/absf.yap +++ b/pl/absf.yap @@ -235,8 +235,8 @@ absolute_file_name(File0,File) :- '$absf_trace'(' after name/library unfolding: ~w', [Name]), '$variable_expansion'(CorePath, Opts,ExpandedPath), '$absf_trace'(' after environment variable expansion: ~s', [ExpandedPath]), - '$prefix'(ExpandedPath, Opts, Path , []), - '$absf_trace'(' after prefix expansion: ~s', [Path]), + '$file_prefix'(ExpandedPath, Opts, Path , []), + '$absf_trace'(' after file_prefix expansion: ~s', [Path]), atom_codes( APath, Path ), ( Expand = true @@ -366,11 +366,12 @@ absolute_file_name(File0,File) :- '$absf_trace'(' try no suffix', []). '$add_suffix'(Cs) --> - { Cs = [0'. |_Codes] } + ( + { Cs = [0'. |_Codes] } -> Cs ; - ".", Cs. + ".", Cs ). '$glob'(Opts) --> { @@ -392,32 +393,32 @@ absolute_file_name(File0,File) :- Base \= '.', Base \='..'. -'$prefix'( CorePath, _Opts) --> +'$file_prefix'( CorePath, _Opts) --> { is_absolute_file_name( CorePath ) }, !, CorePath. -'$prefix'( CorePath, Opts) --> - { get_abs_file_parameter( relative_to, Opts, Prefix ), - Prefix \= '', - '$absf_trace'(' relative_to ~a', [Prefix]), - sub_atom(Prefix, _, 1, 0, Last), - atom_codes(Prefix, S) +'$file_prefix'( CorePath, Opts) --> + { get_abs_file_parameter( relative_to, Opts, File_Prefix ), + File_Prefix \= '', + '$absf_trace'(' relative_to ~a', [File_Prefix]), + sub_atom(File_Prefix, _, 1, 0, Last), + atom_codes(File_Prefix, S) }, !, S, '$dir'(Last), CorePath. -'$prefix'( CorePath, _) --> +'$file_prefix'( CorePath, _) --> { - recorded('$path',Prefix,_), - '$absf_trace'(' try YAP path database ~a', [Prefix]), - sub_atom(Prefix, _, _, 1, Last), - atom_codes(Prefix, S) }, + recorded('$path',File_Prefix,_), + '$absf_trace'(' try YAP path database ~a', [File_Prefix]), + sub_atom(File_Prefix, _, _, 1, Last), + atom_codes(File_Prefix, S) }, S, '$dir'(Last), CorePath. -'$prefix'(CorePath, _ ) --> - '$absf_trace'(' empty prefix', []), +'$file_prefix'(CorePath, _ ) --> + '$absf_trace'(' empty file_prefix ', []), CorePath. diff --git a/pl/control.yap b/pl/control.yap index 700bae5a0..ae0baa865 100644 --- a/pl/control.yap +++ b/pl/control.yap @@ -164,8 +164,8 @@ ignore(Goal) :- (Goal->true;true). * */ if(X,Y,Z) :- - ( - CP is '$last_choice_pt', + ( + '$$save_by'(CP), '$call'(X,CP,if(X,Y,Z),M), '$execute'(X), '$clean_ifcp'(CP), diff --git a/pl/debug.yap b/pl/debug.yap index d7ae2575f..661308502 100644 --- a/pl/debug.yap +++ b/pl/debug.yap @@ -284,7 +284,7 @@ be lost. * @return `call(Goal)` */ '$spy'([Mod|G]) :- - '$trace'([Mod|G]). + '$trace'(Mod:G). /** * @pred $trace( +Goal ) @@ -298,13 +298,13 @@ be lost. * @param _Mod_:_Goal_ is the goal to be examined. * @return `call(Goal)` */ -%% '$trace'([Mod|G]) :- -%% '$stop_creeping'(_), -% set_prolog_flag(debug, true), -%% !, -%% '$execute_nonstop'(G,Mod). -'$trace'([Mod|G]) :- - CP is '$last_choice_pt', +'$trace'(Mod:G) :- + '$stop_creeping'(_), + ( prolog_flag(debug, false) ; '__NB_getval__'('$debug_status',state(zip,_Border,_Spy), fail) ), + !, + '$execute_nonstop'(G,Mod). +'$trace'(Mod:G) :- + '$$save_by'(CP), '$trace_query'(G, Mod, CP, G, EG), gated_call( '$debugger_input', @@ -323,47 +323,47 @@ be lost. -'$trace'([Mod|G], A1) :- +'$trace'(Mod:G, A1) :- G =.. L, lists:append( L, [A1], NL), NG =.. NL, - '$trace'([Mod|NG]). + '$trace'(Mod:NG). -'$trace'([Mod|G], A1, A2) :- +'$trace'(Mod:G, A1, A2) :- G =.. L, lists:append( L, [A1, A2], NL), NG =.. NL, - '$trace'([Mod|NG]). + '$trace'(Mod:NG). -'$trace'([Mod|G], A1, A2, A3) :- +'$trace'(Mod:G, A1, A2, A3) :- G =.. L, lists:append( L, [A1, A2, A3], NL), NG =.. NL, - '$trace'([Mod|NG]). + '$trace'(Mod:NG). -'$trace'([Mod|G], A1, A2, A3, A4) :- +'$trace'(Mod:G, A1, A2, A3, A4) :- G =.. L, lists:append( L, [A1,A2,A3,A4], NL), NG =.. NL, - '$trace'([Mod|NG]). + '$trace'(Mod:NG). -'$trace'([Mod|G], A1, A2, A3, A4, A5) :- +'$trace'(Mod:G, A1, A2, A3, A4, A5) :- G =.. L, lists:append( L, [A1, A2, A3, A4, A5], NL), NG =.. NL, - '$trace'([Mod|NG]). + '$trace'(Mod:NG). -'$trace'([Mod|G], A1, A2, A3, A4, A5, A6) :- +'$trace'(Mod:G, A1, A2, A3, A4, A5, A6) :- G =.. L, lists:append( L, [A1, A2, A3, A4, A5, A6], NL), NG =.. NL, - '$trace'([Mod|NG]). + '$trace'(Mod:NG). -'$trace'([Mod|G], A1, A2, A3, A4, A5, A6, A7) :- +'$trace'(Mod:G, A1, A2, A3, A4, A5, A6, A7) :- G =.. L, lists:append( L, [A1, A2, A3, A4, A5, A6, A7 ], NL), NG =.. NL, - '$trace'([Mod|NG]). + '$trace'(Mod:NG). /** * @pred debugger_input. @@ -573,8 +573,8 @@ be lost. * */ '$trace_go'(GoalNumber, G, M, Info) :- - X=marker(_,M,G), - CP is '$last_choice_pt', + X=marker(_,M,G), + '$$save_by'(CP), clause(M:G, Cl, _), '$retry_clause'(GoalNumber, G, M, Info, X), '$trace_query'(Cl, M, CP, Cl, ECl), @@ -651,12 +651,8 @@ be lost. %%% - abort: forward throw while the call is newer than goal -'$TraceError'( abort, _, _, _, _). -'$TraceError'(forward(redo,_G0), _, _, _, _). -%%% - backtrack long distance -'$TraceError'(forward(fail,_G0),GoalNumber, _, _, _) :- !, - throw(debugger(fail,GoalNumber)). -%%% +'$TraceError'( error(Id,Info), _, _, _, _) :- + throw( error(Id, Info) ). %%% - forward through the debugger '$TraceError'(forward('$wrapper',Event), _, _, _, _) :- !, @@ -689,8 +685,9 @@ be lost. % '$gg'(CP,Goal) :- - CP is '$last_choice_point', - Goal. + '$$save_by'(CP0), + CP = CP0, + Goal. '$port'(_P, _G, _M,GoalNumber,_Determinic, _Info ) :- %%> leap '__NB_getval__'('$debug_status',state(leap,Border,_), fail), @@ -1008,8 +1005,7 @@ be lost. '$cps'([CP|CPs]) :- - yap_hacks:choicepoint(CP,A,B,C,D,E,F), - write(A:B:C:D:E:F),nl, + yap_hacks:choicepoint(CP,_A_,_B,_C,_D,_E,_F), '$cps'(CPs). '$cps'([]). @@ -1050,7 +1046,7 @@ be lost. '$debugger_process_meta_arguments'(G, _M, G). '$ldebugger_process_meta_args'([], _, [], []). -'$ldebugger_process_meta_args'([G|BGs], M, [N|BMs], ['$trace'([M1|G1])|BG1s]) :- +'$ldebugger_process_meta_args'([G|BGs], M, [N|BMs], ['$user_call'(G1,M1)|BG1s]) :- number(N), N >= 0, '$yap_strip_module'( M:G, M1, G1 ), diff --git a/pl/messages.yap b/pl/messages.yap index 8314f11d7..290a0f756 100644 --- a/pl/messages.yap +++ b/pl/messages.yap @@ -197,6 +197,9 @@ compose_message( halt, _Level) --> !, [ 'YAP execution halted.'-[] ]. % syntax error. +compose_message( error(event(Type),Info), _Level ) --> + !, + event(Type, Info). compose_message(error(warning(syntax_error,Info), Exc), Level) --> !, compose_message(error(syntax_error(Info), Exc), Level). @@ -239,7 +242,7 @@ compose_message(trace_command(C), _Leve) --> compose_message(trace_help, _Leve) --> !, [ ' Please enter a valid debugger command (h for help).' ]. -compose_message(version(Version), _Leve) --> +compose_message(version(Version), _Level) --> !, [ '~a' - [Version] ]. compose_message(myddas_version(Version), _Leve) --> @@ -296,6 +299,10 @@ location( error(_,Info), Level, LC ) --> [ '~a:~d:0 ~a while executing ~a():'-[File, FilePos,Level,FF] ]. location( _Ball, _Level, _LC ) --> []. +event(redo, _Info) --> {fail}. +event(fail, _Info) --> {fail}. +event(abort, Info) --> { throw(event(abort, Info)) }. + simplify_pred(user:F, F) :- !. simplify_pred(prolog:F, F) :- !. simplify_pred(F, F). diff --git a/pl/protect.yap b/pl/protect.yap index 07ca65fd6..5fe5a9210 100755 --- a/pl/protect.yap +++ b/pl/protect.yap @@ -48,8 +48,8 @@ prolog:'$protect' :- '$new_system_predicate'(Name,Arity,M), sub_atom(Name,0,1,_, '$'), functor(P,Name,Arity), -% '$hide_predicate'(P,M), '$stash_predicate'(P,M), +% '$hide_predicate'(P,M), fail. prolog:'$protect' :- current_atom(Name), diff --git a/pl/signals.yap b/pl/signals.yap index f32a78711..f9b9603be 100644 --- a/pl/signals.yap +++ b/pl/signals.yap @@ -178,7 +178,7 @@ debug, '$execute'(M:G). '$start_creep'([Mod|G], _WhereFrom) :- - '$trace'([Mod|G]). + '$trace'(Mod:G). '$no_creep_call'('$execute_clause'(G,Mod,Ref,CP),_) :- !, '$enable_debugging', diff --git a/pl/top.yap b/pl/top.yap index 02904b1da..6e6e814a0 100644 --- a/pl/top.yap +++ b/pl/top.yap @@ -13,7 +13,8 @@ * @{ * \*/ -:- '$system_meta_predicates'([ + :- '$system_meta_predicates'([ + gated_call(0,0,?,0), catch(0,?,0), log_event(+,:)]). @@ -338,11 +339,10 @@ live :- % '$delayed_goals'(G, V, NV, LGs, NCP) :- ( - CP is '$last_choice_pt', - '$current_choice_point'(NCP1), + '$$save_by'(NCP1), attributes:delayed_goals(G, V, NV, LGs), - '$clean_ifcp'(CP), - '$current_choice_point'(NCP2), + '$clean_ifcp'(NCP1), + '$$save_by'(NCP2), NCP is NCP2-NCP1 ; copy_term_nat(V, NV), @@ -830,6 +830,7 @@ Command = (H --> B) -> /* General purpose predicates */ +'$head_and_body'(M:(H:-B),M:H,M:B) :- !. '$head_and_body'((H:-B),H,B) :- !. '$head_and_body'(H,H,true). diff --git a/swi/library/plunit.pl b/swi/library/plunit.pl index e5921b06c..bbabffca0 100644 --- a/swi/library/plunit.pl +++ b/swi/library/plunit.pl @@ -1095,8 +1095,8 @@ setup(_,_,_). % Call Goal in Module after applying goal expansion. call_ex(Module, Goal) :- - Module:(expand_goal(Goal, GoalEx), - GoalEx). + (expand_goal(Goal,Module: GoalEx), + Module:GoalEx). %% cleanup(+Module, +Options) is det. %