From 2e3221a68d74116b30c72d4c3133897a3d16c101 Mon Sep 17 00:00:00 2001
From: vsc <vsc@b08c6af1-5177-4d33-ba66-4b1c6b8b522a>
Date: Wed, 10 Mar 2004 14:59:55 +0000
Subject: [PATCH] optimise -> for type tests

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1024 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
---
 C/absmi.c      | 289 ++++++++++++++++++++++++++++---------------------
 C/amasm.c      |  29 ++++-
 C/computils.c  |  24 ++--
 C/index.c      | 110 ++++++++++++-------
 H/YapOpcodes.h |  49 +++++----
 H/amidefs.h    |  19 +++-
 H/rheap.h      |  16 ++-
 7 files changed, 325 insertions(+), 211 deletions(-)

diff --git a/C/absmi.c b/C/absmi.c
index 839f74d2d..620b74070 100644
--- a/C/absmi.c
+++ b/C/absmi.c
@@ -10,8 +10,11 @@
 *									 *
 * File:		absmi.c							 *
 * comments:	Portable abstract machine interpreter                    *
-* Last rev:     $Date: 2004-03-08 19:31:01 $,$Author: vsc $						 *
-* $Log: not supported by cvs2svn $									 *
+* Last rev:     $Date: 2004-03-10 14:59:54 $,$Author: vsc $						 *
+* $Log: not supported by cvs2svn $
+* Revision 1.124  2004/03/08 19:31:01  vsc
+* move to 4.5.3
+*									 *
 *									 *
 *************************************************************************/
 
@@ -7093,98 +7096,106 @@ Yap_absmi(int inp)
 *	Basic Primitive Predicates					 *
 \************************************************************************/
 
-      Op(p_atom_x, x);
+      Op(p_atom_x, xF);
       BEGD(d0);
-      d0 = XREG(PREG->u.x.x);
+      d0 = XREG(PREG->u.xF.x);
       deref_head(d0, atom_x_unk);
     atom_x_nvar:
       if (IsAtomTerm(d0)) {
-	PREG = NEXTOP(PREG, x);
+	PREG = NEXTOP(PREG, xF);
 	GONext();
       }
       else {
-	FAIL();
+	PREG = PREG->u.xF.F;
+	GONext();
       }
 
       BEGP(pt0);
       deref_body(d0, pt0, atom_x_unk, atom_x_nvar);
-      FAIL();
+      PREG = PREG->u.xF.F;
+      GONext();
       ENDP(pt0);
       ENDD(d0);
       ENDOp();
 
-      Op(p_atom_y, y);
+      Op(p_atom_y, yF);
       BEGD(d0);
       BEGP(pt0);
-      pt0 = YREG + PREG->u.y.y;
+      pt0 = YREG + PREG->u.yF.y;
       d0 = *pt0;
       deref_head(d0, atom_y_unk);
     atom_y_nvar:
       if (IsAtomTerm(d0)) {
-	PREG = NEXTOP(PREG, y);
+	PREG = NEXTOP(PREG, yF);
 	GONext();
       }
       else {
-	FAIL();
+	PREG = PREG->u.yF.F;
+	GONext();
       }
 
       derefa_body(d0, pt0, atom_y_unk, atom_y_nvar);
-      FAIL();
+      PREG = PREG->u.yF.F;
+      GONext();
       ENDP(pt0);
       ENDD(d0);
       ENDOp();
 
-      Op(p_atomic_x, x);
+      Op(p_atomic_x, xF);
       BEGD(d0);
-      d0 = XREG(PREG->u.x.x);
+      d0 = XREG(PREG->u.xF.x);
       deref_head(d0, atomic_x_unk);
     atomic_x_nvar:
       /* non variable */
       if (IsAtomicTerm(d0)) {
-	PREG = NEXTOP(PREG, x);
+	PREG = NEXTOP(PREG, xF);
 	GONext();
       }
       else {
-	FAIL();
+	PREG = PREG->u.xF.F;
+	GONext();
       }
 
       BEGP(pt0);
       deref_body(d0, pt0, atomic_x_unk, atomic_x_nvar);
-      FAIL();
+      PREG = PREG->u.xF.F;
+      GONext();
       ENDP(pt0);
       ENDD(d0);
       ENDOp();
 
-      Op(p_atomic_y, y);
+      Op(p_atomic_y, yF);
       BEGD(d0);
       BEGP(pt0);
-      pt0 = YREG + PREG->u.y.y;
+      pt0 = YREG + PREG->u.yF.y;
       d0 = *pt0;
       deref_head(d0, atomic_y_unk);
     atomic_y_nvar:
       /* non variable */
       if (IsAtomicTerm(d0)) {
-	PREG = NEXTOP(PREG, y);
+	PREG = NEXTOP(PREG, yF);
 	GONext();
       }
       else {
-	FAIL();
+	PREG = PREG->u.yF.F;
+	GONext();
       }
 
       derefa_body(d0, pt0, atomic_y_unk, atomic_y_nvar);
-      FAIL();
+      PREG = PREG->u.yF.F;
+      GONext();
       ENDP(pt0);
       ENDD(d0);
       ENDOp();
 
-      Op(p_integer_x, x);
+      Op(p_integer_x, xF);
       BEGD(d0);
-      d0 = XREG(PREG->u.x.x);
+      d0 = XREG(PREG->u.xF.x);
       deref_head(d0, integer_x_unk);
     integer_x_nvar:
       /* non variable */
       if (IsIntTerm(d0)) {
-	PREG = NEXTOP(PREG, x);
+	PREG = NEXTOP(PREG, xF);
 	GONext();
       }
       if (IsApplTerm(d0)) {
@@ -7195,32 +7206,35 @@ Yap_absmi(int inp)
 #ifdef USE_GMP
 	  case (CELL)FunctorBigInt:
 #endif
-	    PREG = NEXTOP(PREG, x);
+	    PREG = NEXTOP(PREG, xF);
 	    GONext();
 	  default:
-	    FAIL();
+	    PREG = PREG->u.xF.F;
+	    GONext();
 	  }
 	}
       }
