fix count flag for indices

fix memory expansion with holes.


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

C/adtdefs.c

@@ -461,8 +461,6 @@ Yap_NewPredPropByFunctor(FunctorEntry *fe, SMALLUNSGN cur_mod)
   PredEntry *p = (PredEntry *) Yap_AllocAtomSpace(sizeof(*p));
 
   extern long long int vsc_count;
-  if (p == 0x9183b68) printf("%lld entering %s:%s/%d\n", vsc_count, 
-RepAtom(AtomOfTerm(ModuleName[cur_mod]))->StrOfAE, RepAtom(fe->NameOfFE)->StrOfAE, fe->ArityOfFE);
 
   INIT_RWLOCK(p->PRWLock);
   p->KindOfPE = PEProp;

C/alloc.c

@@ -12,7 +12,7 @@
 * Last rev:								 *
 * mods:									 *
 * comments:	allocating space					 *
-* version:$Id: alloc.c,v 1.37 2003-10-28 01:16:02 vsc Exp $		 *
+* version:$Id: alloc.c,v 1.38 2003-10-30 11:31:05 vsc Exp $		 *
 *************************************************************************/
 #ifdef SCCS
 static char SccsId[] = "%W% %G%";
@@ -342,9 +342,6 @@ Yap_ReleasePreAllocCodeSpace(ADDR ptr)
 static void
 FreeCodeSpace(char *p)
 {
-  if (p == 0x2adc37e4) {
-    printf("Erasing my block\n");
-  }
   FreeBlock(((BlockHeader *) (p - sizeof(YAP_SEG_SIZE))));
 }
 
@@ -714,6 +711,7 @@ ExtendWorkSpace(Int s, int fixed_allocation)
   }
   if (fixed_allocation) {
     if (a != WorkSpaceTop) {
+      munmap((void *)a, (size_t)s);
       Yap_ErrorMessage = Yap_ErrorSay;
       snprintf5(Yap_ErrorMessage, MAX_ERROR_MSG_SIZE,
 		"mmap could not grow memory at %p, got %p", WorkSpaceTop, a );
@@ -1139,10 +1137,12 @@ Yap_AllocHole(UInt actual_request, UInt total_size)
   YAP_SEG_SIZE bsiz = (WorkSpaceTop0-HeapTop)/sizeof(CELL)-2*sizeof(YAP_SEG_SIZE)/sizeof(CELL);
 
   /* push HeapTop to after hole */
-  HeapTop = WorkSpaceTop-actual_request;
+  HeapTop = WorkSpaceTop-(actual_request-sizeof(YAP_SEG_SIZE));
-  *((YAP_SEG_SIZE *) HeapTop) = InUseFlag;
+  ((YAP_SEG_SIZE *) HeapTop)[0] = InUseFlag;
   /* now simulate a block */
-  endb->b_size = (HeapTop-WorkSpaceTop0)/sizeof(CELL) | InUseFlag;
+  ((YAP_SEG_SIZE *) HeapTop)[-1] =
+    endb->b_size =
+    (HeapTop-WorkSpaceTop0)/sizeof(YAP_SEG_SIZE) | InUseFlag;
   newb->b_size = bsiz;
   AddToFreeList(newb);
 }

C/cdmgr.c

@@ -394,7 +394,7 @@ kill_first_log_iblock(LogUpdIndex *c, LogUpdIndex *cl, PredEntry *ap)
       tcl->SiblingIndex = c->SiblingIndex;
     }
   }
-  /* make sure that a child cannot remove ourselves */
+  /* make sure that a child cannot remove us */
   c->ClRefCount++;
   while (ncl != NULL) {
     LogUpdIndex *next = ncl->SiblingIndex;
@@ -422,8 +422,7 @@ kill_first_log_iblock(LogUpdIndex *c, LogUpdIndex *cl, PredEntry *ap)
     decrease_log_indices(c, (yamop *)&(ap->cs.p_code.ExpandCode));
     Yap_FreeCodeSpace((CODEADDR)c);
   } else {
-    c->ClFlags |= (ErasedMask|SwitchRootMask);
+    c->ClFlags |= ErasedMask;
-    c->u.pred = ap;
     c->ChildIndex = NULL;
   }
 }
