fixes for indexing code.

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

C/absmi.c

@@ -10,8 +10,11 @@
 *									 *
 * File:		absmi.c							 *
 * comments:	Portable abstract machine interpreter                    *
-* Last rev:     $Date: 2006-10-25 02:31:07 $,$Author: vsc $						 *
+* Last rev:     $Date: 2006-11-15 00:13:36 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.210  2006/10/25 02:31:07  vsc
+* fix emulation of trust_logical
+*
 * Revision 1.209  2006/10/18 13:47:31  vsc
 * index.c implementation of trust_logical was decrementing the wrong
 * cp_tr
@@ -7975,6 +7978,8 @@ Yap_absmi(int inp)
 	    only increment time stamp if we are working on current time
 	    stamp
 	  */
+	  if (ap->TimeStampOfPred >= TIMESTAMP_RESET)
+	    Yap_UpdateTimestamps(ap);
 	  ap->TimeStampOfPred++;
 	  ap->LastCallOfPred = LUCALL_EXEC;
 	  /*	  fprintf(stderr,"R %x--%d--%ul\n",ap,ap->TimeStampOfPred,ap->ArityOfPE);*/

C/amasm.c

@@ -11,8 +11,11 @@
 * File:		amasm.c							 *
 * comments:	abstract machine assembler				 *
 *									 *
-* Last rev:     $Date: 2006-11-06 18:35:03 $							 *
+* Last rev:     $Date: 2006-11-15 00:13:36 $							 *
 * $Log: not supported by cvs2svn $
+* Revision 1.91  2006/11/06 18:35:03  vsc
+* 1estranha
+*
 * Revision 1.90  2006/10/11 14:53:57  vsc
 * fix memory leak
 * fix overflow handling
@@ -2661,12 +2664,14 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
 	cl_u->luc.ClSize = size;
 	/* Support for timestamps */
 	if (cip->CurrentPred->LastCallOfPred != LUCALL_ASSERT) {
+	  if (cip->CurrentPred->TimeStampOfPred >= TIMESTAMP_RESET)
+	    Yap_UpdateTimestamps(cip->CurrentPred);
 	  ++cip->CurrentPred->TimeStampOfPred;
 	  /* fprintf(stderr,"+ %x--%d--%ul\n",cip->CurrentPred,cip->CurrentPred->TimeStampOfPred,cip->CurrentPred->ArityOfPE);*/
 	  cip->CurrentPred->LastCallOfPred = LUCALL_ASSERT;
 	}
 	cl_u->luc.ClTimeStart = cip->CurrentPred->TimeStampOfPred;
-	cl_u->luc.ClTimeEnd = ~0L; 
+	cl_u->luc.ClTimeEnd = TIMESTAMP_EOT; 
 	if (*clause_has_blobsp) {
 	  cl_u->luc.ClFlags |= HasBlobsMask;
 	}

C/cdmgr.c

@@ -11,8 +11,11 @@
 * File:		cdmgr.c							 *
 * comments:	Code manager						 *
 *									 *
-* Last rev:     $Date: 2006-11-14 11:42:25 $,$Author: vsc $						 *
+* Last rev:     $Date: 2006-11-15 00:13:36 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.198  2006/11/14 11:42:25  vsc
+* fix bug in growstack
+*
 * Revision 1.197  2006/11/06 18:35:03  vsc
 * 1estranha
 *
@@ -5053,32 +5056,69 @@ p_continue_log_update_clause0(void)
   return fetch_next_lu_clause0(pe, ipc, Deref(ARG3), ARG4, B->cp_cp, FALSE);
 }
 
-#if TIMESTAMP_OVERFLOW
 static void