-      FAIL();
+      PREG = PREG->u.xF.F;
+      GONext();
 
       BEGP(pt0);
       deref_body(d0, pt0, integer_x_unk, integer_x_nvar);
-      FAIL();
+      PREG = PREG->u.xF.F;
+      GONext();
       ENDP(pt0);
       ENDD(d0);
       ENDOp();
 
-      Op(p_integer_y, y);
+      Op(p_integer_y, yF);
       BEGD(d0);
       BEGP(pt0);
-      pt0 = YREG + PREG->u.y.y;
+      pt0 = YREG + PREG->u.yF.y;
       d0 = *pt0;
       deref_head(d0, integer_y_unk);
     integer_y_nvar:
       /* non variable */
       if (IsIntTerm(d0)) {
-	PREG = NEXTOP(PREG, x);
+	PREG = NEXTOP(PREG, xF);
 	GONext();
       }
       if (IsApplTerm(d0)) {
@@ -7231,60 +7245,65 @@ Yap_absmi(int inp)
 #ifdef USE_GMP
 	  case (CELL)FunctorBigInt:
 #endif
-	    PREG = NEXTOP(PREG, y);
+	    PREG = NEXTOP(PREG, yF);
 	    GONext();
 	  default:
-	    FAIL();
+	    PREG = PREG->u.yF.F;
+	    GONext();
 	  }
 	}
       }
-      FAIL();
+      PREG = PREG->u.yF.F;
+      GONext();
 
       derefa_body(d0, pt0, integer_y_unk, integer_y_nvar);
-      FAIL();
+      PREG = PREG->u.yF.F;
+      GONext();
       ENDP(pt0);
       ENDD(d0);
       ENDOp();
 
-      Op(p_nonvar_x, x);
+      Op(p_nonvar_x, xF);
       BEGD(d0);
-      d0 = XREG(PREG->u.x.x);
+      d0 = XREG(PREG->u.xF.x);
       deref_head(d0, nonvar_x_unk);
     nonvar_x_nvar:
-      PREG = NEXTOP(PREG, x);
+      PREG = NEXTOP(PREG, xF);
       GONext();
 
       BEGP(pt0);
       deref_body(d0, pt0, nonvar_x_unk, nonvar_x_nvar);
-      FAIL();
+      PREG = PREG->u.xF.F;
+      GONext();
       ENDP(pt0);
       ENDD(d0);
       ENDOp();
 
-      Op(p_nonvar_y, y);
+      Op(p_nonvar_y, yF);
       BEGD(d0);
       BEGP(pt0);
-      pt0 = YREG + PREG->u.y.y;
+      pt0 = YREG + PREG->u.yF.y;
       d0 = *pt0;
       deref_head(d0, nonvar_y_unk);
     nonvar_y_nvar:
-      PREG = NEXTOP(PREG, y);
+      PREG = NEXTOP(PREG, yF);
       GONext();
 
       derefa_body(d0, pt0, nonvar_y_unk, nonvar_y_nvar);
-      FAIL();
+      PREG = PREG->u.yF.F;
+      GONext();
       ENDP(pt0);
       ENDD(d0);
       ENDOp();
 
-      Op(p_number_x, x);
+      Op(p_number_x, xF);
       BEGD(d0);
-      d0 = XREG(PREG->u.x.x);
+      d0 = XREG(PREG->u.xF.x);
       deref_head(d0, number_x_unk);
     number_x_nvar:
       /* non variable */
       if (IsIntTerm(d0)) {
-	PREG = NEXTOP(PREG, x);
+	PREG = NEXTOP(PREG, xF);
 	GONext();
       }
       if (IsApplTerm(d0)) {
@@ -7296,9 +7315,11 @@ Yap_absmi(int inp)
 #ifdef USE_GMP
 	  case (CELL)FunctorBigInt:
 #endif
-	    PREG = NEXTOP(PREG, x);
+	    PREG = NEXTOP(PREG, xF);
 	    GONext();
 	  default:
+	    PREG = PREG->u.xF.F;
+	    GONext();
 	    FAIL();
 	  } 
 	} 
@@ -7307,22 +7328,23 @@ Yap_absmi(int inp)
 
       BEGP(pt0);
       deref_body(d0, pt0, number_x_unk, number_x_nvar);
-      FAIL();
+      PREG = PREG->u.xF.F;
+      GONext();
       ENDP(pt0);
       ENDD(d0);
       ENDOp();
 
-      Op(p_number_y, x);
+      Op(p_number_y, xF);
       BEGD(d0);
       BEGP(pt0);
-      pt0 = YREG + PREG->u.y.y;
+      pt0 = YREG + PREG->u.yF.y;
       d0 = *pt0;
       deref_head(d0, number_y_unk);
     number_y_nvar:
       /* non variable */
       /* non variable */
       if (IsIntTerm(d0)) {
-	PREG = NEXTOP(PREG, x);
+	PREG = NEXTOP(PREG, xF);
 	GONext();
       }
       if (IsApplTerm(d0)) {
@@ -7334,81 +7356,87 @@ Yap_absmi(int inp)
 #ifdef USE_GMP
 	  case (CELL)FunctorBigInt:
 #endif
-	    PREG = NEXTOP(PREG, y);
+	    PREG = NEXTOP(PREG, yF);
 	    GONext();
 	  default:
-	    FAIL();
+	    PREG = PREG->u.yF.F;
+	    GONext();
 	  } 
 	}
       }
       FAIL();
 
       derefa_body(d0, pt0, number_y_unk, number_y_nvar);
