make gc much more aggressive at recovering db space.

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

C/absmi.c

@@ -985,82 +985,22 @@ absmi(int inp)
 	UNLOCK(cl->ClLock);
       }
 #else
-      if (PREG->u.EC.ClENV == 0) {
+      {
 	Clause *cl = (Clause *)PREG->u.EC.ClBase;
+	if (!(cl->ClFlags |= InUseMask)) {
+	  /* Clause *cl = (Clause *)PREG->u.EC.ClBase;
 
-	/* marking a new clause */
+	  PREG->u.EC.ClTrail = TR-(tr_fr_ptr)TrailBase;
-	PREG->u.EC.ClTrail = TR-(tr_fr_ptr)TrailBase;
+	  PREG->u.EC.ClENV = LCL0-YENV;*/
-	PREG->u.EC.ClENV = LCL0-YENV;
+	  cl->ClFlags |= InUseMask;
-	cl->ClFlags |= InUseMask;
+	  TRAIL_CLREF(cl);
-	TRAIL_CLREF(cl);
+	}
       }
 #endif
       PREG = NEXTOP(PREG, EC);
       GONext();
       ENDBOp();
 
-      /* exit logical pred               */
-      BOp(dealloc_for_logical_pred, l);
-      {
-	yamop *ecl = (yamop *)PREG->u.l.l;
-	PREG = NEXTOP(PREG, l);
-	/* check first if environment is protected */
-	BEGP(pt0);
-	pt0 = (CELL *) YENV;
-#ifdef FROZEN_STACKS
-	{ 
-	  choiceptr top_b = PROTECT_FROZEN_B(B);
-
-#ifdef SBA
-	  if (pt0 > (CELL *) top_b || pt0 < H) {
-	    GONext();
-	  }
-#else
-	  if (pt0 > (CELL *) top_b) {
-	    GONext();
-	  }
-#endif
-	}
-#else
-	if (pt0 > (CELL *)B) {
-	  GONext();
-	}
-#endif /* FROZEN_STACKS */
-	ENDP(pt0);
-#if defined(YAPOR) || defined(THREADS)
-	{
-	  Clause *cl = (Clause *)(ecl->u.EC.ClBase);
-	  Term tc = AbsPair(((CELL *)&(cl->ClFlags)));
-
-	  /* Question: how do we find the trail cell we want to reset? */
-	  /* Quick hack: search for it */
-	  tr_fr_ptr trp = (((choiceptr) YENV[E_CB])->cp_tr);
-	  while (TrailTerm(trp) != tc) {
-	    trp++;
-	  }
-	  /* the correct solution would be to store this in the environment */
-	  RESET_VARIABLE(&TrailTerm(trp));
-	  LOCK(cl->ClLock);
-	  DEC_CLREF_COUNT(cl);
-	  UNLOCK(cl->ClLock);
-	}
-#else
-	if (ecl->u.EC.ClENV == LCL0-YENV) {
-	  Clause *cl = (Clause *)(ecl->u.EC.ClBase);
-	  /* if the environment is protected we can't do nothing */
-	  /* unmark the clause */
-	  cl->ClFlags &= ~InUseMask;
-	  ecl->u.EC.ClENV = 0;
-	  RESET_VARIABLE((CELL *)((tr_fr_ptr)TrailBase+ecl->u.EC.ClTrail));
-	  if ((cl->ClFlags & ErasedMask) && (ecl->u.EC.ClRefs == 0)) {
-	    ErCl(cl);
-	  }
-	}
-#endif
-      }
-      GONext();
-      ENDBOp();
-
 /*****************************************************************
 *        try and retry of dynamic predicates                     *
 *****************************************************************/

C/amasm.c

@@ -45,7 +45,6 @@ STATIC_PROTO(COUNT emit_count, (CELL));
 STATIC_PROTO(OPCODE emit_op, (op_numbers));
 STATIC_PROTO(void a_cl, (op_numbers));
 STATIC_PROTO(void a_cle, (op_numbers));
-STATIC_PROTO(void a_cld, (op_numbers));
 STATIC_PROTO(void a_e, (op_numbers));
 STATIC_PROTO(void a_ue, (op_numbers, op_numbers));
 STATIC_PROTO(void a_v, (op_numbers));
@@ -347,16 +346,6 @@ a_cle(op_numbers opcode)
   GONEXT(EC);
 }
 
-static void
-a_cld(op_numbers opcode)
-{
-  if (pass_no) {
-    code_p->opc = emit_op(opcode);
-    code_p->u.l.l = (CODEADDR)(((Clause *)code_addr)->u2.ClExt);
-  }
-  GONEXT(l);
-}
-
 inline static void
 a_e(op_numbers opcode)
 {
@@ -1404,8 +1393,6 @@ a_deallocate(void)
       a_cle(_alloc_for_logical_pred);
     a_e(_allocate);
   }
