support for inlined execution of functor/3 and arg/3/3/3

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

C/absmi.c

@@ -10079,6 +10079,837 @@ absmi(int inp)
       ENDD(d0);
       ENDOp();
 
+      Op(p_func2s_vv, xxx);
+      /* A1 is a variable */
+    restart_func2s:
+#ifdef LOW_LEVEL_TRACER
+      if (do_low_level_trace) {
+	RESET_VARIABLE(H);
+	H[1] = XREG(PREG->u.xxx.x1);
+	H[2] = XREG(PREG->u.xxx.x2);
+	low_level_trace(enter_pred,RepPredProp(GetPredProp(LookupAtom("functor"),3)),H);
+      }
+#endif	/* LOW_LEVEL_TRACE */
+      /* We have to build the structure */
+      BEGD(d0);
+      d0 = XREG(PREG->u.xxx.x1);
+      deref_head(d0, func2s_unk);
+    func2s_nvar:
+      /* we do, let's get the third argument */
+      BEGD(d1);
+      d1 = XREG(PREG->u.xxx.x2);
+      deref_head(d1, func2s_unk2);
+    func2s_nvar2:
+      /* Uuuff, the second and third argument are bound */
+      if (IsIntegerTerm(d1))
+	d1 = IntegerOfTerm(d1);
+      else {
+	Error(TYPE_ERROR_INTEGER,ARG3,"functor/3");
+	FAIL();
+      }
+      if (!IsAtomicTerm(d0)) {
+	Error(TYPE_ERROR_ATOM,d0,"functor/3");
+	FAIL();
+      }
+      /* We made it!!!!! we got in d0 the name, in d1 the arity and
+       * in pt0 the variable to bind it to. */
+      if (d0 == TermDot && d1 == 2) {
+	RESET_VARIABLE(H);
+	RESET_VARIABLE(H+1);
+	d0 = AbsPair(H);
+	H += 2;
+	/* else if arity is 0 just pass d0 through */
+	/* Ding, ding, we made it */
+	XREG(PREG->u.xxx.x) = d0;
+	PREG = NEXTOP(NEXTOP(NEXTOP(PREG, xxx),sla),l);
+	GONext();
+      }
+      else if ((Int)d1 > 0) {
+	/* now let's build a compound term */
+	if (!IsAtomTerm(d0)) {
+	  Error(TYPE_ERROR_ATOM,d0,"functor/3");
+	  FAIL();
+	}
+	BEGP(pt1);
+	if (!IsAtomTerm(d0)) {
+	  FAIL();
+	}
+	else
+	  d0 = (CELL) MkFunctor(AtomOfTerm(d0), (Int) d1);
+	pt1 = H;
+	*pt1++ = d0;
+	d0 = AbsAppl(H);
+	if (pt1+d1 > ENV || pt1+d1 > (CELL *)B) {
+	  /* make sure we have something to show for our trouble */
+	  saveregs();
+	  gc(3, Y, NEXTOP(NEXTOP(PREG,xxx),sla));
+	  setregs();
+	  goto restart_func2s;
+	}
+	while ((Int)d1--) {
+	  RESET_VARIABLE(pt1);
+	  pt1++;
+	}
+	H = pt1;
+	/* done building the term */
+	ENDP(pt1);
+	/* else if arity is 0 just pass d0 through */
+	/* Ding, ding, we made it */
+	XREG(PREG->u.xxx.x) = d0;
+	PREG = NEXTOP(NEXTOP(NEXTOP(PREG, xxx),sla),l);
+	GONext();
+      }	else if ((Int)d1  == 0) {
+	XREG(PREG->u.xxx.x) = d0;
+	PREG = NEXTOP(NEXTOP(NEXTOP(PREG, xxx),sla),l);
+	GONext();
+      }	else {
+	Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,MkIntegerTerm(d1),"functor/3");
+	FAIL();
+      }
+
+      BEGP(pt1);
+      deref_body(d1, pt1, func2s_unk2, func2s_nvar2);
+      Error(INSTANTIATION_ERROR, d1, "functor/3");
+      ENDP(pt1);
+      /* Oops, third argument was unbound */
+      FAIL();
+      ENDD(d1);
+
+      BEGP(pt1);
+      deref_body(d0, pt1, func2s_unk, func2s_nvar);
+      Error(INSTANTIATION_ERROR, d0, "functor/3");
+      ENDP(pt1);
+      /* Oops, second argument was unbound too */
+      FAIL();
+      ENDD(d0);
+      ENDOp();
+
+      Op(p_func2s_cv, xcx);
+      /* A1 is a variable */
+    restart_func2s_cv:
+#ifdef LOW_LEVEL_TRACER
+      if (do_low_level_trace) {
+	RESET_VARIABLE(H);
+	H[1] = XREG(PREG->u.xcx.c);
+	H[2] = XREG(PREG->u.xcx.xi);
+	low_level_trace(enter_pred,RepPredProp(GetPredProp(LookupAtom("functor"),3)),H);
+      }
+#endif	/* LOW_LEVEL_TRACE */
+      BEGD(d0);
+      /* We have to build the structure */
+      d0 = PREG->u.xcx.c;
+      /* we do, let's get the third argument */
+      BEGD(d1);
+      d1 = XREG(PREG->u.xcx.xi);
+      deref_head(d1, func2s_unk2_cv);
+    func2s_nvar2_cv:
+      /* Uuuff, the second and third argument are bound */
+      if (IsIntegerTerm(d1))
+	d1 = IntegerOfTerm(d1);
+      else {
+	Error(TYPE_ERROR_INTEGER,ARG3,"functor/3");
+	FAIL();
+      }
+      /* We made it!!!!! we got in d0 the name, in d1 the arity and
+       * in pt0 the variable to bind it to. */
+      if (d0 == TermDot && d1 == 2) {
+	RESET_VARIABLE(H);
+	RESET_VARIABLE(H+1);
+	d0 = AbsPair(H);
+	H += 2;
+	/* else if arity is 0 just pass d0 through */
+	/* Ding, ding, we made it */
+	XREG(PREG->u.xcx.x) = d0;
+	PREG = NEXTOP(NEXTOP(NEXTOP(PREG, xcx),sla),l);
+	GONext();
+      } else if ((Int)d1 > 0) {
+	/* now let's build a compound term */
+	if (!IsAtomTerm(d0)) {
+	  Error(TYPE_ERROR_ATOM,d0,"functor/3");
+	  FAIL();
+	}
+	BEGP(pt1);
+	if (!IsAtomTerm(d0)) {
+	  FAIL();
+	}
+	else
+	  d0 = (CELL) MkFunctor(AtomOfTerm(d0), (Int) d1);
+	pt1 = H;
+	*pt1++ = d0;
+	d0 = AbsAppl(H);
+	if (pt1+d1 > ENV || pt1+d1 > (CELL *)B) {
+	  /* make sure we have something to show for our trouble */
+	  saveregs();
+	  gc(3, Y, NEXTOP(NEXTOP(PREG,xcx),sla));
+	  setregs();
+	  goto restart_func2s_cv;
+	}
+	while ((Int)d1--) {
+	  RESET_VARIABLE(pt1);
+	  pt1++;
+	}
+	/* done building the term */
+	H = pt1;
+	ENDP(pt1);
+	/* else if arity is 0 just pass d0 through */
+	/* Ding, ding, we made it */
+	XREG(PREG->u.xcx.x) = d0;
+	PREG = NEXTOP(NEXTOP(NEXTOP(PREG, xcx),sla),l);
+	GONext();
+      }	else if (d1  == 0) {
+	XREG(PREG->u.xxx.x) = d0;
+	PREG = NEXTOP(NEXTOP(NEXTOP(PREG, xxx),sla),l);
+	GONext();
+      }	else {
+	Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,MkIntegerTerm(d1),"functor/3");
+	FAIL();
+      }
+
+      BEGP(pt1);
+      deref_body(d1, pt1, func2s_unk2_cv, func2s_nvar2_cv);
+      Error(INSTANTIATION_ERROR, d1, "functor/3");
+      ENDP(pt1);
+      /* Oops, third argument was unbound */
+      FAIL();
+      ENDD(d1);
+      ENDD(d0);
+      ENDOp();
+
+      Op(p_func2s_vc, xxc);
+      /* A1 is a variable */
+    restart_func2s_vc:
+#ifdef LOW_LEVEL_TRACER
+      if (do_low_level_trace) {
+	Term ti;
+	CELL *hi = H;
+
+	ti = MkIntegerTerm((Int)(PREG->u.xxc.c));
+	RESET_VARIABLE(H);
+	H[1] = XREG(PREG->u.xxc.xi);
+	H[2] = ti;
+	low_level_trace(enter_pred,RepPredProp(GetPredProp(LookupAtom("functor"),3)),H);
+	H = hi;
+      }
+#endif	/* LOW_LEVEL_TRACE */
+      /* We have to build the structure */
+      BEGD(d0);
+      d0 = XREG(PREG->u.xxc.xi);
+      deref_head(d0, func2s_unk_vc);
+    func2s_nvar_vc:
+      BEGD(d1);
+      d1 = PREG->u.xxc.c;
+      if (!IsAtomicTerm(d0)) {
+	Error(TYPE_ERROR_ATOM,d0,"functor/3");
+	FAIL();
+      }
+      /* We made it!!!!! we got in d0 the name, in d1 the arity and
+       * in pt0 the variable to bind it to. */
+      if (d0 == TermDot && d1 == 2) {
+	RESET_VARIABLE(H);
+	RESET_VARIABLE(H+1);
+	d0 = AbsPair(H);
+	H += 2;
+	/* else if arity is 0 just pass d0 through */
+	/* Ding, ding, we made it */
+	XREG(PREG->u.xxc.x) = d0;
+	PREG = NEXTOP(NEXTOP(NEXTOP(PREG, xxc),sla),l);
+	GONext();
+      }
+      /* now let's build a compound term */
+      if (d1 == 0) {
+	XREG(PREG->u.xxc.x) = d0;
+	PREG = NEXTOP(NEXTOP(NEXTOP(PREG, xxc),sla),l);
+	GONext();
+      }
+      if (!IsAtomTerm(d0)) {
+	Error(TYPE_ERROR_ATOM,d0,"functor/3");
+	FAIL();
+      }
+      BEGP(pt1);
+      if (!IsAtomTerm(d0)) {
+	FAIL();
+      }
+      else
+	d0 = (CELL) MkFunctor(AtomOfTerm(d0), (Int) d1);
+      pt1 = H;
+      *pt1++ = d0;
+      d0 = AbsAppl(H);
+      if (pt1+d1 > ENV || pt1+d1 > (CELL *)B) {
+	/* make sure we have something to show for our trouble */
+	saveregs();
+	gc(3, Y, NEXTOP(NEXTOP(PREG,xxc),sla));
+	setregs();
+	goto restart_func2s_vc;
+      }
+      while ((Int)d1--) {
+	RESET_VARIABLE(pt1);
+	pt1++;
+      }
+      /* done building the term */
+      H = pt1;
+      ENDP(pt1);
+      ENDD(d1);
+      /* else if arity is 0 just pass d0 through */
+      /* Ding, ding, we made it */
+      XREG(PREG->u.xxc.x) = d0;
+      PREG = NEXTOP(NEXTOP(NEXTOP(PREG, xxc),sla),l);
+      GONext();
+
+      BEGP(pt1);
+      deref_body(d0, pt1, func2s_unk_vc, func2s_nvar_vc);
+      Error(INSTANTIATION_ERROR, d0, "functor/3");
+      ENDP(pt1);
+      /* Oops, second argument was unbound too */
+      FAIL();
+      ENDD(d0);
+      ENDOp();
+
+      Op(p_func2s_y_vv, yxx);
+      /* A1 is a variable */
+    restart_func2s_y:
+#ifdef LOW_LEVEL_TRACER
+      if (do_low_level_trace) {
+	RESET_VARIABLE(H);
+	H[1] = XREG(PREG->u.yxx.x1);
+	H[2] = XREG(PREG->u.yxx.x2);
+	low_level_trace(enter_pred,RepPredProp(GetPredProp(LookupAtom("functor"),3)),H);
+      }
+#endif	/* LOW_LEVEL_TRACE */
+      /* We have to build the structure */
+      BEGD(d0);
+      d0 = XREG(PREG->u.yxx.x1);
+      deref_head(d0, func2s_y_unk);
+    func2s_y_nvar:
+      /* we do, let's get the third argument */
+      BEGD(d1);
+      d1 = XREG(PREG->u.yxx.x2);
+      deref_head(d1, func2s_y_unk2);
+    func2s_y_nvar2:
+      /* Uuuff, the second and third argument are bound */
+      if (IsIntegerTerm(d1))
+	d1 = IntegerOfTerm(d1);
+      else {
+	Error(TYPE_ERROR_INTEGER,ARG3,"functor/3");
+	FAIL();
+      }
+      if (!IsAtomicTerm(d0)) {
+	Error(TYPE_ERROR_ATOM,d0,"functor/3");
+	FAIL();
+      }
+      /* We made it!!!!! we got in d0 the name, in d1 the arity and
+       * in pt0 the variable to bind it to. */
+      if (d0 == TermDot && d1 == 2) {
+	RESET_VARIABLE(H);
+	RESET_VARIABLE(H+1);
+	d0 = AbsPair(H);
+	H += 2;
+	BEGP(pt1);
+	pt1 = Y + PREG->u.yxx.y;
+	PREG = NEXTOP(NEXTOP(NEXTOP(PREG, yxx),sla),l);
+#if defined(SBA) && defined(FROZEN_REGS)
+	Bind_Local(pt1,d0);
+#else
+	*pt1 = d0;
+#endif
+	ENDP(pt1);
+	GONext();
+      } else if ((Int)d1 > 0) {
+	/* now let's build a compound term */
+	if (!IsAtomTerm(d0)) {
+	  Error(TYPE_ERROR_ATOM,d0,"functor/3");
+	  FAIL();
+	}
+	BEGP(pt1);
+	if (!IsAtomTerm(d0)) {
+	  FAIL();
+	}
+	else
+	  d0 = (CELL) MkFunctor(AtomOfTerm(d0), (Int) d1);
+	pt1 = H;
+	*pt1++ = d0;
+	d0 = AbsAppl(H);
+	if (pt1+d1 > ENV || pt1+d1 > (CELL *)B) {
+	  /* make sure we have something to show for our trouble */
+	  saveregs();
+	  gc(3, Y, NEXTOP(NEXTOP(PREG,yxx),sla));
+	  setregs();
+	  goto restart_func2s_y;
+	}
+	while ((Int)d1--) {
+	  RESET_VARIABLE(pt1);
+	  pt1++;
+	}
+	/* done building the term */
+	H = pt1;
+	ENDP(pt1);
+	/* else if arity is 0 just pass d0 through */
+	/* Ding, ding, we made it */
+	BEGP(pt1);
+	pt1 = Y + PREG->u.yxx.y;
+	PREG = NEXTOP(NEXTOP(NEXTOP(PREG, yxx),sla),l);
+#if defined(SBA) && defined(FROZEN_REGS)
+	Bind_Local(pt1,d0);
+#else
+	*pt1 = d0;
+#endif
+	ENDP(pt1);
+	GONext();
+      }	else if (d1  == 0) {
+	BEGP(pt1);
+	pt1 = Y + PREG->u.yxx.y;
+	PREG = NEXTOP(NEXTOP(NEXTOP(PREG, yxx),sla),l);
+#if defined(SBA) && defined(FROZEN_REGS)
+	Bind_Local(pt1,d0);
+#else
+	*pt1 = d0;
+#endif
+	ENDP(pt1);
+	GONext();
+      }	else {
+	Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,MkIntegerTerm(d1),"functor/3");
+	FAIL();
+      }
+
+      BEGP(pt1);
+      deref_body(d1, pt1, func2s_y_unk2, func2s_y_nvar2);
+      Error(INSTANTIATION_ERROR, d1, "functor/3");
+      ENDP(pt1);
+      /* Oops, third argument was unbound */
+      FAIL();
+      ENDD(d1);
+
+      BEGP(pt1);
+      deref_body(d0, pt1, func2s_y_unk, func2s_y_nvar);
+      Error(INSTANTIATION_ERROR, d0, "functor/3");
+      ENDP(pt1);
+      /* Oops, second argument was unbound too */
+      FAIL();
+      ENDD(d0);
+      ENDOp();
+
+      Op(p_func2s_y_cv, ycx);
+      /* A1 is a variable */
+    restart_func2s_y_cv:
+#ifdef LOW_LEVEL_TRACER
+      if (do_low_level_trace) {
+	RESET_VARIABLE(H);
+	H[1] = XREG(PREG->u.ycx.c);
+	H[2] = XREG(PREG->u.ycx.xi);
+	low_level_trace(enter_pred,RepPredProp(GetPredProp(LookupAtom("functor"),3)),H);
+      }
+#endif	/* LOW_LEVEL_TRACE */
+      /* We have to build the structure */
+      BEGD(d0);
+      d0 = PREG->u.ycx.c;
+      /* we do, let's get the third argument */
+      BEGD(d1);
+      d1 = XREG(PREG->u.ycx.xi);
+      deref_head(d1, func2s_y_unk_cv);
+    func2s_y_nvar_cv:
+      /* Uuuff, the second and third argument are bound */
+      if (IsIntegerTerm(d1)) {
+	d1 = IntegerOfTerm(d1);
+      } else {
+	Error(TYPE_ERROR_INTEGER,d1,"functor/3");
+	FAIL();
+      }
+      /* We made it!!!!! we got in d0 the name, in d1 the arity and
+       * in pt0 the variable to bind it to. */
+      if (d0 == TermDot && d1 == 2) {
+	RESET_VARIABLE(H);
+	RESET_VARIABLE(H+1);
+	d0 = AbsPair(H);
+	H += 2;
+	/* else if arity is 0 just pass d0 through */
+	/* Ding, ding, we made it */
+	BEGP(pt1);
+	pt1 = Y + PREG->u.ycx.y;
+	PREG = NEXTOP(NEXTOP(NEXTOP(PREG, ycx),sla),l);
+#if defined(SBA) && defined(FROZEN_REGS)
+	Bind_Local(pt1,d0);
+#else
+	*pt1 = d0;
+#endif
+	ENDP(pt1);
+	GONext();
+      }
+      else if ((Int)d1 > 0) {
+	/* now let's build a compound term */
+	if (!IsAtomTerm(d0)) {
+	  Error(TYPE_ERROR_ATOM,d0,"functor/3");
+	  FAIL();
+	}
+	if (!IsAtomTerm(d0)) {
+	  FAIL();
+	}
+	else
+	  d0 = (CELL) MkFunctor(AtomOfTerm(d0), (Int) d1);
+	BEGP(pt1);
+	pt1 = H;
+	*pt1++ = d0;
+	d0 = AbsAppl(H);
+	if (pt1+d1 > ENV || pt1+d1 > (CELL *)B) {
+	  /* make sure we have something to show for our trouble */
+	  saveregs();
+	  gc(3, Y, NEXTOP(NEXTOP(PREG,ycx),sla));
+	  setregs();
+	  goto restart_func2s_y_cv;
+	}
+	while ((Int)d1--) {
+	  RESET_VARIABLE(pt1);
+	  pt1++;
+	}
+	/* done building the term */
+	H = pt1;
+	ENDP(pt1);
+	/* else if arity is 0 just pass d0 through */
+	/* Ding, ding, we made it */
+	BEGP(pt1);
+	pt1 = Y + PREG->u.ycx.y;
+	PREG = NEXTOP(NEXTOP(NEXTOP(PREG, ycx),sla),l);
+#if defined(SBA) && defined(FROZEN_REGS)
+	Bind_Local(pt1,d0);
+#else
+	*pt1 = d0;
+#endif
+	ENDP(pt1);
+	GONext();
+      }	else if (d1  == 0) {
+	BEGP(pt1);
+	pt1 = Y + PREG->u.ycx.y;
+	PREG = NEXTOP(NEXTOP(NEXTOP(PREG, ycx),sla),l);
+#if defined(SBA) && defined(FROZEN_REGS)
+	Bind_Local(pt1,d0);
+#else
+	*pt1 = d0;
+#endif
+	ENDP(pt1);
+	GONext();
+      }	else {
+	Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,MkIntegerTerm(d1),"functor/3");
+	FAIL();
+      }
+
+      BEGP(pt1);
+      deref_body(d1, pt1, func2s_y_unk_cv, func2s_y_nvar_cv);
+      Error(INSTANTIATION_ERROR, d1, "functor/3");
+      ENDP(pt1);
+      /* Oops, third argument was unbound */
+      FAIL();
+      ENDD(d1);
+      ENDD(d0);
+      ENDOp();
+
+      Op(p_func2s_y_vc, yxc);
+      /* A1 is a variable */
+    restart_func2s_y_vc:
+#ifdef LOW_LEVEL_TRACER
+      if (do_low_level_trace) {
+	Term ti;
+	CELL *hi = H;
+
+	ti = MkIntegerTerm((Int)(PREG->u.yxc.c));
+	RESET_VARIABLE(H);
+	H[1] = XREG(PREG->u.yxc.xi);
+	H[2] = ti;
+	low_level_trace(enter_pred,RepPredProp(GetPredProp(LookupAtom("functor"),3)),H);
+	H = hi;
+      }
+#endif	/* LOW_LEVEL_TRACE */
+      /* We have to build the structure */
+      BEGD(d0);
+      d0 = XREG(PREG->u.yxc.xi);
+      deref_head(d0, func2s_y_unk_vc);
+    func2s_y_nvar_vc:
+      BEGD(d1);
+      d1 = PREG->u.yxc.c;
+      if (!IsAtomicTerm(d0)) {
+	Error(TYPE_ERROR_ATOM,d0,"functor/3");
+	FAIL();
+      }
+      /* We made it!!!!! we got in d0 the name, in d1 the arity and
+       * in pt0 the variable to bind it to. */
+      if (d0 == TermDot && d1 == 2) {
+	RESET_VARIABLE(H);
+	RESET_VARIABLE(H+1);
+	d0 = AbsPair(H);
+	H += 2;
+	/* else if arity is 0 just pass d0 through */
+	/* Ding, ding, we made it */
+	BEGP(pt1);
+	pt1 = Y + PREG->u.yxc.y;
+	PREG = NEXTOP(NEXTOP(NEXTOP(PREG, yxc),sla),l);
+#if defined(SBA) && defined(FROZEN_REGS)
+	Bind_Local(pt1,d0);
+#else
+	*pt1 = d0;
+#endif
+	ENDP(pt1);
+	GONext();
+      }
+      if (d1 == 0) {
+	BEGP(pt1);
+	pt1 = Y + PREG->u.yxc.y;
+	PREG = NEXTOP(NEXTOP(NEXTOP(PREG, yxc),sla),l);
+#if defined(SBA) && defined(FROZEN_REGS)
+	Bind_Local(pt1,d0);
+#else
+	*pt1 = d0;
+#endif
+	ENDP(pt1);
+	GONext();
+      }
+      if (!IsAtomTerm(d0)) {
+	Error(TYPE_ERROR_ATOM,d0,"functor/3");
+	FAIL();
+      }
+      /* now let's build a compound term */
+      if (!IsAtomTerm(d0)) {
+	Error(TYPE_ERROR_ATOM,d0,"functor/3");
+	FAIL();
+      }
+      BEGP(pt1);
+      if (!IsAtomTerm(d0)) {
+	FAIL();
+      }
+      else 
+	d0 = (CELL) MkFunctor(AtomOfTerm(d0), (Int) d1);
+      pt1 = H;
+      *pt1++ = d0;
+      d0 = AbsAppl(H);
+      if (pt1+d1 > ENV || pt1+d1 > (CELL *)B) {
+	/* make sure we have something to show for our trouble */
+	saveregs();
+	gc(3, Y, NEXTOP(NEXTOP(PREG,yxc),sla));
+	setregs();
+	goto restart_func2s_y_vc;
+      }
+      while ((Int)d1--) {
+	RESET_VARIABLE(pt1);
+	pt1++;
+      }
+      /* done building the term */
+      H = pt1;
+      ENDP(pt1);
+      /* else if arity is 0 just pass d0 through */
+      /* Ding, ding, we made it */
+      BEGP(pt1);
+      pt1 = Y + PREG->u.yxc.y;
+      PREG = NEXTOP(NEXTOP(NEXTOP(PREG, yxc),sla),l);
+#if defined(SBA) && defined(FROZEN_REGS)
+      Bind_Local(pt1,d0);
+#else
+      *pt1 = d0;
+#endif
+      ENDP(pt1);
+      ENDD(d1);
+      GONext();
+
+      BEGP(pt1);
+      deref_body(d0, pt1, func2s_y_unk_vc, func2s_y_nvar_vc);
+      Error(INSTANTIATION_ERROR, d0, "functor/3");
+      ENDP(pt1);
+      /* Oops, second argument was unbound too */
+      FAIL();
+      ENDD(d0);
+      ENDOp();
+
+      Op(p_func2f_xx, xxx);
+#ifdef LOW_LEVEL_TRACER
+      if (do_low_level_trace) {
+	H[0] = XREG(PREG->u.xxx.x);
+	RESET_VARIABLE(H+1);
+	RESET_VARIABLE(H+2);
+	low_level_trace(enter_pred,RepPredProp(GetPredProp(LookupAtom("functor"),3)),H);
+      }
+#endif	/* LOW_LEVEL_TRACE */
+      BEGD(d0);
+      d0 = XREG(PREG->u.xxx.x);
+      deref_head(d0, func2f_xx_unk);
+    func2f_xx_nvar:
+      if (IsApplTerm(d0)) {
+	Functor d1 = FunctorOfTerm(d0);
+	if (IsExtensionFunctor(d1)) {
+	  XREG(PREG->u.xxx.x1) = d0;
+	  XREG(PREG->u.xxx.x2) = MkIntTerm(0);
+	  PREG = NEXTOP(PREG, xxx);
+	  GONext();
+	}
+	XREG(PREG->u.xxx.x1) = MkAtomTerm(NameOfFunctor(d1));
+	XREG(PREG->u.xxx.x2) = MkIntegerTerm(ArityOfFunctor(d1));
+	PREG = NEXTOP(PREG, xxx);
+	GONext();
+      } else if (IsPairTerm(d0)) {
+	XREG(PREG->u.xxx.x1) = TermDot;
+	XREG(PREG->u.xxx.x2) = MkIntTerm(2);
+	PREG = NEXTOP(PREG, xxx);
+	GONext();
+      } else {
+	XREG(PREG->u.xxx.x1) = d0;
+	XREG(PREG->u.xxx.x2) = MkIntTerm(0);
+	PREG = NEXTOP(PREG, xxx);
+	GONext();
+      }
+
+      BEGP(pt1);
+      deref_body(d0, pt1, func2f_xx_unk, func2f_xx_nvar);
+      Error(INSTANTIATION_ERROR, d0, "functor/3");
+      ENDP(pt1);
+      /* Oops, second argument was unbound too */
+      FAIL();
+      ENDD(d0);
+      ENDOp();
+
+      Op(p_func2f_xy, xyx);
+#ifdef LOW_LEVEL_TRACER
+      if (do_low_level_trace) {
+	H[0] = XREG(PREG->u.xyx.x);
+	RESET_VARIABLE(H+1);
+	RESET_VARIABLE(H+2);
+	low_level_trace(enter_pred,RepPredProp(GetPredProp(LookupAtom("functor"),3)),H);
+      }
+#endif	/* LOW_LEVEL_TRACE */
+      BEGD(d0);
+      d0 = XREG(PREG->u.xyx.x);
+      deref_head(d0, func2f_xy_unk);
+    func2f_xy_nvar:
+      if (IsApplTerm(d0)) {
+	Functor d1 = FunctorOfTerm(d0);
+	CELL *pt0 = Y+PREG->u.xyx.y2;
+	if (IsExtensionFunctor(d1)) {
+	  XREG(PREG->u.xyx.x1) = d0;
+	  PREG = NEXTOP(PREG, xyx);
+	  *pt0 = MkIntTerm(0);
+	  GONext();
+	}
+	XREG(PREG->u.xyx.x1) = MkAtomTerm(NameOfFunctor(d1));
+	PREG = NEXTOP(PREG, xyx);
+	*pt0 = MkIntegerTerm(ArityOfFunctor(d1));
+	GONext();
+      } else if (IsPairTerm(d0)) {
+	CELL *pt0 = Y+PREG->u.xyx.y2;
+	XREG(PREG->u.xyx.x1) = TermDot;
+	PREG = NEXTOP(PREG, xyx);
+	*pt0 = MkIntTerm(2);
+	GONext();
+      } else {
+	CELL *pt0 = Y+PREG->u.xyx.y2;
+	XREG(PREG->u.xyx.x1) = d0;
+	PREG = NEXTOP(PREG, xyx);
+	*pt0 = MkIntTerm(0);
+	GONext();
+      }
+
+      BEGP(pt1);
+      deref_body(d0, pt1, func2f_xy_unk, func2f_xy_nvar);
+      Error(INSTANTIATION_ERROR, d0, "functor/3");
+      ENDP(pt1);
+      /* Oops, second argument was unbound too */
+      FAIL();
+      ENDD(d0);
+      ENDOp();
+
+      Op(p_func2f_yx, yxx);
+#ifdef LOW_LEVEL_TRACER
+      if (do_low_level_trace) {
+	H[0] = XREG(PREG->u.yxx.x2);
+	RESET_VARIABLE(H+1);
+	RESET_VARIABLE(H+2);
+	low_level_trace(enter_pred,RepPredProp(GetPredProp(LookupAtom("functor"),3)),H);
+      }
+#endif	/* LOW_LEVEL_TRACE */
+      BEGD(d0);
+      d0 = XREG(PREG->u.yxx.x2);
+      deref_head(d0, func2f_yx_unk);
+    func2f_yx_nvar:
+      if (IsApplTerm(d0)) {
+	Functor d1 = FunctorOfTerm(d0);
+	CELL *pt0 = Y+PREG->u.yxx.y;
+	if (IsExtensionFunctor(d1)) {
+	  XREG(PREG->u.yxx.x1) = MkIntTerm(0);
+	  PREG = NEXTOP(PREG, yxx);
+	  *pt0 = d0;
+	  GONext();
+	}
+	XREG(PREG->u.yxx.x1) = MkIntegerTerm(ArityOfFunctor(d1));
+	PREG = NEXTOP(PREG, yxx);
+	*pt0 = MkAtomTerm(NameOfFunctor(d1));
+	GONext();
+      } else if (IsPairTerm(d0)) {
+	CELL *pt0 = Y+PREG->u.yxx.y;
+	XREG(PREG->u.yxx.x1) = MkIntTerm(2);
+	PREG = NEXTOP(PREG, yxx);
+	*pt0 = TermDot;
+	GONext();
+      } else {
+	CELL *pt0 = Y+PREG->u.yxx.y;
+	XREG(PREG->u.yxx.x1) = MkIntTerm(0);
+	PREG = NEXTOP(PREG, yxx);
+	*pt0 = d0;
+	GONext();
+      }
+
+      BEGP(pt1);
+      deref_body(d0, pt1, func2f_yx_unk, func2f_yx_nvar);
+      Error(INSTANTIATION_ERROR, d0, "functor/3");
+      ENDP(pt1);
+      /* Oops, second argument was unbound too */
+      FAIL();
+      ENDD(d0);
+      ENDOp();
+
+      Op(p_func2f_yy, yyx);
+#ifdef LOW_LEVEL_TRACER
+      if (do_low_level_trace) {
+	H[0] = XREG(PREG->u.yyx.x);
+	RESET_VARIABLE(H+1);
+	RESET_VARIABLE(H+2);
+	low_level_trace(enter_pred,RepPredProp(GetPredProp(LookupAtom("functor"),3)),H);
+      }
+#endif	/* LOW_LEVEL_TRACE */
+      BEGD(d0);
+      d0 = XREG(PREG->u.yyx.x);
+      deref_head(d0, func2f_yy_unk);
+    func2f_yy_nvar:
+      if (IsApplTerm(d0)) {
+	Functor d1 = FunctorOfTerm(d0);
+	CELL *pt0 = Y+PREG->u.yyx.y1;
+	CELL *pt1 = Y+PREG->u.yyx.y2;
+	if (IsExtensionFunctor(d1)) {
+	  PREG = NEXTOP(PREG, yyx);
+	  *pt0 =  d0;
+	  *pt1 = MkIntTerm(0);
+	  GONext();
+	}
+	PREG = NEXTOP(PREG, yyx);
+	*pt0 = MkAtomTerm(NameOfFunctor(d1));
+	*pt1 = MkIntegerTerm(ArityOfFunctor(d1));
+	GONext();
+      } else if (IsPairTerm(d0)) {
+	CELL *pt0 = Y+PREG->u.yyx.y1;
+	CELL *pt1 = Y+PREG->u.yyx.y2;
+	PREG = NEXTOP(PREG, yyx);
+	*pt0 = TermDot;
+	*pt1 = MkIntTerm(2);
+	GONext();
+      } else {
+	CELL *pt0 = Y+PREG->u.yyx.y1;
+	CELL *pt1 = Y+PREG->u.yyx.y2;
+	PREG = NEXTOP(PREG, yyx);
+	*pt0 = d0;
+	*pt1 = MkIntTerm(0);
+	GONext();
+      }
+
+      BEGP(pt1);
+      deref_body(d0, pt1, func2f_yy_unk, func2f_yy_nvar);
+      Error(INSTANTIATION_ERROR, d0, "functor/3");
+      ENDP(pt1);
+      /* Oops, second argument was unbound too */
+      FAIL();
+      ENDD(d0);
+      ENDOp();
+
       Op(p_functor, e);
 #ifdef LOW_LEVEL_TRACER
       if (do_low_level_trace)