-      FAIL();
-      ENDP(pt0);
-      ENDD(d0);
-      ENDOp();
-
-      Op(p_var_x, x);
-      BEGD(d0);
-      d0 = XREG(PREG->u.x.x);
-      deref_head(d0, var_x_unk);
-    var_x_nvar:
-      /* non variable */
-      FAIL();
-
-      BEGP(pt0);
-      deref_body(d0, pt0, var_x_unk, var_x_nvar);
-      PREG = NEXTOP(PREG, x);
+      PREG = PREG->u.yF.F;
       GONext();
       ENDP(pt0);
       ENDD(d0);
       ENDOp();
 
-      Op(p_var_y, y);
+      Op(p_var_x, xF);
+      BEGD(d0);
+      d0 = XREG(PREG->u.xF.x);
+      deref_head(d0, var_x_unk);
+    var_x_nvar:
+      /* non variable */
+      PREG = PREG->u.xF.F;
+      GONext();
+
+      BEGP(pt0);
+      deref_body(d0, pt0, var_x_unk, var_x_nvar);
+      PREG = NEXTOP(PREG, xF);
+      GONext();
+      ENDP(pt0);
+      ENDD(d0);
+      ENDOp();
+
+      Op(p_var_y, yF);
       BEGD(d0);
       BEGP(pt0);
-      pt0 = YREG + PREG->u.y.y;
+      pt0 = YREG + PREG->u.yF.y;
       d0 = *pt0;
       deref_head(d0, var_y_unk);
     var_y_nvar:
       /* non variable */
-      FAIL();
+      PREG = PREG->u.yF.F;
+      GONext();
 
       derefa_body(d0, pt0, var_y_unk, var_y_nvar);
-      PREG = NEXTOP(PREG, y);
+      PREG = NEXTOP(PREG, yF);
       GONext();
       ENDP(pt0);
       ENDD(d0);
       ENDOp();
 
-      Op(p_db_ref_x, x);
+      Op(p_db_ref_x, xF);
       BEGD(d0);
-      d0 = XREG(PREG->u.x.x);
+      d0 = XREG(PREG->u.xF.x);
       deref_head(d0, dbref_x_unk);
     dbref_x_nvar:
       /* non variable */
       if (IsDBRefTerm(d0)) {
 	/* only allow references to the database, not general references
 	 * to go through. */
-	PREG = NEXTOP(PREG, x);
+	PREG = NEXTOP(PREG, xF);
 	GONext();
       }
       else {
-	FAIL();
+	PREG = PREG->u.xF.F;
+	GONext();
       }
 
       BEGP(pt0);
       deref_body(d0, pt0, dbref_x_unk, dbref_x_nvar);
-      FAIL();
+      PREG = PREG->u.xF.F;
+      GONext();
       ENDP(pt0);
       ENDD(d0);
       ENDOp();
 
-      Op(p_db_ref_y, y);
+      Op(p_db_ref_y, yF);
       BEGD(d0);
       BEGP(pt0);
-      pt0 = YREG + PREG->u.y.y;
+      pt0 = YREG + PREG->u.yF.y;
       d0 = *pt0;
       deref_head(d0, dbref_y_unk);
     dbref_y_nvar:
@@ -7416,161 +7444,176 @@ Yap_absmi(int inp)
       if (IsDBRefTerm(d0)) {
 	/* only allow references to the database, not general references
 	 * to go through. */
-	PREG = NEXTOP(PREG, y);
+	PREG = NEXTOP(PREG, yF);
 	GONext();
       }
       else {
-	FAIL();
+	PREG = PREG->u.yF.F;
+	GONext();
       }
 
       derefa_body(d0, pt0, dbref_y_unk, dbref_y_nvar);
-      FAIL();
+      PREG = PREG->u.yF.F;
+      GONext();
       ENDP(pt0);
       ENDD(d0);
       ENDOp();
 
-      Op(p_primitive_x, x);
+      Op(p_primitive_x, xF);
       BEGD(d0);
-      d0 = XREG(PREG->u.x.x);
+      d0 = XREG(PREG->u.xF.x);
       deref_head(d0, primi_x_unk);
     primi_x_nvar:
       /* non variable */
       if (IsPrimitiveTerm(d0)) {
-	PREG = NEXTOP(PREG, x);
+	PREG = NEXTOP(PREG, xF);
 	GONext();
       }
       else {
-	FAIL();
+	PREG = PREG->u.xF.F;
+	GONext();
       }
 
       BEGP(pt0);
       deref_body(d0, pt0, primi_x_unk, primi_x_nvar);
-      FAIL();
+      PREG = PREG->u.xF.F;
+      GONext();
       ENDP(pt0);
       ENDD(d0);
       ENDOp();
 
-      Op(p_primitive_y, y);
+      Op(p_primitive_y, yF);
       BEGD(d0);
       BEGP(pt0);
-      pt0 = YREG + PREG->u.y.y;
+      pt0 = YREG + PREG->u.yF.y;
       d0 = *pt0;
       deref_head(d0, primi_y_unk);
     primi_y_nvar:
       /* non variable */
       if (IsPrimitiveTerm(d0)) {
-	PREG = NEXTOP(PREG, y);
+	PREG = NEXTOP(PREG, yF);
 	GONext();
       }
       else {
-	FAIL();
+	PREG = PREG->u.yF.F;
+	GONext();
       }
 
       derefa_body(d0, pt0, primi_y_unk, primi_y_nvar);
-      FAIL();
+      PREG = PREG->u.yF.F;
+      GONext();
       ENDP(pt0);
       ENDD(d0);
       ENDOp();
 
-      Op(p_compound_x, x);
+      Op(p_compound_x, xF);
       BEGD(d0);
