From 45032cc61e5c4266dd97d725749e26a20c69f16a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= <vsc@xato.(none)>
Date: Fri, 11 Feb 2011 19:01:18 +0000
Subject: [PATCH] export current predicate for SWI built-ins.

---
 C/c_interface.c               | 10 +++++++++-
 library/dialect/swi/fli/swi.c | 21 +++++++++++++++++++++
 packages/PLStream/pl-error.c  |  4 ++++
 packages/PLStream/pl-yap.h    |  4 ++++
 4 files changed, 38 insertions(+), 1 deletion(-)

diff --git a/C/c_interface.c b/C/c_interface.c
index b01f32877..ac03546f4 100755
--- a/C/c_interface.c
+++ b/C/c_interface.c
@@ -1480,7 +1480,9 @@ YAP_Execute(PredEntry *pe, CPredicate exec_code)
     for (i=pe->ArityOfPE; i > 0; i--) {
       sl = Yap_InitSlot(XREGS[i]);
     }
+    PP = pe;
     ret = ((codev)(sl,0,&ctx));
+    PP = NULL;
     if (!ret) {
       Term t;
 
@@ -1494,7 +1496,9 @@ YAP_Execute(PredEntry *pe, CPredicate exec_code)
     return ret;
   }
   if (pe->PredFlags & CArgsPredFlag) {
+    PP = pe;
     Int out =  execute_cargs(pe, exec_code);
+    PP = NULL;
     if (!out) {
       Term t;
 
@@ -1524,6 +1528,7 @@ YAP_ExecuteFirst(PredEntry *pe, CPredicate exec_code)
     CPredicateV codev = (CPredicateV)exec_code;
     struct foreign_context *ctx = (struct foreign_context *)(&EXTRA_CBACK_ARG(pe->ArityOfPE,1));
 
+    PP = pe;
     ctx->control = FRG_FIRST_CALL;
     ctx->engine = NULL; //(PL_local_data *)Yap_regp;
     ctx->context = NULL;
@@ -1532,6 +1537,7 @@ YAP_ExecuteFirst(PredEntry *pe, CPredicate exec_code)
     } else {
       val = ((codev)((&ARG1)-LCL0,0,ctx));
     }
+    PP = NULL;
     if (val == 0) {
       Term t;
 
@@ -1554,7 +1560,7 @@ YAP_ExecuteFirst(PredEntry *pe, CPredicate exec_code)
       return TRUE;
     }
   } else {
-    return (exec_code)();
+    (exec_code)();
   }
 }
 
@@ -1567,12 +1573,14 @@ YAP_ExecuteNext(PredEntry *pe, CPredicate exec_code)
     CPredicateV codev = (CPredicateV)exec_code;
     struct foreign_context *ctx = (struct foreign_context *)(&EXTRA_CBACK_ARG(pe->ArityOfPE,1));
     
+    PP = pe;
     ctx->control = FRG_REDO;
     if (pe->PredFlags & CArgsPredFlag) {
       val = execute_cargs_back(pe, exec_code, ctx);
     } else {
       val = ((codev)((&ARG1)-LCL0,0,ctx));
     }
+    PP = NULL;
     if (val == 0) {
       Term t;
 
diff --git a/library/dialect/swi/fli/swi.c b/library/dialect/swi/fli/swi.c
index fef89146b..fbef43571 100755
--- a/library/dialect/swi/fli/swi.c
+++ b/library/dialect/swi/fli/swi.c
@@ -48,6 +48,7 @@
 #include "swi.h"
 
 extern X_API Atom YAP_AtomFromSWIAtom(atom_t at);
+extern int	PL_error(const char *pred, int arity, const char *msg, int id, ...);
 
 X_API extern Atom
 YAP_AtomFromSWIAtom(atom_t at)
@@ -2996,6 +2997,26 @@ X_API pl_wchar_t *PL_atom_generator_w(const pl_wchar_t *pref, pl_wchar_t *buffer
   return NULL;
 }
 
+const char *Yap_GetCurrentPredName(void);
+Int Yap_GetCurrentPredArity(void);
+
+const char *
+Yap_GetCurrentPredName(void)
+{
+  if (!PP)
+    return NULL;
+  if (PP->ArityOfPE)
+    return NameOfFunctor(PP->FunctorOfPred)->StrOfAE;
+  return   RepAtom((Atom)(PP->FunctorOfPred))->StrOfAE;
+}
+
+Int
+Yap_GetCurrentPredArity(void)
+{
+  if (!PP)
+    return (Int)0;
+  return PP->ArityOfPE;
+}
 
 void
 Yap_swi_install(void)
diff --git a/packages/PLStream/pl-error.c b/packages/PLStream/pl-error.c
index dadc5c3ff..becd6b6cd 100644
--- a/packages/PLStream/pl-error.c
+++ b/packages/PLStream/pl-error.c
@@ -379,6 +379,10 @@ X_API int PL_error(const char *pred, int arity, const char *msg, int id, ...)
     goto err_instantiation;
   }
   va_end(args);
+  if (!pred) {
+    pred = Yap_GetCurrentPredName();
+    arity = Yap_GetCurrentPredArity();
+  }
   if ( pred )
     { PL_unify_term(predterm,
 		    PL_FUNCTOR, FUNCTOR_divide2,
diff --git a/packages/PLStream/pl-yap.h b/packages/PLStream/pl-yap.h
index 10be296c8..3e2892744 100644
--- a/packages/PLStream/pl-yap.h
+++ b/packages/PLStream/pl-yap.h
@@ -29,6 +29,10 @@ typedef YAP_Term	       *Word;		/* Anonymous 4 byte object */
 typedef YAP_Atom		Atom;
 typedef YAP_Term		(*Func)();	/* foreign functions */
 
+const char *Yap_GetCurrentPredName(void);
+YAP_Int     Yap_GetCurrentPredArity(void);
+
+
 extern atom_t codeToAtom(int chrcode);
 
 #define valTermRef(t)    ((Word)YAP_AddressFromSlot(t))