try to make comparison faster in indexing code.

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

C/index.c

@@ -68,47 +68,21 @@ static UInt labelno;
 static inline int
 smaller(Term t1, Term t2)
 {
-  if (IsVarTerm(t1)) {
+  CELL tg1 = TagOf(t1), tg2 = TagOf(t2);
-    if (!IsVarTerm(t2)) return TRUE;
+  if (tg1 == tg2) {
-    return (t1 < t2);
+    return t1 < t2;
-  } else if (IsIntTerm(t1)) {
+  } else
-    if (IsVarTerm(t2)) return FALSE;
+    return tg1 < tg2;
-    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 int
 smaller_or_eq(Term t1, Term t2)
 {
-  if (IsVarTerm(t1)) {
+  CELL tg1 = TagOf(t1), tg2 = TagOf(t2);
-    if (!IsVarTerm(t2)) return TRUE;
+  if (tg1 == tg2) {
-    return (t1 <= t2);
+    return t1 <= t2;
-  } else if (IsIntTerm(t1)) {
+  } else
-    if (IsVarTerm(t2)) return FALSE;
+    return tg1 < tg2;
-    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
@@ -345,6 +319,7 @@ regcopy_in(wamreg regs[MAX_REG_COPIES], int regs_count, wamreg copy)
 }
 
 /* Restores a prolog clause, in its compiled form */
+#if YAPOR
 static int 
 has_cut(yamop *pc)
 /*
@@ -352,7 +327,6 @@ 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);
@@ -831,10 +805,10 @@ has_cut(yamop *pc)
       break;
     }
   } while (TRUE);
-#else /* YAPOR */
-  return FALSE;
-#endif /* YAPOR */
 }
+#else
+#define has_cut(pc) 0
+#endif /* YAPOR */
 
 static void 
 add_info(ClauseDef *clause, UInt regno)
@@ -2177,7 +2151,7 @@ emit_try(ClauseDef *cl, PredEntry *ap, int var_group, int first, int clauses, in
 static TypeSwitch *
 emit_type_switch(compiler_vm_op op)
 {
-  return (TypeSwitch *)Yap_emit_extra_size(op, 0, sizeof(TypeSwitch));
+ return (TypeSwitch *)Yap_emit_extra_size(op, 0, sizeof(TypeSwitch));
 }
 
 
@@ -2329,17 +2303,20 @@ log_update_chain(PredEntry *ap)
 {
   yamop *codep = ap->cs.p_code.FirstClause;
   yamop *lastp = ap->cs.p_code.LastClause;
+  int nclauses = (lastp-codep);
 
   Yap_emit(label_op, 1, Zero);
-  Yap_emit(try_op, (CELL)NEXTOP(codep,ld), Zero);
+  Yap_emit(try_op, (CELL)NEXTOP(codep,ld), (nclauses << 1) | has_cut(NEXTOP(codep,ld)->CurrentCode) );
+  nclauses--;
   add_lu_cl_info(codep);
   codep = NextClause(codep);
   while (codep != lastp) { 
-    Yap_emit(retry_op, (CELL)NEXTOP(codep,ld), Zero);
+    Yap_emit(retry_op, (CELL)NEXTOP(codep,ld), (nclauses << 1) | has_cut(NEXTOP(codep,ld)->CurrentCode));
+    nclauses--;
     add_lu_cl_info(codep);
     codep = NextClause(codep);
   }
-  Yap_emit(trust_op, (CELL)NEXTOP(codep,ld), Zero);
+  Yap_emit(trust_op, (CELL)NEXTOP(codep,ld), has_cut(codep->CurrentCode));
   add_lu_cl_info(codep);
   return 1;
 }
@@ -2462,7 +2439,7 @@ do_funcs(GroupDef *grp, PredEntry *ap, UInt argno, int first, int last_arg, UInt
   FuncSwiEntry *fs;
   UInt lbl;
 
-  if (min > grp->LastClause || !IsApplTerm(min->Tag)) {
+  if (min > grp->LastClause || n == 0) {
     /* no clauses, just skip */
     return nxtlbl;
   }
@@ -2493,12 +2470,17 @@ static UInt
 do_pair(GroupDef *grp, PredEntry *ap, UInt argno, int first, int last_arg, UInt nxtlbl, int clleft, CELL *top)
 {
   ClauseDef *min = grp->FirstClause;
-  ClauseDef *max = grp->LastClause;
+  ClauseDef *max = grp->FirstClause;
 
-  if (min > max) {
+  while (IsPairTerm(max->Tag) && max != grp->LastClause) {
+    max++;
+  }
+  if (min > grp->LastClause) {
     /* no clauses, just skip */
     return nxtlbl;
-  } else if (min == max) {
+  }
+  grp->FirstClause = max+1;
+  if (min == max) {
     /* single clause, no need to do indexing, but we do know it is a list */ 
     return (UInt)(min->CurrentCode);
   }
@@ -2604,9 +2586,19 @@ do_nonvar_group(GroupDef *grp, int compound_term, UInt labl, PredEntry *ap, UInt
     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,top);
-    type_sw->ConstEntry = do_consts(grp, ap, argno, first, nxtlbl, clleft, top);
+    type_sw->ConstEntry = 
-    type_sw->FuncEntry = do_funcs(grp, ap, argno, first, last_arg, nxtlbl, clleft, top);
+      type_sw->FuncEntry = 
-    type_sw->PairEntry = do_pair(grp, ap, argno, first, last_arg, nxtlbl, clleft, top);
+      type_sw->PairEntry = 
+      nxtlbl;
+    while (grp->FirstClause <= grp->LastClause) {
+      if (IsAtomOrIntTerm(grp->FirstClause->Tag)) {
+	type_sw->ConstEntry = do_consts(grp, ap, argno, first, nxtlbl, clleft, top);
+      } else if (IsApplTerm(grp->FirstClause->Tag)) {
+	type_sw->FuncEntry = do_funcs(grp, ap, argno, first, last_arg, nxtlbl, clleft, top);
+      } else {
+	type_sw->PairEntry = do_pair(grp, ap, argno, first, last_arg, nxtlbl, clleft, top);
+      }
+    }
   } else {
     do_var_group(grp, ap, labl, TRUE, first, clleft, nxtlbl);
   }
@@ -2875,3 +2867,11 @@ Yap_PredIsIndexable(PredEntry *ap)
 #endif
   return(indx_out);
 }
+
+/* store a new clause in the index, right now it may be first or last  */
+/*Yap_IncrementalIndexing(PredEntry *ap, yamop *cl, int flag)
+{
+  CELL *top = (CELL *) TR;
+  pc = ap->TrueCodeOfPred;
+}
+*/

C/tracer.c

@@ -111,8 +111,8 @@ 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
+  if (vsc_count < 130000) return;
   return;
   if (vsc_count == 133000LL) {
     printf("Here I go\n");

m4/Tags_24bits.h.m4

@@ -11,7 +11,7 @@
 * Last rev:	December 90						 *
 * mods:									 *
 * comments:	Tag Scheme for machines with 24 bits adresses (m68000)   *
-* version:      $Id: Tags_24bits.h.m4,v 1.1.1.1 2001-04-09 19:53:46 vsc Exp $	 *
+* version:      $Id: Tags_24bits.h.m4,v 1.2 2003-06-06 13:16:40 vsc Exp $	 *
 *************************************************************************/
 
      /*   Version for 24 bit	addresses (68000)
@@ -46,6 +46,7 @@
 #define NumberMask	0xb8000000L
 #define MAX_ABS_INT /* 0xfe00000LL */ ((((UInt)(1<<7))-1) << SHIFT_HIGH_TAG)
 
+#define	TagOf(X)	(Unsigned(X) & TagBits)
 #define	NonTagPart(X)	(Signed(X) & MaskAdr)
 #define TAGGEDA(TAG,V)	(TAG | Unsigned(V))
 #define TAGGED(TAG,V)   (TAG | NonTagPart(Unsigned(V)))

m4/Tags_32LowTag.h.m4

@@ -11,7 +11,7 @@
 * Last rev:	December 90						 *
 * mods:									 *
 * comments:	Original Tag Scheme for machines with 32 bits adresses   *
-* version:      $Id: Tags_32LowTag.h.m4,v 1.2 2002-02-22 06:10:15 vsc Exp $	 *
+* version:      $Id: Tags_32LowTag.h.m4,v 1.3 2003-06-06 13:16:40 vsc Exp $	 *
 *************************************************************************/
 
 #define TAG_LOW_BITS_32 1
@@ -65,6 +65,7 @@ property list
 #define NumberBits  /* 0x0000000aL */ MKTAG(0x2,2)
 #define NumberMask  /* 0x0000000bL */ MKTAG(0x2,3)
 
+#define	TagOf(V)	(Unsigned(V) & LowTagBits)
 #define	NonTagPart(V)	((Unsigned(V)>>1) & ~LowTagBits)
 #define TAGGED(TAG,V)	(((Unsigned(V)<<(SHIFT_HIGH_TAG+SHIFT_LOW_TAG+1))>>1)|(TAG))
 #define NONTAGGED(TAG,V) ((Unsigned(V)<<(SHIFT_HIGH_TAG+SHIFT_LOW_TAG+1))>>1)

m4/Tags_32Ops.h.m4

@@ -11,7 +11,7 @@
 * Last rev:	December 90						 *
 * mods:									 *
 * comments:	Original Tag Scheme for machines with 32 bits adresses   *
-* version:      $Id: Tags_32Ops.h.m4,v 1.2 2001-09-24 18:07:16 vsc Exp $	 *
+* version:      $Id: Tags_32Ops.h.m4,v 1.3 2003-06-06 13:16:40 vsc Exp $	 *
 *************************************************************************/
 
 /*
@@ -83,6 +83,7 @@ are now 1 in compound terms and structures.
 #define	ApplBit	    /* 0x00000001L */ 1
 #endif
 
+#define TagOf(t) 	(Unsigned(t)&TagBits)
 #define	NonTagPart(X)	(Signed(X) & MaskPrim)
 #define TAGGEDA(TAG,V)	(TAG | Unsigned(V))
 #define TAGGED(TAG,V)   (TAG | NonTagPart(Unsigned(V)<<2))

m4/Tags_64bits.h.m4

@@ -11,7 +11,7 @@
 * Last rev:	December 90						 *
 * mods:									 *
 * comments:	Original Tag Scheme for machines with 32 bits adresses   *
-* version:      $Id: Tags_64bits.h.m4,v 1.2 2001-06-27 15:14:02 vsc Exp $	 *
+* version:      $Id: Tags_64bits.h.m4,v 1.3 2003-06-06 13:16:40 vsc Exp $	 *
 *************************************************************************/
 
 #define TAG_64BITS 1
@@ -57,6 +57,7 @@ property list
 #define PrimiBits   /* 0x70000004L */ MKTAG(0x7,7)
 #define NumberMask  /* 0x20000007L */ MKTAG(0x2,7)
 
+#define TagOf(t) 	(Unsigned(t)&TagBits)
 #define	NonTagPart(X)	(Signed(X) & MaskPrim)
 #define TAGGEDA(TAG,V)	(TAG | Unsigned(V))
 #define TAGGED(TAG,V)   (TAG | NonTagPart(Unsigned(V)<<3)) /* SQRT(8) */

m4/Tags_64ops.h.m4

@@ -11,7 +11,7 @@
 * Last rev:	December 90						 *
 * mods:									 *
 * comments:	Original Tag Scheme for machines with 32 bits adresses   *
-* version:      $Id: Tags_64ops.h.m4,v 1.2 2001-09-24 18:07:16 vsc Exp $	 *
+* version:      $Id: Tags_64ops.h.m4,v 1.3 2003-06-06 13:16:40 vsc Exp $	 *
 *************************************************************************/
 
 /*
@@ -81,6 +81,7 @@ are now 1 in compound terms and structures.
 #define	ApplBit	    /* 0x00000001L */ 1
 #endif
 
+#define TagOf(t) 	(Unsigned(t)&TagBits)
 #define	NonTagPart(X)	(Signed(X) & MaskPrim)
 #define TAGGEDA(TAG,V)	(TAG | Unsigned(V))
 #define TAGGED(TAG,V)   (TAG | NonTagPart(Unsigned(V)<<2))