@@ -10222,7 +11053,7 @@ absmi(int inp)
 	  setregs();
 	  goto restart_functor;
 	}
-	while (d1-- > 0) {
+	while ((Int)d1--) {
 	  RESET_VARIABLE(pt1);
 	  pt1++;
 	}

C/amasm.c

@@ -1609,6 +1609,53 @@ a_f2(int var)
       return;
     }
   }
+  if (opc == _functor && cpc->nextInst->op == f_var_op) {
+    Ventry *nve;
+
+    cpc = cpc->nextInst;
+    nve = (Ventry *)(cpc->rnd1);
+    if (is_y_var) {
+      if (nve->KindOfVE == PermVar) {
+	if (pass_no) {
+	  code_p->opc = emit_op(_p_func2f_yy);
+	  code_p->u.yyx.y1 = emit_y(ve);
+	  code_p->u.yyx.y2 = emit_y(nve);
+	  code_p->u.yyx.x = x1_arg;
+	}
+	GONEXT(yyx);
+	return;
+      } else {
+	if (pass_no) {
+	  code_p->opc = emit_op(_p_func2f_yx);
+	  code_p->u.yxx.y = emit_y(ve);
+	  code_p->u.yxx.x1 = emit_x(nve->NoOfVE & MaskVarAdrs);
+	  code_p->u.yxx.x2 = x1_arg;
+	}
+	GONEXT(yxx);
+	return;
+      }
+    } else {
+      if (nve->KindOfVE == PermVar) {
+	if (pass_no) {
+	  code_p->opc = emit_op(_p_func2f_xy);
+	  code_p->u.xyx.x1 = emit_x(ve->NoOfVE & MaskVarAdrs);
+	  code_p->u.xyx.y2 = emit_y(nve);
+	  code_p->u.xyx.x = x1_arg;
+	}
+	GONEXT(xyx);
+	return;
+      } else {
+	if (pass_no) {
+	  code_p->opc = emit_op(_p_func2f_xx);
+	  code_p->u.xxx.x1 = emit_x(ve->NoOfVE & MaskVarAdrs);
+	  code_p->u.xxx.x2 = emit_x(nve->NoOfVE & MaskVarAdrs);
+	  code_p->u.xxx.x = x1_arg;
+	}
+	GONEXT(xxx);
+	return;
+      }
+    }
+  }
   if (is_y_var) {
     switch (c_type) {
     case TYPE_XX:
@@ -1641,6 +1688,9 @@ a_f2(int var)
 	case _arg:
 	  code_p->opc = emit_op(_p_arg_y_vv);
 	  break;
+	case _functor:
+	  code_p->opc = emit_op(_p_func2s_y_vv);
+	  break;
 	}
 	code_p->u.yxx.y = emit_y(ve);
 	code_p->u.yxx.x1 = x1_arg;
@@ -1690,6 +1740,9 @@ a_f2(int var)
 	case _arg:
 	  code_p->opc = emit_op(_p_arg_y_cv);
 	  break;
+	case _functor:
+	  code_p->opc = emit_op(_p_func2s_y_cv);
+	  break;
 	}
 	code_p->u.ycx.y = emit_y(ve);
 	code_p->u.ycx.c = c_arg;
