fix memory leak

fix overflow handling
VS: ----------------------------------------------------------------------


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

C/absmi.c

@@ -10,8 +10,12 @@
 *									 *
 * File:		absmi.c							 *
 * comments:	Portable abstract machine interpreter                    *
-* Last rev:     $Date: 2006-10-10 20:21:42 $,$Author: vsc $						 *
+* Last rev:     $Date: 2006-10-11 14:53:57 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.207  2006/10/10 20:21:42  vsc
+* fix new indexing code to actually recover space
+* fix predicate info to work for LUs
+*
 * Revision 1.206  2006/10/10 14:08:15  vsc
 * small fixes on threaded implementation.
 *
@@ -2070,13 +2074,16 @@ Yap_absmi(int inp)
 		LOCK(cl->ClLock);
 		DEC_CLREF_COUNT(cl);
 		cl->ClFlags &= ~InUseMask;
-		erase = (cl->ClFlags & ErasedMask) && !(cl->ClRefCount);
+		erase = (cl->ClFlags & (ErasedMask|DirtyMask)) && !(cl->ClRefCount);
 		UNLOCK(cl->ClLock);
 		if (erase) {
 		  /* at this point, we are the only ones accessing the clause,
 		     hence we don't need to have a lock it */
 		  saveregs();
-		  Yap_ErLogUpdIndex(cl);
+		  if (cl->ClFlags & ErasedMask) 
+		    Yap_ErLogUpdIndex(cl);
+		  else
+		    Yap_CleanUpIndex(cl);
 		  setregs();
 		}
 	      } else {

C/amasm.c

@@ -11,8 +11,11 @@
 * File:		amasm.c							 *
 * comments:	abstract machine assembler				 *
 *									 *
-* Last rev:     $Date: 2006-10-10 14:08:16 $							 *
+* Last rev:     $Date: 2006-10-11 14:53:57 $							 *
 * $Log: not supported by cvs2svn $
+* Revision 1.89  2006/10/10 14:08:16  vsc
+* small fixes on threaded implementation.
+*
 * Revision 1.88  2006/09/20 20:03:51  vsc
 * improve indexing on floats
 * fix sending large lists to DB
@@ -1687,6 +1690,10 @@ a_try(op_numbers opcode, CELL lab, CELL opr, int nofalts, int hascut, yamop *cod
 	save_machine_regs();
 	longjmp(cip->CompilerBotch,2);
       }
+#ifdef DEBUG
+      Yap_NewCps++;
+      Yap_LiveCps++;
+#endif
       if (opcode == try_op) {
 	/*
 	  use the last n field to keep a chain with all 

C/cdmgr.c

@@ -11,8 +11,11 @@
 * File:		cdmgr.c							 *
 * comments:	Code manager						 *
 *									 *
-* Last rev:     $Date: 2006-10-10 14:08:16 $,$Author: vsc $						 *
+* Last rev:     $Date: 2006-10-11 14:53:57 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.192  2006/10/10 14:08:16  vsc
+* small fixes on threaded implementation.
+*
 * Revision 1.191  2006/09/20 20:03:51  vsc
 * improve indexing on floats
 * fix sending large lists to DB
@@ -873,7 +876,7 @@ cleanup_dangling_indices(yamop *ipc, yamop *beg, yamop *end, yamop *suspend_code
 {
   OPCODE ecs = Yap_opcode(_expand_clauses);
 
-  while (ipc < end) {
+  while (ipc) {
     op_numbers op = Yap_op_from_opcode(ipc->opc);
     /* printf("op: %d %p->%p\n", op, ipc, end); */
     switch(op) {
@@ -929,18 +932,32 @@ cleanup_dangling_indices(yamop *ipc, yamop *beg, yamop *end, yamop *suspend_code
 	decrease_ref_counter(ipc->u.lld.d->ClCode, beg, end, suspend_code);
 	ipc = ipc->u.lld.n;
 	Yap_FreeCodeSpace((ADDR)oipc);
+#ifdef DEBUG
+	Yap_DirtyCps--;
+	Yap_FreedCps++;
+#endif
       }
+      end = ipc;
       break;
     case _trust_logical:
     case _count_trust_logical:
     case _profiled_trust_logical:
+#ifdef DEBUG
+      Yap_DirtyCps--;
+      Yap_FreedCps++;
+#endif
       decrease_ref_counter(ipc->u.lld.d->ClCode, beg, end, suspend_code);
       Yap_FreeCodeSpace((ADDR)ipc);
       return;
     case _enter_lu_pred:
       if (ipc->u.Ill.I->ClFlags & InUseMask)
 	return;
+#ifdef DEBUG
+      Yap_DirtyCps+=ipc->u.Ill.s;
+      Yap_LiveCps-=ipc->u.Ill.s;
+#endif
       ipc = ipc->u.Ill.l1;
+      end = ipc;
       break;
     case _try_in:
     case _jump:
@@ -1029,7 +1046,7 @@ decrease_log_indices(LogUpdIndex *c, yamop *suspend_code)
     return;
   }
   op = Yap_op_from_opcode(beg->opc);
-    end = (yamop *)((CODEADDR)c+c->ClSize);
+  end = (yamop *)((CODEADDR)c+c->ClSize);
   ipc = beg;
   cleanup_dangling_indices(ipc, beg, end, suspend_code);
 }
@@ -3707,7 +3724,7 @@ ClauseInfoForCode(yamop *codeptr, CODEADDR *startp, CODEADDR *endp) {
       pc = pc->u.lld.n;
       break;
     case _enter_lu_pred:
-      pc = pc->u.Ill.l2;
+      pc = pc->u.Ill.l1;
       break;
       /* instructions type p */
     case _count_call:
@@ -4985,6 +5002,82 @@ p_continue_log_update_clause0(void)
   return fetch_next_lu_clause0(pe, ipc, Deref(ARG3), ARG4, B->cp_cp, FALSE);
 }
 
+static void
+adjust_cl_timestamp(LogUpdClause *cl, UInt *arp, UInt NStamps)
+{
+  UInt clstamp = cl->ClTimeStart;
+  while (arp[0]);
+  clstamp = cl->ClTimeEnd;
+}
+
+void			/* $hidden_predicate(P) */
+Yap_update_timestamps(PredEntry *ap, UInt arity)
+{
+  choiceptr bptr = B;
+  yamop *cl0 = NEXTOP(PredLogUpdClause0->CodeOfPred,ld);
+  yamop *cl = NEXTOP(PredLogUpdClause->CodeOfPred,ld);
+  UInt ar = ap->ArityOfPE;
+  UInt *arp = ASP;
+  UInt nstamps;
+  LogUpdClause *cl;
+
+#if THREADS
+  YAP_Error(SYSTEM_ERROR,TermNil,"Timestamp overflow %p", ap);
+#endif
+  if (ap->cs.p_code.NOfClauses < 2)
+    return;
+ restart:
+  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]);
+	if (ts != arp[0]) {
+	  if (arp-H < 1024) {
+	    goto overflow;
+	  }
+	  *--arp = ts;
+	}
+      }
+      break;
+    case _retry:
+      if ((bptr->cp_ap == cl0 || bptr->cp_ap == cl) &&
+	  ((PredEntry *)IntegerOfTerm((bptr+1)->cp_args[0]) == ap)) {
+	UInt ts = IntegerOfTerm(bptr->cp_args[5]);
+	if (ts != arp[0]) {
+	  if (arp-H < 1024) {
+	    goto overflow;
+	  }
+	  *--arp = ts;
+	}
+      }
+      break;
+    default:
+      continue;
+    }
+  }
+  NStamps = (ASP-arp);
+  cl = ClauseCodeToLogUpdClause(ap->cs.p_code.FirstClause);
+  while (cl) {
+    adjust_cl_timestamp(cl, arp, NStamps);
+    cl = cl->ClNext;
+  }
+  return;
+ overflow:
+  if (!Yap_gc(arity, ENV, P)) {
+    Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
+    return;
+  }
+  goto restart;
+}
+
 static Int
 fetch_next_static_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr, yamop *cp_ptr, int first_time)
 {
@@ -5397,6 +5490,15 @@ p_predicate_erased_statistics(void)
     Yap_unify(ARG4,MkIntegerTerm(icls)) &&
     Yap_unify(ARG5,MkIntegerTerm(isz));
 }