-      d0 = XREG(PREG->u.x.x);
+      d0 = XREG(PREG->u.xF.x);
       deref_head(d0, compound_x_unk);
     compound_x_nvar:
       /* non variable */
       if (IsPairTerm(d0)) {
-	PREG = NEXTOP(PREG, x);
+	PREG = NEXTOP(PREG, xF);
 	GONext();
       }
       else if (IsApplTerm(d0)) {
 	if (IsExtensionFunctor(FunctorOfTerm(d0))) {
 	  FAIL();
 	}
-	PREG = NEXTOP(PREG, x);
+	PREG = NEXTOP(PREG, xF);
 	GONext();
       }
       else {
-	FAIL();
+	PREG = PREG->u.xF.F;
+	GONext();
       }
 
       BEGP(pt0);
       deref_body(d0, pt0, compound_x_unk, compound_x_nvar);
-      FAIL();
+      PREG = PREG->u.xF.F;
+      GONext();
       ENDP(pt0);
       ENDD(d0);
       ENDOp();
 
-      Op(p_compound_y, y);
+      Op(p_compound_y, yF);
       BEGD(d0);
       BEGP(pt0);
-      pt0 = YREG + PREG->u.y.y;
+      pt0 = YREG + PREG->u.yF.y;
       d0 = *pt0;
       deref_head(d0, compound_y_unk);
     compound_y_nvar:
       /* non variable */
       if (IsPairTerm(d0)) {
-	PREG = NEXTOP(PREG, x);
+	PREG = NEXTOP(PREG, yF);
 	GONext();
       }
       else if (IsApplTerm(d0)) {
 	if (IsExtensionFunctor(FunctorOfTerm(d0))) {
-	  FAIL();
+	  PREG = PREG->u.yF.F;
+	  GONext();
 	}
-	PREG = NEXTOP(PREG, x);
+	PREG = NEXTOP(PREG, yF);
 	GONext();
       }
       else {
-	FAIL();
+	PREG = PREG->u.yF.F;
+	GONext();
       }
 
       derefa_body(d0, pt0, compound_y_unk, compound_y_nvar);
-      FAIL();
+      PREG = PREG->u.yF.F;
+      GONext();
       ENDP(pt0);
       ENDD(d0);
       ENDOp();
 
-      Op(p_float_x, x);
+      Op(p_float_x, xF);
       BEGD(d0);
-      d0 = XREG(PREG->u.x.x);
+      d0 = XREG(PREG->u.xF.x);
       deref_head(d0, float_x_unk);
     float_x_nvar:
       /* non variable */
       if (IsFloatTerm(d0)) {
-	PREG = NEXTOP(PREG, x);
+	PREG = NEXTOP(PREG, xF);
 	GONext();
       }
-      FAIL();
+      PREG = PREG->u.xF.F;
+      GONext();
 
       BEGP(pt0);
       deref_body(d0, pt0, float_x_unk, float_x_nvar);
-      FAIL();
+      PREG = PREG->u.xF.F;
+      GONext();
       ENDP(pt0);
       ENDD(d0);
       ENDOp();
 
-      Op(p_float_y, y);
+      Op(p_float_y, yF);
       BEGD(d0);
       BEGP(pt0);
-      pt0 = YREG + PREG->u.y.y;
+      pt0 = YREG + PREG->u.yF.y;
       d0 = *pt0;
       deref_head(d0, float_y_unk);
     float_y_nvar:
       /* non variable */
       if (IsFloatTerm(d0)) {
-	PREG = NEXTOP(PREG, x);
+	PREG = NEXTOP(PREG, xF);
 	GONext();
       }
-      FAIL();
+      PREG = PREG->u.yF.F;
+      GONext();
 
       derefa_body(d0, pt0, float_y_unk, float_y_nvar);
-      FAIL();
+      PREG = PREG->u.yF.F;
+      GONext();
       ENDP(pt0);
       ENDD(d0);
       ENDOp();
 
-      Op(p_cut_by_x, x);
+      Op(p_cut_by_x, xF);
       BEGD(d0);
-      d0 = XREG(PREG->u.x.x);
+      d0 = XREG(PREG->u.xF.x);
       deref_head(d0, cutby_x_unk);
     cutby_x_nvar:
 #if defined(SBA) && defined(FROZEN_STACKS)
@@ -7601,7 +7644,7 @@ Yap_absmi(int inp)
 	TR = trim_trail(B, TR, HBREG);
       }
       ENDCHO(pt0);
-      PREG = NEXTOP(PREG, x);
+      PREG = NEXTOP(PREG, xF);
       GONext();
 
       BEGP(pt1);
@@ -7613,10 +7656,10 @@ Yap_absmi(int inp)
       ENDD(d0);
       ENDOp();
 
-      Op(p_cut_by_y, y);
+      Op(p_cut_by_y, yF);
       BEGD(d0);
       BEGP(pt0);
-      pt0 = YREG + PREG->u.y.y;
+      pt0 = YREG + PREG->u.yF.y;
       d0 = *pt0;
       deref_head(d0, cutby_y_unk);
     cutby_y_nvar:
@@ -7647,7 +7690,7 @@ Yap_absmi(int inp)
 	HBREG = PROTECT_FROZEN_H(B);
 	TR = trim_trail(B, TR, HBREG);
       }
-      PREG = NEXTOP(PREG, y);
+      PREG = NEXTOP(PREG, yF);
       GONext();
       ENDCHO(pt1);
 
diff --git a/C/amasm.c b/C/amasm.c
index 9dc901595..bda7daaf2 100644
--- a/C/amasm.c
+++ b/C/amasm.c
@@ -9,10 +9,11 @@
 **************************************************************************
 *									 *
 * File:		amasm.c							 *
-* Last rev:								 *
-* mods:									 *
 * comments:	abstract machine assembler				 *
 *									 *
