insert some more slack for indices in LU

Use doubly linked list for LU indices so that updating is less cumbersome.


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

C/agc.c

@@ -325,7 +325,7 @@ clean_atoms(void)
 	NOfAtoms--;
       } else {
 #ifdef DEBUG_RESTORE3
-	fprintf(stderr, "Purged %s\n", at->StrOfAE);
+	fprintf(stderr, "Purged %p:%s\n", at, at->StrOfAE);
 #endif
 	*patm = at->NextOfAE;
 	atm = at->NextOfAE;
@@ -397,10 +397,11 @@ Yap_atom_gc(void)
 static Int
 p_atom_gc(void)
 {
+  return TRUE;
 #ifndef FIXED_STACKS
   atom_gc();
 #endif  /* FIXED_STACKS */
-  return(TRUE);
+  return TRUE;
 }
 
 static Int

C/alloc.c

@@ -12,7 +12,7 @@
 * Last rev:								 *
 * mods:									 *
 * comments:	allocating space					 *
-* version:$Id: alloc.c,v 1.70 2005-05-31 00:12:30 ricroc Exp $		 *
+* version:$Id: alloc.c,v 1.71 2005-05-31 19:42:27 vsc Exp $		 *
 *************************************************************************/
 #ifdef SCCS
 static char SccsId[] = "%W% %G%";
@@ -396,6 +396,9 @@ GetBlock(unsigned int n)
 
   if (FreeBlocks == NIL)
     return (NIL);
+  /* check for bugs */
+  p = &FreeBlocks;
+  /* end check for bugs */
   p = &FreeBlocks;
   while (((b = *p) != NIL) && b->b_size < n)
     p = &b->b_next_size;

C/amasm.c

@@ -11,8 +11,11 @@
 * File:		amasm.c							 *
 * comments:	abstract machine assembler				 *
 *									 *
-* Last rev:     $Date: 2005-05-30 05:33:43 $							 *
+* Last rev:     $Date: 2005-05-31 19:42:27 $							 *
 * $Log: not supported by cvs2svn $
+* Revision 1.76  2005/05/30 05:33:43  vsc
+* get rid of annoying debugging message.
+*
 * Revision 1.75  2005/05/30 05:26:49  vsc
 * fix tabling
 * allow atom gc again for now.
@@ -1308,6 +1311,11 @@ init_log_upd_table(LogUpdIndex *ic, union clause_obj *cl_u)
 {
   /* insert myself in the indexing code chain */ 
   ic->SiblingIndex = cl_u->lui.ChildIndex;
+  if (ic->SiblingIndex) {
+    ic->SiblingIndex->PrevSiblingIndex = ic;
+  }
+  cl_u->lui.ChildIndex = ic;
+  ic->PrevSiblingIndex = NULL;
   ic->ChildIndex = NULL;
   ic->ClRefCount = 0;
   ic->u.ParentIndex = (LogUpdIndex *)cl_u;
@@ -2382,6 +2390,7 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
 	cl_u->lui.ClFlags = LogUpdMask|IndexedPredFlag|IndexMask|SwitchRootMask;
 	cl_u->lui.ChildIndex = NULL;
 	cl_u->lui.SiblingIndex = NULL;
+	cl_u->lui.PrevSiblingIndex = NULL;
 	cl_u->lui.u.pred = cip->CurrentPred;
 	cl_u->lui.ClSize = size;
 	cl_u->lui.ClRefCount =  0;

C/cdmgr.c

@@ -11,8 +11,11 @@
 * File:		cdmgr.c							 *
 * comments:	Code manager						 *
 *									 *
-* Last rev:     $Date: 2005-05-31 00:30:23 $,$Author: ricroc $						 *
+* Last rev:     $Date: 2005-05-31 19:42:27 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.158  2005/05/31 00:30:23  ricroc
+* remove abort_yapor function
+*
 * Revision 1.157  2005/05/12 03:36:32  vsc
 * debugger was making predicates meta instead of testing
 * fix handling of dbrefs in facts and in subarguments.
@@ -923,12 +926,16 @@ kill_first_log_iblock(LogUpdIndex *c, LogUpdIndex *parent, PredEntry *ap)
     LOCK(parent->ClLock);
     if (c == parent->ChildIndex) {
       parent->ChildIndex = c->SiblingIndex;
-    } else {
+      if (parent->ChildIndex) {
-      LogUpdIndex *tcl = parent->ChildIndex;
+	parent->ChildIndex->PrevSiblingIndex = NULL;
-      while (tcl->SiblingIndex != c) {
+      }
-	tcl = tcl->SiblingIndex;
+    } else {
+      c->PrevSiblingIndex->SiblingIndex =
+	c->SiblingIndex;
+      if (c->SiblingIndex) {
+	c->SiblingIndex->PrevSiblingIndex =
+	  c->PrevSiblingIndex;
       }
-      tcl->SiblingIndex = c->SiblingIndex;
     }
     UNLOCK(parent->ClLock);
   }

C/index.c

@@ -11,8 +11,11 @@
 * File:		index.c							 *
 * comments:	Indexing a Prolog predicate				 *
 *									 *
-* Last rev:     $Date: 2005-05-31 04:46:06 $,$Author: vsc $						 *
+* Last rev:     $Date: 2005-05-31 19:42:27 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.130  2005/05/31 04:46:06  vsc
+* fix expand_index on tabled code.
+*
 * Revision 1.129  2005/05/31 02:15:53  vsc
 * fix SYSTEM_ERROR messages
 *
@@ -3305,6 +3308,11 @@ 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) {
@@ -3324,6 +3332,11 @@ 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);
       }
     }
   }