@@ -470,7 +469,14 @@ Yap_kill_iblock(ClauseUnion *blk, ClauseUnion *parent_blk, PredEntry *ap)
 void 
 Yap_ErLogUpdIndex(LogUpdIndex *clau)
 {
-  kill_first_log_iblock(clau, NULL, clau->u.pred);
+  LogUpdIndex *c = clau;
+  if (c->ClFlags & SwitchRootMask) {
+     kill_first_log_iblock(clau, NULL, c->u.pred);
+ } else {
+    while (!(c->ClFlags & SwitchRootMask)) 
+      c = c->u.ParentIndex;
+    kill_first_log_iblock(clau, clau->u.ParentIndex, c->u.pred);
+ }
 }
 
 void

C/dbase.c

@@ -1476,7 +1476,7 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat)
       }
     }
     if (tofref != TmpRefBase) {
-      CodeAbs += TmpRefBase - tofref + 1;
+      CodeAbs += (TmpRefBase - tofref) + 1;
       if ((CELL *)((char *)ntp0+(CELL)CodeAbs) > AuxSp) {
 	Yap_Error_Size = (UInt)DBLength(CodeAbs);
 	DBErrorFlag = OVF_ERROR_IN_DB;
@@ -1494,7 +1494,7 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat)
 #endif
 #endif
     if (p == NULL) {
-      ppt = (DBTerm *)AllocDBSpace(sizeof(DBTerm)+(UInt)CodeAbs);
+      ppt = (DBTerm *)AllocDBSpace(DBLength(CodeAbs));
       if (ppt == NULL) {
 	Yap_ReleasePreAllocCodeSpace((ADDR)pp0);
 	return generate_dberror_msg(OVF_ERROR_IN_DB, (UInt)DBLength(CodeAbs), "heap crashed against stacks");
@@ -4106,9 +4106,9 @@ p_instance_module(void)
     if (IsIntegerTerm(t1)) 
       dbr = (DBRef)IntegerOfTerm(t1);
     else
-      return (FALSE);
+      return FALSE;
     /* limited sanity checking */
-    if (dbr->id != FunctorDBRef) {
+    if (dbr > (DBRef)Yap_HeapBase && dbr < (DBRef)HeapTop && dbr->id != FunctorDBRef) {
       return FALSE;
     }
   } else {

C/index.c

@@ -4737,6 +4737,8 @@ replace_lu_block(LogUpdIndex *blk, int flag, PredEntry *ap, yamop *code, int has
   pcl = blk->u.ParentIndex;
   ncl->SiblingIndex = pcl->ChildIndex;
   pcl->ChildIndex = ncl;
+  /* we have a new pointer to our clause */
+  pcl->ClRefCount++;
   if (!(blk->ClFlags & ErasedMask)) {
     Yap_kill_iblock((ClauseUnion *)blk, (ClauseUnion *)pcl, ap);
   }

H/alloc.h

@@ -55,7 +55,7 @@ typedef	struct FREEB {
   YAP_SEG_SIZE		b_size;
   struct FREEB		*b_next;
   struct FREEB		*b_next_size;
-	} BlockHeader;
+} BlockHeader;
 
 #define MinBlockSize	(sizeof(BlockHeader)+sizeof(YAP_SEG_SIZE))
 #define MaxBlockSize	0xffffff

pl/preds.yap

@@ -292,15 +292,20 @@ clause(V,Q) :-
 '$clause'(P,M,Q) :-
 	'$clause'(P,M,Q,_).
 
-clause(P,Q,R) :- db_reference(R), !,
+clause(P,Q,R) :- var(P), !,
-	instance(R,T),
+	'$current_module'(M),
-	( T = (H :- B) -> P = H, Q = B ; P=T, Q = true).
+	'$clause'(P,M,Q,R).
 clause(M:P,Q,R) :- !,
 	'$clause'(P,M,Q,R).
 clause(V,Q,R) :-
 	'$current_module'(M),
 	'$clause'(V,M,Q,R).
 
+'$clause'(P,M,Q,R) :-
+	'$instance_module'(R,M0), !,
+	M0 = M,
+	instance(R,T),
+	( T = (H :- B) -> P = H, Q = B ; P=T, Q = true).
 '$clause'(V,M,Q,_) :- var(V), !, 
 	'$do_error'(instantiation_error,M:clause(V,Q)).
 '$clause'(C,M,Q,_) :- number(C), !,