debugger progress

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:

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_save_by	(_std_base+11)
-#define _p_predc	(_std_base+12)
+#define _p_succ		(_std_base+12)
-#define _p_plus		(_std_base+13)
+#define _p_predc	(_std_base+13)
-#define _p_minus	(_std_base+14)
+#define _p_plus		(_std_base+14)
-#define _p_times	(_std_base+15)
+#define _p_minus	(_std_base+15)
-#define _p_div		(_std_base+16)
+#define _p_times	(_std_base+16)
-#define _p_dif		(_std_base+17)
+#define _p_div		(_std_base+17)
-#define _p_eq		(_std_base+18)
+#define _p_dif		(_std_base+18)
-#define _p_arg		(_std_base+19)
+#define _p_eq		(_std_base+19)
-#define _p_functor	(_std_base+20)
+#define _p_arg		(_std_base+20)
+#define _p_functor	(_std_base+21)
 
 

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);
 }

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;

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);

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;

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);

H/amidefs.h

@@ -163,6 +163,7 @@ typedef enum {
   _number,
   _var,
   _cut_by,
+  _save_by,
   _db_ref,
   _primitive,
   _dif,

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'
 	;

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
 	 ->

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->A), 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'((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'(Exit, Debugger) :-
-'$continue_debugging'(zip, debugger) :- !.
+%	writeln('$continue_debugging'(Exit, Debugger)), fail.
-'$continue_debugging'(fail, debugger) :- !.
+% 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)) :-

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),

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).