@@ -1731,6 +1784,9 @@ a_f2(int var)
 	  save_machine_regs();
 	  longjmp(CompilerBotch, 1);
 	  break;
+	case _functor:
+	  code_p->opc = emit_op(_p_func2s_y_vc);
+	  break;
 	}
 	code_p->u.yxc.y = emit_y(ve);
 	code_p->u.yxc.c = c_arg;
@@ -1771,6 +1827,9 @@ a_f2(int var)
 	case _arg:
 	  code_p->opc = emit_op(_p_arg_vv);
 	  break;
+	case _functor:
+	  code_p->opc = emit_op(_p_func2s_vv);
+	  break;
 	}
 	code_p->u.xxx.x = emit_x(ve->NoOfVE & MaskVarAdrs);
 	code_p->u.xxx.x1 = x1_arg;
@@ -1816,6 +1875,9 @@ a_f2(int var)
 	case _arg:
 	  code_p->opc = emit_op(_p_arg_cv);
 	  break;
+	case _functor:
+	  code_p->opc = emit_op(_p_func2s_cv);
+	  break;
 	}
 	code_p->u.xxc.x = emit_x(ve->NoOfVE & MaskVarAdrs);
 	code_p->u.xxc.c = c_arg;
@@ -1857,6 +1919,9 @@ a_f2(int var)
 	  save_machine_regs();
 	  longjmp(CompilerBotch, 1);
 	  break;
