From 84721e1005caa38a727a86c27b0581456b869500 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Wed, 20 Feb 2019 10:45:21 +0000 Subject: [PATCH] copy --- C/terms.c | 43 +++++++++++------------- C/utilpreds.c | 8 ++--- pl/debug.yap | 90 +++++++++++++++++++++++++++++---------------------- pl/top.yap | 2 +- 4 files changed, 74 insertions(+), 69 deletions(-) diff --git a/C/terms.c b/C/terms.c index e6230f90e..3e325f01e 100644 --- a/C/terms.c +++ b/C/terms.c @@ -981,16 +981,8 @@ static Term bind_vars_in_complex_term(CELL * pt0_, CELL * pt0_end_ USES_REGS) { *ptd0 = TermFoundVar; /* next make sure noone will see this as a variable again */ if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - /* Trail overflow */ - if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) { - while (to_visit > to_visit0) { - to_visit--; - CELL *ptd0 = to_visit->ptd0; - *ptd0 = to_visit->d0; - } goto trail_overflow; } - } TrailTerm(TR++) = (CELL)ptd0; END_WALK(); @@ -1043,41 +1035,42 @@ if (found_module && t != t0) { return Yap_unify(ARG2, t) && Yap_unify(ARG3, out); } -#define FOUND_VAR_AGAIN() \ -if (d0 == TermFoundVar) { \ - CELL *pt2 = pt0; \ - while (IsVarTerm(*pt2)) \ - pt2 = (CELL *)(*pt2); \ - HR[1] = AbsPair(HR + 2); \ - HR[0] = (CELL)pt2; \ - HR += 2; \ - *pt2 = TermRefoundVar; \ -} +#define FOUND_VAR_AGAIN() \ + if (d0 == TermFoundVar) \ + { \ + HR[0] = (CELL)ptd0; \ + HR[1] = AbsPair(HR + 2); \ + HR += 2; \ + *ptd0 = TermRefoundVar; \ + } static Term non_singletons_in_complex_term(CELL * pt0_, CELL * pt0_end_ USES_REGS) { - HB = (CELL *)ASP; - CELL output = AbsPair(HR); WALK_COMPLEX_TERM__({}, {}, FOUND_VAR_AGAIN()); /* do or pt2 are unbound */ - YapBind(ptd0, TermFoundVar); - goto restart; + *ptd0 = TermFoundVar; + /* next make sure noone will see this as a variable again */ + if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) + { + goto trail_overflow; + } + TrailTerm(TR++) = (CELL)ptd0; END_WALK(); clean_tr(TR0 PASS_REGS); pop_text_stack(lvl); - HB = (CELL *)B->cp_b; if (HR != InitialH) { /* close the list */ HR[-1] = Deref(ARG2); - return output; + return AbsPair(InitialH); } else { return ARG2; } def_aux_overflow(); + def_trail_overflow(); } static Int p_non_singletons_in_term( @@ -1094,7 +1087,7 @@ static Int p_non_singletons_in_term( } else { out = non_singletons_in_complex_term(&(t)-1, &(t)PASS_REGS); } - return out; + return Yap_unify(ARG3,out); } static Term numbervar(Int me USES_REGS) { diff --git a/C/utilpreds.c b/C/utilpreds.c index 092ea2ced..89d18adff 100644 --- a/C/utilpreds.c +++ b/C/utilpreds.c @@ -395,9 +395,9 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, RESET_VARIABLE(ptf); *ptd0 = (CELL)ptf; ptf++; - if ((ADDR)TR > LOCAL_TrailTop - 16) + TrailTerm(TR++) = (CELL)ptd0; + if ((ADDR)TR > LOCAL_TrailTop - 16) goto trail_overflow; - } } @@ -521,7 +521,7 @@ CopyTerm(Term inp, UInt arity, int share, int newattvs USES_REGS) { Term Yap_CopyTerm(Term inp) { CACHE_REGS - return CopyTerm(inp, 0, TRUE, TRUE PASS_REGS); + return CopyTerm(inp, 0, false, TRUE PASS_REGS); } Term @@ -533,7 +533,7 @@ Yap_CopyTermNoShare(Term inp) { static Int p_copy_term( USES_REGS1 ) /* copy term t to a new instance */ { - Term t = CopyTerm(ARG1, 2, TRUE, TRUE PASS_REGS); + Term t = CopyTerm(ARG1, 2, false, TRUE PASS_REGS); if (t == 0L) return FALSE; /* be careful, there may be a stack shift here */ diff --git a/pl/debug.yap b/pl/debug.yap index ca648226f..cc6abede9 100644 --- a/pl/debug.yap +++ b/pl/debug.yap @@ -16,7 +16,7 @@ *************************************************************************/ -:- system_module( '$_debug', [], ['$trace_query'/4, +:- system_module( '$_debug', [], ['$trace_plan'/4, '$init_debugger'/0, '$skipeol'/1]). @@ -254,7 +254,7 @@ be lost. * * The debugger is an interpreter. with main predicates: * - $trace: this is the API - * - $trace_query: reduce a query to a goal + * - $trace_plan: reduce a query to a goal * - $trace_goal: execute: * + using the source, Luke * + hooking into the WAM procedure call mechanism @@ -308,7 +308,7 @@ be lost. '$execute_nonstop'(G,Mod). '$trace'(Mod:G) :- '$$save_by'(CP), - '$trace_query'(G, Mod, CP, G, EG), + '$trace_plan'(G, Mod, CP, G, EG), gated_call( '$debugger_io', EG, @@ -415,42 +415,54 @@ be lost. '$trace_meta_call'( G, M, CP ) :- - '$trace_query'(G, M, CP, G, EG ), + '$trace_plan'(G, M, CP, G, EG ), call(EG). -%% @pred '$trace_query'( +G, +M, +CP, +Expanded) +%% @pred '$trace_plan'( +G, +M, +CP, +Expanded) % % debug a complex query % -'$trace_query'(V, M, _CP, _, call(M:V)) :- +'$trace_plan'(V, M, _CP, _, call(M:V)) :- var(V), !. -'$trace_query'(!, _, CP, _, '$$cut_by'(CP)) :- +'$trace_plan'(!, _, CP, _, '$$cut_by'(CP)) :- !. -'$trace_query'('$cut_by'(M), _, _, _, '$$cut_by'(M)) :- +'$trace_plan'('$cut_by'(M), _, _, _, '$$cut_by'(M)) :- !. -'$trace_query'('$$cut_by'(M), _, _, _, '$$cut_by'(M)) :- +'$trace_plan'('$$cut_by'(M), _, _, _, '$$cut_by'(M)) :- !. -'$trace_query'(true, _, _, _, true) :- !. -'$trace_query'(fail, _, _, _, '$trace'(fail)) :- !. -'$trace_query'(M:G, _, CP,S, Expanded) :- - !, - '$yap_strip_module'(M:G, M0, G0), - '$trace_query'(G0, M0, CP,S, Expanded ). -'$trace_query'((A,B), M, CP, S, (EA,EB)) :- !, - '$trace_query'(A, M, CP, S, EA), - '$trace_query'(B, M, CP, S, EB). -'$trace_query'((A->B), M, CP, S, (EA->EB)) :- !, - '$trace_query'(A, M, CP, S, EA), - '$trace_query'(B, M, CP, S, EB). -'$trace_query'((A;B), M, CP, S, (EA;EB)) :- !, - '$trace_query'(A, M, CP, S, EA), - '$trace_query'(B, M, CP, S, EB). -'$trace_query'((A|B), M, CP, S, (EA|EB)) :- !, - '$trace_query'(A, M, CP, S, EA), - '$trace_query'(B, M, CP, S, EB). -'$trace_query'((\+ A), M, CP, S, (\+ EA)) :- !, - '$trace_query'(A, M, CP, S, EA). -'$trace_query'(G, M, _CP, _, ( +'$trace_plan'(true, _, _, _, true) :- !. +'$trace_plan'(fail, _, _, _, '$trace'(fail)) :- !. +'$trace_plan'((A,B), M, CP, S, (EA,EB)) :- !, + '$trace_plan'(A, M, CP, S, EA), + '$trace_plan'(B, M, CP, S, EB). +'$trace_plan'((A->B), M, CP, S, (EA->EB)) :- !, + '$trace_plan'(A, M, CP, S, EA), + '$trace_plan'(B, M, CP, S, EB). +'$trace_plan'((A;B), M, CP, S, (EA;EB)) :- !, + '$trace_plan'(A, M, CP, S, EA), + '$trace_plan'(B, M, CP, S, EB). +'$trace_plan'((A|B), M, CP, S, (EA|EB)) :- !, + '$trace_plan'(A, M, CP, S, EA), + '$trace_plan'(B, M, CP, S, EB). + '$trace_plan'(C, M, CP, S, EC), +'$trace_plan'((A->*B), M, CP, S, (EA->EB)) :- !, + '$trace_plan'(A, M, CP, S, EA), + '$trace_plan'(B, M, CP, S, EB). +'$trace_plan'((A->*B;C), M, CP, S, (EA->EB;EC)) :- !, + '$trace_plan'(A, M, CP, S, EA), + '$trace_plan'(B, M, CP, S, EB), + '$trace_plan'(C, M, CP, S, EC). +'$trace_plan'(if(A,B,C), M, CP, S, (EA->EB;EC)) :- !, + '$trace_plan'(A, M, CP, S, EA), + '$trace_plan'(B, M, CP, S, EB), + '$trace_plan'(C, M, CP, S, EC). +'$trace_plan'((\+ A), M, CP, S, ( EA -> fail ; true)) :- !, + '$trace_plan'(A, M, CP, S, EA). +'$trace_plan'(once(A), M, CP, S, ( EA -> true)) :- !, + '$trace_plan'(A, M, CP, S, EA). +'$trace_plan'(ignore(A), M, CP, S, ( EA -> true; true)) :- !, + '$trace_plan'(A, M, CP, S, EA). +'$trace_plan'(G, M, _CP, _, ( % spy a literal '$id_goal'(L), catch( @@ -487,9 +499,9 @@ be lost. ). % meta system '$trace_goal'(G, M, GoalNumber, H) :- - '$is_metapredicate'(G, prolog), - !, - '$debugger_expand_meta_call'(M:G, [], G1), + '$is_metapredicate'(G, prolog), + !, + '$debugger_expand_meta_call'(M:G, [], G1), strip_module(G1, MF, NG), gated_call( '$enter_trace'(GoalNumber, G, M, H), @@ -604,7 +616,7 @@ be lost. '$$save_by'(CP), clause(M:G, Cl, _), '$retry_clause'(GoalNumber, G, M, Info, X), - '$trace_query'(Cl, M, CP, Cl, ECl), + '$trace_plan'(Cl, M, CP, Cl, ECl), '$execute0'(ECl,M). '$creep_step'(GoalNumber, G, M, Info) :- @@ -654,7 +666,7 @@ be lost. %%% - abort: forward throw while the call is newer than goal -%% @pred '$re_trace_query'( Exception, +Goal, +Mod, +GoalID ) +%% @pred '$re_trace_plan'( Exception, +Goal, +Mod, +GoalID ) % % debugger code for exceptions. Recognised cases are: % - abort always forwarded @@ -1046,10 +1058,10 @@ be lost. '$cps'([]). -'$debugger_skip_trace_query'([CP|CPs],CPs1) :- - yap_hacks:choicepoint(CP,_,prolog,'$trace_query',4,(_;_),_), !, - '$debugger_skip_trace_query'(CPs,CPs1). -'$debugger_skip_trace_query'(CPs,CPs). +'$debugger_skip_trace_plan'([CP|CPs],CPs1) :- + yap_hacks:choicepoint(CP,_,prolog,'$trace_plan',4,(_;_),_), !, + '$debugger_skip_trace_plan'(CPs,CPs1). +'$debugger_skip_trace_plan'(CPs,CPs). '$debugger_skip_traces'([CP|CPs],CPs1) :- yap_hacks:choicepoint(CP,_,prolog,'$port',4,(_;_),_), !, diff --git a/pl/top.yap b/pl/top.yap index 13197f25c..3f84a9c56 100644 --- a/pl/top.yap +++ b/pl/top.yap @@ -295,7 +295,7 @@ live :- '$write_answer'(Vs, LGs, Written), '$write_query_answer_true'(Written), ( - '$prompt_alternatives_on'(determinism), CP == NCP, DCP = 0 + yap_flag(prompt_alternatives_on,determinism), CP == NCP, DCP = 0 -> format(user_error, '.~n', []), !