+
+static Int
+p_predicate_lu_cps(void)
+{
+  return Yap_unify(ARG1, MkIntegerTerm(Yap_LiveCps)) &&
+    Yap_unify(ARG2, MkIntegerTerm(Yap_FreedCps)) &&
+    Yap_unify(ARG3, MkIntegerTerm(Yap_DirtyCps)) &&
+    Yap_unify(ARG4, MkIntegerTerm(Yap_NewCps));
+}
 #endif
 
 static Int
@@ -5656,6 +5758,7 @@ Yap_InitCdMgr(void)
   Yap_InitCPred("$choicepoint_info", 5, p_choicepoint_info, HiddenPredFlag);
 #ifdef DEBUG
   Yap_InitCPred("predicate_erased_statistics", 5, p_predicate_erased_statistics, SyncPredFlag);
+  Yap_InitCPred("predicate_live_cps", 4, p_predicate_lu_cps, 0L);
 #endif
 }
 

C/dbase.c

@@ -1417,6 +1417,12 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat, UInt extra_size, struc
 	return NULL;
     }
     ntp0 = ppt0->Contents;
+    if ((ADDR)TR >= Yap_TrailTop-1024) {
+	Yap_Error_Size = 0;
+	Yap_Error_TYPE = OUT_OF_TRAIL_ERROR;
+	Yap_ReleasePreAllocCodeSpace((ADDR)pp0);
+	return NULL;
+    }
     dbg->lr = dbg->LinkAr = (link_entry *)TR;
 #ifdef COROUTINING
     /* attachment */ 