-adjust_cl_timestamp(LogUpdClause *cl, UInt *arp, UInt NStamps)
+adjust_cl_timestamp(LogUpdClause *cl, UInt *arp, UInt *base)
 {
-  UInt clstamp = cl->ClTimeStart;
+  UInt clstamp = cl->ClTimeEnd;
-  while (arp[0]);
+  if (cl->ClTimeEnd != TIMESTAMP_EOT) {
+    while (arp[0] > clstamp)
+      arp--;
+    if (arp[0] == clstamp) {
+      cl->ClTimeEnd = (arp-base);
+    } else {
+      cl->ClTimeEnd = (arp-base)+1;
+    }
+  }
+  clstamp = cl->ClTimeStart;
+  while (arp[0] > clstamp)
+    arp--;
+  if (arp[0] == clstamp) {
+    cl->ClTimeStart = (arp-base);
+  } else {
+    cl->ClTimeStart = (arp-base)+1;
+  }
   clstamp = cl->ClTimeEnd;
 }
 
+
+static Term
+replace_integer(Term orig, UInt new)
+{
+  CELL *pt;
+
+  if (IntInBnd((Int)new)) 
+    return MkIntTerm(new);
+  /* should create an old integer */
+  if (!IsApplTerm(orig)) {
+    Yap_Error(SYSTEM_ERROR,orig,"%uld-->%uld  where it should increase",(unsigned long int)IntegerOfTerm(orig),(unsigned long int)new);
+    return MkIntegerTerm(new);
+  }
+  /* appl->appl */
+  /* replace integer in situ */
+  pt = RepAppl(orig)+1;
+  *pt = new;
+  return orig;
+}
+
 void			/* $hidden_predicate(P) */
-Yap_update_timestamps(PredEntry *ap, UInt arity)
+Yap_UpdateTimestamps(PredEntry *ap)
 {
   choiceptr bptr = B;
   yamop *cl0 = NEXTOP(PredLogUpdClause0->CodeOfPred,ld);
   yamop *cl = NEXTOP(PredLogUpdClause->CodeOfPred,ld);
   UInt ar = ap->ArityOfPE;
-  UInt *arp = ASP;
+  UInt *arp, *top, *base;
-  UInt nstamps;
+  LogUpdClause *lcl;
-  LogUpdClause *cl;
 
 #if THREADS
-  YAP_Error(SYSTEM_ERROR,TermNil,"Timestamp overflow %p", ap);
+  Yap_Error(SYSTEM_ERROR,TermNil,"Timestamp overflow %p", ap);
+  return;
 #endif
-  if (ap->cs.p_code.NOfClauses < 2)
+  if (!ap->cs.p_code.NOfClauses)
     return;
  restart:
+  *--ASP = TIMESTAMP_EOT;
+  top = arp = (UInt *)ASP;
   while (bptr) {
     op_numbers opnum = Yap_op_from_opcode(bptr->cp_ap->opc);
 
@@ -5095,43 +5135,96 @@ Yap_update_timestamps(PredEntry *ap, UInt arity)
 	  if (arp-H < 1024) {
 	    goto overflow;
 	  }
+	  /* be thrifty, have this in case there is a hole */
+	  if (ts != arp[0]-1) {
+	    UInt x = arp[0];
+	    *--arp = x;
+	  }
 	  *--arp = ts;
 	}
       }
+      bptr = bptr->cp_b;
       break;
     case _retry:
       if ((bptr->cp_ap == cl0 || bptr->cp_ap == cl) &&
-	  ((PredEntry *)IntegerOfTerm((bptr+1)->cp_args[0]) == ap)) {
+	  ((PredEntry *)IntegerOfTerm(bptr->cp_args[0]) == ap)) {
 	UInt ts = IntegerOfTerm(bptr->cp_args[5]);
 	if (ts != arp[0]) {
 	  if (arp-H < 1024) {
 	    goto overflow;
 	  }
+	  if (ts != arp[0]-1) {
+	    UInt x = arp[0];
+	    *--arp = x;
+	  }
 	  *--arp = ts;
 	}
       }
+      bptr = bptr->cp_b;
       break;
     default:
+      bptr = bptr->cp_b;
       continue;
     }
   }
