debugger fixes

make sure we always go back to current module, even during initizlization.


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1062 b08c6af1-5177-4d33-ba66-4b1c6b8b522a

C/absmi.c

@@ -10,8 +10,11 @@
 *									 *
 * File:		absmi.c							 *
 * comments:	Portable abstract machine interpreter                    *
-* Last rev:     $Date: 2004-04-29 03:45:49 $,$Author: vsc $						 *
+* Last rev:     $Date: 2004-05-13 20:54:57 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.132  2004/04/29 03:45:49  vsc
+* fix garbage collection in execute_tail
+*
 * Revision 1.131  2004/04/22 20:07:02  vsc
 * more fixes for USE_SYSTEM_MEMORY
 *
@@ -146,7 +149,12 @@ push_live_regs(yamop *pco)
 #include <stdio.h>
 void prof_alrm(int signo)
 {
+#ifdef i386
   fprintf(FProf,"%p\n", PREG);
+#else
+  /* vsc: not really supported for shadow regs */
+  fprintf(FProf,"%p\n", P);
+#endif
   return;
 }
 
@@ -1305,6 +1313,7 @@ Yap_absmi(int inp)
 	LogUpdClause *cl = ClauseCodeToLogUpdClause(PREG);
 	Term t;
 
+	ASP = YREG;
 	saveregs();
 	while ((t = Yap_FetchTermFromDB(cl->ClSource)) == 0L) {
 	  if (!Yap_gc(3, ENV, CP)) {
@@ -1409,12 +1418,10 @@ Yap_absmi(int inp)
 
       /* spy_or_trymark                   */
       BOp(spy_or_trymark, ld);
-      if (FlipFlop ^= 1) {
+      READ_LOCK(((PredEntry *)(PREG->u.ld.p))->PRWLock);
-	READ_LOCK(((PredEntry *)(PREG->u.ld.p))->PRWLock);
+      PREG = (yamop *)(&(((PredEntry *)(PREG->u.ld.p))->OpcodeOfPred));
-	PREG = (yamop *)(&(((PredEntry *)(PREG->u.ld.p))->OpcodeOfPred));
+      READ_UNLOCK(((PredEntry *)(PREG->u.ld.p))->PRWLock);
-	READ_UNLOCK(((PredEntry *)(PREG->u.ld.p))->PRWLock);
+      goto dospy;
-	goto dospy;
-      }
       ENDBOp();
 
       /* try_and_mark   Label,NArgs       */
@@ -6609,17 +6616,6 @@ Yap_absmi(int inp)
       ENDBOp();
 
       BOp(spy_pred, e);
-      {
-	PredEntry *pe = PredFromDefCode(PREG);
-	if (FlipFlop == 0) {
-	  READ_LOCK(pe->PRWLock);
-	  PREG = pe->cs.p_code.TrueCodeOfPred;
-	  READ_UNLOCK(pe->PRWLock);
-	  JMPNext();
-	}
-	ENDBOp();
-      }
-
     dospy:
       {
 	PredEntry *pe = PredFromDefCode(PREG);

C/attvar.c

@@ -644,6 +644,7 @@ p_attvar_bound(void)
 
 void Yap_InitAttVarPreds(void)
 {
+  Term OldCurrentModule = CurrentModule;
   attas[attvars_ext].bind_op = WakeAttVar;
   attas[attvars_ext].copy_term_op = CopyAttVar;
   attas[attvars_ext].to_term_op = AttVarToTerm;
@@ -659,7 +660,7 @@ void Yap_InitAttVarPreds(void)
   Yap_InitCPred("n_of_atts", 1, p_n_atts, SafePredFlag);
   Yap_InitCPred("bind_attvar", 1, p_bind_attvar, SafePredFlag);
   Yap_InitCPred("all_attvars", 1, p_all_attvars, SafePredFlag);
-  CurrentModule = PROLOG_MODULE;
+  CurrentModule = OldCurrentModule;
   Yap_InitCPred("$is_att_variable", 1, p_is_attvar, SafePredFlag|TestPredFlag);
   Yap_InitCPred("$att_bound", 1, p_attvar_bound, SafePredFlag|TestPredFlag);
 }

C/c_interface.c

@@ -934,7 +934,7 @@ YAP_Init(YAP_init_args *yap_init)
     Yap_InitYaamRegs();
 #endif /* SBA */
     /* slaves, waiting for work */
-    CurrentModule = 1;
+    CurrentModule = USER_MODULE;
     P = GETWORK_FIRST_TIME;
     Yap_exec_absmi(FALSE);
     abort_optyap("abstract machine unexpected exit");

C/cdmgr.c

@@ -11,8 +11,11 @@
 * File:		cdmgr.c							 *
 * comments:	Code manager						 *
 *									 *
-* Last rev:     $Date: 2004-04-27 16:21:16 $,$Author: vsc $						 *
+* Last rev:     $Date: 2004-05-13 20:54:57 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.120  2004/04/27 16:21:16  vsc
+* stupid bug
+*
 * Revision 1.119  2004/04/27 15:03:43  vsc
 * more fixes for expand_clauses
 *
@@ -1095,8 +1098,9 @@ not_was_reconsulted(PredEntry *p, Term t, int mode)
   if (fp != ConsultBase)
     return (FALSE);
   if (mode) {
-    if (ConsultSp == ConsultLow+1)
+    if (ConsultSp == ConsultLow+1) {
       expand_consult();
+    }
     --ConsultSp;
     ConsultSp->p = p0;
     if (ConsultBase[1].mode && 
@@ -1144,7 +1148,6 @@ addcl_permission_error(AtomEntry *ap, Int Arity, int in_use)
   }
 }
 
-
 static Term
 addclause(Term t, yamop *cp, int mode, int mod)
 /*

C/corout.c

@@ -388,11 +388,11 @@ TermToSuspendedVar(Term gs, Term var)
   vs = (sus_tag *)Yap_ReadTimedVar(DelayedVars);
   if (H0 - (CELL *)vs < 1024)
     return(FALSE);
+  Yap_UpdateTimedVar(DelayedVars, (CELL)(vs+1));
   RESET_VARIABLE(&(vs->ActiveSus));
   vs->sus_id = susp_ext;
   vs->SG = terms_to_suspended_goals(gs);
   Yap_unify(var,(CELL)&(vs->ActiveSus));
-  Yap_UpdateTimedVar(DelayedVars, (CELL)(vs+1));
   return(TRUE);
 }
 

C/dbase.c

@@ -652,7 +652,6 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
   int vars_found = 0;
 #ifdef COROUTINING
   Term ConstraintsTerm = TermNil;
-  CELL *ConstraintsBottom = NULL;
   CELL *origH = H;
 #endif
   CELL *CodeMaxBase = CodeMax;
@@ -899,19 +898,14 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
 	  int sz = to_visit-to_visit_base;
 
 	  H = (CELL *)to_visit;
-	  /* store the constraint away for now */
+	  /* store the constraint away for: we need a back pointer to
+	     the variable, the constraint in some cannonical form, what type
+	     of constraint, and a list pointer */
 	  t[0] = (CELL)ptd0;
 	  t[1] = attas[ExtFromCell(ptd0)].to_term_op(ptd0);
 	  t[2] = MkIntegerTerm(ExtFromCell(ptd0));
-	  t[3] = TermNil;
+	  t[3] = ConstraintsTerm;
-	  if (ConstraintsBottom == NULL) {
+	  ConstraintsTerm = Yap_MkApplTerm(FunctorClist, 4, t);
-	    ConstraintsTerm = Yap_MkApplTerm(FunctorClist, 4, t);
-	    ConstraintsBottom = RepAppl(ConstraintsTerm)+4;
-	  } else {
-	    Term new = Yap_MkApplTerm(FunctorClist, 4, t);
-	    *ConstraintsBottom = new;
-	    ConstraintsBottom = RepAppl(new)+4;
-	  }
 	  if (H+sz >= ASP) {
 	    goto error2;
 	  }
@@ -961,14 +955,18 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
 
 #ifdef COROUTINING
   /* we still may have constraints to do */
-  if (ConstraintsTerm != TermNil) {
+  if (ConstraintsTerm != TermNil &&
-    *attachmentsp = (CELL)CodeMax;
+      !(RepAppl(ConstraintsTerm) >= tbase &&
+	RepAppl(ConstraintsTerm) < StoPoint)
+      ) {
+    *attachmentsp = (CELL)(CodeMax+1);
     pt0 = RepAppl(ConstraintsTerm)+1;
     pt0_end = RepAppl(ConstraintsTerm)+4;
-    ConstraintsTerm = TermNil; 
     StoPoint = CodeMax;
+    *StoPoint++ = RepAppl(ConstraintsTerm)[0];
+    ConstraintsTerm = AbsAppl(CodeMax);
     CheckDBOverflow();
-    CodeMax += 4;
+    CodeMax += 5;
     goto loop;
   }
 #endif
@@ -1431,7 +1429,7 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat, UInt extra_size, struc
 #ifdef COROUTINING
     /* attachment */ 
     if (IsVarTerm(Tm)) {
-      tt = sizeof(CELL);
+      tt = (CELL)(ppt0->Contents);
       ntp = MkDBTerm(VarOfTerm(Tm), VarOfTerm(Tm), ntp0, ntp0+1, ntp0-1,
 		     &attachments,
 		     &vars_found,
@@ -2432,7 +2430,11 @@ GetDBTerm(DBTerm *DBSP)
 {
   Term t = DBSP->Entry;
 
-  if (IsVarTerm(t)) {
+  if (IsVarTerm(t) 
+#if COROUTINING
+      && !DBSP->attachments
+#endif
+      ) {
     return MkVarTerm();
   } else if (IsAtomOrIntTerm(t)) {
     return t;

C/exec.c

@@ -21,13 +21,11 @@ static char     SccsId[] = "@(#)cdmgr.c	1.1 05/02/98";
 #include "absmi.h"
 #include "yapio.h"
 
-STATIC_PROTO(Int  CallPredicate, (PredEntry *, choiceptr));
+STATIC_PROTO(Int  CallPredicate, (PredEntry *, choiceptr, yamop *));
 STATIC_PROTO(Int  EnterCreepMode, (Term, Term));
-STATIC_PROTO(Int  CallClause, (PredEntry *, Int));
 STATIC_PROTO(Int  p_save_cp, (void));
 STATIC_PROTO(Int  p_execute, (void));
 STATIC_PROTO(Int  p_execute0, (void));
-STATIC_PROTO(Int  p_at_execute, (void));
 
 static Term
 cp_as_integer(choiceptr cp)
@@ -42,7 +40,7 @@ Yap_cp_as_integer(choiceptr cp)
 }
 
 static inline Int
-CallPredicate(PredEntry *pen, choiceptr cut_pt) {
+CallPredicate(PredEntry *pen, choiceptr cut_pt, yamop *code) {
 #ifdef LOW_LEVEL_TRACER
   if (Yap_do_low_level_trace)
     low_level_trace(enter_pred,pen,XREGS+1);
@@ -61,7 +59,7 @@ CallPredicate(PredEntry *pen, choiceptr cut_pt) {
     DEPTH -= MkIntConstant(2);
 #endif	/* DEPTH_LIMIT */
   CP = P;
-  P = pen->CodeOfPred;
+  P = code;
   /* vsc: increment reduction counter at meta-call entry */
   READ_UNLOCK(pen->PRWLock);
   if (pen->PredFlags & ProfiledPredFlag) {
@@ -80,7 +78,7 @@ CallMetaCall(Term mod) {
   ARG2 = cp_as_integer(B); /* p_save_cp */
   ARG3 = ARG1;
   ARG4 = mod;
-  return (CallPredicate(PredMetaCall, B));
+  return (CallPredicate(PredMetaCall, B, PredMetaCall->CodeOfPred));
 }
 
 Term
@@ -104,97 +102,6 @@ CallError(yap_error_number err, Term mod)
   }
 }
 
-static Int 
-CallClause(PredEntry *pen, Int position)
-{
-  CELL            flags;
-
-  if (position == -1) return(CallPredicate(pen, B));
-  READ_LOCK(pen->PRWLock);
-  flags = pen->PredFlags;
-  if ((flags & (CompiledPredFlag | DynamicPredFlag)) ||
-      pen->OpcodeOfPred == UNDEF_OPCODE) {
-    yamop *q;
-#ifdef DEPTH_LIMIT
-    if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is prolog */
-      if (pen->ModuleOfPred) {
-	if (DEPTH == MkIntTerm(0))
-	  return(FALSE);
-	else DEPTH = RESET_DEPTH();
-      }
-    } else if (pen->ModuleOfPred)
-      DEPTH -= MkIntConstant(2);
-#endif	/* DEPTH_LIMIT */
-#ifdef LOW_LEVEL_TRACER
-    if (Yap_do_low_level_trace)
-      low_level_trace(enter_pred,pen,XREGS+1);
-#endif	/* LOW_LEVEL_TRACE */
-    ENV = YENV;
-    YENV = ASP;
-    YENV[E_CB] = (CELL)(B->cp_b);
-    CP = P;
-    q = pen->cs.p_code.FirstClause;
-    if (pen->PredFlags & ProfiledPredFlag) {
-      LOCK(pen->StatisticsForPred.lock);
-      if (position == 1)
-	pen->StatisticsForPred.NOfEntries++;
-      else
-	pen->StatisticsForPred.NOfRetries++;
-      UNLOCK(pen->StatisticsForPred.lock);
-    }
-    if (flags & DynamicPredFlag) {
-      CLAUSECODE->arity = pen->ArityOfPE;
-      CLAUSECODE->func = pen->FunctorOfPred;
-      while (position > 1) {
-	while (ClauseCodeToDynamicClause(q)->ClFlags & ErasedMask)
-	  q = NextDynamicClause(q);
-	position--;
-	q = NextDynamicClause(q);
-      }
-      while (ClauseCodeToDynamicClause(q)->ClFlags & ErasedMask)
-	q = NextDynamicClause(q);
-#if defined(YAPOR) || defined(THREADS)
-      {
-	DynamicClause *cl = ClauseCodeToDynamicClause(q);
-	
-	LOCK(cl->ClLock);
-	TRAIL_CLREF(cl);
-	INC_CLREF_COUNT(cl);
-	UNLOCK(cl->ClLock);
-      }
-#else 
-      if (!(ClauseCodeToDynamicClause(q)->ClFlags & InUseMask)) {
-	CELL     *opp = &(ClauseCodeToDynamicClause(q)->ClFlags);
-	TRAIL_CLREF(ClauseCodeToDynamicClause(q));
-	*opp |= InUseMask;
-      }
-#endif
-      READ_UNLOCK(pen->PRWLock);
-      CLAUSECODE->clause = NEXTOP(q,ld);
-      P = CLAUSECODE->clause;
-      return((CELL)(&(CLAUSECODE->clause)));
-    } else if (flags & LogUpdatePredFlag) {
-      LogUpdClause *cl = ClauseCodeToLogUpdClause(q);
-      for (; position > 1; position--)
-	cl = cl->ClNext;
-      READ_UNLOCK(pen->PRWLock);
-      P = cl->ClCode;
-      return (Unsigned(pen));
-    } else {
-      /* static clause */
-      LogUpdClause *cl = ClauseCodeToLogUpdClause(q);
-      for (; position > 1; position--)
-	cl = cl->ClNext;
-      READ_UNLOCK(pen->PRWLock);
-      P = cl->ClCode;
-      return (Unsigned(pen));
-    }
-  } else {
-    Yap_Error(SYSTEM_ERROR,ARG1,"debugger tries to debug clause for builtin");    
-    return (FALSE);
-  }
-}
-
 static Int
 p_save_cp(void)
 {
@@ -217,10 +124,12 @@ p_save_cp(void)
 inline static Int
 do_execute(Term t, Term mod)
 {
-  if (ActiveSignals) {
+  /* first do predicate expansion, even before you process signals.
-    return(EnterCreepMode(t, mod));
+     This way you don't get to spy goal_expansion(). */
-  } else if (PRED_GOAL_EXPANSION_ON) {
+  if (PRED_GOAL_EXPANSION_ON) {
-    return(CallMetaCall(mod));
+    return CallMetaCall(mod);
+  } else if (ActiveSignals) {
+    return EnterCreepMode(t, mod);
   }
  restart_exec:
   if (IsVarTerm(t)) {
@@ -268,7 +177,7 @@ do_execute(Term t, Term mod)
       XREGS[i] = *pt++;
 #endif
     }
-    return (CallPredicate(pen, B));
+    return (CallPredicate(pen, B, pen->CodeOfPred));
   } else if (IsAtomTerm(t)) { 
     PredEntry            *pe;
     Atom a = AtomOfTerm(t);
@@ -279,7 +188,7 @@ do_execute(Term t, Term mod)
       return(FALSE);
     /* call may not define new system predicates!! */
     pe = RepPredProp(PredPropByAtom(a, mod));
-    return (CallPredicate(pe, B));
+    return (CallPredicate(pe, B, pe->CodeOfPred));
   } else if (IsIntTerm(t)) {
     return CallError(TYPE_ERROR_CALLABLE, mod);
   } else {
@@ -311,7 +220,7 @@ EnterCreepMode(Term t, Term mod) {
   CreepFlag = CalculateStackGap();
   UNLOCK(SignalLock);
   P_before_spy = P;
-  return (CallPredicate(PredCreep, B));
+  return (CallPredicate(PredCreep, B, PredCreep->CodeOfPred));
 }
 
 static Int
@@ -335,10 +244,13 @@ p_execute0(void)
   unsigned int    arity;
   Prop            pe;
 
+  if (ActiveSignals) {
+    return EnterCreepMode(t, mod);
+  }
  restart_exec:
   if (IsVarTerm(t)) {
     Yap_Error(INSTANTIATION_ERROR,ARG3,"call/1");    
-    return(FALSE);
+    return FALSE;
   } else if (IsAtomTerm(t)) {
     Atom a = AtomOfTerm(t);
     pe = PredPropByAtom(a, mod);
@@ -376,11 +288,71 @@ p_execute0(void)
     }
   } else {
     Yap_Error(TYPE_ERROR_CALLABLE,ARG3,"call/1");    
-    return(FALSE);
+    return FALSE;
   }
   /*	N = arity; */
   /* call may not define new system predicates!! */
-  return (CallPredicate(RepPredProp(pe), B));
+  return CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred);
+}
+
+static Int
+p_execute_nonstop(void)
+{				/* '$execute_nonstop'(Goal,Mod)	 */
+  Term            t = Deref(ARG1);
+  Term            mod = Deref(ARG2);
+  unsigned int    arity;
+  Prop            pe;
+
+ restart_exec:
+  if (IsVarTerm(t)) {
+    Yap_Error(INSTANTIATION_ERROR,ARG3,"call/1");    
+    return FALSE;
+  } else if (IsAtomTerm(t)) {
+    Atom a = AtomOfTerm(t);
+    pe = PredPropByAtom(a, mod);
+  } else if (IsApplTerm(t)) {
+    register Functor f = FunctorOfTerm(t);
+    register unsigned int    i;
+    register CELL *pt;
+
+    if (IsExtensionFunctor(f))
+      return(FALSE);
+    if (f == FunctorModule) {
+      Term tmod = ArgOfTerm(1,t);
+      if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) {
+	mod = tmod;
+	t = ArgOfTerm(2,t);
+	goto restart_exec;
+      }
+    }
+    pe = PredPropByFunc(f, mod);
+    arity = ArityOfFunctor(f);
+    /* I cannot use the standard macro here because
+       otherwise I would dereference the argument and
+       might skip a svar */
+    pt = RepAppl(t)+1;
+    for (i = 1; i <= arity; ++i) {
+#if SBA
+	Term d0 = *pt++;
+	if (d0 == 0)
+	  XREGS[i] = (CELL)(pt-1);
+	else
+	  XREGS[i] = d0;
+#else
+      XREGS[i] = *pt++;
+#endif
+    }
+  } else {
+    Yap_Error(TYPE_ERROR_CALLABLE,ARG3,"call/1");    
+    return FALSE;
+  }
+  /*	N = arity; */
+  /* call may not define new system predicates!! */
+  if (RepPredProp(pe)->PredFlags & SpiedPredFlag) {
+    return CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->cs.p_code.TrueCodeOfPred);
+  } else {
+    return CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred);
+  }
 }
 
 static Int
@@ -417,7 +389,7 @@ p_execute_0(void)
     XREGS[1] = ptr[0];
     XREGS[2] = ptr[1];
   }
-  return (CallPredicate(RepPredProp(pe), B));
+  return (CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred));
 }
 
 static Int
@@ -463,7 +435,7 @@ p_execute_1(void)
     XREGS[1] = ptr[0];
     XREGS[2] = ptr[1];
   }
-  return (CallPredicate(RepPredProp(pe), B));
+  return (CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred));
 }
 
 static Int