@@ -3439,8 +3452,16 @@ suspend_indexing(ClauseDef *min, ClauseDef *max, PredEntry *ap, struct intermedi
   if (cls < tcls/8) {
     yamop *ncode;
     yamop **st;
-    UInt sz = (UInt)NEXTOP((yamop *)NULL,sp)+cls*sizeof(yamop *);
+    UInt tels;
+    UInt sz;
 
+    if (ap->PredFlags & LogUpdatePredFlag) {
+      /* give it some slack */
+      tels = cls + 4;
+    } else {
+      tels = cls;
+    }
+    sz = (UInt)NEXTOP((yamop *)NULL,sp)+tels*sizeof(yamop *), sz;
 #if DEBUG
     Yap_expand_clauses_sz += sz;
 #endif
@@ -3450,13 +3471,18 @@ suspend_indexing(ClauseDef *min, ClauseDef *max, PredEntry *ap, struct intermedi
     /* create an expand_block */
     ncode->opc = Yap_opcode(_expand_clauses);
     ncode->u.sp.p = ap;
-    ncode->u.sp.s1 = ncode->u.sp.s2 = cls;
+    ncode->u.sp.s1 = tels;
+    ncode->u.sp.s2 = cls;
     ncode->u.sp.s3 = 1;
     st = (yamop **)NEXTOP(ncode,sp);
     while (min <= max) {
       *st++ = min->Code;
       min++;
     }
+    while (cls < tels) {
+      *st++ = NULL;
+      cls++;
+    }
     LOCK(ExpandClausesListLock);
     ncode->u.sp.snext = ExpandClausesFirst;
     ncode->u.sp.sprev = NULL;
@@ -5292,6 +5318,10 @@ ExpandIndex(PredEntry *ap, int ExtraArgs) {
       ic = (LogUpdIndex *)Yap_find_owner_index((yamop *)labp, ap);
     /* insert myself in the indexing code chain */ 
     nic->SiblingIndex = ic->ChildIndex;
+    nic->PrevSiblingIndex = NULL;
+    if (ic->ChildIndex) {
+      ic->ChildIndex->PrevSiblingIndex = nic;
+    }
     nic->u.ParentIndex = ic;
     nic->ClFlags &= ~SwitchRootMask;
     ic->ChildIndex = nic;
@@ -5463,6 +5493,7 @@ replace_index_block(ClauseUnion *parent_block, yamop *cod, yamop *ncod, PredEntr
       *ncl = ClauseCodeToLogUpdIndex(ncod),
       *c = parent_block->lui.ChildIndex;
     ncl->SiblingIndex = cl->SiblingIndex;
+    ncl->PrevSiblingIndex = cl->PrevSiblingIndex;
     ncl->ClRefCount = cl->ClRefCount;
     ncl->ChildIndex = cl->ChildIndex;
     ncl->u.ParentIndex = cl->u.ParentIndex;
@@ -5470,10 +5501,10 @@ replace_index_block(ClauseUnion *parent_block, yamop *cod, yamop *ncod, PredEntr
     if (c == cl) {
       parent_block->lui.ChildIndex = ncl;
     } else {
-      while (c->SiblingIndex != cl) {
+      cl->PrevSiblingIndex->SiblingIndex = ncl;
-	c = c->SiblingIndex;
+    }
-      }
+    if (cl->SiblingIndex) {
-      c->SiblingIndex = ncl;
+      cl->SiblingIndex->PrevSiblingIndex = ncl;
     }
     c = cl->ChildIndex;
     while (c != NULL) {
@@ -6095,6 +6126,10 @@ replace_lu_block(LogUpdIndex *blk, int flag, PredEntry *ap, yamop *code, int has
   } else {
     pcl = blk->u.ParentIndex;
     ncl->SiblingIndex = pcl->ChildIndex;
+    ncl->PrevSiblingIndex = NULL;
+    if (pcl->ChildIndex) {
+      pcl->ChildIndex->PrevSiblingIndex = ncl;
+    }
     pcl->ChildIndex = ncl;
     /* we have a new pointer to our clause */
     pcl->ClRefCount++;
@@ -6143,8 +6178,7 @@ clean_up_index(LogUpdIndex *blk, yamop **jlbl, PredEntry *ap)
 }
 
 static int is_trust(OPCODE opc) {
-  op_numbers op = Yap_op_from_opcode(opc);
+  return opc == Yap_opcode(_trust);
-  return op == _trust;
 }
 
 static yamop *
@@ -6163,7 +6197,7 @@ insertz_in_lu_block(LogUpdIndex *blk, PredEntry *ap, yamop *code)
   /* block should start with an enter_lu_pred and end with a trust,
      otherwise I just don't understand what is going on */
   if ((op != _enter_lu_pred && op != _stale_lu_index) ||
-      ! is_trust(begin->u.xll.l2->opc)) {
+      ! is_trust(PREVOP(begin->u.xll.l2,ld)->opc)) {
     if (blk->ClFlags & SwitchRootMask) {
       Yap_kill_iblock((ClauseUnion *)blk, NULL, ap);
     } else {
@@ -6268,7 +6302,8 @@ inserta_in_lu_block(LogUpdIndex *blk, PredEntry *ap, yamop *code)
     begin = NEXTOP(begin, xll);
     op = Yap_op_from_opcode(begin->opc);
   }
-  if (op != _enter_lu_pred && op != _stale_lu_index) {
+  if ((op != _enter_lu_pred && op != _stale_lu_index) ||
+      ! is_trust(PREVOP(begin->u.xll.l2,ld)->opc)) {
     if (blk->ClFlags & SwitchRootMask) {
       Yap_kill_iblock((ClauseUnion *)blk, NULL, ap);
     } else {
@@ -6492,6 +6527,41 @@ kill_unsafe_block(path_stack_entry *sp, op_numbers op, PredEntry *ap, int first,
   return kill_block(sp+1, ap);
 }
 
+static int
+compacta_expand_clauses(yamop *ipc)
+{
+  /* expand clauses so that you have a hole at the beginning */
+  /* we know that there is at least one element here */
+  yamop **start = (yamop **)(NEXTOP(ipc,sp));
+  yamop **ptr, **end;
+
+  ptr = end = start+ipc->u.sp.s1;
+
+  while (--ptr > start) {
+    yamop *next = *ptr;
+    if (next) *--end = next;
+  }
+  return ptr+1 != end;
+}
+
+static int
+compactz_expand_clauses(yamop *ipc)
+{
+  /* expand clauses so that you have a hole at the beginning */
+  /* we know that there is at least one element here */
+  yamop **start = (yamop **)(NEXTOP(ipc,sp));
+  yamop **ptr, **end;
+
+  end = start+ipc->u.sp.s1;
+  ptr = start;
+
+  while (ptr < end) {
+    yamop *next = *ptr++;
+    if (next) *start++ = next;
+  }
+  return ptr != start;
+}
+
 /* this code should be called when we jumped to clauses */
 static yamop *
 add_to_expand_clauses(path_stack_entry **spp, yamop *ipc, ClauseDef *cls, PredEntry *ap, int first)
@@ -6500,24 +6570,28 @@ add_to_expand_clauses(path_stack_entry **spp, yamop *ipc, ClauseDef *cls, PredEn
   yamop **clar = (yamop **)NEXTOP(ipc,sp);
 
   if (first) {
-    if (*clar == NULL) {
+    do {
-      while (*clar == NULL) clar++;
+      if (*clar == NULL || clar[0] == cls->Code) {
-      if (clar[0] != cls->Code) {
+	while (*clar == NULL) clar++;
-	clar[-1] = cls->Code;
+	if (clar[0] != cls->Code) {
-	ipc->u.sp.s2++;
+	  clar[-1] = cls->Code;
+	  ipc->u.sp.s2++;
+	}
+	return pop_path(spp, cls, ap);
       }
-      return pop_path(spp, cls, ap);
+    } while (compacta_expand_clauses(ipc));
-    }
   } else {
-    clar += ipc->u.sp.s1;
+    do {
-    if (clar[-1] == NULL) {
+      clar += ipc->u.sp.s1;
-      while (*--clar == NULL);
+      if (clar[-1] == NULL  || clar[-1] == cls->Code) {
-      if (clar[0] != cls->Code) {
+	while (*--clar == NULL);
-	clar[1] = cls->Code;
+	if (clar[0] != cls->Code) {
-	ipc->u.sp.s2++;
+	  clar[1] = cls->Code;
+	  ipc->u.sp.s2++;
+	}
+	return pop_path(spp, cls, ap);
       }
-      return pop_path(spp, cls, ap);
+    } while (compactz_expand_clauses(ipc));
-    }
   }
   while ((--sp)->flag != block_entry);
   if (sp->u.cle.entry_code) {

H/clause.h

@@ -52,6 +52,7 @@ typedef struct logic_upd_index {
     struct logic_upd_index *ParentIndex;
   } u;
   struct logic_upd_index *SiblingIndex;
+  struct logic_upd_index *PrevSiblingIndex;
   struct logic_upd_index *ChildIndex;
   /* The instructions, at least one of the form sl */
   yamop            ClCode[MIN_ARRAY];