nth_clause cleanup with support for mega and exo clauses

C/cdmgr.c

@@ -5198,79 +5198,6 @@ p_static_clause( USES_REGS1 )
   return fetch_next_static_clause(pe, pe->CodeOfPred, ARG1, ARG3, ARG4, new_cp, TRUE);
 }
 
-static Int			/* $nth_clause(P) */
-p_nth_clause( USES_REGS1 )
-{
-  PredEntry      *pe;
-  Term t1 = Deref(ARG1);
-  Term tn = Deref(ARG3);
-  LogUpdClause *cl;
-  Int ncls;
-
-  Int CurSlot, sl;
-  if (!IsIntegerTerm(tn))
-    return FALSE;
-  ncls = IntegerOfTerm(tn);
-  pe = get_pred(t1, Deref(ARG2), "clause/3");
-  if (pe == NULL || EndOfPAEntr(pe))
-    return FALSE;
-  PELOCK(47,pe);
-  if (!(pe->PredFlags & (SourcePredFlag|LogUpdatePredFlag))) {
-    UNLOCK(pe->PELock);
-    return FALSE;
-  }
-  CurSlot = Yap_StartSlots( PASS_REGS1 );
-  sl = Yap_InitSlot( ARG4 PASS_REGS );
-  /* in case we have to index or to expand code */
-  if (pe->ModuleOfPred != IDB_MODULE) {
-    UInt i;
-
-    for (i = 1; i <= pe->ArityOfPE; i++) {
-      XREGS[i] = MkVarTerm();
-    }
-  } else {
-      XREGS[2] = MkVarTerm();
-  }
-  if(pe->OpcodeOfPred == INDEX_OPCODE) {
-    IPred(pe, 0, CP);
-  }
-  cl = Yap_NthClause(pe, ncls);
-  ARG4 = Yap_GetFromSlot( sl PASS_REGS );
-  LOCAL_CurSlot = CurSlot;  
-  if (cl == NULL) {
-    UNLOCK(pe->PELock);
-    return FALSE;
-  }
-  if (pe->PredFlags & LogUpdatePredFlag) {
-#if MULTIPLE_STACKS
-    TRAIL_CLREF(cl);		/* So that fail will erase it */
-    INC_CLREF_COUNT(cl);
-#else
-    if (!(cl->ClFlags & InUseMask)) {
-      cl->ClFlags |= InUseMask;
-      TRAIL_CLREF(cl);	/* So that fail will erase it */
-    }
-#endif
-    UNLOCK(pe->PELock);
-    return Yap_unify(MkDBRefTerm((DBRef)cl), ARG4);
-  } else if (pe->PredFlags & MegaClausePredFlag) {
-    MegaClause *mcl = ClauseCodeToMegaClause(pe->cs.p_code.FirstClause);
-    if (mcl->ClFlags & ExoMask) {
-      Term tf[2];
-      tf[0] = pe->ModuleOfPred;
-      tf[1] = Yap_MkApplTerm(pe->FunctorOfPred, pe->ArityOfPE, (CELL *)((char *)mcl->ClCode+(ncls-1)*mcl->ClItemSize));
-      UNLOCK(pe->PELock);
-      return Yap_unify(Yap_MkApplTerm(FunctorExoClause, 2, tf), ARG4);
-    }
-    /* fast access to nth element, all have same size */
-    UNLOCK(pe->PELock);
-    return Yap_unify(Yap_MkMegaRefTerm(pe,(yamop *)cl), ARG4);
-  } else {
-    UNLOCK(pe->PELock);
-    return Yap_unify(Yap_MkStaticRefTerm((StaticClause *)cl, pe), ARG4);
-  }
-}
-
 static Int			/* $hidden_predicate(P) */
 p_continue_static_clause( USES_REGS1 )
 {
@@ -6251,6 +6178,213 @@ p_instance_property( USES_REGS1 )
   return FALSE;
 }
 
