a few more simple fixes

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

C/absmi.c

@@ -1470,8 +1470,9 @@ Yap_absmi(int inp)
 	    yamop *ipc = PREG;
 
 	    while (go_on) {
-	      go_on = FALSE;
 	      op_numbers opnum = Yap_op_from_opcode(ipc->opc);
+
+	      go_on = FALSE;
 	      switch (opnum) {
 #ifdef TABLING
 	      case _table_answer_resolution:
@@ -6569,11 +6570,8 @@ Yap_absmi(int inp)
       JMPNext();
       ENDBOp();
 
+      /* same as retry */
       BOp(retry_killed, ld);
-      goto retry_label;
-      ENDBOp();
-
-      BOp(retry, ld);
     retry_label:
       CACHE_Y(B);
       restore_yaam_regs(NEXTOP(PREG, ld));
@@ -6590,12 +6588,51 @@ Yap_absmi(int inp)
       JMPNext();
       ENDBOp();
 
+      BOp(retry, ld);
+      CACHE_Y(B);
+      restore_yaam_regs(NEXTOP(PREG, ld));
+      restore_at_least_one_arg(PREG->u.ld.s);
+#ifdef FROZEN_STACKS
+      B_YREG = PROTECT_FROZEN_B(B_YREG);
+      set_cut(S_YREG, B->cp_b);
+#else
+      set_cut(S_YREG, B_YREG->cp_b);
+#endif /* FROZEN_STACKS */
+      SET_BB(B_YREG);
+      ENDCACHE_Y();
+      PREG = PREG->u.ld.d;
+      JMPNext();
+      ENDBOp();
+
+      /* same as trust */
       BOp(trust_killed, ld);
-      goto trust_label;
+      CACHE_Y(B);
+#ifdef YAPOR
+      if (SCH_top_shared_cp(B)) {
+	SCH_last_alternative(PREG, B_YREG);
+	restore_at_least_one_arg(PREG->u.ld.s);
+#ifdef FROZEN_STACKS
+        B_YREG = PROTECT_FROZEN_B(B_YREG);
+#endif /* FROZEN_STACKS */
+	set_cut(S_YREG, B->cp_b);
+      }
+      else
+#endif	/* YAPOR */
+      {
+	pop_yaam_regs();
+	pop_at_least_one_arg(PREG->u.ld.s);
+#ifdef FROZEN_STACKS
+        B_YREG = PROTECT_FROZEN_B(B_YREG);
+#endif /* FROZEN_STACKS */
+	set_cut(S_YREG, B);
+      }
+      SET_BB(B_YREG);
+      ENDCACHE_Y();
+      PREG = PREG->u.ld.d;
+      JMPNext();
       ENDBOp();
 
       BOp(trust, ld);
-    trust_label:
       CACHE_Y(B);
 #ifdef YAPOR
       if (SCH_top_shared_cp(B)) {

C/amasm.c

@@ -2080,7 +2080,7 @@ do_pass(void)
       /* static clause */
       if (pass_no) {
 	cl_u->sc.Id = FunctorDBRef;
-	cl_u->sc.ClFlags = 0;
+	cl_u->sc.ClFlags = StaticMask;
 	cl_u->sc.Owner = Yap_ConsultingFile();
 	if (clause_has_blobs) {
 	  cl_u->sc.ClFlags |= HasBlobsMask;
@@ -2687,7 +2687,7 @@ Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact)
     }
     H = h0;
     cl = (StaticClause *)((CODEADDR)x-(UInt)size);
-    cl->ClSource = x;
+    cl->usc.ClSource = x;
     code_addr = (yamop *)cl;
   } else {
     while ((code_addr = (yamop *) Yap_AllocCodeSpace(size)) == NULL) {

C/cdmgr.c

@@ -396,16 +396,16 @@ kill_static_child_indxs(StaticIndex *indx)
 }
 
 static void
-kill_first_log_iblock(LogUpdIndex *c, LogUpdIndex *cl, PredEntry *ap)
+kill_first_log_iblock(LogUpdIndex *c, LogUpdIndex *parent, PredEntry *ap)
 {
   LogUpdIndex *ncl = c->ChildIndex;
 
-  if (cl != NULL &&
+  if (parent != NULL &&
       !(c->ClFlags & ErasedMask)) {
-    if (c == cl->ChildIndex) {
+    if (c == parent->ChildIndex) {
-      cl->ChildIndex = c->SiblingIndex;
+      parent->ChildIndex = c->SiblingIndex;
     } else {
-      LogUpdIndex *tcl = cl->ChildIndex;
+      LogUpdIndex *tcl = parent->ChildIndex;
       while (tcl->SiblingIndex != c) {
 	tcl = tcl->SiblingIndex;
       }
@@ -421,32 +421,35 @@ kill_first_log_iblock(LogUpdIndex *c, LogUpdIndex *cl, PredEntry *ap)
   }
   c->ClRefCount--;
   /* check if we are still the main index */
-  if (cl == NULL &&
+  if (parent == NULL &&
       ap->cs.p_code.TrueCodeOfPred == c->ClCode) {
     RemoveMainIndex(ap);
   }
   if (!((c->ClFlags & InUseMask) || c->ClRefCount)) {
-    if (cl != NULL) {
+    if (parent != NULL) {
-      cl->ClRefCount--;
+      parent->ClRefCount--;
-      if (cl->ClFlags & ErasedMask && cl->ClRefCount == 0) {
+      if (parent->ClFlags & ErasedMask &&
+	  !(parent->ClFlags & InUseMask) &&
+	  parent->ClRefCount == 0) {
 	/* cool, I can erase the father too. */
-	if (cl->ClFlags & SwitchRootMask) {
+	if (parent->ClFlags & SwitchRootMask) {
-	  kill_first_log_iblock(cl, NULL, ap);
+	  kill_first_log_iblock(parent, NULL, ap);
 	} else {
-	  kill_first_log_iblock(cl, cl->u.ParentIndex, ap);
+	  kill_first_log_iblock(parent, parent->u.ParentIndex, ap);
 	}
       }
     }
     decrease_log_indices(c, (yamop *)&(ap->cs.p_code.ExpandCode));
 #ifdef DEBUG
     {
-      LogUpdIndex *cl = DBErasedIList, *c0 = NULL;
+      LogUpdIndex *parent = DBErasedIList, *c0 = NULL;
-      while (cl != NULL) {
+      while (parent != NULL) {
-	if (c == cl) {
+	if (c == parent) {
 	  if (c0) c0->SiblingIndex = c->SiblingIndex;
 	  else DBErasedIList = c->SiblingIndex;
 	}
-	cl = cl->SiblingIndex;
+	c0 = parent;
+	parent = parent->SiblingIndex;
       }
     }
 #endif
@@ -458,11 +461,11 @@ kill_first_log_iblock(LogUpdIndex *c, LogUpdIndex *cl, PredEntry *ap)
 #endif
     c->ClFlags |= ErasedMask;
     /* try to move up, so that we don't hold an index */
-    if (cl != NULL &&
+    if (parent != NULL &&
-	cl->ClFlags & SwitchTableMask) {
+	parent->ClFlags & SwitchTableMask) {
-      c->u.ParentIndex = cl->u.ParentIndex;
+      c->u.ParentIndex = parent->u.ParentIndex;
-      cl->u.ParentIndex->ClRefCount++;
+      parent->u.ParentIndex->ClRefCount++;
-      cl->ClRefCount--;
+      parent->ClRefCount--;
     }
     c->ChildIndex = NULL;
   }
@@ -1203,7 +1206,7 @@ addclause(Term t, yamop *cp, int mode, int mod)
       if (IsAtomTerm(t) ||
 	  FunctorOfTerm(t) != FunctorAssert) {
 	clp->ClFlags |= FactMask;
-	clp->ClSource = NULL;
+	clp->usc.ClPred = p;
       }
     }
     if (compile_mode)
@@ -3202,7 +3205,7 @@ fetch_next_static_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr
   } else {
     Term t;
 
-    while ((t = Yap_FetchTermFromDB(cl->ClSource)) == 0L) {
+    while ((t = Yap_FetchTermFromDB(cl->usc.ClSource)) == 0L) {
       if (first_time) {
 	if (!Yap_gc(4, YENV, P)) {
 	  Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);

C/dbase.c

@@ -4201,12 +4201,55 @@ p_erased(void)
   return (DBRefOfTerm(t)->Flags & ErasedMask);
 }
 
+static Int
+static_instance(StaticClause *cl)
+{
+  if (cl->ClFlags & ErasedMask) {
+    return FALSE;
+  }
+  if (cl->ClFlags & FactMask) {
+    PredEntry *ap = cl->usc.ClPred;
+    if (ap->ArityOfPE == 0) {
+      return Yap_unify(ARG2,MkAtomTerm((Atom)ap->FunctorOfPred));
+    } else {
+      Functor f = ap->FunctorOfPred;
+      UInt arity = ArityOfFunctor(ap->FunctorOfPred), i;
+      Term t2 = Deref(ARG2);
+      CELL *ptr;
+
+      if (IsVarTerm(t2)) {
+	Yap_unify(ARG2, (t2 = Yap_MkNewApplTerm(f,arity)));
+      } else if (!IsApplTerm(t2) || FunctorOfTerm(t2) != f) {
+	return FALSE;
+      }
+      ptr = RepAppl(t2)+1;
+      for (i=0; i<arity; i++) {
+	XREGS[i+1] = ptr[i];
+      }
+      CP = P;
+      YENV = ASP;
+      YENV[E_CB] = (CELL) B;
+      P = cl->ClCode;
+      return TRUE;
+    }
+  } else {
+    Term TermDB;
+
+    while ((TermDB = GetDBTerm(cl->usc.ClSource)) == 0L) {
+      /* oops, we are in trouble, not enough stack space */
+      if (!Yap_gc(2, ENV, P)) {
+	Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
+	return(FALSE);
+      }
+    }
+    return Yap_unify(ARG2, TermDB);
+  }
+}
 
 /* instance(+Ref,?Term) */
 static Int 
 p_instance(void)
 {
-  Term            TermDB;
   Term t1 = Deref(ARG1);
   DBRef dbr;
 
@@ -4222,7 +4265,9 @@ p_instance(void)
   } else {
     dbr = DBRefOfTerm(t1);
   }
-  if (dbr->Flags & LogUpdMask) {
+  if (dbr->Flags & StaticMask) {
+    return static_instance((StaticClause *)dbr);
+  } else if (dbr->Flags & LogUpdMask) {
     op_numbers opc;
     LogUpdClause *cl = (LogUpdClause *)dbr;
 
@@ -4259,6 +4304,7 @@ p_instance(void)
     if (opc == _unify_idb_term) {
       return Yap_unify(ARG2, cl->ClSource->Entry);
     } else  {
+      Term            TermDB;
       while ((TermDB = GetDBTerm(cl->ClSource)) == 0L) {
 	/* oops, we are in trouble, not enough stack space */
 	if (!Yap_gc(2, ENV, P)) {
@@ -4269,6 +4315,7 @@ p_instance(void)
       return Yap_unify(ARG2, TermDB);
     }
   } else {
+    Term            TermDB;
     while ((TermDB = GetDBTermFromDBEntry(dbr)) == 0L) {
       /* oops, we are in trouble, not enough stack space */
       if (!Yap_gc(2, ENV, P)) {

C/index.c

@@ -3962,6 +3962,7 @@ expand_index(PredEntry *ap) {
       }
     } else {
       op_numbers op = Yap_op_from_opcode(alt->opc);
+	fprintf(stderr,"hello, %d\n", op);
       if (op == _retry ||
 	  op == _trust) {
 	last = PREVOP(alt->u.ld.d,ld);

C/tracer.c

@@ -115,10 +115,7 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
   /*  extern int gc_calls; */
 
   vsc_count++;
-  if (vsc_count == 121085) 
+  return;
-    vsc_xstop = 1;
-  if (vsc_count < 121000LL)
-    return;
 #ifdef COMMENTED
   if (port != enter_pred ||
       !pred ||

H/clause.h

@@ -108,7 +108,10 @@ typedef struct static_clause {
   /* A set of flags describing info on the clause */
   Functor         Id;
   CELL            ClFlags;
-  DBTerm          *ClSource;
+  union {
+    DBTerm          *ClSource;
+    PredEntry       *ClPred;
+  } usc;
   Atom Owner;
   /* The instructions, at least one of the form sl */
   yamop            ClCode[MIN_ARRAY];