-  NStamps = (ASP-arp);
+  if (*arp)
-  cl = ClauseCodeToLogUpdClause(ap->cs.p_code.FirstClause);
+    *--arp = 0L;
-  while (cl) {
+  base = arp;
-    adjust_cl_timestamp(cl, arp, NStamps);
+  lcl = ClauseCodeToLogUpdClause(ap->cs.p_code.FirstClause);
-    cl = cl->ClNext;
+  while (lcl) {
+    adjust_cl_timestamp(lcl, top-1, base);
+    lcl = lcl->ClNext;
+  }
+  lcl = DBErasedList;
+  while (lcl) {
+    if (lcl->ClPred == ap)
+      adjust_cl_timestamp(lcl, top-1, base);
+    lcl = lcl->ClNext;
+  }
+  arp = top-1;
+  bptr = B;
+  while (bptr) {
+    op_numbers opnum = Yap_op_from_opcode(bptr->cp_ap->opc);
+
+    switch (opnum) {
+    case _retry_logical:
+    case _count_retry_logical:
+    case _profiled_retry_logical:
+    case _trust_logical:
+    case _count_trust_logical:
+    case _profiled_trust_logical:
+      if (bptr->cp_ap->u.lld.d->ClPred == ap) {
+	UInt ts = IntegerOfTerm(bptr->cp_args[ar]);
+	while (ts != arp[0])
+	  arp--;
+	bptr->cp_args[ar] = replace_integer(bptr->cp_args[ar], arp-base);
+      }
+      bptr = bptr->cp_b;
+      break;
+    case _retry:
+      if ((bptr->cp_ap == cl0 || bptr->cp_ap == cl) &&
+	  ((PredEntry *)IntegerOfTerm(bptr->cp_args[0]) == ap)) {
+	UInt ts = IntegerOfTerm(bptr->cp_args[5]);
+	while (ts != arp[0])
+	  arp--;
+	bptr->cp_args[5] = replace_integer(bptr->cp_args[5], arp-base);
+      }
+      bptr = bptr->cp_b;
+      break;
+    default:
+      bptr = bptr->cp_b;
+      continue;
+    }
   }
   return;
  overflow:
-  if (!Yap_gc(arity, ENV, P)) {
+  if (!Yap_growstack(64*1024)) {
     Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
     return;
   }
   goto restart;
 }
 
-#endif
-
 static Int
 fetch_next_static_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr, yamop *cp_ptr, int first_time)
 {
@@ -5500,7 +5593,6 @@ p_static_pred_statistics(void)
   return static_statistics(pe);
 }
 
-#ifdef DEBUG
 static Int
 p_predicate_erased_statistics(void)
 {
@@ -5545,6 +5637,7 @@ p_predicate_erased_statistics(void)
     Yap_unify(ARG5,MkIntegerTerm(isz));
 }
 
+#ifdef DEBUG
 static Int
 p_predicate_lu_cps(void)
 {
@@ -5810,9 +5903,9 @@ Yap_InitCdMgr(void)
   Yap_InitCPred("$program_continuation", 3, p_program_continuation, SafePredFlag|SyncPredFlag|HiddenPredFlag);
   Yap_InitCPred("$all_choicepoints", 1, p_all_choicepoints, HiddenPredFlag);
   Yap_InitCPred("$choicepoint_info", 5, p_choicepoint_info, HiddenPredFlag);
+  Yap_InitCPred("$predicate_erased_statistics", 5, p_predicate_erased_statistics, SyncPredFlag);
 #ifdef DEBUG
-  Yap_InitCPred("predicate_erased_statistics", 5, p_predicate_erased_statistics, SyncPredFlag);
+  Yap_InitCPred("$predicate_live_cps", 4, p_predicate_lu_cps, 0L);
-  Yap_InitCPred("predicate_live_cps", 4, p_predicate_lu_cps, 0L);
 #endif
 }
 

C/dbase.c