@@ -3636,6 +3642,7 @@ index_sz(LogUpdIndex *x)
   if (op == _enter_lu_pred) {
     PredEntry *ap = x->ClPred;
     OPCODE endop, op1;
+    UInt count = 0, count0 = start->u.Ill.s, dead=0;
 
     if (ap->PredFlags & CountPredFlag)
       endop = Yap_opcode(_count_trust_logical);
@@ -3647,8 +3654,17 @@ index_sz(LogUpdIndex *x)
     do {
       sz += (UInt)NEXTOP((yamop*)NULL,lld);
       op1 = start->opc;
+      count++;
+      if (start->u.lld.d->ClFlags & ErasedMask)
+	dead++;
       start = start->u.lld.n;
     } while (op1 != endop);
+    if (x->ClFlags & InUseMask)
+      fprintf(stderr,"Inuse -- %p(%p)\n",ap,x);
+    if (x->ClFlags & DirtyMask)
+      fprintf(stderr,"Dirty -- %p(%p)\n",ap,x);
+    if (count > 200)
+      fprintf(stderr,"%d/%d/%d -- %p(%p)\n",count,count0,dead,ap,x);
   }
   x = x->ChildIndex;
   while (x != NULL) {

C/index.c

@@ -11,8 +11,11 @@
 * File:		index.c							 *
 * comments:	Indexing a Prolog predicate				 *
 *									 *
-* Last rev:     $Date: 2006-10-10 14:08:16 $,$Author: vsc $						 *
+* Last rev:     $Date: 2006-10-11 14:53:57 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.170  2006/10/10 14:08:16  vsc
+* small fixes on threaded implementation.
+*
 * Revision 1.169  2006/09/20 20:03:51  vsc
 * improve indexing on floats
 * fix sending large lists to DB
@@ -6153,6 +6156,10 @@ remove_clause_from_index(yamop **prevp, yamop *curp, LogUpdClause *cl)
     ocurp->u.lld.n = curp->u.lld.n;
     ocurp->u.lld.t.block = curp->u.lld.t.block;
   }
+#ifdef DEBUG
+  Yap_DirtyCps--;
+  Yap_FreedCps++;
+#endif
   clean_ref_to_clause(cl);
   Yap_FreeCodeSpace((ADDR)curp);
 }