+static Int
+p_nth_instance( USES_REGS1 )
+{
+  PredEntry      *pe;
+  UInt pred_arity;
+  Functor pred_f;
+  Term pred_module;
+  Term t4 = Deref(ARG4);
+
+  if (IsVarTerm(t4)) {
+    // we must know I or count;
+    Term            TCount;
+    Int             Count;
+
+    TCount = Deref(ARG3);
+    if (IsVarTerm(TCount)) {
+      return FALSE; // backtrack?
+    }
+    if (!IsIntegerTerm(TCount)) {
+      Yap_Error(TYPE_ERROR_INTEGER, TCount, "nth_instance/3");
+      return FALSE;
+    }
+    Count = IntegerOfTerm(TCount);
+    if (Count <= 0) {
+      if (Count) 
+	Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, TCount, "nth_clause/3");
+      else
+	Yap_Error(DOMAIN_ERROR_NOT_ZERO, TCount, "nth_clause/3");
+      return FALSE;
+    }
+    pe = get_pred(Deref(ARG1), Deref(ARG2), "nth_clause/3");
+    if (pe) {
+      PELOCK(47,pe); 
+    }
+    if (Deref(ARG2) == IDB_MODULE) {
+      return Yap_db_nth_recorded( pe, Count PASS_REGS );
+    } else {
+      Int CurSlot, sl4;
+      UInt i;
+      void *cl0;
+
+      if (!pe)
+	return FALSE;
+      if (!(pe->PredFlags & (SourcePredFlag|LogUpdatePredFlag))) {
+	UNLOCK(pe->PELock);
+	return FALSE;
+      }
+      CurSlot = Yap_StartSlots( PASS_REGS1 );
+      /* I have pe and n */
+      sl4 = Yap_InitSlot( ARG4 PASS_REGS );
+      /* in case we have to index or to expand code */
+      for (i = 1; i <= pe->ArityOfPE; i++) {
+	XREGS[i] = MkVarTerm();
+      }
+      if(pe->OpcodeOfPred == INDEX_OPCODE) {
+	IPred(pe, 0, CP);
+      }
+      cl0 = Yap_NthClause(pe, Count);
+      ARG4 = Yap_GetFromSlot( sl4 PASS_REGS );
+      LOCAL_CurSlot = CurSlot;  
+      if (cl0 == NULL) {
+	UNLOCK(pe->PELock);
+	return FALSE;
+      }
+      if (pe->PredFlags & LogUpdatePredFlag) {
+	LogUpdClause *cl = cl0;
+	
+#if MULTIPLE_STACKS
+	TRAIL_CLREF(cl);		/* So that fail will erase it */
+	INC_CLREF_COUNT(cl);
+#else
+	if (!(cl->ClFlags & InUseMask)) {
+	  cl->ClFlags |= InUseMask;
+	  TRAIL_CLREF(cl);	/* So that fail will erase it */
+	}
+#endif
+	UNLOCK(pe->PELock);
+	return Yap_unify(MkDBRefTerm((DBRef)cl), ARG4);
+      } else if (pe->PredFlags & MegaClausePredFlag) {
+	MegaClause *mcl = ClauseCodeToMegaClause(pe->cs.p_code.FirstClause);
+	if (mcl->ClFlags & ExoMask) {
+	  UNLOCK(pe->PELock);
+	  return Yap_unify(Yap_MkExoRefTerm(pe,Count-1), ARG4);
+	}
+	/* fast access to nth element, all have same size */
+	UNLOCK(pe->PELock);
+	return Yap_unify(Yap_MkMegaRefTerm(pe,cl0), ARG4);
+      } else {
+	UNLOCK(pe->PELock);
+	return Yap_unify(Yap_MkStaticRefTerm(cl0, pe), ARG4);
+      }
+    }
+  }
+  /* t4 is bound, we have a reference */
+  if (IsDBRefTerm(t4)) {
+    DBRef ref = DBRefOfTerm(t4);
+    if (ref->Flags & LogUpdMask) {
+      LogUpdClause *cl = (LogUpdClause *)ref;
+      LogUpdClause *ocl;
+      UInt icl = 0;
+
+      pe = cl->ClPred;
+      PELOCK(66,pe);
+      if (cl->ClFlags & ErasedMask) {
+	UNLOCK(pe->PELock);
+	return FALSE;
+      }
+      ocl = ClauseCodeToLogUpdClause(pe->cs.p_code.FirstClause);
+      do {
+	icl++;
+	if (cl == ocl) break;
+	ocl = ocl->ClNext;
+      } while (ocl != NULL);
+      UNLOCK(pe->PELock);
+      if (ocl == NULL) {
+	return FALSE;
+      }
+      if (!Yap_unify(ARG3,MkIntegerTerm(icl))) {
+	return FALSE;
+      }
+    } else {
+      return Yap_unify_immediate_ref(ref PASS_REGS);
+    }
+  } else if (IsApplTerm(t4)) {
+    Functor f = FunctorOfTerm(t4);
+    
+    if (f == FunctorStaticClause) {
+      StaticClause *cl = Yap_ClauseFromTerm(t4), *cl0;
+      pe = (PredEntry *)IntegerOfTerm(ArgOfTerm(2, t4));
+      Int i;
+
+      if (!pe) {
+	return FALSE;
+      }
+      if (! pe->cs.p_code.NOfClauses )
+	return FALSE;
+      cl0 = ClauseCodeToStaticClause(pe->cs.p_code.FirstClause);
+      //linear scan
+      for (i = 1; i < pe->cs.p_code.NOfClauses; i++) {
+	if (cl0 == cl) {
+	  if (!Yap_unify(MkIntTerm(i), ARG3))
+	    return FALSE;
+	  break;
+	}
+      }
+    } else if (f == FunctorMegaClause) {
+      MegaClause *mcl;
+      yamop *cl = Yap_MegaClauseFromTerm(t4);
+      Int i;
+
+      pe = Yap_MegaClausePredicateFromTerm(t4);
+      mcl = ClauseCodeToMegaClause(pe->cs.p_code.FirstClause);
+      i = ((char *)cl-(char *)mcl->ClCode)/mcl->ClItemSize;
+      if (!Yap_unify(MkIntTerm(i), ARG3))
+	return FALSE;
+    } else if (f == FunctorExoClause) {
+      Int i;
+
+      pe = Yap_ExoClausePredicateFromTerm(t4);
+      i = Yap_ExoClauseFromTerm(t4);
+      if (!Yap_unify(MkIntTerm(i+1), ARG3)) {
+	return FALSE;
+      }
+    } else {
+      Yap_Error(TYPE_ERROR_REFERENCE, t4, "nth_clause/3");
+      return FALSE;
+    }
+  } else {
+    Yap_Error(TYPE_ERROR_REFERENCE, t4, "nth_clause/3");
+    return FALSE;
+  }
+  pred_module = pe->ModuleOfPred;
+  if (pred_module != IDB_MODULE) {
+    pred_f = pe->FunctorOfPred;
+    pred_arity = pe->ArityOfPE;
+  } else {
+    if (pe->PredFlags & NumberDBPredFlag) {
+      pred_f = (Functor)MkIntegerTerm(pe->src.IndxId);
+      pred_arity = 0;
+    } else {
+      pred_f = pe->FunctorOfPred;
+      if (pe->PredFlags & AtomDBPredFlag) {
+	pred_arity = 0;
+      } else {
+	pred_arity = ArityOfFunctor(pred_f);
+      }
+    }
+  }
+  if (pred_arity) {
+    if (!Yap_unify(ARG1,Yap_MkNewApplTerm(pred_f, pred_arity)))
+      return FALSE;
+  } else {
+    if (!Yap_unify(ARG1,MkAtomTerm((Atom)pred_f)))
+      return FALSE;
+  }
+  if (pred_module == PROLOG_MODULE) {
+    if (!Yap_unify(ARG2,TermProlog))
+      return FALSE;
+  } else {
+    if (!Yap_unify(ARG2,pred_module))
+      return FALSE;
+  }	
+  return TRUE;    
+
+}
+
+
 void 
 Yap_InitCdMgr(void)
 {
@@ -6310,9 +6444,9 @@ Yap_InitCdMgr(void)
   Yap_InitCPred("$static_clause", 4, p_static_clause, SyncPredFlag);
   Yap_InitCPred("$continue_static_clause", 5, p_continue_static_clause, SafePredFlag|SyncPredFlag);
   Yap_InitCPred("$static_pred_statistics", 5, p_static_pred_statistics, SyncPredFlag);
-  Yap_InitCPred("$p_nth_clause", 4, p_nth_clause, SyncPredFlag);
   Yap_InitCPred("$program_continuation", 3, p_program_continuation, SafePredFlag|SyncPredFlag);
   Yap_InitCPred("$instance_property", 3, p_instance_property, SafePredFlag|SyncPredFlag);
+  Yap_InitCPred("$fetch_nth_clause", 4, p_nth_instance, SyncPredFlag);
   CurrentModule = HACKS_MODULE;
   Yap_InitCPred("current_choicepoints", 1, p_all_choicepoints, 0);
   Yap_InitCPred("current_continuations", 1, p_all_envs, 0);

C/dbase.c

@@ -92,8 +92,6 @@ static char     SccsId[] = "%W% %G%";
 #define ToSmall(V)	((link_entry)(Unsigned(V)>>3))
 #endif
 
-#define DEAD_REF(ref) FALSE
-
 #ifdef SFUNC
 
 #define MaxSFs		256
@@ -2473,6 +2471,22 @@ UnifyDBNumber(DBRef DBSP, Term t)
   return Yap_unify(MkIntegerTerm(i),t);
 }
 