+	case _functor:
+	  code_p->opc = emit_op(_p_func2s_vc);
+	  break;
 	}
 	code_p->u.xcx.x = emit_x(ve->NoOfVE & MaskVarAdrs);
 	code_p->u.xcx.c = c_arg;

C/analyst.c

@@ -543,8 +543,21 @@ p_show_ops_by_group(void)
     opcount[_p_slr_y_vc] +
     opcount[_p_dif] +
     opcount[_p_eq] +
-    opcount[_p_arg] +
+    opcount[_p_arg_vv] +
+    opcount[_p_arg_cv] +
+    opcount[_p_arg_y_vv] +
+    opcount[_p_arg_y_cv] +
     opcount[_p_functor];
+    opcount[_p_func2s_vv] +
+    opcount[_p_func2s_cv] +
+    opcount[_p_func2s_vc] +
+    opcount[_p_func2s_y_vv] +
+    opcount[_p_func2s_y_cv] +
+    opcount[_p_func2s_y_vc] +
+    opcount[_p_func2f_xx] +
+    opcount[_p_func2f_xy] +
+    opcount[_p_func2f_yx] +
+    opcount[_p_func2f_yy];
 
   c_control.ncuts =
     opcount[_cut] +

C/compiler.c

@@ -740,7 +740,6 @@ c_bifun(Int Op, Term t1, Term t2, Term t3)
 	/* now we know where the arguments are */
       }
     } else {
-      /* it has to be either an integer or a floating point */
       if (Op == _arg) {
 	Term tn = MkVarTerm();
 	Int v1 = --tmpreg;
@@ -750,6 +749,7 @@ c_bifun(Int Op, Term t1, Term t2, Term t3)
 	/* these should be the arguments */
 	c_var(t1, v1, 0);
 	c_var(tn, v2, 0);
+      /* it has to be either an integer or a floating point */
       } else if (IsIntTerm(t2)) {
 	/* first temp */
 	Int v1 = --tmpreg;
@@ -786,12 +786,84 @@ c_bifun(Int Op, Term t1, Term t2, Term t3)
 	Error_Term = t2;
 	ErrorMessage = ErrorSay;
 	bip_name(Op, s);
-	sprintf(ErrorMessage, "compiling %s/2", s);
+	sprintf(ErrorMessage, "compiling functor/3");
 	save_machine_regs();
 	longjmp(CompilerBotch,1);
       }
     } else {
-      if (Op == _arg) {
+      if (Op == _functor) {
+	/* both arguments are bound, we must perform unification */
+	Int i2;
+	
+	if (!IsIntegerTerm(t2)) {
+	  char s[32];
+
+	  Error_TYPE = TYPE_ERROR_INTEGER;
+	  Error_Term = t2;
+	  ErrorMessage = ErrorSay;
+	  bip_name(Op, s);
+	  sprintf(ErrorMessage, "compiling functor/3");
+	  save_machine_regs();
+	  longjmp(CompilerBotch,1);
+	}
+	i2 = IntegerOfTerm(t2);
+	if (i2 < 0) {
+	  char s[32];
+
+	  Error_TYPE = DOMAIN_ERROR_NOT_LESS_THAN_ZERO;
+	  Error_Term = t2;
+	  ErrorMessage = ErrorSay;
+	  bip_name(Op, s);
+	  sprintf(ErrorMessage, "compiling functor/3");
+	  save_machine_regs();
+	  longjmp(CompilerBotch,1);
+	}
+	if (IsNumTerm(t1)) {
+	  /* we will always fail */
+	  if (i2)
+	    c_goal(MkAtomTerm(AtomFalse));
+	} else if (!IsAtomTerm(t1)) {
+	  char s[32];
+
+	  Error_TYPE = TYPE_ERROR_ATOM;
+	  Error_Term = t2;
+	  ErrorMessage = ErrorSay;
+	  bip_name(Op, s);
+	  sprintf(ErrorMessage, "compiling functor/3");
+	  save_machine_regs();
+	  longjmp(CompilerBotch,1);
+	}
+	if (i2 == 0)
+	  c_eq(t1, t3);
+	else {
+	  CELL *hi = H;
+	  Int i;
+
+	  if (t1 == TermDot && i2 == 2) {
+	    if (H+2 >= (CELL *)freep0) {
+	      /* oops, too many new variables */
+	      save_machine_regs();
+	      longjmp(CompilerBotch,4);
+	    }
+	    RESET_VARIABLE(H);
+	    RESET_VARIABLE(H+1);
+	    H += 2;
+	    c_eq(AbsPair(H-2),t3);
+	  } else {
+	    *H++ = (CELL)MkFunctor(AtomOfTerm(t1),i2);
+	    for (i=0; i < i2; i++) {
+	      if (H >= (CELL *)freep0) {
+		/* oops, too many new variables */
+		save_machine_regs();
+		longjmp(CompilerBotch,4);
+	      }
+	      RESET_VARIABLE(H);
+	      H++;	    
+	    }
+	    c_eq(AbsAppl(hi),t3);
+	  }
+	}
+      } else if (Op == _arg) {
 	Int i1;
 	if (IsIntegerTerm(t1))
 	  i1 = IntegerOfTerm(t1);
@@ -850,7 +922,78 @@ c_bifun(Int Op, Term t1, Term t2, Term t3)
 	longjmp(CompilerBotch,1);
       }
     }
-    if (IsIntTerm(t1)) {
+    if (Op == _functor) {
+      if (!IsAtomicTerm(t1)) {
+	char s[32];
+
+	Error_TYPE = TYPE_ERROR_ATOM;
+	Error_Term = t1;
+	ErrorMessage = ErrorSay;
+	bip_name(Op, s);
+	sprintf(ErrorMessage, "compiling %s/2",  s);
+	save_machine_regs();
+	longjmp(CompilerBotch,1);
+      } else {
+	if (!IsVarTerm(t2)) {
+	  Int arity;
+
+	  /* We actually have the term ready, so let's just do the unification now */
+	  if (!IsIntegerTerm(t2)) {
+	    char s[32];
+
+	    Error_TYPE = TYPE_ERROR_INTEGER;
+	    Error_Term = t2;
+	    ErrorMessage = ErrorSay;
+	    bip_name(Op, s);
+	    sprintf(ErrorMessage, "compiling %s/2",  s);
+	    save_machine_regs();
+	    longjmp(CompilerBotch,1);
+	  }
+	  arity = IntOfTerm(t2);
+	  if (arity < 0) {
+	    /* fail straight away */
+	    emit(fail_op, Zero, Zero);
+	  }
+	  if (arity) {
+	    Term tnew;
+	    if (!IsAtomTerm(t1)) {
+	      char s[32];
+
+	      Error_TYPE = TYPE_ERROR_ATOM;
+	      Error_Term = t1;
+	      ErrorMessage = ErrorSay;
+	      bip_name(Op, s);
+	      sprintf(ErrorMessage, "compiling %s/2",  s);
+	      save_machine_regs();
+	      longjmp(CompilerBotch,1);
+	    }
+	    if (H+1+arity >= (CELL *)freep0) {
+	      /* oops, too many new variables */
+	      save_machine_regs();
+	      longjmp(CompilerBotch,4);
+	    }
+	    tnew = AbsAppl(H);
+	    *H++ = (CELL)MkFunctor(AtomOfTerm(t1),arity);
+	    while (arity--) {
+	      RESET_VARIABLE(H);
+	      H++;
+	    }
+	    c_eq(tnew, t3);
+	  } else {
+	    /* just unify the two arguments */
+	    c_eq(t1,t3);
+	  }
+	  return;
+	} else {
+	  /* first temp */
+	  Int v1 = --tmpreg;
+	  emit(fetch_args_cv_op, t1, Zero);
+	  /* these should be the arguments */
+	  c_var(t2, v1, 0);
+	  /* now we know where the arguments are */
+	}
+      }
+    } else if (IsIntTerm(t1)) {
       /* first temp */
       Int v1 = --tmpreg;
       emit(fetch_args_cv_op, (CELL)IntOfTerm(t1), Zero);
@@ -900,6 +1043,10 @@ c_bifun(Int Op, Term t1, Term t2, Term t3)
     }
   } else if (IsNewVar(t3) && cur_branch == 0) {
     c_var(t3,f_flag,(unsigned int)Op);
+    if (Op == _functor) {
+      emit(empty_call_op, Zero, Zero);
+      emit(restore_tmps_and_skip_op, Zero, Zero);
+    }
   } else {
     /* generate code for a temp and then unify temp with previous variable */ 
     Term tmpvar = MkVarTerm();
@@ -909,10 +1056,57 @@ c_bifun(Int Op, Term t1, Term t2, Term t3)
       longjmp(CompilerBotch,4);
     }
     c_var(tmpvar,f_flag,(unsigned int)Op);
+    /* I have to dit here, before I do the unification */
+    if (Op == _functor) {
+      emit(empty_call_op, Zero, Zero);
+      emit(restore_tmps_and_skip_op, Zero, Zero);
+    }
     c_eq(tmpvar,t3);
   }
 }
 