-  if (CurrentPred->PredFlags & LogUpdatePredFlag)
-    a_cld(_dealloc_for_logical_pred);
   if (NEXTOPC == execute_op) {
     cpc = cpc->nextInst;
     a_p(_dexecute);

C/dbase.c

@@ -1225,6 +1225,7 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag)
     pp->Entry = (CELL) Tm;
     pp->Code = NULL;
     pp->DBRefs = NULL;
+    pp->NOfCells = 1;
     INIT_LOCK(pp->lock);
     INIT_DBREF_COUNT(pp);
     return(pp);
@@ -1253,6 +1254,7 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag)
     pp->Entry = (CELL) Tm;
     pp->Code = NULL;
     pp->DBRefs = NULL;
+    pp->NOfCells = 1;
     INIT_LOCK(pp->lock);
     INIT_DBREF_COUNT(pp);
     return(pp);

C/heapgc.c

@@ -500,7 +500,7 @@ store_ref_in_dbtable(DBRef entry)
   if ((ADDR)new > TrailTop-1024)
     growtrail(64 * 1024L);
   new->val = entry;
-  new->lim = entry->Contents+entry->NOfCells;
+  new->lim = (CELL *)((CODEADDR)entry+SizeOfBlock((CODEADDR)entry));
   new->left = new->right = NULL;
   if (db_vec == db_vec0) {
     db_vec++;
@@ -526,6 +526,42 @@ store_ref_in_dbtable(DBRef entry)
   }
 }
 
+/* init the table */
+static void
+store_cl_in_dbtable(Clause *cl)
+{
+  dbentry parent = db_vec0;
+  dbentry new = db_vec;
+
+  if ((ADDR)new > TrailTop-1024)
+    growtrail(64 * 1024L);
+  new->val = (DBRef)cl;
+  new->lim = (CELL *)((CODEADDR)cl + SizeOfBlock((CODEADDR)cl));
+  new->left = new->right = NULL;
+  if (db_vec == db_vec0) {
+    db_vec++;
+    return;
+  }
+  db_vec++;
+  parent = db_vec0;
+ beg:
+  if ((DBRef)cl < parent->val) {
+    if (parent->right == NULL) {
+      parent->right = new;
+    } else {
+      parent = parent->right;
+      goto beg;
+    }
+  } else {
+    if (parent->left == NULL) {
+      parent->left = new;
+    } else {
+      parent = parent->left;
+      goto beg;
+    }
+  }
+}
+
 /* find an element in the dbentries table */
 static DBRef
 find_ref_in_dbtable(DBRef entry)