+Int
+Yap_unify_immediate_ref(DBRef ref USES_REGS)
+{
+  // old immediate semantics style
+  LOCK(ref->lock);
+  if (ref == NULL
+      || DEAD_REF(ref)
+      || !UnifyDBKey(ref,0,ARG1)
+      || !UnifyDBNumber(ref,ARG2)) {
+    UNLOCK(ref->lock);
+    return FALSE;
+  } else {
+    UNLOCK(ref->lock);
+    return TRUE;
+  }
+}
 
 static Term 
 GetDBTerm(DBTerm *DBSP, int src USES_REGS)
@@ -2949,17 +2963,16 @@ lu_nth_recorded(PredEntry *pe, Int Count USES_REGS)
   if (cl == NULL)
     return FALSE;
 #if MULTIPLE_STACKS
-  PELOCK(65,pe);
   TRAIL_CLREF(cl);		/* So that fail will erase it */
   INC_CLREF_COUNT(cl);
-  UNLOCK(pe->PELock);
 #else
   if (!(cl->ClFlags & InUseMask)) {
     cl->ClFlags |= InUseMask;
     TRAIL_CLREF(cl);	/* So that fail will erase it */
   }
 #endif
-  return Yap_unify(MkDBRefTerm((DBRef)cl),ARG3);
+  UNLOCK(pe->PELock);
+  return Yap_unify(MkDBRefTerm((DBRef)cl),ARG4);
 }
 
 