+* Last rev:     $Date: 2004-03-10 14:59:55 $							 *
+* $Log: not supported by cvs2svn $									 *
+*									 *
 *************************************************************************/
 #ifdef SCCS
 static char SccsId[] = "@(#)amasm.c	1.3 3/15/90";
@@ -39,6 +40,7 @@ typedef struct cmp_op_info_struct {
   wamreg x1_arg, x2_arg;
   Int c_arg;
   int c_type;
+  struct clause_info_struct *cl_info;
 } cmp_op_info;
 
 typedef struct clause_info_struct {
@@ -1658,7 +1660,7 @@ a_f2(int var, cmp_op_info *cmp_info, yamop *code_p, int pass_no, struct intermed
   if (opc <= _primitive) {
     if (is_y_var) {
       if (pass_no) {
-	code_p->u.y.y = emit_y(ve);
+	code_p->u.yF.y = emit_y(ve);
 	switch (opc) {
 	case _atom:
 	  code_p->opc = opcode(_p_atom_y);
@@ -1694,12 +1696,19 @@ a_f2(int var, cmp_op_info *cmp_info, yamop *code_p, int pass_no, struct intermed
 	  code_p->opc = opcode(_p_primitive_y);
 	  break;
 	}
+	if (cmp_info->cl_info->commit_lab) {
+	  code_p->u.yF.F = 
+	    emit_a(Unsigned(cip->code_addr) + cip->label_offset[cmp_info->cl_info->commit_lab]);
+	  cmp_info->cl_info->commit_lab = 0;
+	} else {
+	  code_p->u.yF.F = FAILCODE;
+	}
       }
-      GONEXT(y);
+      GONEXT(yF);
       return code_p;
     } else {
       if (pass_no) {
-	code_p->u.x.x = emit_x(ve->NoOfVE & MaskVarAdrs);
+	code_p->u.xF.x = emit_x(ve->NoOfVE & MaskVarAdrs);
 	switch (opc) {
 	case _atom:
 	  code_p->opc = opcode(_p_atom_x);
@@ -1735,8 +1744,15 @@ a_f2(int var, cmp_op_info *cmp_info, yamop *code_p, int pass_no, struct intermed
 	  code_p->opc = opcode(_p_primitive_x);
 	  break;
 	}
+	if (cmp_info->cl_info->commit_lab) {
+	  code_p->u.xF.F = 
+	    emit_a(Unsigned(cip->code_addr) + cip->label_offset[cmp_info->cl_info->commit_lab]);
+	  cmp_info->cl_info->commit_lab = 0;
+	} else {
+	  code_p->u.xF.F = FAILCODE;
+	}
       }
-      GONEXT(x);
+      GONEXT(xF);
       return code_p;
     }
   }
@@ -2102,6 +2118,7 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
   clinfo.commit_lab = 0L;
   clinfo.CurrentPred = cip->CurrentPred;
   cmp_info.c_type = TYPE_XX;
+  cmp_info.cl_info = &clinfo;
   do_not_optimise_uatom = FALSE;
 
   /* Space while for the clause flags */
diff --git a/C/computils.c b/C/computils.c
index 91c908e26..24d2d8eef 100644
--- a/C/computils.c
+++ b/C/computils.c
@@ -9,10 +9,11 @@
 **************************************************************************
 *									 *
 * File:		computils.c						 *
-* Last rev:								 *
-* mods:									 *
 * comments:	some useful routines for YAP's compiler			 *
 *									 *
+* Last rev:     $Date: 2004-03-10 14:59:55 $							 *
+* $Log: not supported by cvs2svn $									 *
+*									 *
 *************************************************************************/
 #ifdef SCCS
 static char SccsId[] = "%W% %G%";
@@ -76,9 +77,9 @@ Yap_AllocCMem (int size, struct intermediates *cip)
 int
 Yap_is_a_test_pred (Term arg, Term mod)
 {
-  if (IsVarTerm (arg))
+  if (IsVarTerm (arg)) {
     return FALSE;
-  else if (IsAtomTerm (arg)) {
+  } else if (IsAtomTerm (arg)) {
       Atom At = AtomOfTerm (arg);
       PredEntry *pe = RepPredProp(PredPropByAtom(At, mod));
       if (EndOfPAEntr(pe))
@@ -86,10 +87,17 @@ Yap_is_a_test_pred (Term arg, Term mod)
       return pe->PredFlags & TestPredFlag;
   } else if (IsApplTerm (arg)) {
     Functor f = FunctorOfTerm (arg);
-      PredEntry *pe = RepPredProp(PredPropByFunc(f, mod));
-      if (EndOfPAEntr(pe))
-	return FALSE;
-      return pe->PredFlags & (TestPredFlag|BinaryTestPredFlag);
+    PredEntry *pe = RepPredProp(PredPropByFunc(f, mod));
+    if (EndOfPAEntr(pe))
+      return FALSE;
+    if (pe->PredFlags & AsmPredFlag) {
+      int op = pe->PredFlags & 0x7f;
+      if (op >= _atom && op <= _primitive) {
+	return TRUE;
+      }
+      return FALSE;
+    }      
+    return pe->PredFlags & (TestPredFlag|BinaryTestPredFlag);
   } else {
     return FALSE;
   }
diff --git a/C/index.c b/C/index.c
index 70440b147..fdc7b3587 100644
--- a/C/index.c
+++ b/C/index.c
@@ -483,6 +483,9 @@ has_cut(yamop *pc)
     case _write_x_var:
     case _write_x_val:
     case _write_x_loc:
+      pc = NEXTOP(pc,x);
+      break;
+      /* instructions type xF */
     case _p_atom_x:
     case _p_atomic_x:
     case _p_integer_x:
@@ -493,13 +496,17 @@ has_cut(yamop *pc)
     case _p_primitive_x:
     case _p_compound_x:
     case _p_float_x:
-      pc = NEXTOP(pc,x);
+    case _p_cut_by_x:
+      pc = NEXTOP(pc,xF);
       break;
       /* instructions type y */
     case _save_b_y:
     case _write_y_var:
     case _write_y_val: 
     case _write_y_loc:
+      pc = NEXTOP(pc,y);
+      break;
+      /* instructions type yF */
     case _p_atom_y:
     case _p_atomic_y:
     case _p_integer_y:
@@ -510,7 +517,8 @@ has_cut(yamop *pc)
     case _p_primitive_y:
     case _p_compound_y:
     case _p_float_y:
-      pc = NEXTOP(pc,y);
+    case _p_cut_by_y:
+      pc = NEXTOP(pc,yF);
       break;
       /* instructions type sla */
     case _p_execute:
@@ -843,12 +851,10 @@ add_info(ClauseDef *clause, UInt regno)
       break;
     case _save_b_x:
     case _commit_b_x:
-    case _p_cut_by_x:
     case _write_x_val:
     case _write_x_loc:
     case _write_x_var:
     case _put_list:
-    case _p_nonvar_x:
       if (regcopy_in(myregs, nofregs, cl->u.x.x)) {
 	clause->Tag = (CELL)NULL;
 	clause->u.t_ptr = (CELL)NULL;
@@ -856,77 +862,85 @@ add_info(ClauseDef *clause, UInt regno)
       }
       cl = NEXTOP(cl,x);
       break;
+    case _p_nonvar_x:
+      if (regcopy_in(myregs, nofregs, cl->u.xF.x)) {
+	clause->Tag = (CELL)NULL;
+	clause->u.t_ptr = (CELL)NULL;
+	return;
+      }
+      cl = NEXTOP(cl,xF);
+      break;
     case _p_number_x:
-      if (regcopy_in(myregs, nofregs, cl->u.x.x)) {
+      if (regcopy_in(myregs, nofregs, cl->u.xF.x)) {
 	clause->Tag = (_number+1)*sizeof(CELL);
 	clause->u.t_ptr = (CELL)NULL;
 	return;
       }
-      cl = NEXTOP(cl,x);
+      cl = NEXTOP(cl,xF);
       break;
     case _p_atomic_x:
-      if (regcopy_in(myregs, nofregs, cl->u.x.x)) {
+      if (regcopy_in(myregs, nofregs, cl->u.xF.x)) {
 	clause->Tag = (_atomic+1)*sizeof(CELL);
 	clause->u.t_ptr = (CELL)NULL;
 	return;
       }
-      cl = NEXTOP(cl,x);
+      cl = NEXTOP(cl,xF);
       break;
     case _p_integer_x:
-      if (regcopy_in(myregs, nofregs, cl->u.x.x)) {
+      if (regcopy_in(myregs, nofregs, cl->u.xF.x)) {
 	clause->Tag = (_integer+1)*sizeof(CELL);
 	clause->u.t_ptr = (CELL)NULL;
 	return;
       }
-      cl = NEXTOP(cl,x);
+      cl = NEXTOP(cl,xF);
       break;
     case _p_primitive_x:
-      if (regcopy_in(myregs, nofregs, cl->u.x.x)) {
+      if (regcopy_in(myregs, nofregs, cl->u.xF.x)) {
 	clause->Tag = (_primitive+1)*sizeof(CELL);
 	clause->u.t_ptr = (CELL)NULL;
 	return;
       }
-      cl = NEXTOP(cl,x);
+      cl = NEXTOP(cl,xF);
       break;
     case _p_compound_x:
-      if (regcopy_in(myregs, nofregs, cl->u.x.x)) {
+      if (regcopy_in(myregs, nofregs, cl->u.xF.x)) {
 	clause->Tag = (_compound+1)*sizeof(CELL);
 	clause->u.t_ptr = (CELL)NULL;
 	return;
       }
-      cl = NEXTOP(cl,x);
+      cl = NEXTOP(cl,xF);
       break;
     case _p_var_x:
-      if (regcopy_in(myregs, nofregs, cl->u.x.x)) {
+      if (regcopy_in(myregs, nofregs, cl->u.xF.x)) {
 	clause->Tag = (_var+1)*sizeof(CELL);
 	clause->u.t_ptr = (CELL)NULL;
 	return;
       }
-      cl = NEXTOP(cl,x);
+      cl = NEXTOP(cl,xF);
       break;
     case _p_db_ref_x:
-      if (regcopy_in(myregs, nofregs, cl->u.x.x)) {
+      if (regcopy_in(myregs, nofregs, cl->u.xF.x)) {
 	clause->Tag = AbsAppl((CELL *)FunctorDBRef);
 	clause->u.t_ptr = (CELL)NULL;
 	return;
       }
-      cl = NEXTOP(cl,x);
+      cl = NEXTOP(cl,xF);
       break;
     case _p_float_x:
-      if (regcopy_in(myregs, nofregs, cl->u.x.x)) {
+      if (regcopy_in(myregs, nofregs, cl->u.xF.x)) {
 	clause->Tag = AbsAppl((CELL *)FunctorDouble);
 	clause->u.t_ptr = (CELL)NULL;
 	return;
       }
-      cl = NEXTOP(cl,x);
+      cl = NEXTOP(cl,xF);
       break;
     case _p_atom_x:
-      if (regcopy_in(myregs, nofregs, cl->u.x.x)) {
+      if (regcopy_in(myregs, nofregs, cl->u.xF.x)) {
 	clause->Tag = (_atom+1)*sizeof(CELL);
 	clause->u.t_ptr = (CELL)NULL;
 	return;
       }
-      cl = NEXTOP(cl,x);
+      cl = NEXTOP(cl,xF);
       break;
     case _get_list:
       if (regcopy_in(myregs, nofregs, cl->u.x.x)) {
@@ -936,13 +950,14 @@ add_info(ClauseDef *clause, UInt regno)
       }
       cl = NEXTOP(cl,x);
       break;
+    case _p_cut_by_x:
+      cl = NEXTOP(cl,xF);
+      break;
     case _save_b_y:
     case _commit_b_y:
     case _write_y_var:
     case _write_y_val: 
     case _write_y_loc:
-    case _p_cut_by_y:
-    case _p_nonvar_y:
       if (cl->u.y.y == ycopy) {
 	clause->Tag = (CELL)NULL;
 	clause->u.t_ptr = (CELL)NULL;
@@ -950,77 +965,88 @@ add_info(ClauseDef *clause, UInt regno)
       }
       cl = NEXTOP(cl,y);
       break;
+    case _p_nonvar_y:
+      if (cl->u.yF.y == ycopy) {
+	clause->Tag = (CELL)NULL;
+	clause->u.t_ptr = (CELL)NULL;
+	return;
+      }
+      cl = NEXTOP(cl,yF);
+      break;
     case _p_atomic_y:
-      if (ycopy == cl->u.y.y) {
+      if (ycopy == cl->u.yF.y) {
 	clause->Tag = (_atomic+1)*sizeof(CELL);
 	clause->u.t_ptr = (CELL)NULL;
 	return;
       }
-      cl = NEXTOP(cl,y);
+      cl = NEXTOP(cl,yF);
       break;
     case _p_integer_y:
-      if (ycopy == cl->u.y.y) {
+      if (ycopy == cl->u.yF.y) {
 	clause->Tag = (_integer+1)*sizeof(CELL);
 	clause->u.t_ptr = (CELL)NULL;
 	return;
       }
-      cl = NEXTOP(cl,y);
+      cl = NEXTOP(cl,yF);
       break;
     case _p_number_y:
-      if (ycopy == cl->u.y.y) {
+      if (ycopy == cl->u.yF.y) {
 	clause->Tag = (_number+1)*sizeof(CELL);
 	clause->u.t_ptr = (CELL)NULL;
 	return;
       }
-      cl = NEXTOP(cl,y);
+      cl = NEXTOP(cl,yF);
       break;
     case _p_primitive_y:
-      if (ycopy == cl->u.y.y) {
+      if (ycopy == cl->u.yF.y) {
 	clause->Tag = (_primitive+1)*sizeof(CELL);
 	clause->u.t_ptr = (CELL)NULL;
 	return;
       }
-      cl = NEXTOP(cl,y);
+      cl = NEXTOP(cl,yF);
       break;
     case _p_compound_y:
-      if (ycopy == cl->u.y.y) {
+      if (ycopy == cl->u.yF.y) {
 	clause->Tag = (_compound+1)*sizeof(CELL);
 	clause->u.t_ptr = (CELL)NULL;
 	return;
       }
-      cl = NEXTOP(cl,y);
+      cl = NEXTOP(cl,yF);
       break;
     case _p_db_ref_y:
-      if (ycopy == cl->u.y.y) {
+      if (ycopy == cl->u.yF.y) {
 	clause->Tag = AbsAppl((CELL *)FunctorDBRef);
 	clause->u.t_ptr = (CELL)NULL;
 	return;
       }
-      cl = NEXTOP(cl,y);
+      cl = NEXTOP(cl,yF);
       break;
     case _p_float_y:
-      if (ycopy == cl->u.y.y) {
+      if (ycopy == cl->u.yF.y) {
 	clause->Tag = AbsAppl((CELL *)FunctorDouble);
 	clause->u.t_ptr = (CELL)NULL;
 	return;
       }
-      cl = NEXTOP(cl,y);
+      cl = NEXTOP(cl,yF);
       break;
     case _p_atom_y:
-      if (cl->u.y.y == ycopy) {
+      if (cl->u.yF.y == ycopy) {
 	clause->Tag = (_atom+1)*sizeof(CELL);
 	clause->u.t_ptr = (CELL)NULL;
 	return;
       }
-      cl = NEXTOP(cl,y);
+      cl = NEXTOP(cl,yF);
       break;
     case _p_var_y:
-      if (cl->u.y.y == ycopy) {
+      if (cl->u.yF.y == ycopy) {
 	clause->Tag = (_var+1)*sizeof(CELL);
 	clause->u.t_ptr = (CELL)NULL;
 	return;
       }
-      cl = NEXTOP(cl,y);
+      cl = NEXTOP(cl,yF);
+      break;
+    case _p_cut_by_y:
+      cl = NEXTOP(cl,yF);
       break;
     case _p_execute:
     case _fcall:
diff --git a/H/YapOpcodes.h b/H/YapOpcodes.h
index fbee7aa23..73b2d2675 100644
--- a/H/YapOpcodes.h
+++ b/H/YapOpcodes.h
@@ -9,10 +9,11 @@
 **************************************************************************
 *									 *
 * File:		YapOpcodes.h						 *
-* Last rev:								 *
-* mods:									 *
 * comments:	Central Table with all YAP opcodes                       *
 *									 *
+* Last rev:     $Date: 2004-03-10 14:59:55 $							 *
+* $Log: not supported by cvs2svn $									 *
+*									 *
 *************************************************************************/
     OPCODE(Ystop                   ,e),
     OPCODE(Nstop                   ,e),               
@@ -288,28 +289,28 @@
     OPCODE(unify_s_end             ,),
     OPCODE(write_s_end             ,),
 #endif /* SFUNC */
-    OPCODE(p_atom_x                ,x),			
-    OPCODE(p_atom_y                ,y),
-    OPCODE(p_atomic_x              ,x),			
-    OPCODE(p_atomic_y              ,y),			
-    OPCODE(p_integer_x             ,x),			
-    OPCODE(p_integer_y             ,y),			
-    OPCODE(p_nonvar_x              ,x),			
-    OPCODE(p_nonvar_y              ,y),			
-    OPCODE(p_number_x              ,x),			
-    OPCODE(p_number_y              ,y),			
-    OPCODE(p_var_x                 ,x),			
-    OPCODE(p_var_y                 ,y),			
-    OPCODE(p_compound_x            ,x),			
-    OPCODE(p_compound_y            ,y),			
-    OPCODE(p_float_x	           ,x),			
-    OPCODE(p_float_y	           ,y),			
-    OPCODE(p_db_ref_x              ,x),			
-    OPCODE(p_db_ref_y              ,y),			
-    OPCODE(p_cut_by_x              ,x),			
-    OPCODE(p_cut_by_y              ,y),			
-    OPCODE(p_primitive_x           ,x),		
-    OPCODE(p_primitive_y           ,y),		
+    OPCODE(p_atom_x                ,xF),
+    OPCODE(p_atom_y                ,yF),
+    OPCODE(p_atomic_x              ,xF),			
+    OPCODE(p_atomic_y              ,yF),			
+    OPCODE(p_integer_x             ,xF),			
+    OPCODE(p_integer_y             ,yF),			
+    OPCODE(p_nonvar_x              ,xF),			
+    OPCODE(p_nonvar_y              ,yF),			
+    OPCODE(p_number_x              ,xF),			
+    OPCODE(p_number_y              ,yF),			
+    OPCODE(p_var_x                 ,xF),			
+    OPCODE(p_var_y                 ,yF),			
+    OPCODE(p_compound_x            ,xF),			
+    OPCODE(p_compound_y            ,yF),			
+    OPCODE(p_float_x	           ,xF),			
+    OPCODE(p_float_y	           ,yF),			
+    OPCODE(p_db_ref_x              ,xF),			
+    OPCODE(p_db_ref_y              ,yF),			
+    OPCODE(p_cut_by_x              ,xF),			
+    OPCODE(p_cut_by_y              ,yF),			
+    OPCODE(p_primitive_x           ,xF),		
+    OPCODE(p_primitive_y           ,yF),		
     OPCODE(p_equal                 ,e),			
     OPCODE(p_dif                   ,e),			
     OPCODE(p_eq                    ,e),			
diff --git a/H/amidefs.h b/H/amidefs.h
index d31d96258..3dec8fb32 100644
--- a/H/amidefs.h
+++ b/H/amidefs.h
@@ -1,18 +1,19 @@
 /*************************************************************************
 *									 *
-*	 YAP Prolog    @(#)amidefs.h	1.3 3/15/90
+*	 YAP Prolog    @(#)amidefs.h	1.3 3/15/90                      *
 *									 *
-*	Yiap Prolog was developed at NCCUP - Universidade do Porto	 *
+*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
 *									 *
 * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
 *									 *
 **************************************************************************
 *									 *
 * File:		amidefs.h						 *
-* Last rev:								 *
-* mods:									 *
 * comments:	Abstract machine peculiarities				 *
 *									 *
+* Last rev:     $Date: 2004-03-10 14:59:55 $							 *
+* $Log: not supported by cvs2svn $									 *
+*									 *
 *************************************************************************/
 
 #if ALIGN_LONGS
@@ -406,6 +407,11 @@ typedef struct yami {
 	 Int                 a;
 	 CELL next;
        } xf;
+       struct {
+	 wamreg                x;
+	 struct yami          *F;
+	 CELL next;
+       } xF;
        struct {
 	 wamreg                x;
 	 struct yami	       *l;
@@ -443,6 +449,11 @@ typedef struct yami {
 	 yslot                y;
 	 CELL next;
        } y;
+       struct {
+	 yslot                y;
+	 struct yami         *F;
+	 CELL next;
+       } yF;
        struct {
 	 yslot                y;
 	 wamreg                x;
diff --git a/H/rheap.h b/H/rheap.h
index 83c1850d7..ddaa67595 100644
--- a/H/rheap.h
+++ b/H/rheap.h
@@ -695,6 +695,10 @@ restore_opcodes(yamop *pc)
     case _write_x_var:
     case _write_x_val:
     case _write_x_loc:
+      pc->u.x.x = XAdjust(pc->u.x.x);
+      pc = NEXTOP(pc,x);
+      break;
+      /* instructions type xF */
     case _p_atom_x:
     case _p_atomic_x:
     case _p_integer_x:
@@ -706,8 +710,8 @@ restore_opcodes(yamop *pc)
     case _p_compound_x:
     case _p_float_x:
     case _p_cut_by_x:
-      pc->u.x.x = XAdjust(pc->u.x.x);
-      pc = NEXTOP(pc,x);
+      pc->u.xF.x = XAdjust(pc->u.xF.x);
+      pc = NEXTOP(pc,xF);
       break;
       /* instructions type y */
     case _save_b_y:
@@ -715,6 +719,10 @@ restore_opcodes(yamop *pc)
     case _write_y_var:
     case _write_y_val: 
     case _write_y_loc:
+      pc->u.y.y = YAdjust(pc->u.y.y);
+      pc = NEXTOP(pc,y);
+      break;
+      /* instructions type yF */
     case _p_atom_y:
     case _p_atomic_y:
     case _p_integer_y:
@@ -726,8 +734,8 @@ restore_opcodes(yamop *pc)
     case _p_compound_y:
     case _p_float_y:
     case _p_cut_by_y:
-      pc->u.y.y = YAdjust(pc->u.y.y);
-      pc = NEXTOP(pc,y);
+      pc->u.yF.y = YAdjust(pc->u.yF.y);
+      pc = NEXTOP(pc,yF);
       break;
       /* instructions type sla */      
     case _p_execute: