gated call

C/exec.c

@@ -765,22 +765,13 @@ static void complete_inner_computation(choiceptr old_B) {
   ENV = myB->cp_env;
 }
 
-static Int Yap_ignore(Term t USES_REGS) {
+static Int Yap_ignore(Term t, bool fail USES_REGS) {
   yamop *oP = P, *oCP = CP;
   Int oENV = LCL0 - ENV;
   Int oYENV = LCL0 - YENV;
   Int oB = LCL0 - (CELL *)B;
   bool rc = Yap_RunTopGoal(t, false);
 
-  if (Yap_RaiseException()) {
-    P = oP;
-    CP = oCP;
-    ENV = LCL0 - oENV;
-    YENV = LCL0 - oYENV;
-    B = (choiceptr)(LCL0 - oB);
-    return false;
-  }
-
   if (!rc) {
     complete_inner_computation((choiceptr)(LCL0 - oB));
     // We'll pass it through
@@ -816,15 +807,18 @@ static bool watch_cut(Term ext USES_REGS) {
   //
   Term task = TailOfTerm(ext);
   Term cleanup = ArgOfTerm(3, task);
-  bool complete = !IsVarTerm(Deref(ArgOfTerm(4, task)));
+  Term e = 0;
+  bool complete = IsNonVarTerm(Deref(ArgOfTerm(4, task)));
   bool active = ArgOfTerm(5, task) == TermTrue;
-  
+  bool ex_mode = false;
+
   if (complete) {
     return true;
   }
   CELL *port_pt = deref_ptr(RepAppl(task) + 2);
-  if (Yap_HasException()) {
+  CELL *completion_pt = deref_ptr(RepAppl(task) + 4);
-    Term e = Yap_GetException();
+  if ((ex_mode = Yap_HasException())) {
+    e = Yap_GetException();
     Term t;
     if (active) {
       t = Yap_MkApplTerm(FunctorException, 1, &e);
@@ -832,12 +826,17 @@ static bool watch_cut(Term ext USES_REGS) {
       t = Yap_MkApplTerm(FunctorExternalException, 1, &e);
     }
     port_pt[0] = t;
+    completion_pt[0] = TermException;
   } else {
-    port_pt[0] = TermCut;
+    completion_pt[0] = port_pt[0] = TermCut;
   }
-  Yap_ignore(cleanup);
+  Yap_ignore(cleanup, false);
   CELL *complete_pt = deref_ptr(RepAppl(task) + 4);
   complete_pt[0] = TermTrue;
+  if (ex_mode) {
+    Yap_PutException(e);
+    return true;
+  }
   if (Yap_RaiseException())
     return false;
   return true;
@@ -854,31 +853,34 @@ static bool watch_cut(Term ext USES_REGS) {
 static bool watch_retry(Term d0 USES_REGS) {
   // called after backtracking..
   //
-  CELL d = ((CELL *)Yap_blob_info(HeadOfTerm(d0)))[0];
-
-  choiceptr B0 = (choiceptr)(LCL0 - d);
   Term task = TailOfTerm(d0);
   bool box = ArgOfTerm(1, task) == TermTrue;
   Term cleanup = ArgOfTerm(3, task);
   bool complete = !IsVarTerm(ArgOfTerm(4, task));
   bool active = ArgOfTerm(5, task) == TermTrue;
+  choiceptr B0 = (choiceptr)(LCL0 - IntegerOfTerm(ArgOfTerm(6, task)));
 
-  if ( complete)
+  if (complete)
     return true;
-  CELL *port_pt= deref_ptr(RepAppl(Deref(task))+ 2);
+  CELL *port_pt = deref_ptr(RepAppl(Deref(task)) + 2);
-  CELL *complete_pt= deref_ptr(RepAppl(Deref(task))+ 4);
+  CELL *complete_pt = deref_ptr(RepAppl(Deref(task)) + 4);
-  Term t;
+  Term t, e = 0;
+  bool ex_mode = false;
 
   while (B->cp_ap->opc == FAIL_OPCODE)
     B = B->cp_b;
-  if (Yap_HasException()) {
+
-    Term e = Yap_GetException();
+  // just do the frrpest
+  if (B >= B0 && !ex_mode && !active)
+    return true;
+  if ((ex_mode = Yap_HasException())) {
+    e = Yap_GetException();
     if (active) {
       t = Yap_MkApplTerm(FunctorException, 1, &e);
     } else {
       t = Yap_MkApplTerm(FunctorExternalException, 1, &e);
     }
-    complete_pt[0] = t;
+    complete_pt[0] = TermException;
   } else if (B >= B0) {
     t = TermFail;
     complete_pt[0] = t;
@@ -889,8 +891,12 @@ static bool watch_retry(Term d0 USES_REGS) {
     return true;
   }
   port_pt[0] = t;
-  Yap_ignore(cleanup);
+  Yap_ignore(cleanup, true);
-  if ( Yap_RaiseException())
+  if (ex_mode) {
+    Yap_PutException(e);
+    return true;
+  }
+  if (Yap_RaiseException())
     return false;
   return true;
 }
@@ -947,27 +953,30 @@ static Int cleanup_on_exit(USES_REGS1) {
   bool box = ArgOfTerm(1, task) == TermTrue;
   Term cleanup = ArgOfTerm(3, task);
   Term catcher = ArgOfTerm(2, task);
-  Term complete = !IsVarTerm( ArgOfTerm(4, task));
+  Term complete = IsNonVarTerm(ArgOfTerm(4, task));
 
   while (B->cp_ap->opc == FAIL_OPCODE)
     B = B->cp_b;
-  if (complete )
+  if (complete) {
     return true;
-  CELL *catcher_p = deref_ptr(RepAppl(Deref(task))+2);
+  }
-  if (B < B0)
+  CELL *catcher_pt = deref_ptr(RepAppl(Deref(task)) + 2);
-  {
+  CELL *complete_pt = deref_ptr(RepAppl(Deref(task)) + 4);
+  if (B < B0) {
     // non-deterministic
     set_watch(LCL0 - (CELL *)B, task);
-    catcher_p[0] =  TermAnswer;
     if (!box) {
       return true;
     }
+    catcher_pt[0] = TermAnswer;
   } else {
-    catcher_p[0] =   TermExit;
+    catcher_pt[0] = TermExit;
-    CELL *complete_p = deref_ptr(RepAppl(Deref(task))+4);
+    complete_pt[0] = TermExit;
-    complete_p[0] = TermExit;
+  }
+  Yap_ignore(cleanup, false);
+  if (Yap_RaiseException()) {
+    return false;
   }
-  Yap_ignore(cleanup);
   return true;
 }
 

pl/boot.yap

@@ -1091,23 +1091,19 @@ incore(G) :- '$execute'(G).
 	'$call'(G, CP, G, M).
 
 '$user_call'(G, M) :-
-	(
+    '$gated_call'(
-	 '$$save_by'(CP),
+       ('$$save_by'(CP),
-	 '$enable_debugging',
+       '$enable_debugging'),
-	 '$call'(G, CP, M:G, M),
+  	 '$call'(G, CP, M:G, M),
-	 '$$save_by'(CP2),
+       Port,
-	 (
+  	   '$disable_debugging_on_port'(Port)
-	  CP == CP2
+       ).
-	 ->
+
-	  !
+'$disable_debugging_on_port'(retry) :-
-	 ;
+    !,
-	  ( true ; '$enable_debugging', fail )
+    '$enable_debugging'.
-	 ),
+'$disable_debugging_on_port'(_Port) :-
-	 '$disable_debugging'
+	 '$disable_debugging'.
-	;
-	 '$disable_debugging',
-	 fail
-	).
 
 
 
@@ -1433,6 +1429,19 @@ Command = (H --> B) ->
 '$head_and_body'((H:-B),H,B) :- !.
 '$head_and_body'(H,H,true).
 
+
+gated_call(Setup, Goal, Catcher, Cleanup) :-
+'$setup_call_catcher_cleanup'(Setup),
+'$gated_call'( true , Goal, Catcher, Cleanup)  .
+
+'$gated_call'( All , Goal, Catcher, Cleanup) :-
+	Task0 = cleanup( All, Catcher, Cleanup, Tag, true, CP0),
+	TaskF = cleanup( All, Catcher, Cleanup, Tag, false, CP0),
+	'$tag_cleanup'(CP0, Task0),
+	call( Goal ),
+	'$cleanup_on_exit'(CP0, TaskF).
+
+
 %
 % split head and body, generate an error if body is unbound.
 %

pl/control.yap

@@ -262,12 +262,10 @@ This is similar to call_cleanup/1 but with an additional
 
 */
 call_cleanup(Goal, Cleanup) :-
-	call_cleanup(Goal, _Catcher, Cleanup).
+'$gated_call'( false , Goal,_Catcher, Cleanup)  .
 
 call_cleanup(Goal, Catcher, Cleanup) :-
-    '$tag_cleanup'(CP0, cleanup( false, Catcher, Cleanup, Tag, 0, Done)),
+'$gated_call'( false , Goal, Catcher, Cleanup)  .
-    call( Goal ),
-    '$cleanup_on_exit'(CP0, cleanup( false, Catcher, Cleanup, Tag, 1, Done	)).
 
 /** @pred setup_call_cleanup(: _Setup_,: _Goal_, : _CleanUpGoal_)
 
@@ -291,15 +289,6 @@ setup_call_catcher_cleanup(Setup, Goal, Catcher, Cleanup) :-
     '$setup_call_catcher_cleanup'(Setup),
 	call_cleanup(Goal, Catcher, Cleanup).
 
-gated_call(Setup, Goal, Catcher, Cleanup) :-
-	Task0 = cleanup( true, Catcher, Cleanup, Tag, true, Done),
-	TaskF = cleanup( true, Catcher, Cleanup, Tag, false, Done),
-	'$setup_call_catcher_cleanup'(Setup),
-	'$tag_cleanup'(CP0, Task0),
-	call( Goal ),
-	'$cleanup_on_exit'(CP0, TaskF).
-
-
 
 /** @pred  call_with_args(+ _Name_,...,? _Ai_,...)
 

pl/debug.yap

@@ -406,45 +406,83 @@ be lost.
 '$do_spy'(ignore(G), M, CP, CalledFromDebugger) :- !,
 	ignore( '$do_spy'(G, M, CP, CalledFromDebugger) ).
 '$do_spy'(G, Module, _, CalledFromDebugger) :-
+    '$loop_spy'(G, Module, CalledFromDebugger).
+
+% we are skipping, so we can just call the goal,
+% while leaving the minimal structure in place.
+'$loop_spy'(G, Module, CalledFromDebugger) :-
+    catch(
+    gated_call(
+	'$enter_spy'(GoalNumber, G, Module, CalledFromDebugger, H),
+	'$loop_spy2'(GoalNumber, G, Module, CalledFromDebugger),
+		Port,
+        '$spy_port'(Port, GoalNumber, G, Module, CalledFromDebugger, H)),
+        E,
+        '$redo_spy'( E, G, Module, CalledFromDebugger, GoalNumber, H)
+        ).
+
+%%% fail just fails.
+'$redo_spy'(abort, _G, _Module, _CalledFromDebugger, _GoalNumber, _H) :-
+	z
+    abort.
+'$redo_spy'('$forward'('$wrapper'(E),G0), _G, _Module, _CalledFromDebugger, _                           z'$redo_spy'('$forward'('$fail_spy',G0), __G, __Module, __CalledFromDebugger, GoalNumber, _H) :-
+    GoalNumber =< G0,
+    !,
+    fail.
+'$redo_spy'('$forward'('$retry_spy',G0), G, Module, CalledFromDebugger, GoalNumber, H) :-
+    GoalNumber =< G0,
+    !,
+    catch(
+    gated_call(
+	'$enter_spy'(GoalNumber, G, Module, CalledFromDebugger, H),
+	'$loop_spy2'(GoalNumber, G, Module, CalledFromDebugger),
+		Port,
+        '$spy_port'(Port, GoalNumber, G, Module, CalledFromDebugger, H)),
+        E,
+        '$redo_spy'( G, Module, CalledFromDebugger, H)
+        ).
+'$redo_spy'('$forward'(C,G0), G, Module, CalledFromDebugger, GoalNumber, H) :-
+            throw(C,G0).
+
+'$enter_spy'(GoalNumber, G, Module, CalledFromDebugger, H) :-
         '__NB_getval__'('$spy_gn',L,fail),		/* get goal no.			*/
 	L1 is L+1,			/* bump it			*/
 	'__NB_setval__'('$spy_gn',L1),	/* and save it globaly		*/
         '__NB_getval__'('$spy_glist',History,true),	/* get goal list		*/
-	'__B_setval__'('$spy_glist',[info(L,Module,G,_Retry,_Det,_HasFoundAnswers)|History]),
+    H  = [info(L,Module,G,_Retry,_Det,_HasFoundAnswers)|History],
+	'__B_setval__'('$spy_glist',H).
 	/* and update it		*/
-	'$loop_spy'(L, G, Module, CalledFromDebugger).
 
-% we are skipping, so we can just call the goal,
+'$spy_port'(Port, GoalNumber, G, Module, CalledFromDebugger, Info) :-
-% while leaving the minimal structure in place.
+    '$stop_creeping'(_) ,
-'$loop_spy'(GoalNumber, G, Module, CalledFromDebugger) :-
+    '$spy_port_'(Port, GoalNumber, G, Module, CalledFromDebugger, Info).
-	'$current_choice_point'(CP),
+
-	'$system_catch'('$loop_spy2'(GoalNumber, G, Module, CalledFromDebugger, CP),
+'$spy_port_'(exit, GoalNumber, G, Module, CalledFromDebugger, Info) :-
-		    Module, Error,
+    nb_setarg(6, Info, true),
-		    '$TraceError'(Error, GoalNumber, G, Module, CalledFromDebugger)).
+    '$show_trace'(exit,G,Module,GoalNumber,true),
+    '$continue_debugging'(exit, CalledFromDebugger).
+'$spy_port_'(answer, GoalNumber, G, Module, CalledFromDebugger, Info) :-
+    '$show_trace'(exit,G,Module,GoalNumber,false),
+    '$continue_debugging'(exit, CalledFromDebugger).
+'$spy_port_'(redo, GoalNumber, G, Module, CalledFromDebugger, Info) :-
+    '$show_trace'(redo,G,Module,GoalNumber,_), /* inform user_error		*/
+    '$continue_debugging'(fail, CalledFromDebugger).
+'$spy_port_'(fail, GoalNumber, G, Module, CalledFromDebugger, Info) :-
+    '$show_trace'(fail,G,Module,GoalNumber,_), /* inform user_error		*/
+    '$continue_debugging'(fail, CalledFromDebugger).
+'$spy_port_'(! ,G,Module,GoalNumber,_) :- /* inform user_error		*/
+    !.
+'$spy_port_'(exception(E), GoalNumber, G, Module, CalledFromDebugger, _Info) :-
+    '$TraceError'(E, GoalNumber, G, Module, CalledFromDebugger).
+'$spy_port_'(external_exception(E), GoalNumber, G, Module, CalledFromDebugger, _Info) :-
+    '$TraceError'(E, GoalNumber, G, Module, CalledFromDebugger).
+
 
-/**
-  * @pred '$TraceError'(+Exception, +CurrentGoalId, +CurrentGoal, +Module, +Status)
-  *
-  * forward exception until leaving the debugger or
-  * finding a matching frame:
-  *
-*/
 %%% - retry: forward throw while the call is newer than goal
-'$TraceError'( abort, _, _, _, _) :-
+'$TraceError'( abort, _, _, _, _).
-    '$stop_creeping'(_),
+'$TraceError'('$forward'('$retry_spy'(G0)), _, _, _, _).
-    abort.
-'$TraceError'('$forward'('$retry_spy'(G0)), GoalNumber, G, Module, CalledFromDebugger) :-
-	( G0 >= GoalNumber
-  ->
-	'$loop_spy'(GoalNumber, G, Module, CalledFromDebugger)
-;
-	throw('$forward'('$retry_spy'(G0)))
-  ).
 %%% - backtrack long distance
-'$TraceError'('$forward'('$fail_spy'(G0)), GoalNumber, G, Module, CalledFromDebugger) :-
+'$TraceError'('$forward'('$fail_spy'(G0)), _, _, _, _) :- !,
-	G0 >= GoalNumber, !,
-	'$loop_fail'(GoalNumber, G, Module, CalledFromDebugger).
-'$TraceError'('$forward'('$fail_spy'(GoalNumber)), _, _, _, _) :- !,
 	throw(error('$fail_spy'(GoalNumber))).
 %%%
 %%% - forward through the debugger
@@ -473,75 +511,6 @@ be lost.
 	'$continue_debugging'(fail, CalledFromDebugger),
 	fail.
 
-/**
- * core routine for the debugger
- *
- * @param _ GoalNumbera id
- * @param _ S9c
- * @param _
- * @param Retry
- * @param Det
- * @param false
- *
- * @return
-*/
-'$loop_spy2'(GoalNumber, G, Module, CalledFromDebugger, CP) :-
-/* the following choice point is where the predicate is  called */
-	   '__NB_getval__'('$spy_glist',[Info|_],true),	/* get goal list		*/
-	   Info = info(_,_,_,Retry,Det,false),
-	   (
-	    /* call port */
-	    '$enter_goal'(GoalNumber, G, Module),
-	    '$spycall'(G, Module, CalledFromDebugger, Retry),
-	    '$stop_creeping'(_) ,
-	    % make sure we are in system mode when running the debugger.
-	    (
-	      '$debugger_deterministic_goal'(G) ->
-	      Det=true
-	    ;
-	      Det=false
-	    ),
-	    /* go execute the continuation	*/
-	    (
-	       /* exit port */
-         Retry = false,
-         /* found an answer, so it can redo */
-         nb_setarg(6, Info, true),
-         '$show_trace'(exit,G,Module,GoalNumber,Det),	/* output message at exit	*/
-        /* exit port */
-        /* get rid of deterministic computations */
-        (
-         Det == true
-		->
-         '$$cut_by'(CP)
-		;
-         true
-        ),
-         '$continue_debugging'(exit, CalledFromDebugger)
-	     ;
-	     /* make sure we are in system mode when running the debugger. */
-         /* backtracking from exit				*/
-         /* we get here when we want to redo a goal		*/
-         /* redo port */
-         (
-          arg(6, Info, true)
-         ->
-          '$stop_creeping'(_) ,
-          '$show_trace'(redo,G,Module,GoalNumber,_), /* inform user_error		*/
-         nb_setarg(6, Info, false)
-         ;
-          true
-         ),
-	     '$continue_debugging'(fail, CalledFromDebugger),
-	     fail			/* to backtrack to spycall	*/
-        )
-	  ;
-        '$stop_creeping'(_) ,
-	    '$show_trace'(fail,G,Module,GoalNumber,_), /* inform at fail port		*/
-       '$continue_debugging'(fail, CalledFromDebugger),
-	    /* fail port */
-	    fail
-       ).
 
 '$enter_goal'(GoalNumber, G, Module) :-
     '$zip'(GoalNumber, G, Module), !.