improvements to indexing: allow user control and fix bugs in sorting

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

C/cdmgr.c

@@ -906,14 +906,14 @@ addclause(Term t, yamop *cp, int mode, int mod)
       p->PredFlags |= CompiledPredFlag | FastPredFlag;
     else
       p->PredFlags |= CompiledPredFlag;
-    if ((Yap_GetValue(AtomIndex) != TermNil) && 
+    if (yap_flags[INDEXING_MODE_FLAG] != INDEX_MODE_OFF && 
-	(p->cs.p_code.FirstClause != NIL) &&
+	p->cs.p_code.FirstClause != NULL &&
-	(Arity != 0)) {
+	Arity != 0) {
       p->OpcodeOfPred = INDEX_OPCODE;
       p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred)); 
     }
   }
-  if (p->cs.p_code.FirstClause == NIL) {
+  if (p->cs.p_code.FirstClause == NULL) {
     if (!(p->PredFlags & DynamicPredFlag)) {
       add_first_static(p, cp, spy_flag);
       /* make sure we have a place to jump to */

C/exec.c

@@ -1552,7 +1552,6 @@ Yap_InitYaamRegs(void)
   Yap_regp = &Yap_standard_regs;
 #endif /* PUSH_REGS */
   Yap_PutValue (AtomBreak, MkIntTerm (0));
-  Yap_PutValue (AtomIndex, MkAtomTerm (AtomTrue));
   AuxSp = (CELL *)AuxTop;
   TR = (tr_fr_ptr)Yap_TrailBase;
 #ifdef COROUTINING

C/index.c

@@ -88,102 +88,209 @@ smaller(Term t1, Term t2)
   }
 }
 
+static inline int
+smaller_or_eq(Term t1, Term t2)
+{
+  if (IsVarTerm(t1)) {
+    if (!IsVarTerm(t2)) return TRUE;
+    return (t1 <= t2);
+  } else if (IsIntTerm(t1)) {
+    if (IsVarTerm(t2)) return FALSE;
+    if (!IsIntTerm(t2)) return TRUE;
+    return (IntOfTerm(t1) <= IntOfTerm(t2));
+  } else if (IsAtomTerm(t1)) {
+    if (IsVarTerm(t2) || IsIntTerm(t2)) return FALSE;
+    if (IsApplTerm(t2) || IsPairTerm(t2)) return TRUE;
+    return (t1 <= t2);
+  } else if (IsApplTerm(t1)) {
+    if (IsVarTerm(t2) || IsAtomTerm(t2) || IsIntTerm(t2)) return FALSE;
+    if (IsPairTerm(t2)) return TRUE;
+    return (t1 <= t2);
+  } else /* if (IsPairTerm(t1)) */ {
+    return FALSE;
+  }
+}
+
 static inline void
 clcpy(ClauseDef *d, ClauseDef *s)
 {
   memcpy((void *)d, (void *)s, sizeof(ClauseDef));
 }
 
-/*
+static void
-  original code from  In Hyuk Choi,
+insort(ClauseDef base[], CELL *p, CELL *q, int my_p)
-  found at http://userpages.umbc.edu/~ichoi1/project/cs441.htm
-*/
-
-static inline void
-exchange(ClauseDef b[], Int i, Int j)
 {
-  ClauseDef t;
+  CELL *j;
 
-  clcpy(&t, b+j);
+  if (my_p) {
-  clcpy(b+j, b+i);
+    p[1] = p[0];
-  clcpy(b+i, &t);
+    for (j = p+2; j < q; j += 2) {
+      Term key;
+      Int off = *j;
+      CELL *i;
+
+      key = base[off].Tag;
+      i = j+1;
+    
+      /* we are at offset 1 */
+      while (i > p+1 && smaller(key,base[i[-2]].Tag)) {
+	i[0] = i[-2];
+	i -= 2;
+      }
+      i[0] = off;
+    }
+  } else {
+    for (j = p+2; j < q; j += 2) {
+      Term key;
+      Int off = *j;
+      CELL *i;
+
+      key = base[off].Tag;
+      i = j;
+    
+      /* we are at offset 1 */
+      while (i > p && smaller(key,base[i[-2]].Tag)) {
+	i[0] = i[-2];
+	i -= 2;
+      }
+      i[0] = off;
+    }
+  }
 }
 
-static UInt
+
-partition(ClauseDef a[], Int p, Int r)
+/* copy to a new list of terms */
+static
+void msort(ClauseDef *base, Int *pt, Int size, int my_p)
 {
-  Term x;
-  UInt i, j;
 
-  x = a[p].Tag;
+  if (size > 2) {
-  i = p+1;
+    Int half_size = size / 2;
-  j = r;
+    Int *pt_left, *pt_right, *end_pt, *end_pt_left;
+    int left_p, right_p;
 
-  while (smaller(x,a[j].Tag) && i < j) {
+    if (size < 50) {
-    j--;
+       insort(base, pt, pt+2*size, my_p);
-  }
+       return;
-  while (smaller(a[i].Tag, x) && i < j) {
-    i++;
-  }
-  while(i < j) {
-    exchange(a, i, j);
-    i++;
-    j--;
-    while (smaller(x, a[j].Tag) && i < j) {
-      j--;
     }
-    while (smaller(a[i].Tag, x) && i < j) {
+    pt_right = pt + half_size*2;
-      i++;
+    left_p = my_p^1;
+    right_p = my_p;
+    msort(base, pt, half_size, left_p);
+    msort(base, pt_right, size-half_size, right_p);
+    /* now implement a simple merge routine */
+    
+    /* pointer to after the end of the list */
+    end_pt = pt + 2*size;
+    /* pointer to the element after the last element to the left */
+    end_pt_left = pt+half_size*2;
+    /* where is left list */
+    pt_left = pt+left_p;
+    /* where is right list */
+    pt_right += right_p;
+    /* where is new list */
+    pt += my_p;
+    /* while there are elements in the left or right vector do compares */
+    while (pt_left < end_pt_left && pt_right < end_pt) {
+      /* if the element to the left is larger than the one to the right */
+      if (smaller_or_eq(base[pt_left[0]].Tag, base[pt_right[0]].Tag)) {
+	/* copy the one to the left */
+	pt[0] = pt_left[0];
+	/* and avance the two pointers */
+	pt += 2;
+	pt_left += 2;
+      } else {
+	/* otherwise, copy the one to the right */
+	pt[0] = pt_right[0];
+	pt += 2;
+	pt_right += 2;
+      }
+    }
+    /* if any elements were left in the left vector just copy them */
+    while (pt_left < end_pt_left) {
+      pt[0] = pt_left[0];
+      pt += 2;
+      pt_left += 2;
+    }
+    /* if any elements were left in the right vector
+       and they are in the wrong place, just copy them */
+    if (my_p != right_p) {
+      while(pt_right < end_pt) {
+	pt[0] = pt_right[0];
+	pt += 2;
+	pt_right += 2;
+      }
+    }
+  } else {
+    if (size > 1 && smaller(base[pt[2]].Tag,base[pt[0]].Tag)) {
+      CELL t = pt[2];
+      pt[2+my_p] = pt[0];
+      pt[my_p] = t;
+    } else if (my_p) {
+      pt[1] = pt[0];
+      if (size > 1)
+	pt[3] = pt[2];
     }
   }
-  if (smaller(x, a[i].Tag))
-    i--;
-  exchange(a, p, i);
-  return(i);
 }
 
 static void
-insort(ClauseDef a[], Int p, Int q)
+copy_back(ClauseDef *dest, CELL *pt, int max) {
-{
+  /* first need to say that we had no need to make a copy */
-  Int j;
+  int i;
+  CELL *tmp = pt;
+  for (i=0; i < max; i++) {
+    if (*tmp != i) {
+      ClauseDef cl;
+      int j = i;
+      CELL *pnt = tmp;
 
-  for (j = p+1; j <= q; j ++) {
+      /* found a chain */
-    ClauseDef key;
+      /* make a backup copy */
-    Int i;
+      clcpy(&cl, dest+i);
+      do {
+	/* follow the chain */
+	int k = *pnt;
 
-    clcpy(&key, a+j);
+	*pnt = j;
-    i = j;
+	//	printf("i=%d, k = %d, j = %d\n",i,j,k);
-	 
+	if (k == i) {
-    while (i > p && smaller(key.Tag,a[i-1].Tag)) {
+	  clcpy(dest+j, &cl);
-      clcpy(a+i, a+(i-1));
+	  break;
-      i --;
+	} else {
+	  clcpy(dest+j, dest+k);
+	}
+	pnt = pt+2*k;
+	j = k;
+      } while (TRUE);
     }
-    clcpy(a+i, &key);
+    /* we don't need to do swap */
-  }
+    tmp += 2;
-}
-
-
-static void
-quicksort(ClauseDef a[], Int p, Int r)
-{ 
-  Int q;
-  if (p < r) {
-    if (r - p < 100) {
-      insort(a, p, r);
-      return;
-    }
-    exchange(a, p, (p+r)/2);
-    q = partition (a, p, r);  
-    quicksort(a, p, q-1);
-    quicksort(a, q + 1, r);
   }
 }
 
 /* sort a group of clauses by using their tags */
 static void
-sort_group(GroupDef *grp)
+sort_group(GroupDef *grp, CELL *top)
 {
-  quicksort(grp->FirstClause, 0, grp->LastClause-grp->FirstClause);
+  int max = (grp->LastClause-grp->FirstClause)+1, i;
+  CELL *pt = top;
+
+  while (top+2*max > (CELL *)Yap_TrailTop) {
+    if (!Yap_growtrail(2*max*CellSize)) {
+      Yap_Error(SYSTEM_ERROR,TermNil,"YAP failed to reserve %ld in growtrail",
+		2*max*CellSize);
+      return;
+    }
+  }
+  /* initialise vector */
+  for (i=0; i < max; i++) {
+    *pt = i;
+    pt += 2;
+  }
+#define M_EVEN  0
+  msort(grp->FirstClause, top, max, M_EVEN);
+  copy_back(grp->FirstClause, top, max);
 }
 
 /* add copy to register stack for original reg */
@@ -197,6 +304,14 @@ add_regcopy(wamreg regs[MAX_REG_COPIES], int regs_count, wamreg copy)
   return regs_count+1;
 }
 
+/* add copy to register stack for original reg */
+static int
+init_regcopy(wamreg regs[MAX_REG_COPIES], wamreg copy)
+{
+  regs[0] = copy;
+  return 1;
+}
+
 /* add copy to register stack for original reg */
 static int
 delete_regcopy(wamreg regs[MAX_REG_COPIES], int regs_count, wamreg copy)
@@ -219,12 +334,12 @@ inline static int
 regcopy_in(wamreg regs[MAX_REG_COPIES], int regs_count, wamreg copy)
 {
   int i = 0;
-  while (i < regs_count) {
+  do {
     if (regs[i] == copy) {
       return TRUE;
     }
     i++;
-  }
+  } while (i < regs_count);
   /* this copy could not be found */
   return FALSE;
 }
@@ -237,6 +352,7 @@ has_cut(yamop *pc)
  * clause for this predicate or not 
  */
 {
+#if YAPOR
   do {
     op_numbers op = Yap_op_from_opcode(pc->opc);
     pc->opc = Yap_opcode(op);
@@ -715,6 +831,9 @@ has_cut(yamop *pc)
       break;
     }
   } while (TRUE);
+#else /* YAPOR */
+  return FALSE;
+#endif /* YAPOR */
 }
 
 static void 
@@ -725,117 +844,14 @@ add_info(ClauseDef *clause, UInt regno)
   yslot ycopy = 0;
   yamop *cl;
   
-  nofregs = add_regcopy(myregs, 0, Yap_regnotoreg(regno));
+  nofregs = init_regcopy(myregs, Yap_regnotoreg(regno));
   cl = clause->CurrentCode;
   while (TRUE) {
     op_numbers op = Yap_op_from_opcode(cl->opc);
     switch (op) {
-    case _Ystop:
-    case _Nstop:
-    case _try_me:
-    case _retry_me:
-    case _trust_me:
-    case _profiled_retry_me:
-    case _profiled_trust_me:
-    case _count_retry_me:
-    case _count_trust_me:
-    case _try_me0:
-    case _retry_me0:
-    case _trust_me0:
-    case _try_me1:
-    case _retry_me1:
-    case _trust_me1:
-    case _try_me2:
-    case _retry_me2:
-    case _trust_me2:
-    case _try_me3:
-    case _retry_me3:
-    case _trust_me3:
-    case _try_me4:
-    case _retry_me4:
-    case _trust_me4:
-    case _spy_or_trymark:
-    case _try_and_mark:
-    case _profiled_retry_and_mark:
-    case _count_retry_and_mark:
-    case _retry_and_mark:
-    case _try_clause:
-    case _retry:
-    case _trust:
-#ifdef YAPOR
-    case _getwork:
-    case _getwork_seq:
-    case _sync:
-#endif
-#ifdef TABLING
-    case _table_try_me_single:
-    case _table_try_me:
-    case _table_retry_me:
-    case _table_trust_me:
-    case _table_answer_resolution:
-    case _table_completion:
-#endif
-    case _enter_profiling:
-    case _count_call:
-    case _retry_profiled:
-    case _count_retry:
-    case _try_logical_pred:
-    case _trust_logical_pred:
-    case _execute:
-    case _dexecute:
-    case _jump:
-    case _move_back:
-    case _skip:
-    case _jump_if_var:
-    case _try_in:
-      clause->Tag = (CELL)NULL;
-      return;
     case _alloc_for_logical_pred:
       cl = NEXTOP(cl,EC);
       break;
-      /* instructions type e */
-    case _trust_fail:
-    case _op_fail:
-    case _procceed:
-#if !defined(YAPOR)
-    case _or_last:
-#endif
-    case _pop:
-    case _index_pred:
-    case _undef_p:
-    case _spy_pred:
-    case _p_equal:
-    case _p_dif:
-    case _p_eq:
-    case _p_functor:
-    case _p_execute_tail:
-#ifdef YAPOR
-    case _getwork_first_time:
-#endif
-#ifdef TABLING
-    case _trie_do_var:
-    case _trie_trust_var:
-    case _trie_try_var:
-    case _trie_retry_var:
-    case _trie_do_val:
-    case _trie_trust_val:
-    case _trie_try_val:
-    case _trie_retry_val:
-    case _trie_do_atom:
-    case _trie_trust_atom:
-    case _trie_try_atom:
-    case _trie_retry_atom:
-    case _trie_do_list:
-    case _trie_trust_list:
-    case _trie_try_list:
-    case _trie_retry_list:
-    case _trie_do_struct:
-    case _trie_trust_struct:
-    case _trie_try_struct:
-    case _trie_retry_struct:
-#endif
-      clause->Tag = (CELL)NULL;
-      return;
     case _cut:
     case _cut_t:
     case _cut_e:
@@ -1487,6 +1503,109 @@ add_info(ClauseDef *clause, UInt regno)
     case _call_bfunc_yy:
       cl = NEXTOP(cl,lyy);
       break;
+    case _Ystop:
+    case _Nstop:
+    case _try_me:
+    case _retry_me:
+    case _trust_me:
+    case _profiled_retry_me:
+    case _profiled_trust_me:
+    case _count_retry_me:
+    case _count_trust_me:
+    case _try_me0:
+    case _retry_me0:
+    case _trust_me0:
+    case _try_me1:
+    case _retry_me1:
+    case _trust_me1:
+    case _try_me2:
+    case _retry_me2:
+    case _trust_me2:
+    case _try_me3:
+    case _retry_me3:
+    case _trust_me3:
+    case _try_me4:
+    case _retry_me4:
+    case _trust_me4:
+    case _spy_or_trymark:
+    case _try_and_mark:
+    case _profiled_retry_and_mark:
+    case _count_retry_and_mark:
+    case _retry_and_mark:
+    case _try_clause:
+    case _retry:
+    case _trust:
+#ifdef YAPOR
+    case _getwork:
+    case _getwork_seq:
+    case _sync:
+#endif
+#ifdef TABLING
+    case _table_try_me_single:
+    case _table_try_me:
+    case _table_retry_me:
+    case _table_trust_me:
+    case _table_answer_resolution:
+    case _table_completion:
+#endif
+    case _enter_profiling:
+    case _count_call:
+    case _retry_profiled:
+    case _count_retry:
+    case _try_logical_pred:
+    case _trust_logical_pred:
+    case _execute:
+    case _dexecute:
+    case _jump:
+    case _move_back:
+    case _skip:
+    case _jump_if_var:
+    case _try_in:
+      clause->Tag = (CELL)NULL;
+      return;
+      /* instructions type e */
+    case _trust_fail:
+    case _op_fail:
+    case _procceed:
+#if !defined(YAPOR)
+    case _or_last:
+#endif
+    case _pop:
+    case _index_pred:
+    case _undef_p:
+    case _spy_pred:
+    case _p_equal:
+    case _p_dif:
+    case _p_eq:
+    case _p_functor:
+    case _p_execute_tail:
+#ifdef YAPOR
+    case _getwork_first_time:
+#endif
+#ifdef TABLING
+    case _trie_do_var:
+    case _trie_trust_var:
+    case _trie_try_var:
+    case _trie_retry_var:
+    case _trie_do_val:
+    case _trie_trust_val:
+    case _trie_try_val:
+    case _trie_retry_val:
+    case _trie_do_atom:
+    case _trie_trust_atom:
+    case _trie_try_atom:
+    case _trie_retry_atom:
+    case _trie_do_list:
+    case _trie_trust_list:
+    case _trie_try_list:
+    case _trie_retry_list:
+    case _trie_do_struct:
+    case _trie_trust_struct:
+    case _trie_try_struct:
+    case _trie_retry_struct:
+#endif
+      clause->Tag = (CELL)NULL;
+      return;
     }
   }
 }
@@ -2484,7 +2603,7 @@ do_nonvar_group(GroupDef *grp, int compound_term, UInt labl, PredEntry *ap, UInt
     type_sw = emit_type_switch(switch_on_type_op);
     type_sw->VarEntry = do_var_entries(grp, ap, argno, first, clleft, nxtlbl);
     grp->LastClause = cls_move(grp->FirstClause, grp->LastClause, compound_term, argno, last_arg);
-    sort_group(grp);
+    sort_group(grp,top);
     type_sw->ConstEntry = do_consts(grp, ap, argno, first, nxtlbl, clleft, top);
     type_sw->FuncEntry = do_funcs(grp, ap, argno, first, last_arg, nxtlbl, clleft, top);
     type_sw->PairEntry = do_pair(grp, ap, argno, first, last_arg, nxtlbl, clleft, top);
@@ -2540,7 +2659,8 @@ do_index(ClauseDef *min, ClauseDef* max, PredEntry *ap, UInt argno, UInt fail_l,
     /* base case, just commit to the current code */
     return emit_single_switch_case(min, ap, first, clleft, fail_l);
   }
-  if (ap->ArityOfPE < argno) {
+  if ((argno > 1 && yap_flags[INDEXING_MODE_FLAG] == INDEX_MODE_SINGLE) ||
+      ap->ArityOfPE < argno) {
     UInt labl = new_label();
     do_var_clauses(min, max, FALSE, ap, labl, first, clleft, fail_l);
     return labl;
@@ -2643,6 +2763,11 @@ do_compound_index(ClauseDef *min, ClauseDef* max, PredEntry *ap, UInt arity, UIn
     /* base case, just commit to the current code */
     return emit_single_switch_case(cl, ap, first, clleft, fail_l);
   }
+  if (yap_flags[INDEXING_MODE_FLAG] == INDEX_MODE_SINGLE) {
+    UInt labl = new_label();
+    do_var_clauses(min, max, FALSE, ap, labl, first, clleft, fail_l);
+    return labl;
+  }
   group = (GroupDef *)top;
   cl = min;
   while (i < arity) { 

C/init.c

@@ -667,6 +667,8 @@ InitFlags(void)
 #else
   yap_flags[ALLOW_ASSERTING_STATIC_FLAG] = TRUE;
 #endif
+  /* current default */
+  yap_flags[INDEXING_MODE_FLAG] = INDEX_MODE_MULTI;
 }
 
 static void 
@@ -838,7 +840,6 @@ InitCodes(void)
   AtomGVar = Yap_LookupAtom("var");
   heap_regs->atom_global = Yap_LookupAtom("global_sp");
   heap_regs->atom_heap_used = Yap_LookupAtom("heapused");
-  heap_regs->atom_index = Yap_LookupAtom("$doindex");
   heap_regs->atom_inf = Yap_LookupAtom("inf");
   heap_regs->atom_l_t = Yap_LookupAtom("<");
   heap_regs->atom_local = Yap_LookupAtom("local_sp");

C/stdpreds.c

@@ -110,7 +110,7 @@ STD_PROTO(static Int profres2, (void));
 
 typedef struct prof_files {
   FILE *f_prof, *f_preds;
-};
+} prof_files_struct;
 
 void
 Yap_inform_profiler_of_clause(yamop *code_start, yamop *code_end, PredEntry *pe) {
@@ -2434,6 +2434,11 @@ p_set_yap_flags(void)
       return(FALSE);
     yap_flags[STACK_DUMP_ON_ERROR_FLAG] = value;
     break;
+  case INDEXING_MODE_FLAG:
+    if (value < INDEX_MODE_OFF || value >  INDEX_MODE_MAX)
+      return(FALSE);
+    yap_flags[INDEXING_MODE_FLAG] = value;
+    break;
   default:
     return(FALSE);
   }

C/tracer.c

@@ -111,9 +111,10 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
   /*  extern int gc_calls; */
 
   vsc_count++;
+  if (vsc_count < 130000) return;
 #ifdef COMMENTED
   return;
-  if (vsc_count == 124881LL) {
+  if (vsc_count == 133000LL) {
     printf("Here I go\n");
   } 
   if (vsc_count > 500000) exit(0);

C/unify.c

@@ -561,13 +561,6 @@ unify_var_nvar_trail:
 
 #if USE_THREADED_CODE
 
-static inline int
-rtable_hash_op(OPCODE opc, int hash_mask) {
-  return((((CELL)opc) >> 3) & hash_mask);
-}
-
-#define OP_HASH_SIZE 2048
-
 /* mask a hash table that allows for fast reverse translation from
    instruction address to corresponding opcode */
 static void
@@ -610,31 +603,8 @@ InitReverseLookupOpcode(void)
     opeptr[j].opc = opc;
   }
 }
-
-/* given an opcode find the corresponding opnumber. This should make
-   switches on ops a much easier operation */
-op_numbers
-Yap_op_from_opcode(OPCODE opc)
-{
-  int j = rtable_hash_op(opc,OP_HASH_SIZE-1);
-
-  while (OP_RTABLE[j].opc != opc) {
-    if (j == OP_HASH_SIZE-1)
-      j = 0;
-    else
-      j++;
-  }
-  return(OP_RTABLE[j].opnum);
-}
-#else
-op_numbers
-Yap_op_from_opcode(OPCODE opc)
-{
-  return((op_numbers)opc);
-}
 #endif
 
-
 void 
 Yap_InitUnify(void)
 {

C/ypsocks.c

@@ -191,9 +191,9 @@ Yap_init_socks(char *host, long interface_port)
 
 #if   USE_SOCKET
    he = gethostbyname(host);
-   if (!he) {
+   if (he == NULL) {
 #if HAVE_STRERROR
-     Yap_Error(SYSTEM_ERROR, TermNil, "can not get address for host: %s", strerror(errno));
+     Yap_Error(SYSTEM_ERROR, TermNil, "can not get address for host %s: %s", host, strerror(h_errno));
 #else
      Yap_Error(SYSTEM_ERROR, TermNil, "can not get address for host");
 #endif

H/Heap.h

@@ -10,7 +10,7 @@
 * File:		Heap.h         						 *
 * mods:									 *
 * comments:	Heap Init Structure					 *
-* version:      $Id: Heap.h,v 1.42 2003-05-21 13:00:23 vsc Exp $	 *
+* version:      $Id: Heap.h,v 1.43 2003-06-06 11:54:01 vsc Exp $	 *
 *************************************************************************/
 
 /* information that can be stored in Code Space */
@@ -199,7 +199,6 @@ typedef struct various_codes {
     atom_gc_very_verbose,
     atom_global,
     atom_heap_used,
-    atom_index,
     atom_inf,
     atom_l_t,
     atom_local,
@@ -430,7 +429,6 @@ typedef struct various_codes {
 #define  AtomGcVeryVerbose        heap_regs->atom_gc_very_verbose
 #define  AtomGlobal               heap_regs->atom_global
 #define  AtomHeapUsed             heap_regs->atom_heap_used
-#define  AtomIndex                heap_regs->atom_index
 #define  AtomInf                  heap_regs->atom_inf
 #define  AtomLocal                heap_regs->atom_local
 #define  AtomLT                   heap_regs->atom_l_t

H/Yapproto.h

@@ -10,7 +10,7 @@
 * File:		Yap.proto						 *
 * mods:									 *
 * comments:	Function declarations for YAP				 *
-* version:      $Id: Yapproto.h,v 1.36 2003-05-21 13:00:23 vsc Exp $	 *
+* version:      $Id: Yapproto.h,v 1.37 2003-06-06 11:54:02 vsc Exp $	 *
 *************************************************************************/
 
 /* prototype file for Yap */
@@ -275,7 +275,6 @@ void	STD_PROTO(Yap_InitLowLevelTrace,(void));
 void         STD_PROTO(Yap_InitAbsmi,(void));
 void         STD_PROTO(Yap_InitUnify,(void));
 int          STD_PROTO(Yap_IUnify,(register CELL d0,register CELL d1));
-op_numbers   STD_PROTO(Yap_op_from_opcode,(OPCODE));
 
 /* userpreds.c */
 void	STD_PROTO(Yap_InitUserCPreds,(void));

H/amidefs.h

@@ -615,4 +615,3 @@ extern int Yap_opcount[_std_top+1];
 #endif
 
 
-

H/clause.h

@@ -144,8 +144,40 @@ Term    STD_PROTO(Yap_cp_as_integer,(choiceptr));
 /* index.c */
 yamop   *STD_PROTO(Yap_PredIsIndexable,(PredEntry *));
 
-
 #if LOW_PROF
 /* profiling */
 yamop *Yap_prof_end;
 #endif /* LOW_PROF */
+
+#if USE_THREADED_CODE
+
+#define OP_HASH_SIZE 2048
+
+static inline int
+rtable_hash_op(OPCODE opc, int hash_mask) {
+  return((((CELL)opc) >> 3) & hash_mask);
+}
+
+/* given an opcode find the corresponding opnumber. This should make
+   switches on ops a much easier operation */
+static inline op_numbers
+Yap_op_from_opcode(OPCODE opc)
+{
+  int j = rtable_hash_op(opc,OP_HASH_SIZE-1);
+
+  while (OP_RTABLE[j].opc != opc) {
+    if (j == OP_HASH_SIZE-1) {
+      j = 0;
+    } else {
+      j++;
+    }
+  }
+  return OP_RTABLE[j].opnum;
+}
+#else
+static inline op_numbers
+Yap_op_from_opcode(OPCODE opc)
+{
+  return((op_numbers)opc);
+}
+#endif /* USE_THREADED_CODE */

H/rheap.h

@@ -210,7 +210,6 @@ restore_codes(void)
   heap_regs->atom_gc_very_verbose = AtomAdjust(heap_regs->atom_gc_very_verbose);
   heap_regs->atom_global = AtomAdjust(heap_regs->atom_global);
   heap_regs->atom_heap_used = AtomAdjust(heap_regs->atom_heap_used);
-  heap_regs->atom_index = AtomAdjust(heap_regs->atom_index);
   heap_regs->atom_inf = AtomAdjust(heap_regs->atom_inf);
   heap_regs->atom_l_t = AtomAdjust(heap_regs->atom_l_t);
   heap_regs->atom_local = AtomAdjust(heap_regs->atom_local);

m4/Yap.h.m4

@@ -10,7 +10,7 @@
 * File:		Yap.h.m4						 *
 * mods:									 *
 * comments:	main header file for YAP				 *
-* version:      $Id: Yap.h.m4,v 1.46 2003-05-20 19:11:59 vsc Exp $	 *
+* version:      $Id: Yap.h.m4,v 1.47 2003-06-06 11:54:02 vsc Exp $	 *
 *************************************************************************/
 
 #include "config.h"
@@ -509,7 +509,8 @@ typedef enum {
   ALLOW_ASSERTING_STATIC_FLAG = 14,
   HALT_AFTER_CONSULT_FLAG = 15,
   FAST_BOOT_FLAG = 16,
-  STACK_DUMP_ON_ERROR_FLAG = 17
+  STACK_DUMP_ON_ERROR_FLAG = 17,
+  INDEXING_MODE_FLAG = 18
 } yap_flags;
 
 #define STRING_AS_CHARS		0
@@ -522,7 +523,15 @@ typedef enum {
 #define ISO_CHARACTER_ESCAPES			1
 #define SICSTUS_CHARACTER_ESCAPES		2
 
-#define NUMBER_OF_YAP_FLAGS     STACK_DUMP_ON_ERROR_FLAG+1
+typedef enum {
+  INDEX_MODE_OFF = 0,
+  INDEX_MODE_SINGLE = 1,
+  INDEX_MODE_COMPACT = 2,
+  INDEX_MODE_MULTI = 3,
+  INDEX_MODE_MAX = 4
+} index_mode_options;
+
+#define NUMBER_OF_YAP_FLAGS     INDEXING_MODE_FLAG+1
 
 /************************  prototypes **********************************/
 

pl/directives.yap

@@ -205,10 +205,23 @@ yap_flag(bounded,X) :-
 	'$do_error'(domain_error(flag_value,bounded+X),yap_flag(bounded,X)).
 
 % do or do not indexation
-yap_flag(index,X) :- var(X), !,
+yap_flag(index,X) :- var(X),
-	 ( '$get_value'('$doindex',true) -> X=on ; X=off).
+	'$access_yap_flags'(18, X1),
-yap_flag(index,on)  :- !, '$set_value'('$doindex',true).
+	'$transl_to_index_mode'(X1,X), !.
-yap_flag(index,off) :- '$set_value'('$doindex',[]).
+yap_flag(index,X)  :-
+	'$transl_to_index_mode'(X1,X), !,
+	'$set_yap_flags'(18,X1).
+yap_flag(index,X) :-
+	'$do_error'(domain_error(flag_value,index+X),yap_flag(index,X)).
+
+% should match definitions in Yap.h.m4
+'$transl_to_index_mode'(0, off).
+'$transl_to_index_mode'(1, single).
+'$transl_to_index_mode'(2, compact).
+'$transl_to_index_mode'(3, multi).
+'$transl_to_index_mode'(3, on). % default is multi argument indexing
+'$transl_to_index_mode'(4, max).
+
 
 yap_flag(informational_messages,X) :- var(X), !,
 	 '$get_value'('$verbose',X).