@@ -1826,6 +1826,8 @@ new_lu_db_entry(Term t, PredEntry *pe)
   cl->ClSize = dbg.sz;
   /* Support for timestamps */
   if (pe && pe->LastCallOfPred != LUCALL_ASSERT) {
+    if (pe->TimeStampOfPred >= TIMESTAMP_RESET)
+      Yap_UpdateTimestamps(pe);
     ++pe->TimeStampOfPred;
     /*  fprintf(stderr,"+ %x--%d--%ul\n",pe,pe->TimeStampOfPred,pe->ArityOfPE);*/
     pe->LastCallOfPred = LUCALL_ASSERT;
@@ -1833,7 +1835,7 @@ new_lu_db_entry(Term t, PredEntry *pe)
   } else {
     cl->ClTimeStart = 0L;
   }
-  cl->ClTimeEnd = ~0L; 
+  cl->ClTimeEnd = TIMESTAMP_EOT; 
 #if defined(YAPOR) || defined(THREADS)
   INIT_LOCK(cl->ClLock);
   INIT_CLREF_COUNT(cl);
@@ -3788,7 +3790,6 @@ p_lu_statistics(void)
 }
 
 
-#ifdef DEBUG
 static Int
 p_total_erased(void)
 {
@@ -3865,7 +3866,6 @@ p_heap_space_info(void)
     Yap_unify(ARG3,MkIntegerTerm(Yap_expand_clauses_sz));
 }
 
-#endif
 
 
 /*
@@ -4004,7 +4004,6 @@ complete_lu_erase(LogUpdClause *clau)
       clau->ClExt->u.EC.ClRefs > 0) {
     return;
   }
-#ifdef DEBUG
 #ifndef THREADS
   if (clau->ClNext)
     clau->ClNext->ClPrev = clau->ClPrev;
@@ -4013,7 +4012,6 @@ complete_lu_erase(LogUpdClause *clau)
   } else {
     DBErasedList = clau->ClNext;
   }
-#endif
 #endif
   if (cp != NULL) {
     DBRef ref;
@@ -4099,7 +4097,6 @@ EraseLogUpdCl(LogUpdClause *clau)
       ap->cs.p_code.NOfClauses--;
     }
     clau->ClFlags |= ErasedMask;
-#ifdef DEBUG
 #ifndef THREADS
     {
       LogUpdClause *er_head = DBErasedList;
@@ -4112,7 +4109,6 @@ EraseLogUpdCl(LogUpdClause *clau)
       }
       DBErasedList = clau;
     }
-#endif
 #endif
     /* we are holding a reference to the clause */
     clau->ClRefCount++;
