diff --git a/BEAM/eam_am.c b/BEAM/eam_am.c index e02dc2e40..f9c5fe187 100644 --- a/BEAM/eam_am.c +++ b/BEAM/eam_am.c @@ -1428,6 +1428,7 @@ static void *OpAddress[]= { &&p_db_ref, &&p_primitive, &&p_cut_by, + &&p_save_by, &&p_succ, &&p_predc, &&p_plus, @@ -3536,6 +3537,7 @@ break_debug(contador); p_db_ref: p_primitive: p_cut_by: + p_save_by: p_succ: p_predc: p_plus: diff --git a/BEAM/eamamasm.h b/BEAM/eamamasm.h index c7d731cee..bbfa97a40 100644 --- a/BEAM/eamamasm.h +++ b/BEAM/eamamasm.h @@ -115,15 +115,16 @@ #define _p_db_ref (_std_base+8) #define _p_primitive (_std_base+9) #define _p_cut_by (_std_base+10) -#define _p_succ (_std_base+11) -#define _p_predc (_std_base+12) -#define _p_plus (_std_base+13) -#define _p_minus (_std_base+14) -#define _p_times (_std_base+15) -#define _p_div (_std_base+16) -#define _p_dif (_std_base+17) -#define _p_eq (_std_base+18) -#define _p_arg (_std_base+19) -#define _p_functor (_std_base+20) +#define _p_save_by (_std_base+11) +#define _p_succ (_std_base+12) +#define _p_predc (_std_base+13) +#define _p_plus (_std_base+14) +#define _p_minus (_std_base+15) +#define _p_times (_std_base+16) +#define _p_div (_std_base+17) +#define _p_dif (_std_base+18) +#define _p_eq (_std_base+19) +#define _p_arg (_std_base+20) +#define _p_functor (_std_base+21) diff --git a/C/compiler.c b/C/compiler.c index 9d6907a70..579d0a167 100644 --- a/C/compiler.c +++ b/C/compiler.c @@ -923,6 +923,8 @@ c_test(Int Op, Term t1, compiler_struct *cglobs) { } if (Op == _cut_by) c_var(t, commit_b_flag, 1, 0, cglobs); + else if (Op == _save_by) + c_var(t, save_b_flag, 1, 0, cglobs); else c_var(t, f_flag,(unsigned int)Op, 0, cglobs); } diff --git a/C/computils.c b/C/computils.c index 4d90d9890..c3f117195 100644 --- a/C/computils.c +++ b/C/computils.c @@ -331,6 +331,9 @@ bip_name(Int op, char *s) case _cut_by: strcpy(s,"cut_by"); break; + case _save_by: + strcpy(s,"save_by"); + break; case _db_ref: strcpy(s,"db_ref"); break; diff --git a/C/exec.c b/C/exec.c index c8b0458ff..d595327c9 100644 --- a/C/exec.c +++ b/C/exec.c @@ -1916,6 +1916,7 @@ Yap_InitExecFs(void) Yap_InitCPred("$execute0", 2, p_execute0, 0); Yap_InitCPred("$execute_nonstop", 2, p_execute_nonstop, 0); Yap_InitCPred("$execute_clause", 4, p_execute_clause, 0); + Yap_InitCPred("$current_choice_point", 1, p_save_cp, 0); CurrentModule = HACKS_MODULE; Yap_InitCPred("current_choice_point", 1, p_save_cp, 0); Yap_InitCPred("current_choicepoint", 1, p_save_cp, 0); diff --git a/C/exo.c b/C/exo.c index c9721f568..3541a55dd 100644 --- a/C/exo.c +++ b/C/exo.c @@ -258,13 +258,13 @@ add_index(struct index_t **ip, UInt bmap, PredEntry *ap, UInt count, UInt bnds[] if (!(base = (CELL *)Yap_AllocCodeSpace(sizeof(CELL)*(ncls+i->hsize)))) { CACHE_REGS save_machine_regs(); - LOCAL_Error_Size = 3*ncls*sizeof(CELL); + LOCAL_Error_Size = sizeof(CELL)*(ncls+i->hsize); LOCAL_ErrorMessage = "not enough space to generate indices"; Yap_FreeCodeSpace((void *)i); Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage); return NULL; } - bzero(base, 3*sizeof(CELL)*ncls); + bzero(base, sizeof(CELL)*(ncls+i->hsize)); } i->size = sizeof(CELL)*(ncls+i->hsize)+sz+sizeof(struct index_t); i->key = (CELL **)base; diff --git a/C/inlines.c b/C/inlines.c index 59a563a46..356de33a4 100644 --- a/C/inlines.c +++ b/C/inlines.c @@ -760,6 +760,13 @@ p_functor( USES_REGS1 ) /* functor(?,?,?) */ ENDD(d0); } +static Term +cp_as_integer(choiceptr cp USES_REGS) +{ + return(MkIntegerTerm(LCL0-(CELL *)cp)); +} + + static Int p_cut_by( USES_REGS1 ) { @@ -897,6 +904,20 @@ cont_genarg( USES_REGS1 ) Yap_unify(ARG3,pt[0]); } +static Int +p_save_cp( USES_REGS1 ) +{ + Term t = Deref(ARG1); + Term td; +#if SHADOW_HB + register CELL *HBREG = HB; +#endif + if (!IsVarTerm(t)) return(FALSE); + td = cp_as_integer(B PASS_REGS); + Bind((CELL *)t,td); + return(TRUE); +} + void Yap_InitInlines(void) @@ -904,6 +925,7 @@ Yap_InitInlines(void) CACHE_REGS Term cm = CurrentModule; Yap_InitAsmPred("$$cut_by", 1, _cut_by, p_cut_by, SafePredFlag); + Yap_InitAsmPred("$$save_by", 1, _save_by, p_save_cp, SafePredFlag); Yap_InitAsmPred("atom", 1, _atom, p_atom, SafePredFlag); Yap_InitAsmPred("atomic", 1, _atomic, p_atomic, SafePredFlag); Yap_InitAsmPred("integer", 1, _integer, p_integer, SafePredFlag); diff --git a/H/amidefs.h b/H/amidefs.h index cf424bc22..fbb2c224b 100644 --- a/H/amidefs.h +++ b/H/amidefs.h @@ -163,6 +163,7 @@ typedef enum { _number, _var, _cut_by, + _save_by, _db_ref, _primitive, _dif, diff --git a/pl/boot.yap b/pl/boot.yap index 410069815..ac477fb81 100755 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -485,10 +485,10 @@ true :- true. '$yes_no'(G,(?-)). '$query'(G,V) :- ( - yap_hacks:current_choice_point(CP), + '$current_choice_point'(CP), '$current_module'(M), '$execute_outside_system_mode'(G, M), - yap_hacks:current_choice_point(NCP), + '$current_choice_point'(NCP), '$delayed_goals'(G, V, NV, LGs, DCP), '$write_answer'(NV, LGs, Written), '$write_query_answer_true'(Written), @@ -531,9 +531,9 @@ true :- true. '$delayed_goals'(G, V, NV, LGs, NCP) :- ( CP is '$last_choice_pt', - yap_hacks:current_choice_point(NCP1), + '$current_choice_point'(NCP1), '$attributes':delayed_goals(G, V, NV, LGs), - yap_hacks:current_choice_point(NCP2), + '$current_choice_point'(NCP2), '$clean_ifcp'(CP), NCP is NCP2-NCP1 ; @@ -759,7 +759,7 @@ incore(G) :- '$execute'(G). % standard meta-call, called if $execute could not do everything. % '$meta_call'(G, M) :- - yap_hacks:current_choice_point(CP), + '$current_choice_point'(CP), '$call'(G, CP, G, M). @@ -814,7 +814,7 @@ not(G) :- \+ '$execute'(G). % '$meta_call'(G,_ISO,M) :- '$iso_check_goal'(G,G), - yap_hacks:current_choice_point(CP), + '$current_choice_point'(CP), '$call'(G, CP, G, M). '$meta_call'(G, CP, G0, M) :- @@ -851,7 +851,7 @@ not(G) :- \+ '$execute'(G). ). '$call'((X*->Y; Z),CP,G0,M) :- !, ( - yap_hacks:current_choicepoint(DCP), + '$current_choicepoint'(DCP), '$call'(X,CP,G0,M), yap_hacks:cut_at(DCP), '$call'(Y,CP,G0,M) @@ -874,7 +874,7 @@ not(G) :- \+ '$execute'(G). ). '$call'((X*->Y| Z),CP,G0,M) :- !, ( - yap_hacks:current_choicepoint(DCP), + '$current_choicepoint'(DCP), '$call'(X,CP,G0,M), yap_hacks:cut_at(DCP), '$call'(Y,CP,G0,M) @@ -888,7 +888,7 @@ not(G) :- \+ '$execute'(G). '$call'(B,CP,G0,M) ). '$call'(\+ X, _CP, _G0, M) :- !, - yap_hacks:current_choicepoint(CP), + '$current_choicepoint'(CP), \+ '$call'(X,CP,G0,M). '$call'(not(X), _CP, _G0, M) :- !, \+ '$call'(X,CP,G0,M). @@ -1165,9 +1165,9 @@ expand_term(Term,Expanded) :- % where was the previous catch catch(G, C, A) :- '$catch'(C,A,_), - yap_hacks:current_choice_point(CP0), + '$$save_by'(CP0), '$execute'(G), - yap_hacks:current_choice_point(CP1), + '$$save_by'(CP1), (CP0 == CP1 -> !; true ). % makes sure we have an environment. @@ -1182,9 +1182,9 @@ catch(G, C, A) :- '$system_catch'(G, M, C, A) :- % check current trail '$catch'(C,A,_), - yap_hacks:current_choice_point(CP0), + '$$save_by'(CP0), '$execute_nonstop'(G, M), - yap_hacks:current_choice_point(CP1), + '$$save_by'(CP1), (CP0 == CP1 -> !; true ). % @@ -1264,13 +1264,24 @@ catch_ball(C, C). ). '$execute_outside_system_mode'(G, M, CP) :- nb_getval('$trace', on), !, - '$do_spy'(G, M, CP, no). -'$execute_outside_system_mode'(G, M, CP) :- ( - yap_hacks:current_choice_point(CP1), + '$$save_by'(CP1), + '$do_spy'(G, M, CP, meta_creep), + % we may exit system mode... + '$$save_by'(CP2), + (CP1 == CP2 -> ! ; ( true ; '$exit_system_mode', fail ) ), + '$enter_system_mode' + ; + '$enter_system_mode', + fail + ). +'$execute_outside_system_mode'(G, M, CP) :- + format('start~n', []), + ( + '$$save_by'(CP1), '$exit_system_mode', '$execute_nonstop'(G,M), - yap_hacks:current_choice_point(CP2), + '$$save_by'(CP2), (CP1 == CP2 -> ! ; ( true ; '$exit_system_mode', fail ) ), '$enter_system_mode' ; diff --git a/pl/control.yap b/pl/control.yap index de7665ba1..e3e678578 100644 --- a/pl/control.yap +++ b/pl/control.yap @@ -112,16 +112,16 @@ setup_call_catcher_cleanup(Setup, Goal, Catcher, Cleanup) :- throw(Exception). '$safe_call_cleanup'(Goal, Cleanup, Catcher, Exception) :- - yap_hacks:current_choice_point(MyCP1), + '$current_choice_point'(MyCP1), '$coroutining':freeze_goal(Catcher, '$clean_call'(Active, Cleanup)), ( yap_hacks:trail_suspension_marker(Catcher), yap_hacks:enable_interrupts, - yap_hacks:current_choice_point(CP0), + '$current_choice_point'(CP0), '$execute'(Goal), % ensure environment for delayed variables in Goal '$true', - yap_hacks:current_choice_point(CPF), + '$current_choice_point'(CPF), ( CP0 =:= CPF -> diff --git a/pl/debug.yap b/pl/debug.yap index 3dfb6ebf4..f7b707631 100644 --- a/pl/debug.yap +++ b/pl/debug.yap @@ -287,10 +287,13 @@ debugging :- '$execute_nonstop'(G,Mod). '$spy'([Mod|G]) :- CP is '$last_choice_pt', + '$enter_system_mode', '$do_spy'(G, Mod, CP, spy). % last argument to do_spy says that we are at the end of a context. It % is required to know whether we are controlled by the debugger. +%'$do_spy'(V, M, CP, Flag) :- +% writeln('$do_spy'(V, M, CP, Flag)), fail. '$do_spy'(V, M, CP, Flag) :- var(V), !, '$do_spy'(call(V), M, CP, Flag). @@ -303,20 +306,20 @@ debugging :- '$do_spy'(M:G, _, CP, CalledFromDebugger) :- !, '$do_spy'(G, M, CP, CalledFromDebugger). '$do_spy'((A,B), M, CP, CalledFromDebugger) :- !, - '$do_spy'(A, M, CP, yes), + '$do_spy'(A, M, CP, debugger), '$do_spy'(B, M, CP, CalledFromDebugger). '$do_spy'((T->A;B), M, CP, CalledFromDebugger) :- !, - ( '$do_spy'(T, M, CP, yes) -> '$do_spy'(A, M, CP, yes) + ( '$do_spy'(T, M, CP, debugger) -> '$do_spy'(A, M, CP, CalledFromDebugger) ; '$do_spy'(B, M, CP, CalledFromDebugger) ). '$do_spy'((T->A|B), M, CP, CalledFromDebugger) :- !, - ( '$do_spy'(T, M, CP, debugger) -> '$do_spy'(A, M, CP, yes) + ( '$do_spy'(T, M, CP, debugger) -> '$do_spy'(A, M, CP, CalledFromDebugger) ; '$do_spy'(B, M, CP, CalledFromDebugger) ). -'$do_spy'((T->A), M, CP, _) :- !, - ( '$do_spy'(T, M, CP, yes) -> '$do_spy'(A, M, CP, yes) ). +'$do_spy'((T->A), M, CP, CalledFromDebugger) :- !, + ( '$do_spy'(T, M, CP, debugger) -> '$do_spy'(A, M, CP, CalledFromDebugger) ). '$do_spy'((A;B), M, CP, CalledFromDebugger) :- !, ( '$do_spy'(A, M, CP, CalledFromDebugger) @@ -344,7 +347,7 @@ debugging :- % we are skipping, so we can just call the goal, % while leaving the minimal structure in place. '$loop_spy'(GoalNumber, G, Module, CalledFromDebugger) :- - yap_hacks:current_choice_point(CP), + '$current_choice_point'(CP), '$system_catch'('$loop_spy2'(GoalNumber, G, Module, CalledFromDebugger, CP), Module, error(Event,Context), '$loop_spy_event'(error(Event,Context), GoalNumber, G, Module, CalledFromDebugger)). @@ -404,6 +407,8 @@ debugging :- /* call port */ '$enter_goal'(GoalNumber, G, Module), '$spycall'(G, Module, CalledFromDebugger, Retry), + % make sure we are in system mode when running the debugger. + '$enter_system_mode', ( '$debugger_deterministic_goal'(G) -> Det=true @@ -428,6 +433,8 @@ debugging :- ), '$continue_debugging'(exit, CalledFromDebugger) ; + % make sure we are in system mode when running the debugger. + '$enter_system_mode', /* backtracking from exit */ /* we get here when we want to redo a goal */ /* redo port */ @@ -443,6 +450,7 @@ debugging :- fail /* to backtrack to spycalls */ ) ; + '$enter_system_mode', '$show_trace'(fail,G,Module,GoalNumber,_), /* inform at fail port */ '$continue_debugging'(fail, CalledFromDebugger), /* fail port */ @@ -510,7 +518,7 @@ debugging :- CP is '$last_choice_pt', '$clause'(G, M, Cl, _), % I may backtrack to here from far away - ( '$do_spy'(Cl, M, CP, CalledFromDebugger) ; InRedo = true ). + ( '$do_spy'(Cl, M, CP, debugger) ; InRedo = true ). '$spycall'(G, M, CalledFromDebugger, InRedo) :- '$undefined'(G, M), !, '$find_goal_definition'(M, G, NM, Goal), @@ -528,11 +536,11 @@ debugging :- '$meta_creep'(G,M) :- ( - yap_hacks:current_choice_point(CP1), + '$$save_by'(CP1), '$exit_system_mode', '$meta_creep', '$execute_nonstop'(G,M), - yap_hacks:current_choice_point(CP2), + '$$save_by'(CP2), (CP1 == CP2 -> ! ; ( true ; '$exit_system_mode', '$meta_creep', fail ) ), '$enter_system_mode' ; @@ -544,6 +552,8 @@ debugging :- '$flags'(G,M,F,F), F /\ 0x00000040 =\= 0. +%'$trace'(P,G,Module,L,Deterministic) :- +% '$nb_getval'('$system_mode',On,fail), writeln(On), fail. '$trace'(P,G,Module,L,Deterministic) :- % at this point we are done with leap or skip nb_setval('$debug_run',off), @@ -730,24 +740,34 @@ debugging :- % first argument is exit, zip or fail % second is creep, meta_creep, spy, or debugger -'$continue_debugging'(exit, debugger) :- !. -'$continue_debugging'(zip, debugger) :- !. -'$continue_debugging'(fail, debugger) :- !. +%'$continue_debugging'(Exit, Debugger) :- +% writeln('$continue_debugging'(Exit, Debugger)), fail. +% that's what follows +'$continue_debugging'(_, debugger) :- !. % do not need to debug! +% go back to original sequence. +'$continue_debugging'(zip, _) :- !, '$exit_system_mode'. +'$continue_debugging'(fail, _) :- !. '$continue_debugging'(exit, meta_creep) :- !, + '$exit_system_mode', '$meta_creep'. -'$continue_debugging'(_, no) :- +'$continue_debugging'(_, creep) :- !, + '$exit_system_mode', '$creep'. +'$continue_debugging'(_, spy) :- !, + '$exit_system_mode', + '$creep'. +'$continue_debugging'(_, _) :- '$exit_system_mode'. % if we are in the interpreter, don't need to care about forcing a trace, do we? -'$continue_debugging_goal'(_, yes,G) :- !, +'$continue_debugging_goal'(yes,G) :- !, '$execute_dgoal'(G). % do not need to debug! -'$continue_debugging_goal'(_, _,G) :- +'$continue_debugging_goal'(_,G) :- 'nb_getval'('$debug_run',Zip), (Zip == nodebug ; number(Zip) ; Zip == spy ), !, '$execute_dgoal'(G). -'$continue_debugging_goal'(_, _,G) :- +'$continue_debugging_goal'(_,G) :- '$execute_creep_dgoal'(G). '$execute_dgoal'('$execute_nonstop'(G,M)) :- diff --git a/pl/hacks.yap b/pl/hacks.yap index 4ae8aef43..015d28379 100644 --- a/pl/hacks.yap +++ b/pl/hacks.yap @@ -47,7 +47,7 @@ code_location(Info,Where,Location) :- integer(Where) , !, '$pred_for_code'(Where,Name,Arity,Mod,Clause), construct_code(Clause,Name,Arity,Mod,Info,Location). -code_location(Info,_,Info). +code_location(Ixnfo,_,Info). construct_code(-1,Name,Arity,Mod,Where,Location) :- !, number_codes(Arity,ArityCode), diff --git a/pl/signals.yap b/pl/signals.yap index ae553a988..bd629c42c 100644 --- a/pl/signals.yap +++ b/pl/signals.yap @@ -88,6 +88,9 @@ '$current_module'(M0), '$execute0'((Goal,M:G),M0). +% we may be creeping outside and coming back to system mode. +'$start_creep'([_|'$enter_system_mode'], _) :- !, + '$enter_system_mode'. '$start_creep'([Mod|G], _) :- '$in_system_mode', !, '$execute0'(G, Mod).