fixes to handle expansion of dyn amic predicates more efficiently.

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

C/heapgc.c

@@ -1559,10 +1559,6 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B
   while (trail_base < trail_ptr) {
     register CELL trail_cell;
     
-    if (trail_base == ((CELL *)0x204bc000)+0x320d) {
-      extern int jmp_deb();
-      jmp_deb(1);
-    }
     trail_cell = TrailTerm(trail_base);
 
     if (IsVarTerm(trail_cell)) {

C/index.c

@@ -11,8 +11,11 @@
 * File:		index.c							 *
 * comments:	Indexing a Prolog predicate				 *
 *									 *
-* Last rev:     $Date: 2006-03-20 19:51:43 $,$Author: vsc $						 *
+* Last rev:     $Date: 2006-03-21 15:06:35 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.154  2006/03/20 19:51:43  vsc
+* fix indexing and tabling bugs
+*
 * Revision 1.153  2006/02/22 11:55:36  vsc
 * indexing code would get confused about size of float/1, db_reference1.
 *
@@ -4832,6 +4835,67 @@ count_clauses_left(yamop *cl, PredEntry *ap)
   }
 }
 
+/*
+  We have jumped across indexing code. Check if we jumped within the current
+  indexing block, if we moved back to a parent, or if we jumped to a child.
+ */
+static ClausePointer
+index_jmp(ClausePointer cur, yamop *ipc, int is_lu, yamop *e_code)
+{
+  if (cur.lui == NULL) {
+    cur.lui = NULL;
+    return cur;
+  }
+  if (is_lu) {
+    LogUpdIndex *lcur = cur.lui, *ncur;
+    if (ipc == FAILCODE ||
+	ipc == e_code ||
+	ipc->opc == Yap_opcode(_expand_clauses)
+	)
+      return cur;
+    /* check myself */
+    if (ipc >= lcur->ClCode && ipc <= (yamop *)((CODEADDR)lcur+lcur->ClSize))
+      return cur;
+    /* maybe I jumped to some parent */
+    if (lcur->ParentIndex) {
+      LogUpdIndex *pcur = lcur->ParentIndex;
+      if (ipc >= pcur->ClCode && ipc <= (yamop *)((CODEADDR)pcur+pcur->ClSize)) {
+	cur.lui = pcur;
+      }
+      return cur;
+    }
+    /* maybe I am a new group */
+    ncur = ClauseCodeToLogUpdIndex(ipc);
+    if (ncur->ParentIndex != lcur) {
+#ifdef DEBUG
+      fprintf(stderr,"OOPS, bad parent in lu index\n");
+#endif
+      cur.lui = NULL;
+      return cur;
+    }
+    cur.lui = lcur;
+    return cur;    
+  } else {
+    StaticIndex *scur = cur.si;
+    /* check myself */
+    if (ipc >= scur->ClCode && ipc <= (yamop *)((CODEADDR)scur+scur->ClSize))   
+      return cur;
+    cur.si = NULL;
+    return cur;
+  }
+}
+
+static ClausePointer
+code_to_indexcl(yamop *ipc, int is_lu)
+{
+  ClausePointer ret;
+  if (is_lu)
+    ret.lui = ClauseCodeToLogUpdIndex(ipc);
+  else
+    ret.si = ClauseCodeToStaticIndex(ipc);
+  return ret;    
+}
+
 static yamop **
 expand_index(struct intermediates *cint) {
   /* first clause */
@@ -4843,7 +4907,8 @@ expand_index(struct intermediates *cint) {
   /* last clause to experiment with */
   yamop *ipc;
   /* labp should point at the beginning of the sequence */
-  yamop **labp = NULL, **olabp = NULL;
+  yamop **labp = NULL;
+  ClausePointer parentcl;
   Term t = TermNil, *s_reg = NULL;
   int is_last_arg = TRUE;
   int argno = 1;
@@ -4854,6 +4919,7 @@ expand_index(struct intermediates *cint) {
   UInt lab, fail_l, clleft, i = 0;
   int is_lu = ap->PredFlags & LogUpdatePredFlag;
   yamop *eblk = NULL;
+  yamop *e_code = (yamop *)&(ap->cs.p_code.ExpandCode);
 
   ipc = ap->cs.p_code.TrueCodeOfPred;
   first = ap->cs.p_code.FirstClause;
@@ -4863,6 +4929,7 @@ expand_index(struct intermediates *cint) {
   stack[0].pos = 0;
   /* try to refine the interval using the indexing code */
 
+  parentcl = code_to_indexcl(ipc,is_lu);
   while (ipc != NULL) {
     op_numbers op;
 
@@ -4962,8 +5029,8 @@ expand_index(struct intermediates *cint) {
       break;
     case _jump:
       /* just skip for now, but should worry about memory management */
-      olabp = NULL;  
       ipc = ipc->u.l.l;
+      parentcl = index_jmp(parentcl, ipc, is_lu, e_code);
       break;
     case _lock_lu:
     case _procceed:
@@ -4974,9 +5041,9 @@ expand_index(struct intermediates *cint) {
       break;
     case _jump_if_var:
       if (IsVarTerm(Deref(ARG1))) {
-	olabp = NULL;
 	labp = &(ipc->u.l.l);
 	ipc = ipc->u.l.l;
+	parentcl = index_jmp(parentcl, ipc, is_lu, e_code);
       } else {
 	ipc = NEXTOP(ipc,l);
       }
@@ -4988,9 +5055,9 @@ expand_index(struct intermediates *cint) {
       /* expand_index expects to find the new argument */
       if (!IsVarTerm(t)) {
 	argno--;
-	olabp = NULL;
 	labp = &(ipc->u.xll.l1);
 	ipc = ipc->u.xll.l1;
+	parentcl = index_jmp(parentcl, ipc, is_lu, e_code);
       } else {
 	ipc = NEXTOP(ipc,xll);
       }
@@ -5015,13 +5082,11 @@ expand_index(struct intermediates *cint) {
       argno = 1;
       i = 0;
       if (IsVarTerm(t)) {
-	olabp = NULL;
 	labp = &(ipc->u.llll.l4);
 	ipc = ipc->u.llll.l4;
       } else if (IsPairTerm(t)) {
 	sp = push_stack(sp, 1, AbsPair(NULL), TermNil, cint);
 	s_reg = RepPair(t);
-	olabp = NULL;
 	labp = &(ipc->u.llll.l1);
 	ipc = ipc->u.llll.l1;	
       } else if (IsApplTerm(t)) {
@@ -5031,17 +5096,16 @@ expand_index(struct intermediates *cint) {
 	sp = push_stack(sp, argno, t, TermNil, cint);
 	ipc = ipc->u.llll.l2;	
       }
+      parentcl = index_jmp(parentcl, ipc, is_lu, e_code);
       break;
     case _switch_list_nl:
       t = Deref(ARG1);
       argno = 1;
       i = 0;
       if (IsVarTerm(t)) {	
-	olabp = NULL;
 	labp = &(ipc->u.ollll.l4);
 	ipc = ipc->u.ollll.l4;
       } else if (IsPairTerm(t)) {
-	olabp = NULL;
 	s_reg = RepPair(t);
 	labp = &(ipc->u.ollll.l1);
 	sp = push_stack(sp, 1, AbsPair(NULL), TermNil, cint);
@@ -5060,18 +5124,17 @@ expand_index(struct intermediates *cint) {
 	sp = push_stack(sp, argno, tn, TermNil, cint);
 	ipc = ipc->u.ollll.l3;	
       }
+      parentcl = index_jmp(parentcl, ipc, is_lu, e_code);
       break;
     case _switch_on_arg_type:
       argno = arg_from_x(ipc->u.xllll.x);
       i = 0;
       t = Deref(XREGS[argno]);
       if (IsVarTerm(t)) {
-	olabp = NULL;
 	labp = &(ipc->u.xllll.l4);
 	ipc = ipc->u.xllll.l4;
       } else if (IsPairTerm(t)) {
 	s_reg = RepPair(t);
-	olabp = NULL;
 	sp = push_stack(sp, argno, AbsPair(NULL), TermNil, cint);
 	labp = &(ipc->u.xllll.l1);
 	ipc = ipc->u.xllll.l1;	
@@ -5082,6 +5145,7 @@ expand_index(struct intermediates *cint) {
 	sp = push_stack(sp, argno, t, TermNil, cint);
 	ipc = ipc->u.xllll.l2;	
       }
+      parentcl = index_jmp(parentcl, ipc, is_lu, e_code);
       break;
     case _switch_on_sub_arg_type:
       i = ipc->u.sllll.s;
@@ -5089,14 +5153,12 @@ expand_index(struct intermediates *cint) {
       if (i != arity-1) is_last_arg = FALSE;
       t = Deref(s_reg[i]);
       if (IsVarTerm(t)) {
-	olabp = NULL;
 	labp = &(ipc->u.sllll.l4);
 	ipc = ipc->u.sllll.l4;
 	i++;
       } else if (IsPairTerm(t)) {
 	s_reg = RepPair(t);
 	sp = push_stack(sp, -i-1, AbsPair(NULL), TermNil, cint);
-	olabp = NULL;
 	labp = &(ipc->u.sllll.l1);
 	ipc = ipc->u.sllll.l1;
 	i = 0;
@@ -5112,6 +5174,7 @@ expand_index(struct intermediates *cint) {
 	ipc = ipc->u.sllll.l2;	
 	i++;
       }
+      parentcl = index_jmp(parentcl, ipc, is_lu, e_code);
       break;
     case _if_not_then:
       labp = NULL;
@@ -5135,9 +5198,9 @@ expand_index(struct intermediates *cint) {
 	}
 	newpc = (yamop *)(fe->Label);
 
-	olabp = &(ipc->u.sssl.l);
 	labp = (yamop **)(&(fe->Label));
-	if (newpc == (yamop *)&(ap->cs.p_code.ExpandCode)) {
+	parentcl = code_to_indexcl(ipc->u.sssl.l,is_lu);
+	if (newpc == e_code) {
 	  /* we found it */
 	  ipc = NULL;
 	} else {
@@ -5157,9 +5220,9 @@ expand_index(struct intermediates *cint) {
 	  ae = lookup_c(t,ipc->u.sssl.l,ipc->u.sssl.s);
 	}
 
-	olabp = &(ipc->u.sssl.l);
 	labp = (yamop **)(&(ae->Label));
-	if (ae->Label == (CELL)&(ap->cs.p_code.ExpandCode)) {
+	parentcl = code_to_indexcl(ipc->u.sssl.l,is_lu);
+	if (ae->Label == (CELL)e_code) {
 	  /* we found it */
 	  ipc = NULL;
 	} else {
@@ -5199,15 +5262,9 @@ expand_index(struct intermediates *cint) {
   /* if there was an overflow while generating the code, make sure
      S is still correct */
   if (is_lu) {
-    if (olabp)
+    cint->current_cl.lui = parentcl.lui;
-      cint->current_cl.lui = ClauseCodeToLogUpdIndex(*olabp);
-    else 
-      cint->current_cl.lui = NULL;
   } else {
-    if (olabp)
+    cint->current_cl.si = parentcl.si;
-      cint->current_cl.si = ClauseCodeToStaticIndex(*olabp);
-    else
-      cint->current_cl.si = NULL;
   }
   if (s_reg != NULL)
     S = s_reg;

H/clause.h

@@ -150,6 +150,15 @@ typedef union clause_obj {
   struct static_index si;
 } ClauseUnion;
 
+typedef union clause_ptr {
+  struct logic_upd_clause *luc;
+  struct logic_upd_index *lui;
+  struct dynamic_clause *ic;
+  struct static_clause *sc;
+  struct static_mega_clause *mc;
+  struct static_index *si;
+} ClausePointer;
+
 #define ClauseCodeToDynamicClause(p)    ((DynamicClause *)((CODEADDR)(p)-(CELL)(((DynamicClause *)NULL)->ClCode)))
 #define ClauseCodeToStaticClause(p)    ((StaticClause *)((CODEADDR)(p)-(CELL)(((StaticClause *)NULL)->ClCode)))
 #define ClauseCodeToLogUpdClause(p)    ((LogUpdClause *)((CODEADDR)(p)-(CELL)(((LogUpdClause *)NULL)->ClCode)))