@@ -4120,6 +4116,8 @@ EraseLogUpdCl(LogUpdClause *clau)
       /* mark it as erased */
       if (ap->LastCallOfPred != LUCALL_RETRACT) {
 	if (ap->cs.p_code.NOfClauses > 1) {
+	  if (ap->TimeStampOfPred >= TIMESTAMP_RESET)
+	    Yap_UpdateTimestamps(ap);
 	  ++ap->TimeStampOfPred;
 	  /*	  fprintf(stderr,"- %x--%d--%ul\n",ap,ap->TimeStampOfPred,ap->ArityOfPE);*/
 	  ap->LastCallOfPred = LUCALL_RETRACT;
@@ -5299,11 +5297,9 @@ Yap_InitDBPreds(void)
   Yap_InitCPred("$resize_int_keys", 1, p_resize_int_keys, SafePredFlag|SyncPredFlag|HiddenPredFlag);
   Yap_InitCPred("key_statistics", 4, p_key_statistics, SyncPredFlag);
   Yap_InitCPred("$lu_statistics", 5, p_lu_statistics, SyncPredFlag);
-#ifdef DEBUG
   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);
-#endif
   Yap_InitCPred("$nth_instance", 3, p_nth_instance, SyncPredFlag);
   Yap_InitCPred("$nth_instancep", 3, p_nth_instancep, SyncPredFlag|HiddenPredFlag);
   Yap_InitCPred("$jump_to_next_dynamic_clause", 0, p_jump_to_next_dynamic_clause, SyncPredFlag|HiddenPredFlag);

C/index.c

@@ -11,8 +11,11 @@
 * File:		index.c							 *
 * comments:	Indexing a Prolog predicate				 *
 *									 *
-* Last rev:     $Date: 2006-11-08 01:53:08 $,$Author: vsc $						 *
+* Last rev:     $Date: 2006-11-15 00:13:36 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.176  2006/11/08 01:53:08  vsc
+* avoid generating suspensions on static code.
+*
 * Revision 1.175  2006/11/06 18:35:04  vsc
 * 1estranha
 *
@@ -3669,11 +3672,6 @@ do_var_clauses(ClauseDef *c0, ClauseDef *cf, int var_group, struct intermediates
     else
       ncls = 0;
     Yap_emit_3ops(enter_lu_op, labl_dyn0, labl_dynf, ncls, cint);
-    /* get some placeholders */
-    Yap_emit(jump_op, labl_dyn0, Zero, cint);
-    Yap_emit(jump_op, labl_dyn0, Zero, cint);
-    Yap_emit(jump_op, labl_dyn0, Zero, cint);
-    Yap_emit(jump_op, labl_dyn0, Zero, cint);
     Yap_emit(label_op, labl_dyn0, Zero, cint); 
   }
   if (c0 == cf) {
@@ -3693,11 +3691,6 @@ do_var_clauses(ClauseDef *c0, ClauseDef *cf, int var_group, struct intermediates
       if (!clleft && 
 	  cint->CurrentPred->PredFlags & LogUpdatePredFlag) {
 	Yap_emit(label_op, labl_dynf, Zero, cint); 
-	/* get some placeholders */
-	Yap_emit(jump_op, labl_dynf, Zero, cint);
-	Yap_emit(jump_op, labl_dynf, Zero, cint);
-	Yap_emit(jump_op, labl_dynf, Zero, cint);
-	Yap_emit(jump_op, labl_dynf, Zero, cint);
       }
     }
   }
@@ -7865,6 +7858,8 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y
 	    only increment time stamp if we are working on current time
 	    stamp
 	  */
+	  if (ap->TimeStampOfPred >= TIMESTAMP_RESET)
+	    Yap_UpdateTimestamps(ap);
 	  ap->TimeStampOfPred++;
 	  /*	  fprintf(stderr,"R %x--%d--%ul\n",ap,ap->TimeStampOfPred,ap->ArityOfPE);*/
 	  ap->LastCallOfPred = LUCALL_EXEC;

H/Yatom.h

@@ -609,6 +609,9 @@ typedef enum {
   LUCALL_RETRACT
 } timestamp_type;
 
+#define TIMESTAMP_EOT   ((UInt)(~0L))
+#define TIMESTAMP_RESET (TIMESTAMP_EOT-1024)
+
 typedef struct pred_entry
 {
   Prop NextOfPE;		/* used to chain properties             */
@@ -1193,6 +1196,7 @@ IsArrayProperty (int flags)
 
 /* cdmgr.c */
 int STD_PROTO (Yap_RemoveIndexation, (PredEntry *));
+void STD_PROTO (Yap_UpdateTimestamps, (PredEntry *));
 
 /* dbase.c */
 void STD_PROTO (Yap_ErDBE, (DBRef));

changes-5.1.html

@@ -16,6 +16,7 @@
 
 <h2>Yap-5.1.2:</h2>
 <ul>
+<li> FIXED:  allow overflows on timestamps.</li> 
 <li> FIXED:  more fixes for new dynamic code and stack shifting.</li> 
 <li> FIXED:  if we can generate index on an sub-argument and the
 argument is unbound we should generate the code, suspend

pl/init.yap

@@ -135,4 +135,3 @@ file_search_path(system, Dir) :-
 
 :- dynamic library_directory/1.
 
-:- yap_flag(index,single).