@@ -3003,175 +3016,22 @@ nth_recorded(DBProp AtProp, Int Count USES_REGS)
   }
   READ_UNLOCK(AtProp->DBRWLock);
 #endif
-  return Yap_unify(MkDBRefTerm(ref),ARG3);
+  return Yap_unify(MkDBRefTerm(ref),ARG4);
 }
 
-static Int
+Int
-p_nth_instance( USES_REGS1 )
+Yap_db_nth_recorded( PredEntry *pe, Int Count USES_REGS )
 {
   DBProp          AtProp;
-  Term            TCount;
-  Int             Count;
-  PredEntry      *pe;
-  Term t3 = Deref(ARG3);
 
-  if (!IsVarTerm(t3)) {
+  if (pe == NULL) {
-    if (!IsDBRefTerm(t3)) {
-      Yap_Error(TYPE_ERROR_DBREF,t3,"nth_instance/3");
-      return FALSE;
-    } else {
-      DBRef ref = DBRefOfTerm(t3);
-      if (ref->Flags & LogUpdMask) {
-	LogUpdClause *cl = (LogUpdClause *)ref;
-	PredEntry *pe;
-	LogUpdClause *ocl;
-	UInt pred_arity, icl = 0;
-	Functor pred_f;
-	Term tpred;
-	Term pred_module;
-
-	pe = cl->ClPred;
-	PELOCK(66,pe);
-	if (cl->ClFlags & ErasedMask) {
-	  UNLOCK(pe->PELock);
-	  return FALSE;
-	}
-	ocl = ClauseCodeToLogUpdClause(pe->cs.p_code.FirstClause);
-	pred_module = pe->ModuleOfPred;
-	if (pred_module != IDB_MODULE) {
-	  pred_f = pe->FunctorOfPred;
-	  pred_arity = pe->ArityOfPE;
-	} else {
-	  if (pe->PredFlags & NumberDBPredFlag) {
-	    pred_f = (Functor)MkIntegerTerm(pe->src.IndxId);
-	    pred_arity = 0;
-	  } else {
-	    pred_f = pe->FunctorOfPred;
-	    if (pe->PredFlags & AtomDBPredFlag) {
-	      pred_arity = 0;
-	    } else {
-	      pred_arity = ArityOfFunctor(pred_f);
-	    }
-	  }
-	}
-	do {
-	  icl++;
-	  if (cl == ocl) break;
-	  ocl = ocl->ClNext;
-	} while (ocl != NULL);
-	UNLOCK(pe->PELock);
-	if (ocl == NULL) {
-	  return FALSE;
-	}
-	if (!Yap_unify(ARG2,MkIntegerTerm(icl))) {
-	  return FALSE;
-	}
-	if (pred_arity) {
-	  tpred = Yap_MkNewApplTerm(pred_f,pred_arity);
-	} else {
-	  tpred = MkAtomTerm((Atom)pred_f);
-	}
-	if (pred_module == IDB_MODULE) {
-	  return Yap_unify(ARG1,tpred);
-	} else {
-	  Term ttpred, ts[2];
-	  ts[0] = pred_module;
-	  ts[1] = tpred;
-	  ttpred = Yap_MkApplTerm(FunctorModule,pred_arity,ts);
-	  return Yap_unify(ARG1,ttpred);
-	}
-      } else {
-	LOCK(ref->lock);
-	if (ref == NULL
-	    || DEAD_REF(ref)
-	    || !UnifyDBKey(ref,0,ARG1)
-	    || !UnifyDBNumber(ref,ARG2)) {
-	  UNLOCK(ref->lock);
-	  return FALSE;
-	} else {
-	  UNLOCK(ref->lock);
-	  return TRUE;
-	}
-      }
-    }
-  }
-  TCount = Deref(ARG2);
-  if (IsVarTerm(TCount)) {
-    Yap_Error(INSTANTIATION_ERROR, TCount, "nth_instance/3");
-    return FALSE;
-  }
-  if (!IsIntegerTerm(TCount)) {
-    Yap_Error(TYPE_ERROR_INTEGER, TCount, "nth_instance/3");
-    return FALSE;
-  }
-  Count = IntegerOfTerm(TCount);
-  if (Count <= 0) {
-    if (Count) 
-      Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, TCount, "nth_instance/3");
-    else
-      Yap_Error(DOMAIN_ERROR_NOT_ZERO, TCount, "nth_instance/3");
-    return FALSE;
-  }
-  if ((pe = find_lu_entry(Deref(ARG1))) != NULL) {
     return lu_nth_recorded(pe,Count PASS_REGS);
   }
   if (EndOfPAEntr(AtProp = FetchDBPropFromKey(Deref(ARG1), 0, FALSE, "nth_instance/3"))) {
+    UNLOCK(pe->PELock);
     return FALSE;
   }
-  return nth_recorded(AtProp,Count PASS_REGS);
+  return nth_recorded(AtProp, Count PASS_REGS);
-}
-
-static Int
-p_nth_instancep( USES_REGS1 )
-{
-  DBProp          AtProp;
-  Term            TCount;
-  Int             Count;
-  Term            t3 = Deref(ARG3);
-
-  if (!IsVarTerm(t3)) {
-    if (!IsDBRefTerm(t3)) {
-      Yap_Error(TYPE_ERROR_DBREF,t3,"nth_instance/3");
-      return FALSE;
-    } else {
-      DBRef ref = DBRefOfTerm(t3);
-      LOCK(ref->lock);
-      if (ref == NULL
-	  || DEAD_REF(ref)
-	  || !UnifyDBKey(ref,CodeDBBit,ARG1)
-	  || !UnifyDBNumber(ref,ARG2)) {
-	UNLOCK(ref->lock);
-	return
-	  FALSE;
-      } else {
-	UNLOCK(ref->lock);
-	return
-	  TRUE;
-      }
-    }
-  }
-  if (EndOfPAEntr(AtProp = FetchDBPropFromKey(Deref(ARG1), MkCode, FALSE, "nth_instance/3"))) {
-    return
-      FALSE;
-  }
-  TCount = Deref(ARG2);
-  if (IsVarTerm(TCount)) {
-    Yap_Error(INSTANTIATION_ERROR, TCount, "recorded_at/4");
-    return (FALSE);
-  }
-  if (!IsIntegerTerm(TCount)) {
-    Yap_Error(TYPE_ERROR_INTEGER, TCount, "recorded_at/4");
-    return (FALSE);
-  }
-  Count = IntegerOfTerm(TCount);
-  if (Count <= 0) {
-    if (Count) 
-      Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, TCount, "recorded_at/4");
-    else
-      Yap_Error(DOMAIN_ERROR_NOT_ZERO, TCount, "recorded_at/4");
-    return (FALSE);
-  }
-  return nth_recorded(AtProp,Count PASS_REGS);
 }
 
 static Int