@@ -6173,6 +6180,10 @@ remove_dirty_clauses_from_index(yamop **prevp, yamop *curp)
   while ((cl = curp->u.lld.d)->ClFlags & ErasedMask) {
     yamop *ocurp = curp;
 
+#ifdef DEBUG
+    Yap_DirtyCps--;
+    Yap_FreedCps++;
+#endif
     clean_ref_to_clause(cl);
     curp = curp->u.lld.n;
     Yap_FreeCodeSpace((ADDR)ocurp);
@@ -6187,6 +6198,10 @@ remove_dirty_clauses_from_index(yamop **prevp, yamop *curp)
     if ((cl = curp->u.lld.d)->ClFlags & ErasedMask) {
       yamop *ocurp = curp;
 
+#ifdef DEBUG
+      Yap_DirtyCps--;
+      Yap_FreedCps++;
+#endif
       clean_ref_to_clause(cl);
       if (curp->opc == endop) {
 	previouscurp->opc = endop;
@@ -6510,6 +6525,10 @@ add_try(PredEntry *ap, ClauseDef *cls, yamop *next, struct intermediates *cint)
     save_machine_regs();
     longjmp(cint->CompilerBotch,2);
   }
+#ifdef DEBUG
+  Yap_NewCps++;
+  Yap_LiveCps++;
+#endif
   newcp->opc = Yap_opcode(_try_logical);
   newcp->u.lld.t.s = ap->ArityOfPE;
   newcp->u.lld.n = next;
@@ -6531,6 +6550,10 @@ add_trust(LogUpdIndex *icl, ClauseDef *cls, struct intermediates *cint)
     save_machine_regs();
     longjmp(cint->CompilerBotch,2);
   }
+#ifdef DEBUG
+  Yap_NewCps++;
+  Yap_LiveCps++;
+#endif
   if (ap->PredFlags & CountPredFlag)
     newcp->opc = Yap_opcode(_count_trust_logical);
   else if (ap->PredFlags & ProfiledPredFlag)
@@ -7172,6 +7195,10 @@ remove_from_index(PredEntry *ap, path_stack_entry *sp, ClauseDef *cls, yamop *bg
       break;
     case _enter_lu_pred:
       ipc->u.Ill.s--;
+#ifdef DEBUG
+      Yap_DirtyCps++;
+      Yap_LiveCps--;
+#endif
       sp = kill_clause(ipc, bg, lt, sp, ap);
       ipc = pop_path(&sp, cls, ap);
       break;

C/init.c

@@ -1021,6 +1021,12 @@ InitCodes(void)
     pred = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, 1),0));
     Yap_heap_regs->spy_code = pred;
   }
+#if DEBUG
+  Yap_heap_regs->new_cps = 0;
+  Yap_heap_regs->live_cps = 0;
+  Yap_heap_regs->dirty_cps = 0;
+  Yap_heap_regs->freed_cps = 0;
+#endif
   Yap_heap_regs->system_profiling = FALSE;
   Yap_heap_regs->system_call_counting = FALSE;
   Yap_heap_regs->system_pred_goal_expansion_all = FALSE;

H/Heap.h

@@ -10,7 +10,7 @@
 * File:		Heap.h         						 *
 * mods:									 *
 * comments:	Heap Init Structure					 *
-* version:      $Id: Heap.h,v 1.106 2006-10-10 14:08:17 vsc Exp $	 *
+* version:      $Id: Heap.h,v 1.107 2006-10-11 14:53:57 vsc Exp $	 *
 *************************************************************************/
 
 /* information that can be stored in Code Space */
@@ -288,6 +288,9 @@ typedef struct various_codes {
   struct pred_entry  *creep_code;
   struct pred_entry  *undef_code;
   struct pred_entry  *spy_code;
+#if DEBUG
+  UInt new_cps, live_cps, dirty_cps, freed_cps;
+#endif
   int   system_profiling;
   int   system_call_counting;
   int   system_pred_goal_expansion_all;
@@ -926,6 +929,12 @@ struct various_codes *Yap_heap_regs;
 #define  CreepCode                Yap_heap_regs->creep_code
 #define  UndefCode                Yap_heap_regs->undef_code
 #define  SpyCode                  Yap_heap_regs->spy_code
+#ifdef DEBUG
+#define  Yap_NewCps		  Yap_heap_regs->new_cps
+#define  Yap_LiveCps		  Yap_heap_regs->live_cps
+#define  Yap_DirtyCps		  Yap_heap_regs->dirty_cps
+#define  Yap_FreedCps		  Yap_heap_regs->freed_cps
+#endif
 #if defined(YAPOR) || defined(TABLING)
 #define  GLOBAL		          Yap_heap_regs->global
 #define  REMOTE                   Yap_heap_regs->remote