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))