@@ -4678,6 +4538,36 @@ static_instance(StaticClause *cl, PredEntry *ap USES_REGS)
   }
 }
 
+static Int
+exo_instance(Int i, PredEntry *ap USES_REGS)
+{
+  if (ap->ArityOfPE == 0) {
+    return Yap_unify(ARG2,MkAtomTerm((Atom)ap->FunctorOfPred));
+  } else {
+    MegaClause *mcl = ClauseCodeToMegaClause(ap->cs.p_code.FirstClause);
+    Functor f = ap->FunctorOfPred;
+    UInt arity = ArityOfFunctor(ap->FunctorOfPred);
+    Term t2 = Deref(ARG2);
+    CELL *ptr = (CELL *)((ADDR)mcl->ClCode+2*sizeof(struct index_t *)+i*(mcl->ClItemSize));
+    if (IsVarTerm(t2)) {
+      // fresh slate
+      t2 = Yap_MkApplTerm(f,arity,ptr);
+      Yap_unify(ARG2, t2);
+    } else if (!IsApplTerm(t2) || FunctorOfTerm(t2) != f) {
+      return FALSE;
+    }
+    for (i=0; i<arity; i++) {
+      XREGS[i+1] = ptr[i];
+    }
+    S = ptr;
+    CP = P;
+    YENV = ASP;
+    YENV[E_CB] = (CELL) B;
+    P = mcl->ClCode;
+    return TRUE;
+  }
+}
+
 static Int
 mega_instance(yamop *code, PredEntry *ap USES_REGS)
 {
@@ -4723,7 +4613,7 @@ p_instance( USES_REGS1 )
 	return mega_instance(Yap_MegaClauseFromTerm(t1), Yap_MegaClausePredicateFromTerm(t1) PASS_REGS);
       }
       if (FunctorOfTerm(t1) == FunctorExoClause) {
-	return Yap_unify(ARG2,ArgOfTerm(2,t1));
+	return exo_instance(Yap_ExoClauseFromTerm(t1), Yap_ExoClausePredicateFromTerm(t1) PASS_REGS);
       }
     }
     return FALSE;