@@ -508,7 +480,7 @@ p_execute_2(void)
     XREGS[1] = ptr[0];
     XREGS[2] = ptr[1];
   }
-  return (CallPredicate(RepPredProp(pe), B));
+  return (CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred));
 }
 
 static Int
@@ -560,7 +532,7 @@ p_execute_3(void)
     XREGS[1] = ptr[0];
     XREGS[2] = ptr[1];
   }
-  return (CallPredicate(RepPredProp(pe), B));
+  return (CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred));
 }
 
 static Int
@@ -611,7 +583,7 @@ p_execute_4(void)
     XREGS[1] = ptr[0];
     XREGS[2] = ptr[1];
   }
-  return (CallPredicate(RepPredProp(pe), B));
+  return (CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred));
 }
 
 static Int
@@ -665,7 +637,7 @@ p_execute_5(void)
     XREGS[1] = ptr[0];
     XREGS[2] = ptr[1];
   }
-  return (CallPredicate(RepPredProp(pe), B));
+  return (CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred));
 }
 
 static Int
@@ -722,7 +694,7 @@ p_execute_6(void)
     XREGS[1] = ptr[0];
     XREGS[2] = ptr[1];
   }
-  return (CallPredicate(RepPredProp(pe), B));
+  return (CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred));
 }
 
 static Int