+static void
+c_functor(Term Goal)
+{
+  Term t1 = ArgOfTerm(1, Goal);
+  Term t2 = ArgOfTerm(2, Goal);
+  Term t3 = ArgOfTerm(3, Goal);
+  if (IsVarTerm(t1) && IsNewVar(t1)) {
+    c_bifun(_functor, t2, t3, t1);
+  } else if (IsNonVarTerm(t1)) {
+    /* just split the structure */
+    if (IsAtomicTerm(t1)) {
+      c_eq(t1,t2);
+      c_eq(t3,MkIntTerm(0));
+    } else if (IsApplTerm(t1)) {
+      Functor f = FunctorOfTerm(t1);
+      c_eq(t2,MkAtomTerm(NameOfFunctor(f)));
+      c_eq(t3,MkIntegerTerm(ArityOfFunctor(f)));
+    } else /* list */ {
+      c_eq(t2,TermDot);
+      c_eq(t3,MkIntTerm(2));
+    }
+  } else if (IsVarTerm(t2) && IsNewVar(t2) &&
+	     IsVarTerm(t3) && IsNewVar(t3)) {
+    Int v1 = --tmpreg;
+    emit(fetch_args_vc_op, Zero, Zero);
+    c_var(t1, v1, 0);
+    c_var(t2,f_flag,(unsigned int)_functor);
+    c_var(t3,f_flag,(unsigned int)_functor);
+  } else {
+    Functor f = FunctorOfTerm(Goal);
+    Prop p0 = PredProp(NameOfFunctor(f), ArityOfFunctor(f));
+    if (profiling)
+      emit(enter_profiling_op, (CELL)RepPredProp(p0), Zero);
+    c_args(Goal);
+    if (onlast)
+      emit(deallocate_op, Zero, Zero);
+    emit(safe_call_op, (CELL)p0 , Zero);
+    emit(empty_call_op, Zero, Zero);
+    emit(restore_tmps_and_skip_op, Zero, Zero);
+  }
+}
+
 static void
 c_goal(Term Goal)
 {
@@ -1283,11 +1477,15 @@ c_goal(Term Goal)
 	}
 	CurrentModule = save_CurrentModule;
 	return;