@@ -4826,6 +4716,8 @@ p_instance( USES_REGS1 )
   }
 }
 
+
+
 Term
 Yap_LUInstance(LogUpdClause *cl, UInt arity)
 {
@@ -5617,8 +5509,6 @@ Yap_InitDBPreds(void)
   Yap_InitCPred("total_erased", 4, p_total_erased, SyncPredFlag);
   Yap_InitCPred("key_erased_statistics", 5, p_key_erased_statistics, SyncPredFlag);
   Yap_InitCPred("heap_space_info", 3, p_heap_space_info, SyncPredFlag);
-  Yap_InitCPred("$nth_instance", 3, p_nth_instance, SyncPredFlag);
-  Yap_InitCPred("$nth_instancep", 3, p_nth_instancep, SyncPredFlag);
   Yap_InitCPred("$jump_to_next_dynamic_clause", 0, p_jump_to_next_dynamic_clause, SyncPredFlag);
   Yap_InitCPred("$install_thread_local", 2, p_install_thread_local, SafePredFlag);
 }

C/errors.c

@@ -1866,6 +1866,20 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
       serious = TRUE;
     }
     break;
+  case TYPE_ERROR_REFERENCE:
+    {
+      int i;
+      Term ti[2];
+
+      i = strlen(tmpbuf);
+      ti[0] = MkAtomTerm(AtomDBReference);
+      ti[1] = where;
+      nt[0] = Yap_MkApplTerm(FunctorTypeError, 2, ti);
+      psize -= i;
+      fun = FunctorError;
+      serious = TRUE;
+    }
+    break;
   case TYPE_ERROR_STRING:
     {
       int i;

H/clause.h

@@ -281,6 +281,8 @@ void	Yap_ErCl(DynamicClause *);
 void	Yap_ErLogUpdCl(LogUpdClause *);
 void    Yap_ErLogUpdIndex(LogUpdIndex *);
 Int	Yap_Recordz(Atom, Term);
+Int     Yap_db_nth_recorded( PredEntry *, Int USES_REGS );
+Int     Yap_unify_immediate_ref(DBRef ref USES_REGS );
 
 /* exec.c */
 Term    Yap_cp_as_integer(choiceptr);
@@ -395,6 +397,32 @@ Yap_MegaClausePredicateFromTerm(Term t)
   return (PredEntry *)IntegerOfTerm(ArgOfTerm(1,t));
 }
 