@@ -782,7 +754,7 @@ p_execute_7(void)
     XREGS[1] = ptr[0];
     XREGS[2] = ptr[1];
   }
-  return (CallPredicate(RepPredProp(pe), B));
+  return (CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred));
 }
 
 static Int
@@ -845,7 +817,7 @@ p_execute_8(void)
     XREGS[1] = ptr[0];
     XREGS[2] = ptr[1];
   }
-  return (CallPredicate(RepPredProp(pe), B));
+  return (CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred));
 }
 
 static Int
@@ -911,7 +883,7 @@ p_execute_9(void)
     XREGS[1] = ptr[0];
     XREGS[2] = ptr[1];
   }
-  return (CallPredicate(RepPredProp(pe), B));
+  return (CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred));
 }
 
 static Int
@@ -980,7 +952,7 @@ p_execute_10(void)
     XREGS[1] = ptr[0];
     XREGS[2] = ptr[1];
   }
-  return (CallPredicate(RepPredProp(pe), B));
+  return (CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred));
 }
 
 #ifdef DEPTH_LIMIT
@@ -1005,66 +977,6 @@ p_pred_goal_expansion_on(void) {
   return PRED_GOAL_EXPANSION_ON;
 }
 
-static Int 
-p_at_execute(void)
-{				/* '$execute'(Goal,ClauseNumber) */
-  Term            t = Deref(ARG1), mod = Deref(ARG2), t2 = Deref(ARG3);
-  unsigned	  int arity;
-  Prop            pe;
-  Atom            a;
-
- restart_exec:
-  if (IsAtomTerm(t)) {
-    a = AtomOfTerm(t);
-    pe = PredPropByAtom(a, mod);
-    arity = 0;
-  } else if (IsApplTerm(t)) {
-    register Functor f = FunctorOfTerm(t);
-    register unsigned int    i;
-    register CELL *pt;
-
-    if (IsBlobFunctor(f))
-      return(FALSE);
-    if (f == FunctorModule) {
-      Term tmod = ArgOfTerm(1,t);
-      if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) {
-	mod = tmod;
-	t = ArgOfTerm(2,t);
-	goto restart_exec;
-      }
-      if (IsVarTerm(tmod)) {
-	Yap_Error(INSTANTIATION_ERROR, ARG1, "calling clause in debugger");
-      }
-      Yap_Error(TYPE_ERROR_ATOM, ARG1, "calling clause in debugger");
-    }
-    pe = PredPropByFunc(f,mod);
-    arity = ArityOfFunctor(f);
-    a = NameOfFunctor(f);
-    /* I cannot use the standard macro here because
-       otherwise I would dereference the argument and
-       might skip a svar */
-    pt = RepAppl(t)+1;
-    for (i = 1; i <= arity; ++i)
-#if SBA
-      {
-	Term d0 = *pt++;
-	if (d0 == 0)
-	  XREGS[i] = (CELL)(pt-1);
-	else
-	  XREGS[i] = d0;
-      }
-#else
-      XREGS[i] = *pt++;
-#endif
-  } else
-    return (FALSE);	/* for the moment */
-  if (IsVarTerm(t2) || !IsIntTerm(t2))
-    return (FALSE);
-  /* N = arity; */
-  /* call may not define new system predicates!! */
-  return (CallClause(RepPredProp(pe), IntOfTerm(t2)));
-}
-
 static int
 exec_absmi(int top)
 {
@@ -1607,7 +1519,6 @@ Yap_InitExecFs(void)
   Yap_InitComma();
   Yap_InitCPred("$execute", 1, p_execute, 0);
   Yap_InitCPred("$execute_in_mod", 2, p_execute_in_mod, 0);
-  Yap_InitCPred("$execute", 3, p_at_execute, 0);
   Yap_InitCPred("$call_with_args", 2, p_execute_0, 0);
   Yap_InitCPred("$call_with_args", 3, p_execute_1, 0);
   Yap_InitCPred("$call_with_args", 4, p_execute_2, 0);
@@ -1623,6 +1534,7 @@ Yap_InitExecFs(void)
   Yap_InitCPred("$execute_under_depth_limit", 2, p_execute_depth_limit, 0);
 #endif
   Yap_InitCPred("$execute0", 2, p_execute0, 0);
+  Yap_InitCPred("$execute_nonstop", 2, p_execute_nonstop, 0);
   Yap_InitCPred("$save_current_choice_point", 1, p_save_cp, 0);
   Yap_InitCPred("$pred_goal_expansion_on", 0, p_pred_goal_expansion_on, SafePredFlag);
   Yap_InitCPred("$restore_regs", 1, p_restore_regs, SafePredFlag);

C/iopreds.c

@@ -4634,6 +4634,7 @@ Yap_InitBackIO (void)
 void
 Yap_InitIOPreds(void)
 {
+  Term cm = CurrentModule;
 
   Yap_stdin = stdin;
   Yap_stdout = stdout;
@@ -4658,7 +4659,7 @@ Yap_InitIOPreds(void)
   Yap_InitCPred ("open_mem_read_stream", 2, p_open_mem_read_stream, SyncPredFlag);
   Yap_InitCPred ("open_mem_write_stream", 1, p_open_mem_write_stream, SyncPredFlag);
   Yap_InitCPred ("peek_mem_write_stream", 3, p_peek_mem_write_stream, SyncPredFlag);
-  CurrentModule = PROLOG_MODULE;
+  CurrentModule = cm;
   Yap_InitCPred ("$put", 2, p_put, SafePredFlag|SyncPredFlag);
   Yap_InitCPred ("$put_byte", 2, p_put_byte, SafePredFlag|SyncPredFlag);
   Yap_InitCPred ("$set_read_error_handler", 1, p_set_read_error_handler, SafePredFlag|SyncPredFlag);

C/modules.c

@@ -96,7 +96,7 @@ p_current_module(void)
   if (IsVarTerm(t) || !IsAtomTerm(t))
     return FALSE;
   if (t == TermProlog) {
-    CurrentModule = 0;
+    CurrentModule = PROLOG_MODULE;
   } else {
     CurrentModule = t;
     LookupModule(CurrentModule);

C/save.c

@@ -377,7 +377,6 @@ save_regs(int mode)
     putcellptr(S);
     putcellptr((CELL *)P);
     putout(CreepFlag);
-    putout(FlipFlop);
     putout(EX);
 #ifdef COROUTINING
     putout(DelayedVars);
@@ -711,7 +710,6 @@ get_regs(int flag)
     S = get_cellptr();
     P = (yamop *)get_cellptr();
     CreepFlag = get_cell();
-    FlipFlop = get_cell();
 #ifdef COROUTINING
     DelayedVars = get_cell();
 #endif
@@ -1413,7 +1411,9 @@ Restore(char *s, char *lib_dir)
   restore_regs(restore_mode);
   in_limbo = FALSE;
   /*#endif*/
+  fprintf(stderr,"1 CurrentModule is %p\n", CurrentModule);
   RestoreHeap(old_ops);
+  fprintf(stderr,"1.5 CurrentModule is %p\n", CurrentModule);
   switch(restore_mode) {
   case DO_EVERYTHING:
     if (OldHeapBase != Yap_HeapBase ||
@@ -1437,6 +1437,7 @@ Restore(char *s, char *lib_dir)
     Yap_InitYaamRegs();
     break;
   }
+
   Yap_ReOpenLoadForeign();
   Yap_InitPlIO();
   /* reset time */

C/stdpreds.c

@@ -11,8 +11,11 @@
 * File:		stdpreds.c						 *
 * comments:	General-purpose C implemented system predicates		 *
 *									 *
-* Last rev:     $Date: 2004-04-27 15:14:36 $,$Author: vsc $						 *
+* Last rev:     $Date: 2004-05-13 20:54:58 $,$Author: vsc $						 *
-* $Log: not supported by cvs2svn $									 *
+* $Log: not supported by cvs2svn $
+* Revision 1.65  2004/04/27 15:14:36  vsc
+* fix halt/0 and halt/1
+*									 *
 *									 *
 *************************************************************************/
 #ifdef SCCS
@@ -478,24 +481,6 @@ p_values(void)
   return (TRUE);
 }
 
-static Int 
-p_flipflop(void)
-{				/* '$flipflop'		 */
-  return ((int) (FlipFlop = (1 - FlipFlop)));
-}
-
-static Int 
-p_setflop(void)
-{				/* '$setflop'(N)	 */
-  Term            t = Deref(ARG1);
-
-  if (IsIntTerm(t)) {
-    FlipFlop = IntOfTerm(t) & 1;
-    return (TRUE);
-  }
-  return (FALSE);
-}
-
 inline static void
 do_signal(yap_signals sig)
 {
@@ -516,7 +501,6 @@ p_creep(void)
   CreepCode = pred;
   yap_flags[SPY_CREEP_FLAG] = TRUE;
   do_signal(YAP_CREEP_SIGNAL);
-  FlipFlop = 0;
   return TRUE;
 }
 
@@ -524,7 +508,10 @@ static Int
 p_stop_creep(void)
 {
   LOCK(SignalLock);
-  CreepFlag = CalculateStackGap();
+  ActiveSignals &= ~YAP_CREEP_SIGNAL;
+  if (!ActiveSignals) {
+    CreepFlag = CalculateStackGap();
+  }
   UNLOCK(SignalLock);
   return TRUE;
 }
@@ -2678,9 +2665,6 @@ Yap_InitCPreds(void)
   Yap_InitCPred("set_value", 2, p_setval, SafePredFlag|SyncPredFlag);
   Yap_InitCPred("get_value", 2, p_value, TestPredFlag|SafePredFlag|SyncPredFlag);
   Yap_InitCPred("$values", 3, p_values, SafePredFlag|SyncPredFlag);
-  /* The flip-flop */
-  Yap_InitCPred("$flipflop", 0, p_flipflop, SafePredFlag|SyncPredFlag);
-  Yap_InitCPred("$setflop", 1, p_setflop, SafePredFlag|SyncPredFlag);
   /* general purpose */
   Yap_InitCPred("$opdec", 3, p_opdec, SafePredFlag|SyncPredFlag);
   Yap_InitCPred("name", 2, p_name, SafePredFlag);

C/unify.c

@@ -618,11 +618,12 @@ InitReverseLookupOpcode(void)
 void 
 Yap_InitUnify(void)
 {
+  Term cm = CurrentModule;
   Yap_InitCPred("unify_with_occurs_check", 2, p_ocunify, SafePredFlag);
   CurrentModule = TERMS_MODULE;
   Yap_InitCPred("cyclic_term", 1, p_cyclic, SafePredFlag|TestPredFlag);
   Yap_InitCPred("acyclic_term", 1, p_acyclic, SafePredFlag|TestPredFlag);
-  CurrentModule = PROLOG_MODULE;
+  CurrentModule = cm;
 }
 
 

C/utilpreds.c

@@ -1745,6 +1745,7 @@ camacho_dum(void)
 
 void Yap_InitUtilCPreds(void)
 {
+  Term cm = CurrentModule;
   Yap_InitCPred("copy_term", 2, p_copy_term, 0);
   Yap_InitCPred("$copy_term_but_not_constraints", 2, p_copy_term_no_delays, 0);
   Yap_InitCPred("ground", 1, p_ground, SafePredFlag);
@@ -1756,7 +1757,7 @@ void Yap_InitUtilCPreds(void)
   Yap_InitCPred("term_hash", 4, GvNTermHash, SafePredFlag);
   Yap_InitCPred("variant", 2, p_variant, SafePredFlag);
   Yap_InitCPred("subsumes", 2, p_subsumes, SafePredFlag);
-  CurrentModule = PROLOG_MODULE;
+  CurrentModule = cm;
 #ifdef DEBUG
   Yap_InitCPred("$force_trail_expansion", 1, p_force_trail_expansion, SafePredFlag);
   Yap_InitCPred("dum", 1, camacho_dum, SafePredFlag);

H/Regs.h

@@ -10,7 +10,7 @@
 * File:		Regs.h							 *
 * mods:									 *
 * comments:	YAP abstract machine registers				 *
-* version:      $Id: Regs.h,v 1.27 2004-03-05 15:26:33 vsc Exp $	 *
+* version:      $Id: Regs.h,v 1.28 2004-05-13 20:54:58 vsc Exp $	 *
 *************************************************************************/
 
 
@@ -89,7 +89,6 @@ typedef struct
     CELL  *AuxSp_;		/* 9 Auxiliary stack pointer                  */
     ADDR   AuxTop_;		/* 10 Auxiliary stack top                     */
 /* visualc*/
-    CELL   FlipFlop_;		/* 18                                         */
     CELL   EX_;	    	        /* 18                                         */
 #ifdef COROUTINING
     Term  DelayedVars_;         /* maximum number of attributed variables     */
@@ -650,7 +649,6 @@ EXTERN inline void restore_B(void) {
 #define	AuxTop        Yap_REGS.AuxTop_
 #define TopB          Yap_REGS.TopB_
 #define DelayedB      Yap_REGS.DelayedB_
-#define FlipFlop      Yap_REGS.FlipFlop_
 #define EX            Yap_REGS.EX_
 #define DEPTH	      Yap_REGS.DEPTH_
 #if defined(SBA) || defined(TABLING)

pl/boot.yap

@@ -437,7 +437,7 @@ repeat :- '$repeat'.
 	( get_value('$trace', 1) ->
 	    '$creep'
 	;
-	  '$setflop'(1)
+	    true
 	).
 
 '$do_yes_no'([X|L], M) :- !, '$csult'([X|L], M).
@@ -1086,7 +1086,7 @@ catch(G, C, A) :-
 '$system_catch'(G, M, C, A) :-
 	% check current trail
 	'$catch'(C,A,_),
-	'$execute0'(G, M).
+	'$execute_nonstop'(G, M).
 
 %
 % throw has to be *exactly* after system catch!

pl/debug.yap

@@ -382,7 +382,7 @@ debugging :-
 % 
 '$spycall'(G, M, _) :-
 	'$access_yap_flags'(10,0), !,
-	'$execute0'(G, M).
+	'$execute_nonstop'(G, M).
 '$spycall'(G, M, InControl) :-
 	'$flags'(G,M,F,F),
 	F /\ 0x8402000 =\= 0, !, % dynamic procedure, logical semantics, or source
@@ -393,7 +393,7 @@ debugging :-
 '$spycall'(G, M, _) :-
 	% I lost control here.
 	'$continue_debugging'(no),
-	'$execute0'(G, M).
+	'$execute_nonstop'(G, M).
 
 
 '$trace'(P,G,Module,L) :-
@@ -510,10 +510,9 @@ debugging :-
 	'$skipeol'(0'k),
 	'$set_yap_flags'(10,0),
 	set_value(spy_skip,CallNumber),
-	set_value(spy_stop,on),
+	set_value(spy_stop,on).
 	% skip first call (for current goal),
 	% stop next time.
-	'$setflop'(0).
 '$action'(0'r,P,CallId,_,_) :- !,		% r		retry
 	'$scan_number'(0'r,CallId,ScanNumber),
 	throw('$retry_spy'(ScanNumber)).
@@ -550,17 +549,14 @@ debugging :-
 
 % if we are in the interpreter, don't need to care about forcing a trace, do we?
 '$continue_debugging'(yes) :- !.
-% I don't need to activate the FlipFlop if I am creeping.
 '$continue_debugging'(_) :-
 	'$access_yap_flags'(10,1), !,
 	'$creep'.
 '$continue_debugging'(_) :-
-	get_value(spy_stop, On),
+	get_value(spy_stop, On).
-	(On = on -> '$setflop'(1) ; '$setflop'(0)).
 
 '$stop_debugging' :-
-	'$stop_creep',
+	'$stop_creep'.
-	'$setflop'(0).
 
 '$action_help' :-
 	'$format'(user_error,"newline  creep       a       abort~n", []),

pl/setof.yap

@@ -122,6 +122,7 @@ bagof(Template, Generator, Bag) :-
 	Key =.. ['$'|LFreeVars],
 	'$init_db_queue'(Ref),
 	'$findall_with_common_vars'(Key-Template, Generator, Ref, Bags0),
+write(vsc:(Bags0,Bags)),nl,
 	'$keysort'(Bags0, Bags),
 	'$pick'(Bags, Key, Bag).
 % or we just have a list of answers
@@ -212,22 +213,28 @@ all(T,G,S) :-
 
 % $$set does its best to preserve space
 '$$set'(S,R) :- 
-       '$$build'(S0,S0,R),
+       '$$build'(S0,_,R),
 	S = S0.
 
 '$$build'(Ns,S0,R) :- '$db_dequeue'(R,X), !,
 	'$$build2'(Ns,S0,R,X).
 '$$build'([],_,_).
 
-'$$build2'(Ns,Hash,R,X) :-
-	'$$in'(Hash,X), !,
-	'$$build'(Ns,Hash,R).
 '$$build2'([X|Ns],Hash,R,X) :-
+	'$$new'(Hash,X), !,
+	'$$build'(Ns,Hash,R).
+'$$build2'(Ns,Hash,R,X) :-
 	'$$build'(Ns,Hash,R).
 
-'$$in'(V,_) :- var(V), !, fail.
+'$$new'(V,El) :- var(V), !, V = n(_,El,_).
-'$$in'([El|_],El) :- !.
+'$$new'(n(R,El0,L),El) :- 
-'$$in'([_|S],El) :- '$$in'(S,El).
+	compare(C,El0,El),
+	'$$new'(C,R,L,El).
+
+'$$new'(=,_,_,_) :- !, fail.
+'$$new'(<,R,_,El) :- '$$new'(R,El).
+'$$new'(>,_,L,El) :- '$$new'(L,El).
+
 
 '$$produce'([T1 same X1|Tn],S,X) :- '$$split'(Tn,T1,X1,S1,S2),
 	( S=[T1|S1], X=X1;

pl/signals.yap

@@ -65,7 +65,7 @@
 '$start_creep'([Mod|G]) :-
 	'$hidden_predicate'(G,Mod), !,
 	'$creep',
-	'$execute0'(G,Mod).
+	'$execute_nonstop'(G,Mod).
 '$start_creep'([Mod|G]) :-
 	'$stop_debugging',
 	CP is '$last_choice_pt',	
@@ -90,7 +90,7 @@
 on_signal(Signal,OldAction,default) :-
 	'$reset_signal'(Signal, OldAction).
 on_signal(Signal,OldAction,Action) :-
-	var(Action),
+	var(Action), !,
 	'$check_signal'(OldAction),
 	Action = OldAction.
 on_signal(Signal,OldAction,Action) :-