@@ -533,8 +569,9 @@ find_ref_in_dbtable(DBRef entry)
   dbentry current = db_vec0;
 
   while (current != NULL) {
-    if (current->val < entry && current->lim > (CELL *)entry)
+    if (current->val < entry && current->lim > (CELL *)entry) {
       return(current->val);
+    }
     if (entry < current->val)
       current = current->right;
     else
@@ -554,6 +591,8 @@ mark_db_fixed(CELL *ptr) {
 
 static void 
 init_dbtable(tr_fr_ptr trail_ptr) {
+  Clause *cl = DeadClauses;
+
   db_vec0 = db_vec = (dbentry)TR;
   while (trail_ptr > (tr_fr_ptr)TrailBase) {
     register CELL trail_cell;
@@ -565,6 +604,7 @@ init_dbtable(tr_fr_ptr trail_ptr) {
     if (!IsVarTerm(trail_cell) && IsPairTerm(trail_cell)) {
       CELL *pt0 = RepPair(trail_cell);
       /* DB pointer */ 
+      CODEADDR entry;
       CELL flags;
 
 #ifdef FROZEN_STACKS  /* TRAIL */
@@ -583,14 +623,18 @@ init_dbtable(tr_fr_ptr trail_ptr) {
       flags = Flags((CELL)pt0);
       /* for the moment, if all references to the term in the stacks
 	 are only pointers, reset the flag */
+      entry = ((CODEADDR)pt0 - (CELL) &(((DBRef) NIL)->Flags));
       if (FlagOn(DBClMask, flags)) {
-	if (FlagOn(DBNoVars, flags)) {
+	store_ref_in_dbtable((DBRef)entry);
-	  CODEADDR entry = ((CODEADDR)pt0 - (CELL) &(((DBRef) NIL)->Flags));
+      } else {
-	  store_ref_in_dbtable((DBRef)entry);
+	store_cl_in_dbtable((Clause *)entry);
-	}
       }
     }
   }
+  while (cl != NULL) {
+    store_cl_in_dbtable(cl);
+    cl = cl->u.NextCl;
+  }
   if (db_vec == db_vec0) {
     /* could not find any entries: probably using LOG UPD semantics */
     db_vec0 = NULL;
@@ -879,15 +923,13 @@ mark_variable(CELL_PTR current)
       if ((Functor)cnext == FunctorDBRef) {
 	DBRef tref = DBRefOfTerm(ccur);
 	/* make sure the reference is marked as in use */
-	if (tref->Flags & InUseMask) {
+	if ((tref->Flags & ErasedMask) &&
-	  if ((tref->Flags & ErasedMask) &&
+	    tref->Parent != NULL &&
-	      tref->Parent != NULL &&
+	    tref->Parent->KindOfPE & LogUpdDBBit) {
-	      tref->Parent->KindOfPE & LogUpdDBBit) {
+	  *current = MkDBRefTerm(DBErasedMarker);
-	    *current = MkDBRefTerm(DBErasedMarker);
+	  MARK(current);
-	    MARK(current);
+	} else {
-	  } else {
+	  tref->Flags |= GcFoundMask;
-	    tref->Flags |= GcFoundMask;
-	  }
 	}
       } else {
 	mark_db_fixed(next);
@@ -1065,11 +1107,15 @@ mark_environments(CELL_PTR gc_ENV, OPREG size, CELL *pvbmap)
   while (gc_ENV != NULL) {	/* no more environments */
     Int bmap = 0;
     int currv = 0;
+    Clause *cl;
 
 #ifdef DEBUG
     if (size <  0 || size > 512)
       YP_fprintf(YP_stderr,"Oops, env size for %p is %ld\n", gc_ENV, (unsigned long int)size);
 #endif
+    if ((cl = (Clause *)find_ref_in_dbtable((DBRef)gc_ENV[E_CP])) != NULL) {
+      cl->ClFlags |= GcFoundMask;
+    }
     /* for each saved variable */
     if (size > EnvSizeInCells) {
       int tsize = size - EnvSizeInCells;
@@ -1367,7 +1413,14 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
     op_numbers opnum;
     register OPCODE op;
     yamop *rtp = gc_B->cp_ap;
+    Clause *cl;
 
+    if ((cl = (Clause *)find_ref_in_dbtable((DBRef)rtp)) != NULL) {
+      cl->ClFlags |= GcFoundMask;
+    }
+    if ((cl = (Clause *)find_ref_in_dbtable((DBRef)(gc_B->cp_b))) != NULL) {
+      cl->ClFlags |= GcFoundMask;
+    }
 #ifdef EASY_SHUNTING
     current_B = gc_B;
     prev_HB = HB;
@@ -1393,12 +1446,19 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
       }
     if (very_verbose) {
       switch (opnum) {
+      case _retry_c:
+	if (gc_B->cp_ap == RETRY_C_RECORDED_CODE 
+	    || gc_B->cp_ap == RETRY_C_RECORDED_K_CODE 
+	    || gc_B->cp_ap == RETRY_C_DRECORDED_CODE 
+	    || gc_B->cp_ap == RETRY_C_RECORDEDP_CODE) {
+	  DBRef entryref = (DBRef)EXTRA_CBACK_ARG(3,1);
+	  entryref->Flags |= GcFoundMask;
+	}
       case _or_else:
       case _or_last:
       case _Nstop:
       case _switch_last:
       case _switch_l_list:
-      case _retry_c:
       case _retry_userc:
       case _trust_logical_pred:
       case _retry_profiled:
@@ -1751,6 +1811,7 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
   Int hp_entrs = 0, hp_erased = 0, hp_not_in_use = 0,
     hp_in_use_erased = 0, code_entries = 0;
 #endif
+  Clause **cptr, *cl;
 
 #ifndef FROZEN_STACKS
   /* 
@@ -1852,32 +1913,47 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
 #endif /* FROZEN_STACKS */
 	flags = Flags((CELL)pt0);
 #ifdef DEBUG
-	if (FlagOn(DBClMask, flags)) {
+	hp_entrs++;
-	  hp_entrs++;
+	if (!FlagOn(GcFoundMask, flags)) {
-	  if (!FlagOn(GcFoundMask, flags)) {
+	  hp_not_in_use++;
-	    hp_not_in_use++;
+	  if (!FlagOn(DBClMask, flags)) {
-	    if (FlagOn(ErasedMask, flags)) {
+	    code_entries++;
-	      hp_erased++;
+	  }
-	    }
+	  if (FlagOn(ErasedMask, flags)) {
-	  } else {
+	    hp_erased++;
-	    if (FlagOn(ErasedMask, flags)) {
-	      hp_in_use_erased++;
-	    }		
 	  }
 	} else {
-	  code_entries++;
+	  if (FlagOn(ErasedMask, flags)) {
+	    hp_in_use_erased++;
+	  }		
 	}
 #endif
-      
+      	if (!FlagOn(GcFoundMask, flags)) {
-	if (!FlagOn(GcFoundMask, flags)) {
 	  if (FlagOn(DBClMask, flags)) {
-	    Flags((CELL)pt0) = ResetFlag(InUseMask, flags);
+	    DBRef dbr = (DBRef) ((CELL)pt0 - (CELL) &(((DBRef) NIL)->Flags));
-	    if (FlagOn(ErasedMask, flags)) {
+	    dbr->Flags &= ~InUseMask;
-	      ErDBE((DBRef) ((CELL)pt0 - (CELL) &(((DBRef) NIL)->Flags)));
+	    DEC_DBREF_COUNT(dbr);
+	    if (dbr->Flags & ErasedMask) {
+	      ErDBE(dbr);
+	    }
+	  } else {
+	    Clause *cl = ClauseFlagsToClause((CELL)pt0);
+	    int erase;
+	    DEC_CLREF_COUNT(cl);
+	    cl->ClFlags &= ~InUseMask;
+	    erase = (cl->ClFlags & ErasedMask)
+#if  defined(YAPOR) || defined(THREADS)
+	      && (cl->ref_count == 0)
+#endif
+	      ;
+	    if (erase) {
+	      /* at this point, 
+		 no one is accessing the clause */
+	      ErCl(cl);
 	    }
-	    RESET_VARIABLE(&TrailTerm(dest));
-	    discard_trail_entries++;
 	  }
+	  RESET_VARIABLE(&TrailTerm(dest));
+	  discard_trail_entries++;
 	} else {
 	  Flags((CELL)pt0) = ResetFlag(GcFoundMask, flags);
 	}
@@ -1959,7 +2035,21 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
 	       (unsigned long int)(OldHeapUsed-HeapUsed),
 	       (unsigned long int)((OldHeapUsed-HeapUsed)/(OldHeapUsed/100)),
 	       (unsigned long int)OldHeapUsed);
+  }
+  cptr = &(DeadClauses);
+  cl = DeadClauses;
+  while (cl != NULL) {
+    if (!(cl->ClFlags & GcFoundMask)) {
+      char *ocl = (char *)cl;
+      cl = cl->u.NextCl;
+      *cptr = cl;
+      FreeCodeSpace(ocl);
+    } else {
+      cl->ClFlags &= ~GcFoundMask;
+      cptr = &(cl->u.NextCl);
+      cl = cl->u.NextCl;
     }
+  }
 }
 
 

H/YapOpcodes.h

@@ -252,10 +252,9 @@
     OPCODE(profiled_retry_me       ,ld),
     OPCODE(profiled_trust_me       ,ld),
     OPCODE(profiled_retry_and_mark ,ld),
-    OPCODE(try_logical_pred        ,EC),
+    OPCODE(try_logical_pred        ,l),
     OPCODE(trust_logical_pred      ,l),
-    OPCODE(alloc_for_logical_pred  ,l),
+    OPCODE(alloc_for_logical_pred  ,EC),
-    OPCODE(dealloc_for_logical_pred,l),
 #ifdef SFUNC
     OPCODE(get_s_f                 ,),
     OPCODE(put_s_f                 ,),

H/rheap.h

@@ -651,7 +651,6 @@ RestoreClause(Clause *Cl, int mode)
     case _retry_profiled:
     case _try_logical_pred:
     case _trust_logical_pred:
-    case _dealloc_for_logical_pred:
     case _execute:
     case _dexecute:
     case _jump:

changes4.3.html

@@ -16,6 +16,9 @@
 
 <h2>Yap-4.3.23:</h2>
 <ul>
+	<li>FIXED: garbage collector should recover dynamic clauses
+	and logical semantics DB. Trust gc to recover active clauses </li>
+	<li>FIXED: read_vars was called with unbound argument.</li>
 	<li>FIXED: backtrackable C-predicates (thanks to Christophe
 	Billard for sending the file).</li>
 	<li>FIXED: new options for file_property (Nicos).</li>

pl/preds.yap

@@ -285,7 +285,7 @@ retract(C) :-
 	'$retract'(C,M).
 '$retract'(C,M) :- 
 	'$check_head_and_body'(C,H,B,retract(M:C)),
-	'$is_dynamic'(H, M), !,
+	'$is_dynamic'(H,M), !,
 	'$recordedp'(M:H,(H:-B),R), erase(R).
 '$retract'(C,M) :- 
 	'$check_head_and_body'(C,H,B,retract(M:C)),
@@ -311,7 +311,7 @@ retract(C,R) :- !,
 	db_reference(R), '$is_dynamic'(H,M), !,
 	instance(R,(H:-B)), erase(R).
 '$retract'(C,M,R) :-
-	'$head_and_body'(C,H,B,retract(C,R)),
+	'$check_head_and_body'(C,H,B,retract(C,R)),
 	'$is_dynamic'(H,M), !,
 	var(R),
 	'$recordedp'(M:H,(H:-B),R),