+#define Yap_MkExoRefTerm(ap, i) __Yap_MkExoRefTerm((ap), (i) PASS_REGS)
+
+static inline Term 
+__Yap_MkExoRefTerm(PredEntry *ap,Int i USES_REGS)
+{
+  Term t[2];
+  t[0] = MkIntegerTerm((Int)ap);
+  t[1] = MkIntegerTerm((Int)i);
+  return Yap_MkApplTerm(FunctorExoClause,2,t);
+}
+
+static inline Int 
+Yap_ExoClauseFromTerm(Term t)
+{
+  return IntegerOfTerm(ArgOfTerm(2,t));
+}
+
+static inline PredEntry * 
+Yap_ExoClausePredicateFromTerm(Term t)
+{
+  return (PredEntry *)IntegerOfTerm(ArgOfTerm(1,t));
+}
+
+#define DEAD_REF(ref) FALSE
+
+
 typedef enum {
   FIND_PRED_FROM_ANYWHERE,
   FIND_PRED_FROM_CP,

include/YapError.h

@@ -115,6 +115,7 @@ typedef enum
   TYPE_ERROR_NUMBER,
   TYPE_ERROR_PREDICATE_INDICATOR,
   TYPE_ERROR_PTR,
+  TYPE_ERROR_REFERENCE,
   TYPE_ERROR_STRING,
   TYPE_ERROR_TEXT,
   TYPE_ERROR_UBYTE,

pl/preds.yap

@@ -355,47 +355,18 @@ clause(V,Q,R) :-
 
 :- '$init_preds'.
 
-nth_clause(V,I,R) :- var(V), var(R), !,
-	'$do_error'(instantiation_error,nth_clause(V,I,R)).
-nth_clause(M:V,I,R) :- !,
-	'$nth_clause'(V,M,I,R).
 nth_clause(V,I,R) :-
 	'$current_module'(M),
-	'$nth_clause'(V,M,I,R).
+	strip_module(M:V, M1, P), !,
+	'$nth_clause'(P, M1, I, R).
 
 
-'$nth_clause'(V,M,I,R) :- var(V), var(R), !, 
-	'$do_error'(instantiation_error,M:nth_clause(V,I,R)).
-'$nth_clause'(P1,_,I,R) :- nonvar(P1), P1 = M:P, !,
-	'$nth_clause'(P,M,I,R).
-'$nth_clause'(P,M,I,R) :- nonvar(R), !,
-	'$nth_clause_ref'(P,M,I,R).
-'$nth_clause'(C,M,I,R) :- number(C), !,
-	'$do_error'(type_error(callable,C),M:nth_clause(C,I,R)).
-'$nth_clause'(R,M,I,R) :- db_reference(R), !,
-	'$do_error'(type_error(callable,R),M:nth_clause(R,I,R)).
-'$nth_clause'(P,M,I,R) :- var(I), var(R), !,
-	'$number_of_clauses'(P,M,N), N > 0,
-	between(1, N, I),
-	'$nth_clause'(P,M,I,R).
 '$nth_clause'(P,M,I,R) :-
-	'$p_nth_clause'(P,M,I,R), !.
+	var(I), var(R), !,
+	'$clause'(P,M,_,R),
+	'$fetch_nth_clause'(P,M,I,R).
 '$nth_clause'(P,M,I,R) :-
-	'$is_dynamic'(P,M), !,
+	'$fetch_nth_clause'(P,M,I,R).
-	'$nth_instancep'(M:P,I,R).
-'$nth_clause'(P,M,I,R) :-
-	( '$system_predicate'(P,M) -> true ;
-	    '$number_of_clauses'(P,M,N), N > 0 ),
-	functor(P,Name,Arity),
-	'$do_error'(permission_error(access,private_procedure,Name/Arity),
-	      nth_clause(M:P,I,R)).
-
-'$nth_clause_ref'(Cl,M,I,R) :-
-	'$pred_for_code'(R, _, _, M1, I), I > 0, !,
-	instance(R, Cl),
-	M1 = M.
-'$nth_clause_ref'(P,M,I,R) :-
-	'$nth_instancep'(M:P,I,R).
 
 retract(M:C) :- !,
 	'$retract'(C,M).