-      } else if (op >= _plus && op <= _arg) { 
+      } else if (op >= _plus && op <= _functor) {
+	if (op == _functor) {
+	  c_functor(Goal);
+	} else {
 	  c_bifun(op,
 		  ArgOfTerm(1, Goal),
 		  ArgOfTerm(2, Goal),
 		  ArgOfTerm(3, Goal));
+	}
 	if (onlast) {
 	  emit(deallocate_op, Zero, Zero);
 #ifdef TABLING
@@ -1393,11 +1591,6 @@ c_goal(Term Goal)
     if (onlast)
       emit(deallocate_op, Zero, Zero);
     emit(safe_call_op, (CELL) p0, Zero);
-    if ((p->PredFlags & BasicPredFlag) &&
-	(p->PredFlags & 0x7f) == _functor) {
-      emit(empty_call_op, Zero, Zero);
-      emit(restore_tmps_and_skip_op, Zero, Zero);
-    }
     if (onlast) {
 #ifdef TABLING
       READ_LOCK(CurrentPred->PRWLock);

C/save.c

@@ -2103,6 +2103,7 @@ RestoreClause(Clause *Cl)
     case _p_sll_vv:
     case _p_slr_vv:
     case _p_arg_vv:
+    case _p_func2s_vv:
       pc->u.xxx.x  = XAdjust(pc->u.xxx.x);
       pc->u.xxx.x1 = XAdjust(pc->u.xxx.x1);
       pc->u.xxx.x2 = XAdjust(pc->u.xxx.x2);
@@ -2117,6 +2118,7 @@ RestoreClause(Clause *Cl)
     case _p_or_vc:
     case _p_sll_vc:
     case _p_slr_vc:
+    case _p_func2s_vc:
       pc->u.xxc.x  = XAdjust(pc->u.xxc.x);
       if (IsAtomTerm(pc->u.xxc.c))
 	pc->u.xxc.c = AtomTermAdjust(pc->u.xxc.c);
@@ -2127,6 +2129,11 @@ RestoreClause(Clause *Cl)
     case _p_sll_cv:
     case _p_slr_cv:
     case _p_arg_cv:
+      pc->u.xcx.x  = XAdjust(pc->u.xcx.x);
+      pc->u.xcx.xi = XAdjust(pc->u.xcx.xi);
+      pc = NEXTOP(pc,xcx);
+      break;
+    case _p_func2s_cv:
       pc->u.xcx.x  = XAdjust(pc->u.xcx.x);
       if (IsAtomTerm(pc->u.xcx.c))
 	pc->u.xcx.c = AtomTermAdjust(pc->u.xcx.c);
@@ -2143,6 +2150,7 @@ RestoreClause(Clause *Cl)
     case _p_sll_y_vv:
     case _p_slr_y_vv:
     case _p_arg_y_vv:
+    case _p_func2s_y_vv:
       pc->u.yxx.y  = YAdjust(pc->u.yxx.y);
       pc->u.yxx.x1 = XAdjust(pc->u.yxx.x1);
       pc->u.yxx.x2 = XAdjust(pc->u.yxx.x2);
@@ -2158,8 +2166,8 @@ RestoreClause(Clause *Cl)
     case _p_or_y_vc:
     case _p_sll_y_vc:
     case _p_slr_y_vc:
+    case _p_func2s_y_vc:
       pc->u.yxc.y  = YAdjust(pc->u.yxc.y);
-      if (IsAtomTerm(pc->u.yxc.c))
       pc->u.yxc.c  = AtomTermAdjust(pc->u.yxc.c);
       pc->u.yxc.xi = XAdjust(pc->u.yxc.xi);
       pc = NEXTOP(pc,yxc);
@@ -2168,6 +2176,12 @@ RestoreClause(Clause *Cl)
     case _p_sll_y_cv:
     case _p_slr_y_cv:
     case _p_arg_y_cv:
+      pc->u.ycx.y  = YAdjust(pc->u.ycx.y);
+      pc->u.ycx.xi = XAdjust(pc->u.ycx.xi);
+      pc = NEXTOP(pc,ycx);
+      break;
+      /* instructions type lxx */
+    case _p_func2s_y_cv:
       pc->u.ycx.y  = YAdjust(pc->u.ycx.y);
       if (IsAtomTerm(pc->u.ycx.c))
 	pc->u.ycx.c  = AtomTermAdjust(pc->u.ycx.c);

H/YapOpcodes.h

@@ -343,5 +343,15 @@
     OPCODE(p_arg_vv                ,xxx),
     OPCODE(p_arg_cv                ,xxc),
     OPCODE(p_arg_y_vv              ,yxx),
-    OPCODE(p_arg_y_cv              ,yxc)
+    OPCODE(p_arg_y_cv              ,yxc),
+    OPCODE(p_func2s_vv             ,xxx),
+    OPCODE(p_func2s_cv             ,xcx),
+    OPCODE(p_func2s_vc             ,xxc),
+    OPCODE(p_func2s_y_vv           ,xxx),
+    OPCODE(p_func2s_y_cv           ,xcx),
+    OPCODE(p_func2s_y_vc           ,xxc),
+    OPCODE(p_func2f_xx             ,xxx),
+    OPCODE(p_func2f_xy             ,xyx),
+    OPCODE(p_func2f_yx             ,yxx),
+    OPCODE(p_func2f_yy             ,yyx)
 

H/amidefs.h

@@ -71,7 +71,6 @@ typedef enum {
 	_equal,
 	_dif,
 	_eq,
-	_functor,
 	_plus,
 	_minus,
 	_times,
@@ -80,7 +79,8 @@ typedef enum {
 	_or,
 	_sll,
 	_slr,
-	_arg
+	_arg,
+	_functor
 } basic_preds;
 
 #if USE_THREADED_CODE
@@ -370,6 +370,12 @@ typedef struct yami {
 	 YREG                y;
 	 CELL next;
        } xy;
+       struct {
+	 AREG                x;
+	 YREG                y2;
+	 AREG                x1;
+	 CELL next;
+       } xyx;
        struct {
 	 YREG                y;
 	 CELL next;
@@ -385,6 +391,18 @@ typedef struct yami {
 	 AREG                x2;
 	 CELL next;
        } yxx;
+       struct {
+	 YREG                y1;
+	 YREG                y2;
+	 AREG                x;
+	 CELL next;
+       } yyx;
+       struct {
+	 YREG                y;
+	 YREG                y1;
+	 YREG                y2;
+	 CELL next;
+       } yyy;
        struct {
 	 YREG                y;
 	 Int                 c;

H/compile.h

@@ -146,6 +146,7 @@ typedef enum compiler_op {
   fetch_args_vc_op,
   f_var_op,
   f_val_op,
+  func2f_op,
   enter_profiling_op,
   retry_profiled_op,
   restore_tmps_op,

Makefile.in

@@ -72,6 +72,11 @@ SHELL=/bin/sh
 RANLIB=@RANLIB@
 srcdir=@srcdir@
 SHLIB_SUFFIX=@SHLIB_SUFFIX@
+MAKEINFO=makeinfo
+TEXI2DVI=texi2dvi
+TEXI2HTML=texi2html
+TEXI2PDF=texi2pdf
+
 #4.1VPATH=@srcdir@:@srcdir@/OPTYap
 CWD=$(PWD)
 #

changes4.3.html

@@ -6,9 +6,12 @@
 
 <H2 ALIGN=CENTER>Yap-4.3.19:</H2>
 <UL>
-      <LI> FIXED: allow yap_flag(user_{},V)..
+      <LI> SPEEDUP: inline functor(S) -> Na,Ar.
-      <LI> FIXED: allow second argument unbound to stream_property/2..
+      <LI> SPEEDUP: inline functor(Na,Ar) -> S.
-      <LI> FIXED: alias change had  broke stream_property/2..
+      <LI> FIXED: pillow installation path.
+      <LI> FIXED: allow yap_flag(user_{},V).
+      <LI> FIXED: allow second argument unbound to stream_property/2.
+      <LI> FIXED: alias change had  broke stream_property/2.
       <LI> FIXED: alias change had broke tell(user) and see(user).
       <LI> SPEEDUP: inline arg/3.
       <LI> FIXED: extra clause for module/1.

docs/yap.tex

@@ -3171,9 +3171,7 @@ which generates a new @code{end-of-file} (default for non-tty files).
 @item alias(+@var{Name})
 Specify an alias to the file. The alias @t{Name} must be an atom. The
 alias can be used instead of the file descriptor for every operation
-concerning the file.  YAP only supports the predefined aliases
+concerning the file.
-@code{user}, @code{user_input}, @code{user_output},and
-@code{user_error}.
 
 The operation will fail and give an error if the alias name is already
 in use. YAP allows several aliases for the same file, but only