3441 lines
83 KiB
C
Executable File
3441 lines
83 KiB
C
Executable File
/************************************************************************* *
|
|
* YAP Prolog *
|
|
* Yap Prolog was developed at NCCUP - Universidade do Porto *
|
|
* *
|
|
* Copyright L.Damas, V.Santos Costa and Universidade do Porto 1985-- *
|
|
* *
|
|
**************************************************************************
|
|
* *
|
|
* File: c_interface.c *
|
|
* comments: c_interface primitives definition *
|
|
* *
|
|
* Last rev: $Date: 2008-08-07 20:51:21 $,$Author: vsc $
|
|
**
|
|
* $Log: not supported by cvs2svn $
|
|
* *
|
|
* *
|
|
*************************************************************************/
|
|
|
|
/**
|
|
@file c_interface.c
|
|
*/
|
|
|
|
#ifndef C_INTERFACE_C
|
|
|
|
#define C_INTERFACE_C 1
|
|
|
|
#include <stdlib.h>
|
|
#include "Yap.h"
|
|
#include "clause.h"
|
|
#include "yapio.h"
|
|
#include "Foreign.h"
|
|
#include "attvar.h"
|
|
#if HAVE_UNISTD_H
|
|
#include <unistd.h>
|
|
#endif
|
|
#include <stdlib.h>
|
|
#include <string.h>
|
|
#if HAVE_STDARG_H
|
|
#include <stdarg.h>
|
|
#endif
|
|
#if _MSC_VER || defined(__MINGW32__)
|
|
#include <windows.h>
|
|
#endif
|
|
#include "iopreds.h"
|
|
// we cannot consult YapInterface.h, that conflicts with what we declare, though
|
|
// it shouldn't
|
|
#include "YapInterface.h"
|
|
#include "YapText.h"
|
|
#ifdef TABLING
|
|
#include "tab.macros.h"
|
|
#endif /* TABLING */
|
|
#ifdef YAPOR
|
|
#include "or.macros.h"
|
|
#endif /* YAPOR */
|
|
#include "threads.h"
|
|
#include "cut_c.h"
|
|
#if HAVE_MALLOC_H
|
|
#include <malloc.h>
|
|
#endif
|
|
|
|
typedef enum {
|
|
FRG_FIRST_CALL = 0, /* Initial call */
|
|
FRG_CUTTED = 1, /* Context was cutted */
|
|
FRG_REDO = 2 /* Normal redo */
|
|
} frg_code;
|
|
|
|
struct foreign_context {
|
|
uintptr_t context; /* context value */
|
|
frg_code control; /* FRG_* action */
|
|
struct PL_local_data *engine; /* invoking engine */
|
|
};
|
|
|
|
X_API int YAP_Reset(yap_reset_t mode);
|
|
|
|
#if !HAVE_STRNCPY
|
|
#define strncpy(X, Y, Z) strcpy(X, Y)
|
|
#endif
|
|
#if !HAVE_STRNCAT
|
|
#define strncat(X, Y, Z) strcat(X, Y)
|
|
#endif
|
|
|
|
#if defined(_WIN32)
|
|
#define X_API __declspec(dllexport)
|
|
#endif
|
|
|
|
/**
|
|
@defgroup slotInterface Term Handles or Slots
|
|
@ingroup ChYInterface
|
|
@{
|
|
|
|
Term handles correspond to SWI-Prolog's term_t datatype: they are a safe
|
|
representation
|
|
of terms. Slots are safe houses in the stack, the garbage collector and the
|
|
stack
|
|
shifter know about them and make sure they have correct values. In this
|
|
case, we use a slot to preserve _t_ during the execution of
|
|
YAP_RunGoal). When the execution of _t_ is over we read the
|
|
(possibly changed) value of _t_ back from the slot _sl_ and tell
|
|
YAP that the slot _sl_ is not needed and can be given back to the
|
|
system.
|
|
|
|
YAP supports storing and manipulating term_t like slots or handles, but in the
|
|
C
|
|
the programmer needs to take care as most operations still require unwrapping
|
|
the term
|
|
inside.
|
|
|
|
For implementation details and more information, please check term_t_slots in
|
|
the implementation section.
|
|
|
|
*/
|
|
/// @brief report the current position of the slots, assuming that they occupy
|
|
/// the top of the stack.
|
|
///
|
|
///
|
|
X_API yhandle_t YAP_CurrentSlot(void);
|
|
|
|
/// @brief allocate n empty new slots
|
|
///
|
|
/// Return a handle to the system's default slot.
|
|
X_API yhandle_t YAP_NewSlots(int NumberOfSlots);
|
|
|
|
/// @brief allocate n empty new slots
|
|
///
|
|
/// Allocate _NumberOfSlots_ from the stack and return an handle to the
|
|
/// last one. The other handle can be obtained by decrementing the handle.
|
|
X_API yhandle_t YAP_InitSlot(YAP_Term t);
|
|
|
|
/// @brief read from a slot.
|
|
///
|
|
///
|
|
X_API YAP_Term YAP_GetFromSlot(YAP_handle_t slot);
|
|
|
|
/// @brief get the memory address of a slot
|
|
///
|
|
/// Return the address of slot _slot_: please use with care.
|
|
X_API YAP_Term *YAP_AddressFromSlot(YAP_handle_t);
|
|
|
|
/// @brief get the memory address of the term actually stored in a slot
|
|
///
|
|
///
|
|
X_API YAP_Term *YAP_AddressOfTermInSlot(YAP_handle_t);
|
|
|
|
/// @brief store term in a slot
|
|
///
|
|
///
|
|
X_API void YAP_PutInSlot(YAP_handle_t slot, YAP_Term t);
|
|
|
|
/// @brief Succeeds if it recovers the space allocated for $n$ contiguous slots
|
|
/// starting at topSlot.
|
|
///
|
|
/// Set the contents of slot _slot_ to _t_.
|
|
X_API int YAP_RecoverSlots(int, YAP_handle_t topSlot);
|
|
|
|
/// @brief copies the first new n YAAM registers to slots
|
|
///
|
|
/// Store the current first _HowMany_ arguments in new slots.
|
|
X_API YAP_handle_t YAP_ArgsToSlots(int HowMany);
|
|
|
|
/// @brief copies n slots such that sl is copied to the last abstract ,achine
|
|
/// register.
|
|
///
|
|
/// Set the first _HowMany_ arguments to the _HowMany_ slots
|
|
// starting at _slot_.
|
|
X_API void YAP_SlotsToArgs(int HowMany, YAP_handle_t slot);
|
|
|
|
/// @}
|
|
|
|
/**
|
|
@addtogroup c-interface
|
|
@{
|
|
*/
|
|
|
|
static arity_t current_arity(void) {
|
|
CACHE_REGS
|
|
if (P && PREVOP(P, Osbpp)->opc == Yap_opcode(_call_usercpred)) {
|
|
return PREVOP(P, Osbpp)->y_u.Osbpp.p->ArityOfPE;
|
|
} else {
|
|
return 0;
|
|
}
|
|
}
|
|
|
|
static int doexpand(UInt sz) {
|
|
CACHE_REGS
|
|
UInt arity;
|
|
|
|
if (P && PREVOP(P, Osbpp)->opc == Yap_opcode(_call_usercpred)) {
|
|
arity = PREVOP(P, Osbpp)->y_u.Osbpp.p->ArityOfPE;
|
|
} else {
|
|
arity = 0;
|
|
}
|
|
if (!Yap_gcl(sz, arity, ENV, gc_P(P, CP))) {
|
|
return FALSE;
|
|
}
|
|
return TRUE;
|
|
}
|
|
|
|
X_API YAP_Term YAP_A(int i) {
|
|
CACHE_REGS
|
|
return (Deref(XREGS[i]));
|
|
}
|
|
|
|
X_API YAP_Bool YAP_IsIntTerm(YAP_Term t) { return IsIntegerTerm(t); }
|
|
|
|
X_API YAP_Bool YAP_IsNumberTerm(YAP_Term t) {
|
|
return IsIntegerTerm(t) || IsIntTerm(t) || IsFloatTerm(t) || IsBigIntTerm(t);
|
|
}
|
|
|
|
X_API YAP_Bool YAP_IsLongIntTerm(YAP_Term t) { return IsLongIntTerm(t); }
|
|
|
|
X_API YAP_Bool YAP_IsBigNumTerm(YAP_Term t) {
|
|
#if USE_GMP
|
|
CELL *pt;
|
|
if (IsVarTerm(t))
|
|
return FALSE;
|
|
if (!IsBigIntTerm(t))
|
|
return FALSE;
|
|
pt = RepAppl(t);
|
|
return pt[1] == BIG_INT;
|
|
#else
|
|
return FALSE;
|
|
#endif
|
|
}
|
|
|
|
X_API YAP_Bool YAP_IsRationalTerm(YAP_Term t) {
|
|
#if USE_GMP
|
|
CELL *pt;
|
|
if (IsVarTerm(t))
|
|
return FALSE;
|
|
if (!IsBigIntTerm(t))
|
|
return FALSE;
|
|
pt = RepAppl(t);
|
|
return pt[1] == BIG_RATIONAL;
|
|
#else
|
|
return FALSE;
|
|
#endif
|
|
}
|
|
|
|
X_API YAP_Bool YAP_IsVarTerm(YAP_Term t) { return (IsVarTerm(t)); }
|
|
|
|
X_API YAP_Bool YAP_IsNonVarTerm(YAP_Term t) { return (IsNonVarTerm(t)); }
|
|
|
|
X_API YAP_Bool YAP_IsFloatTerm(Term t) { return (IsFloatTerm(t)); }
|
|
|
|
X_API YAP_Bool YAP_IsDbRefTerm(Term t) { return (IsDBRefTerm(t)); }
|
|
|
|
X_API YAP_Bool YAP_IsAtomTerm(Term t) { return (IsAtomTerm(t)); }
|
|
|
|
X_API YAP_Bool YAP_IsPairTerm(Term t) { return (IsPairTerm(t)); }
|
|
|
|
X_API YAP_Bool YAP_IsApplTerm(Term t) {
|
|
return (IsApplTerm(t) && !IsExtensionFunctor(FunctorOfTerm(t)));
|
|
}
|
|
|
|
X_API YAP_Bool YAP_IsCompoundTerm(Term t) {
|
|
return (IsApplTerm(t) && !IsExtensionFunctor(FunctorOfTerm(t))) ||
|
|
IsPairTerm(t);
|
|
}
|
|
|
|
X_API Term YAP_MkIntTerm(Int n) {
|
|
CACHE_REGS
|
|
Term I;
|
|
BACKUP_H();
|
|
|
|
I = MkIntegerTerm(n);
|
|
RECOVER_H();
|
|
return I;
|
|
}
|
|
|
|
X_API Int YAP_IntOfTerm(Term t) {
|
|
if (!IsApplTerm(t))
|
|
return IntOfTerm(t);
|
|
else {
|
|
return LongIntOfTerm(t);
|
|
}
|
|
}
|
|
|
|
X_API Term YAP_MkBigNumTerm(void *big) {
|
|
#if USE_GMP
|
|
Term I;
|
|
BACKUP_H();
|
|
I = Yap_MkBigIntTerm((MP_INT *)big);
|
|
RECOVER_H();
|
|
return I;
|
|
#else
|
|
return TermNil;
|
|
#endif /* USE_GMP */
|
|
}
|
|
|
|
X_API YAP_Bool YAP_BigNumOfTerm(Term t, void *b) {
|
|
#if USE_GMP
|
|
MP_INT *bz = (MP_INT *)b;
|
|
if (IsVarTerm(t))
|
|
return FALSE;
|
|
if (!IsBigIntTerm(t))
|
|
return FALSE;
|
|
mpz_set(bz, Yap_BigIntOfTerm(t));
|
|
return TRUE;
|
|
#else
|
|
return FALSE;
|
|
#endif /* USE_GMP */
|
|
}
|
|
|
|
X_API Term YAP_MkRationalTerm(void *big) {
|
|
#if USE_GMP
|
|
Term I;
|
|
BACKUP_H();
|
|
I = Yap_MkBigRatTerm((MP_RAT *)big);
|
|
RECOVER_H();
|
|
return I;
|
|
#else
|
|
return TermNil;
|
|
#endif /* USE_GMP */
|
|
}
|
|
|
|
X_API YAP_Bool YAP_RationalOfTerm(Term t, void *b) {
|
|
#if USE_GMP
|
|
MP_RAT *br = (MP_RAT *)b;
|
|
if (IsVarTerm(t))
|
|
return FALSE;
|
|
if (!IsBigIntTerm(t))
|
|
return FALSE;
|
|
mpq_set(br, Yap_BigRatOfTerm(t));
|
|
return TRUE;
|
|
#else
|
|
return FALSE;
|
|
#endif /* USE_GMP */
|
|
}
|
|
|
|
X_API Term YAP_MkBlobTerm(unsigned int sz) {
|
|
CACHE_REGS
|
|
Term I;
|
|
MP_INT *dst;
|
|
BACKUP_H();
|
|
|
|
while (HR + (sz + sizeof(MP_INT) / sizeof(CELL) + 2) > ASP - 1024) {
|
|
if (!doexpand((sz + sizeof(MP_INT) / sizeof(CELL) + 2) * sizeof(CELL))) {
|
|
Yap_Error(RESOURCE_ERROR_STACK, TermNil,
|
|
"YAP failed to grow the stack while constructing a blob: %s",
|
|
LOCAL_ErrorMessage);
|
|
return TermNil;
|
|
}
|
|
}
|
|
I = AbsAppl(HR);
|
|
HR[0] = (CELL)FunctorBigInt;
|
|
HR[1] = ARRAY_INT;
|
|
dst = (MP_INT *)(HR + 2);
|
|
dst->_mp_size = 0L;
|
|
dst->_mp_alloc = sz;
|
|
HR += (2 + sizeof(MP_INT) / sizeof(CELL));
|
|
HR[sz] = EndSpecials;
|
|
HR += sz + 1;
|
|
RECOVER_H();
|
|
|
|
return I;
|
|
}
|
|
|
|
X_API void *YAP_BlobOfTerm(Term t) {
|
|
MP_INT *src;
|
|
|
|
if (IsVarTerm(t))
|
|
return NULL;
|
|
if (!IsBigIntTerm(t))
|
|
return NULL;
|
|
src = (MP_INT *)(RepAppl(t) + 2);
|
|
return (void *)(src + 1);
|
|
}
|
|
|
|
X_API Term YAP_MkFloatTerm(double n) {
|
|
CACHE_REGS
|
|
Term t;
|
|
BACKUP_H();
|
|
|
|
t = MkFloatTerm(n);
|
|
|
|
RECOVER_H();
|
|
return t;
|
|
}
|
|
|
|
X_API YAP_Float YAP_FloatOfTerm(YAP_Term t) { return (FloatOfTerm(t)); }
|
|
|
|
X_API Term YAP_MkAtomTerm(Atom n) {
|
|
Term t;
|
|
|
|
t = MkAtomTerm(n);
|
|
return t;
|
|
}
|
|
|
|
X_API Atom YAP_AtomOfTerm(Term t) { return (AtomOfTerm(t)); }
|
|
|
|
X_API bool YAP_IsWideAtom(Atom a) { return IsWideAtom(a); }
|
|
|
|
X_API const char *YAP_AtomName(Atom a) {
|
|
const char *o;
|
|
|
|
o = AtomName(a);
|
|
return (o);
|
|
}
|
|
|
|
X_API const wchar_t *YAP_WideAtomName(Atom a) { return RepAtom(a)->WStrOfAE; }
|
|
|
|
X_API Atom YAP_LookupAtom(const char *c) {
|
|
CACHE_REGS
|
|
Atom a;
|
|
|
|
while (TRUE) {
|
|
a = Yap_LookupAtom(c);
|
|
if (a == NIL || Yap_get_signal(YAP_CDOVF_SIGNAL)) {
|
|
if (!Yap_locked_growheap(FALSE, 0, NULL)) {
|
|
Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "YAP failed to grow heap: %s",
|
|
LOCAL_ErrorMessage);
|
|
}
|
|
} else {
|
|
return a;
|
|
}
|
|
}
|
|
return NULL;
|
|
}
|
|
|
|
X_API Atom YAP_LookupWideAtom(const wchar_t *c) {
|
|
CACHE_REGS
|
|
Atom a;
|
|
|
|
while (TRUE) {
|
|
a = Yap_LookupWideAtom((wchar_t *)c);
|
|
if (a == NIL || Yap_get_signal(YAP_CDOVF_SIGNAL)) {
|
|
if (!Yap_locked_growheap(FALSE, 0, NULL)) {
|
|
Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "YAP failed to grow heap: %s",
|
|
LOCAL_ErrorMessage);
|
|
}
|
|
} else {
|
|
return a;
|
|
}
|
|
}
|
|
return NULL;
|
|
}
|
|
|
|
X_API Atom YAP_FullLookupAtom(const char *c) {
|
|
CACHE_REGS
|
|
Atom at;
|
|
|
|
while (TRUE) {
|
|
at = Yap_FullLookupAtom(c);
|
|
if (at == NIL || Yap_get_signal(YAP_CDOVF_SIGNAL)) {
|
|
if (!Yap_locked_growheap(FALSE, 0, NULL)) {
|
|
Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "YAP failed to grow heap: %s",
|
|
LOCAL_ErrorMessage);
|
|
}
|
|
} else {
|
|
return at;
|
|
}
|
|
}
|
|
return NULL;
|
|
}
|
|
|
|
X_API size_t YAP_AtomNameLength(Atom at) {
|
|
if (IsBlob(at)) {
|
|
return RepAtom(at)->rep.blob->length;
|
|
}
|
|
if (IsWideAtom(at)) {
|
|
wchar_t *c = RepAtom(at)->WStrOfAE;
|
|
|
|
return wcslen(c);
|
|
} else {
|
|
unsigned char *c = RepAtom(at)->UStrOfAE;
|
|
|
|
return strlen((char *)c);
|
|
}
|
|
}
|
|
|
|
X_API Term YAP_MkVarTerm(void) {
|
|
CACHE_REGS
|
|
CELL t;
|
|
BACKUP_H();
|
|
|
|
t = MkVarTerm();
|
|
|
|
RECOVER_H();
|
|
return t;
|
|
}
|
|
|
|
X_API Term YAP_MkPairTerm(Term t1, Term t2) {
|
|
CACHE_REGS
|
|
Term t;
|
|
BACKUP_H();
|
|
|
|
while (HR > ASP - 1024) {
|
|
Int sl1 = Yap_InitSlot(t1);
|
|
Int sl2 = Yap_InitSlot(t2);
|
|
RECOVER_H();
|
|
if (!Yap_dogc(0, NULL PASS_REGS)) {
|
|
return TermNil;
|
|
}
|
|
BACKUP_H();
|
|
t1 = Yap_GetFromSlot(sl1);
|
|
t2 = Yap_GetFromSlot(sl2);
|
|
Yap_RecoverSlots(2, sl2);
|
|
}
|
|
t = MkPairTerm(t1, t2);
|
|
RECOVER_H();
|
|
return t;
|
|
}
|
|
|
|
X_API Term YAP_MkListFromTerms(Term *ta, Int sz) {
|
|
CACHE_REGS
|
|
Term t;
|
|
CELL *h;
|
|
if (sz == 0)
|
|
return TermNil;
|
|
BACKUP_H();
|
|
while (HR + sz * 2 > ASP - 1024) {
|
|
Int sl1 = Yap_InitSlot((CELL)ta);
|
|
RECOVER_H();
|
|
if (!Yap_dogc(0, NULL PASS_REGS)) {
|
|
return TermNil;
|
|
}
|
|
BACKUP_H();
|
|
ta = (CELL *)Yap_GetFromSlot(sl1);
|
|
Yap_RecoverSlots(1, sl1);
|
|
}
|
|
h = HR;
|
|
t = AbsPair(h);
|
|
while (sz--) {
|
|
Term ti = *ta++;
|
|
if (IsVarTerm(ti)) {
|
|
RESET_VARIABLE(h);
|
|
Yap_unify(ti, h[0]);
|
|
} else {
|
|
h[0] = ti;
|
|
}
|
|
h[1] = AbsPair(h + 2);
|
|
h += 2;
|
|
}
|
|
h[-1] = TermNil;
|
|
HR = h;
|
|
RECOVER_H();
|
|
return t;
|
|
}
|
|
|
|
X_API Term YAP_MkNewPairTerm() {
|
|
CACHE_REGS
|
|
Term t;
|
|
BACKUP_H();
|
|
|
|
if (HR > ASP - 1024)
|
|
t = TermNil;
|
|
else
|
|
t = Yap_MkNewPairTerm();
|
|
|
|
RECOVER_H();
|
|
return t;
|
|
}
|
|
|
|
X_API Term YAP_HeadOfTerm(Term t) { return (HeadOfTerm(t)); }
|
|
|
|
X_API Term YAP_TailOfTerm(Term t) { return (TailOfTerm(t)); }
|
|
|
|
X_API Int YAP_SkipList(Term *l, Term **tailp) {
|
|
return Yap_SkipList(l, tailp);
|
|
Int length = 0;
|
|
Term *s; /* slow */
|
|
Term v; /* temporary */
|
|
|
|
do_derefa(v, l, derefa_unk, derefa_nonvar);
|
|
s = l;
|
|
|
|
if (IsPairTerm(*l)) {
|
|
intptr_t power = 1, lam = 0;
|
|
do {
|
|
if (power == lam) {
|
|
s = l;
|
|
power *= 2;
|
|
lam = 0;
|
|
}
|
|
lam++;
|
|
length++;
|
|
l = RepPair(*l) + 1;
|
|
do_derefa(v, l, derefa2_unk, derefa2_nonvar);
|
|
} while (*l != *s && IsPairTerm(*l));
|
|
}
|
|
*tailp = l;
|
|
|
|
return length;
|
|
}
|
|
|
|
X_API Term YAP_MkApplTerm(Functor f, UInt arity, Term args[]) {
|
|
CACHE_REGS
|
|
Term t;
|
|
BACKUP_H();
|
|
|
|
if (HR + arity > ASP - 1024)
|
|
t = TermNil;
|
|
else
|
|
t = Yap_MkApplTerm(f, arity, args);
|
|
|
|
RECOVER_H();
|
|
return t;
|
|
}
|
|
|
|
X_API Term YAP_MkNewApplTerm(Functor f, UInt arity) {
|
|
CACHE_REGS
|
|
Term t;
|
|
BACKUP_H();
|
|
|
|
if (HR + arity > ASP - 1024)
|
|
t = TermNil;
|
|
else
|
|
t = Yap_MkNewApplTerm(f, arity);
|
|
|
|
RECOVER_H();
|
|
return t;
|
|
}
|
|
|
|
X_API Functor YAP_FunctorOfTerm(Term t) { return (FunctorOfTerm(t)); }
|
|
|
|
X_API Term YAP_ArgOfTerm(UInt n, Term t) { return (ArgOfTerm(n, t)); }
|
|
|
|
X_API Term *YAP_ArgsOfTerm(Term t) {
|
|
if (IsApplTerm(t))
|
|
return RepAppl(t) + 1;
|
|
else if (IsPairTerm(t))
|
|
return RepPair(t);
|
|
return NULL;
|
|
}
|
|
|
|
X_API Functor YAP_MkFunctor(Atom a, UInt n) { return (Yap_MkFunctor(a, n)); }
|
|
|
|
X_API Atom YAP_NameOfFunctor(Functor f) { return (NameOfFunctor(f)); }
|
|
|
|
X_API UInt YAP_ArityOfFunctor(Functor f) { return (ArityOfFunctor(f)); }
|
|
|
|
X_API void *YAP_ExtraSpaceCut(void) {
|
|
CACHE_REGS
|
|
void *ptr;
|
|
BACKUP_B();
|
|
|
|
ptr = (void *)(((CELL *)(Yap_REGS.CUT_C_TOP)) -
|
|
(((yamop *)Yap_REGS.CUT_C_TOP->try_userc_cut_yamop)
|
|
->y_u.OtapFs.extra));
|
|
|
|
RECOVER_B();
|
|
return (ptr);
|
|
}
|
|
|
|
X_API void *YAP_ExtraSpace(void) {
|
|
CACHE_REGS
|
|
void *ptr;
|
|
BACKUP_B();
|
|
BACKUP_H();
|
|
|
|
/* find a pointer to extra space allocable */
|
|
ptr = (void *)((CELL *)(B + 1) + P->y_u.OtapFs.s);
|
|
B->cp_h = HR;
|
|
|
|
RECOVER_H();
|
|
RECOVER_B();
|
|
return (ptr);
|
|
}
|
|
|
|
X_API void YAP_cut_up(void) {
|
|
CACHE_REGS
|
|
BACKUP_B();
|
|
{
|
|
while (POP_CHOICE_POINT(B->cp_b)) {
|
|
POP_EXECUTE();
|
|
}
|
|
}
|
|
/* This is complicated: make sure we can restore the ASP
|
|
pointer back to where cut_up called it. Slots depend on it. */
|
|
if (ENV > B->cp_env) {
|
|
ASP = B->cp_env;
|
|
}
|
|
#ifdef YAPOR
|
|
{
|
|
choiceptr cut_pt;
|
|
|
|
cut_pt = B->cp_b;
|
|
/* make sure we prune C-choicepoints */
|
|
if (POP_CHOICE_POINT(B->cp_b)) {
|
|
POP_EXECUTE();
|
|
}
|
|
CUT_prune_to(cut_pt);
|
|
Yap_TrimTrail();
|
|
B = cut_pt;
|
|
}
|
|
#else
|
|
/* make sure we prune C-choicepoints */
|
|
if (POP_CHOICE_POINT(B->cp_b)) {
|
|
POP_EXECUTE();
|
|
}
|
|
Yap_TrimTrail();
|
|
B = B->cp_b; /* cut_fail */
|
|
#endif
|
|
HB = B->cp_h; /* cut_fail */
|
|
RECOVER_B();
|
|
}
|
|
|
|
X_API bool YAP_Unify(Term t1, Term t2) {
|
|
Int out;
|
|
BACKUP_MACHINE_REGS();
|
|
|
|
out = Yap_unify(t1, t2);
|
|
|
|
RECOVER_MACHINE_REGS();
|
|
return out;
|
|
}
|
|
|
|
X_API int YAP_Unifiable(Term t1, Term t2) {
|
|
int out;
|
|
BACKUP_MACHINE_REGS();
|
|
|
|
out = Yap_Unifiable(t1, t2);
|
|
|
|
RECOVER_MACHINE_REGS();
|
|
return out;
|
|
}
|
|
|
|
/* == */
|
|
X_API int YAP_ExactlyEqual(Term t1, Term t2) {
|
|
int out;
|
|
BACKUP_MACHINE_REGS();
|
|
|
|
out = Yap_eq(t1, t2);
|
|
|
|
RECOVER_MACHINE_REGS();
|
|
return out;
|
|
}
|
|
|
|
/* =@= */
|
|
X_API int YAP_Variant(Term t1, Term t2) {
|
|
int out;
|
|
BACKUP_MACHINE_REGS();
|
|
|
|
out = Yap_Variant(Deref(t1), Deref(t2));
|
|
|
|
RECOVER_MACHINE_REGS();
|
|
return out;
|
|
}
|
|
|
|
/* =@= */
|
|
X_API Int YAP_TermHash(Term t, Int sz, Int depth, int variant) {
|
|
Int out;
|
|
|
|
BACKUP_MACHINE_REGS();
|
|
|
|
out = Yap_TermHash(t, sz, depth, variant);
|
|
|
|
RECOVER_MACHINE_REGS();
|
|
return out;
|
|
}
|
|
|
|
X_API Int YAP_CurrentSlot(void) {
|
|
CACHE_REGS
|
|
return Yap_CurrentSlot();
|
|
}
|
|
|
|
X_API Int YAP_NewSlots(int n) {
|
|
CACHE_REGS
|
|
return Yap_NewSlots(n);
|
|
}
|
|
|
|
X_API Int YAP_InitSlot(Term t) {
|
|
CACHE_REGS
|
|
return Yap_InitSlot(t);
|
|
}
|
|
|
|
X_API int YAP_RecoverSlots(int n, Int top_slot) {
|
|
CACHE_REGS
|
|
return Yap_RecoverSlots(n, top_slot);
|
|
}
|
|
|
|
X_API Term YAP_GetFromSlot(Int slot) {
|
|
CACHE_REGS
|
|
return Yap_GetFromSlot(slot);
|
|
}
|
|
|
|
X_API Term *YAP_AddressFromSlot(Int slot) {
|
|
CACHE_REGS
|
|
return Yap_AddressFromSlot(slot);
|
|
}
|
|
|
|
X_API Term *YAP_AddressOfTermInSlot(Int slot) {
|
|
CACHE_REGS
|
|
Term *b = Yap_AddressFromSlot(slot);
|
|
Term a = *b;
|
|
restart:
|
|
if (!IsVarTerm(a)) {
|
|
return (b);
|
|
} else if (a == (CELL)b) {
|
|
return (b);
|
|
} else {
|
|
b = (CELL *)a;
|
|
a = *b;
|
|
goto restart;
|
|
}
|
|
}
|
|
|
|
X_API void YAP_PutInSlot(Int slot, Term t) {
|
|
CACHE_REGS
|
|
Yap_PutInSlot(slot, t);
|
|
}
|
|
|
|
typedef Int (*CPredicate0)(void);
|
|
typedef Int (*CPredicate1)(yhandle_t);
|
|
typedef Int (*CPredicate2)(yhandle_t, yhandle_t);
|
|
typedef Int (*CPredicate3)(yhandle_t, yhandle_t, yhandle_t);
|
|
typedef Int (*CPredicate4)(yhandle_t, yhandle_t, yhandle_t, yhandle_t);
|
|
typedef Int (*CPredicate5)(yhandle_t, yhandle_t, yhandle_t, yhandle_t,
|
|
yhandle_t);
|
|
typedef Int (*CPredicate6)(yhandle_t, yhandle_t, yhandle_t, yhandle_t,
|
|
yhandle_t, yhandle_t);
|
|
typedef Int (*CPredicate7)(yhandle_t, yhandle_t, yhandle_t, yhandle_t,
|
|
yhandle_t, yhandle_t, yhandle_t);
|
|
typedef Int (*CPredicate8)(yhandle_t, yhandle_t, yhandle_t, yhandle_t,
|
|
yhandle_t, yhandle_t, yhandle_t, yhandle_t);
|
|
typedef Int (*CPredicate9)(yhandle_t, yhandle_t, yhandle_t, yhandle_t,
|
|
yhandle_t, yhandle_t, yhandle_t, yhandle_t,
|
|
yhandle_t);
|
|
typedef Int (*CPredicate10)(yhandle_t, yhandle_t, yhandle_t, yhandle_t,
|
|
yhandle_t, yhandle_t, yhandle_t, yhandle_t,
|
|
yhandle_t, yhandle_t);
|
|
typedef Int (*CPredicateV)(yhandle_t, yhandle_t, struct foreign_context *);
|
|
|
|
static Int execute_cargs(PredEntry *pe, CPredicate exec_code USES_REGS) {
|
|
switch (pe->ArityOfPE) {
|
|
case 0: {
|
|
CPredicate0 code0 = (CPredicate0)exec_code;
|
|
return code0();
|
|
}
|
|
case 1: {
|
|
CPredicate1 code1 = (CPredicate1)exec_code;
|
|
yhandle_t a1 = Yap_InitSlots(1, &ARG1);
|
|
return code1(a1);
|
|
}
|
|
case 2: {
|
|
CPredicate2 code2 = (CPredicate2)exec_code;
|
|
yhandle_t a1 = Yap_InitSlots(2, &ARG1);
|
|
return code2(a1, a1 + 1);
|
|
}
|
|
case 3: {
|
|
CPredicate3 code3 = (CPredicate3)exec_code;
|
|
yhandle_t a1 = Yap_InitSlots(3, &ARG1);
|
|
return code3(a1, a1 + 1, a1 + 2);
|
|
}
|
|
case 4: {
|
|
CPredicate4 code4 = (CPredicate4)exec_code;
|
|
yhandle_t a1 = Yap_InitSlots(4, &ARG1);
|
|
return code4(a1, a1 + 1, a1 + 2, a1 + 3);
|
|
}
|
|
case 5: {
|
|
CPredicate5 code5 = (CPredicate5)exec_code;
|
|
yhandle_t a1 = Yap_InitSlots(5, &ARG1);
|
|
return code5(a1, a1 + 1, a1 + 2, a1 + 3, a1 + 4);
|
|
}
|
|
case 6: {
|
|
CPredicate6 code6 = (CPredicate6)exec_code;
|
|
yhandle_t a1 = Yap_InitSlots(6, &ARG1);
|
|
return code6(a1, a1 + 1, a1 + 2, a1 + 3, a1 + 4, a1 + 5);
|
|
}
|
|
case 7: {
|
|
CPredicate7 code7 = (CPredicate7)exec_code;
|
|
yhandle_t a1 = Yap_InitSlots(7, &ARG1);
|
|
return code7(a1, a1 + 1, a1 + 2, a1 + 3, a1 + 4, a1 + 5, a1 + 6);
|
|
}
|
|
case 8: {
|
|
CPredicate8 code8 = (CPredicate8)exec_code;
|
|
yhandle_t a1 = Yap_InitSlots(8, &ARG1);
|
|
return code8(a1, a1 + 1, a1 + 2, a1 + 3, a1 + 4, a1 + 5, a1 + 6, a1 + 7);
|
|
}
|
|
case 9: {
|
|
CPredicate9 code9 = (CPredicate9)exec_code;
|
|
yhandle_t a1 = Yap_InitSlots(9, &ARG1);
|
|
return code9(a1, a1 + 1, a1 + 2, a1 + 3, a1 + 4, a1 + 5, a1 + 6, a1 + 7,
|
|
a1 + 8);
|
|
}
|
|
case 10: {
|
|
CPredicate10 code10 = (CPredicate10)exec_code;
|
|
yhandle_t a1 = Yap_InitSlots(10, &ARG1);
|
|
return code10(a1, a1 + 1, a1 + 2, a1 + 3, a1 + 4, a1 + 5, a1 + 6, a1 + 7,
|
|
a1 + 8, a1 + 9);
|
|
}
|
|
default:
|
|
YAP_Error(SYSTEM_ERROR_INTERNAL, TermNil,
|
|
"YAP only supports SWI C-call with arity =< 10");
|
|
return (FALSE);
|
|
}
|
|
}
|
|
|
|
typedef uintptr_t (*CBPredicate0)(struct foreign_context *);
|
|
typedef uintptr_t (*CBPredicate1)(yhandle_t, struct foreign_context *);
|
|
typedef uintptr_t (*CBPredicate2)(yhandle_t, yhandle_t,
|
|
struct foreign_context *);
|
|
typedef uintptr_t (*CBPredicate3)(yhandle_t, yhandle_t, yhandle_t,
|
|
struct foreign_context *);
|
|
typedef uintptr_t (*CBPredicate4)(yhandle_t, yhandle_t, yhandle_t, yhandle_t,
|
|
struct foreign_context *);
|
|
typedef uintptr_t (*CBPredicate5)(yhandle_t, yhandle_t, yhandle_t, yhandle_t,
|
|
yhandle_t, struct foreign_context *);
|
|
typedef uintptr_t (*CBPredicate6)(yhandle_t, yhandle_t, yhandle_t, yhandle_t,
|
|
yhandle_t, yhandle_t,
|
|
struct foreign_context *);
|
|
typedef uintptr_t (*CBPredicate7)(yhandle_t, yhandle_t, yhandle_t, yhandle_t,
|
|
yhandle_t, yhandle_t, yhandle_t,
|
|
struct foreign_context *);
|
|
typedef uintptr_t (*CBPredicate8)(yhandle_t, yhandle_t, yhandle_t, yhandle_t,
|
|
yhandle_t, yhandle_t, yhandle_t, yhandle_t,
|
|
struct foreign_context *);
|
|
typedef uintptr_t (*CBPredicate9)(yhandle_t, yhandle_t, yhandle_t, yhandle_t,
|
|
yhandle_t, yhandle_t, yhandle_t, yhandle_t,
|
|
yhandle_t, struct foreign_context *);
|
|
typedef uintptr_t (*CBPredicate10)(yhandle_t, yhandle_t, yhandle_t, yhandle_t,
|
|
yhandle_t, yhandle_t, yhandle_t, yhandle_t,
|
|
yhandle_t, yhandle_t,
|
|
struct foreign_context *);
|
|
|
|
static uintptr_t execute_cargs_back(PredEntry *pe, CPredicate exec_code,
|
|
struct foreign_context *ctx USES_REGS) {
|
|
switch (pe->ArityOfPE) {
|
|
case 0: {
|
|
CBPredicate0 code0 = (CBPredicate0)exec_code;
|
|
return code0(ctx);
|
|
}
|
|
case 1: {
|
|
CBPredicate1 code1 = (CBPredicate1)exec_code;
|
|
yhandle_t a1 = Yap_InitSlots(1, &B->cp_a1);
|
|
return code1(a1, ctx);
|
|
}
|
|
case 2: {
|
|
CBPredicate2 code2 = (CBPredicate2)exec_code;
|
|
yhandle_t a1 = Yap_InitSlots(2, &B->cp_a1);
|
|
return code2(a1, a1 + 1, ctx);
|
|
}
|
|
case 3: {
|
|
CBPredicate3 code3 = (CBPredicate3)exec_code;
|
|
yhandle_t a1 = Yap_InitSlots(3, &B->cp_a1);
|
|
return code3(a1, a1 + 1, a1 + 2, ctx);
|
|
}
|
|
case 4: {
|
|
CBPredicate4 code4 = (CBPredicate4)exec_code;
|
|
yhandle_t a1 = Yap_InitSlots(4, &B->cp_a1);
|
|
return code4(a1, a1 + 1, a1 + 2, a1 + 3, ctx);
|
|
}
|
|
case 5: {
|
|
CBPredicate5 code5 = (CBPredicate5)exec_code;
|
|
yhandle_t a1 = Yap_InitSlots(5, &B->cp_a1);
|
|
return code5(a1, a1 + 1, a1 + 2, a1 + 3, a1 + 4, ctx);
|
|
}
|
|
case 6: {
|
|
CBPredicate6 code6 = (CBPredicate6)exec_code;
|
|
yhandle_t a1 = Yap_InitSlots(6, &B->cp_a1);
|
|
return code6(a1, a1 + 1, a1 + 2, a1 + 3, a1 + 4, a1 + 5, ctx);
|
|
}
|
|
case 7: {
|
|
CBPredicate7 code7 = (CBPredicate7)exec_code;
|
|
yhandle_t a1 = Yap_InitSlots(7, &B->cp_a1);
|
|
return code7(a1, a1 + 1, a1 + 2, a1 + 3, a1 + 4, a1 + 5, a1 + 6, ctx);
|
|
}
|
|
case 8: {
|
|
CBPredicate8 code8 = (CBPredicate8)exec_code;
|
|
yhandle_t a1 = Yap_InitSlots(8, &B->cp_a1);
|
|
return code8(a1, a1 + 1, a1 + 2, a1 + 3, a1 + 4, a1 + 5, a1 + 6, a1 + 7,
|
|
ctx);
|
|
}
|
|
case 9: {
|
|
CBPredicate9 code9 = (CBPredicate9)exec_code;
|
|
yhandle_t a1 = Yap_InitSlots(9, &B->cp_a1);
|
|
return code9(a1, a1 + 1, a1 + 2, a1 + 3, a1 + 4, a1 + 5, a1 + 6, a1 + 7,
|
|
a1 + 8, ctx);
|
|
}
|
|
case 10: {
|
|
CBPredicate10 code10 = (CBPredicate10)exec_code;
|
|
yhandle_t a1 = Yap_InitSlots(10, &B->cp_a1);
|
|
return code10(a1, a1 + 1, a1 + 2, a1 + 3, a1 + 4, a1 + 5, a1 + 6, a1 + 7,
|
|
a1 + 8, a1 + 9, ctx);
|
|
}
|
|
default:
|
|
YAP_Error(SYSTEM_ERROR_INTERNAL, TermNil,
|
|
"YAP only supports SWI C-call with arity =< 10");
|
|
return (FALSE);
|
|
}
|
|
}
|
|
|
|
static uintptr_t complete_fail(choiceptr ptr, int has_cp USES_REGS) {
|
|
// this case is easy, jut be sure to throw everything
|
|
// after the old B;
|
|
while (B != ptr) {
|
|
B = B->cp_b;
|
|
}
|
|
if (has_cp)
|
|
return do_cut(FALSE);
|
|
return FALSE;
|
|
}
|
|
|
|
static uintptr_t complete_exit(choiceptr ptr, int has_cp,
|
|
int cut_all USES_REGS) {
|
|
// the user often leaves open frames, especially in forward execution
|
|
while (B && (!ptr || B < ptr)) {
|
|
if (cut_all || B->cp_ap == NOCODE) { /* separator */
|
|
do_cut(TRUE); // pushes B up
|
|
continue;
|
|
} else if (B->cp_ap->opc == RETRY_USERC_OPCODE && B->cp_b == ptr) {
|
|
// started the current choicepoint, I hope
|
|
return do_cut(TRUE);
|
|
} else
|
|
break; // oops, there is something else
|
|
}
|
|
if (!ptr || B < ptr) {
|
|
// we're still not there yet
|
|
choiceptr new = B;
|
|
while (new &&new < ptr) {
|
|
if (new->cp_ap == NOCODE) /* separator */
|
|
new->cp_ap = FAILCODE; // there are choice-points above but at least,
|
|
// these won't harm innocent code
|
|
else if (new->cp_ap->opc == RETRY_USERC_OPCODE && new->cp_b == ptr) {
|
|
// I can't cut, but I can tag it as done
|
|
new->cp_ap = FAILCODE; // there are choice-points above but at least,
|
|
// these won't harm innocent code
|
|
}
|
|
new = new->cp_b;
|
|
}
|
|
}
|
|
if (has_cp) {
|
|
if (B == ptr) {
|
|
return do_cut(TRUE);
|
|
} else {
|
|
ptr->cp_ap = FAILCODE;
|
|
}
|
|
}
|
|
return TRUE;
|
|
}
|
|
|
|
Int YAP_Execute(PredEntry *pe, CPredicate exec_code) {
|
|
CACHE_REGS
|
|
Int ret;
|
|
Int OASP = LCL0 - (CELL *)B;
|
|
yhandle_t CurSlot = Yap_StartSlots();
|
|
// Term omod = CurrentModule;
|
|
// if (pe->PredFlags & CArgsPredFlag) {
|
|
// CurrentModule = pe->ModuleOfPred;
|
|
//}
|
|
if (pe->PredFlags & SWIEnvPredFlag) {
|
|
CPredicateV codev = (CPredicateV)exec_code;
|
|
struct foreign_context ctx;
|
|
|
|
ctx.engine = NULL;
|
|
yhandle_t s0 = Yap_InitSlots(pe->ArityOfPE, &ARG1);
|
|
PP = pe;
|
|
ret = codev(s0, 0, &ctx);
|
|
} else if (pe->PredFlags & CArgsPredFlag) {
|
|
PP = pe;
|
|
ret = execute_cargs(pe, exec_code PASS_REGS);
|
|
} else {
|
|
PP = pe;
|
|
ret = (exec_code)(PASS_REGS1);
|
|
}
|
|
PP = NULL;
|
|
// check for junk: open frames, etc */
|
|
Yap_CloseSlots(CurSlot);
|
|
if (ret)
|
|
complete_exit(((choiceptr)(LCL0 - OASP)), FALSE, FALSE PASS_REGS);
|
|
else
|
|
complete_fail(((choiceptr)(LCL0 - OASP)), FALSE PASS_REGS);
|
|
// CurrentModule = omod;
|
|
if (!ret) {
|
|
Term t;
|
|
|
|
LOCAL_BallTerm = EX;
|
|
EX = NULL;
|
|
if ((t = Yap_GetException())) {
|
|
Yap_JumpToEnv(t);
|
|
return FALSE;
|
|
}
|
|
}
|
|
return ret;
|
|
}
|
|
|
|
#define FRG_REDO_MASK 0x00000003L
|
|
#define FRG_REDO_BITS 2
|
|
#define REDO_INT 0x02 /* Returned an integer */
|
|
#define REDO_PTR 0x03 /* returned a pointer */
|
|
|
|
Int YAP_ExecuteFirst(PredEntry *pe, CPredicate exec_code) {
|
|
CACHE_REGS
|
|
CELL ocp = LCL0 - (CELL *)B;
|
|
/* for slots to work */
|
|
Int CurSlot = Yap_StartSlots();
|
|
if (pe->PredFlags &
|
|
(SWIEnvPredFlag | CArgsPredFlag | ModuleTransparentPredFlag)) {
|
|
uintptr_t val;
|
|
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 = (uintptr_t)NULL;
|
|
if (pe->PredFlags & CArgsPredFlag) {
|
|
val = execute_cargs_back(pe, exec_code, ctx PASS_REGS);
|
|
} else {
|
|
val = codev(Yap_InitSlots(pe->ArityOfPE, &ARG1), 0, ctx);
|
|
}
|
|
Yap_CloseSlots(CurSlot);
|
|
PP = NULL;
|
|
if (val == 0) {
|
|
Term t;
|
|
|
|
LOCAL_BallTerm = EX;
|
|
EX = NULL;
|
|
if ((t = Yap_GetException())) {
|
|
cut_c_pop();
|
|
B = B->cp_b;
|
|
Yap_JumpToEnv(t);
|
|
return FALSE;
|
|
}
|
|
return complete_fail(((choiceptr)(LCL0 - ocp)), TRUE PASS_REGS);
|
|
} else if (val == 1) { /* TRUE */
|
|
return complete_exit(((choiceptr)(LCL0 - ocp)), TRUE, FALSE PASS_REGS);
|
|
} else {
|
|
if ((val & REDO_PTR) == REDO_PTR)
|
|
ctx->context = (uintptr_t)(val & ~REDO_PTR);
|
|
else
|
|
ctx->context = (uintptr_t)((val & ~REDO_PTR) >> FRG_REDO_BITS);
|
|
/* fix dropped cps */
|
|
return complete_exit(((choiceptr)(LCL0 - ocp)), FALSE, FALSE PASS_REGS);
|
|
}
|
|
} else {
|
|
Int ret = (exec_code)(PASS_REGS1);
|
|
Yap_CloseSlots(CurSlot);
|
|
if (!ret) {
|
|
Term t;
|
|
|
|
LOCAL_BallTerm = EX;
|
|
EX = NULL;
|
|
if ((t = Yap_GetException())) {
|
|
Yap_JumpToEnv(t);
|
|
return FALSE;
|
|
}
|
|
}
|
|
return ret;
|
|
}
|
|
}
|
|
|
|
Int YAP_ExecuteOnCut(PredEntry *pe, CPredicate exec_code,
|
|
struct cut_c_str *top) {
|
|
CACHE_REGS
|
|
choiceptr oB = B;
|
|
Int val;
|
|
/* for slots to work */
|
|
yhandle_t CurSlot = Yap_StartSlots();
|
|
/* find out where we belong */
|
|
while (B->cp_b < (choiceptr)top)
|
|
B = B->cp_b;
|
|
PP = pe;
|
|
if (pe->PredFlags & (SWIEnvPredFlag | CArgsPredFlag)) {
|
|
// SWI Emulation
|
|
CPredicateV codev = (CPredicateV)exec_code;
|
|
struct foreign_context *ctx =
|
|
(struct foreign_context *)(&EXTRA_CBACK_ARG(pe->ArityOfPE, 1));
|
|
CELL *args = B->cp_args;
|
|
|
|
B = oB;
|
|
ctx->control = FRG_CUTTED;
|
|
ctx->engine = NULL; //(PL_local_data *)Yap_regp;
|
|
if (pe->PredFlags & CArgsPredFlag) {
|
|
val = execute_cargs_back(pe, exec_code, ctx PASS_REGS);
|
|
} else {
|
|
val = codev(Yap_InitSlots(pe->ArityOfPE, args), 0, ctx);
|
|
}
|
|
} else {
|
|
// YAP Native
|
|
val = exec_code(PASS_REGS1);
|
|
B = oB;
|
|
}
|
|
Yap_CloseSlots(CurSlot);
|
|
|
|
PP = NULL;
|
|
// B = LCL0-(CELL*)oB;
|
|
if (val == 0) {
|
|
Term t;
|
|
|
|
LOCAL_BallTerm = EX;
|
|
EX = NULL;
|
|
if ((t = Yap_GetException())) {
|
|
cut_c_pop();
|
|
Yap_JumpToEnv(t);
|
|
return FALSE;
|
|
}
|
|
return FALSE;
|
|
} else { /* TRUE */
|
|
return TRUE;
|
|
}
|
|
}
|
|
|
|
Int YAP_ExecuteNext(PredEntry *pe, CPredicate exec_code) {
|
|
CACHE_REGS
|
|
/* for slots to work */
|
|
Yap_StartSlots();
|
|
UInt ocp = LCL0 - (CELL *)B;
|
|
yhandle_t CurSlot = Yap_StartSlots();
|
|
if (pe->PredFlags & (SWIEnvPredFlag | CArgsPredFlag)) {
|
|
Int val;
|
|
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 PASS_REGS);
|
|
} else {
|
|
val = codev(Yap_InitSlots(pe->ArityOfPE, &ARG1), 0, ctx);
|
|
}
|
|
Yap_CloseSlots(CurSlot);
|
|
/* we are below the original choice point ?? */
|
|
/* make sure we clean up the frames left by the user */
|
|
PP = NULL;
|
|
if (val == 0) {
|
|
Term t;
|
|
|
|
LOCAL_BallTerm = EX;
|
|
EX = NULL;
|
|
if ((t = Yap_GetException())) {
|
|
cut_c_pop();
|
|
B = B->cp_b;
|
|
Yap_JumpToEnv(t);
|
|
return FALSE;
|
|
} else {
|
|
return complete_fail(((choiceptr)(LCL0 - ocp)), TRUE PASS_REGS);
|
|
}
|
|
} else if (val == 1) { /* TRUE */
|
|
return complete_exit(((choiceptr)(LCL0 - ocp)), TRUE, FALSE PASS_REGS);
|
|
} else {
|
|
if ((val & REDO_PTR) == REDO_PTR)
|
|
ctx->context = (uintptr_t)(val & ~REDO_PTR);
|
|
else
|
|
ctx->context = (uintptr_t)((val & ~REDO_PTR) >> FRG_REDO_BITS);
|
|
}
|
|
/* fix dropped cps */
|
|
return complete_exit(((choiceptr)(LCL0 - ocp)), FALSE, FALSE PASS_REGS);
|
|
} else {
|
|
Int ret = (exec_code)(PASS_REGS1);
|
|
Yap_CloseSlots(CurSlot);
|
|
if (!ret) {
|
|
Term t;
|
|
|
|
LOCAL_BallTerm = EX;
|
|
EX = NULL;
|
|
if ((t = Yap_GetException())) {
|
|
Yap_JumpToEnv(t);
|
|
return FALSE;
|
|
}
|
|
}
|
|
return ret;
|
|
}
|
|
}
|
|
|
|
X_API Int YAP_CallProlog(Term t) {
|
|
CACHE_REGS
|
|
Int out;
|
|
Term mod = CurrentModule;
|
|
BACKUP_MACHINE_REGS();
|
|
|
|
while (!IsVarTerm(t) && IsApplTerm(t) && FunctorOfTerm(t) == FunctorModule) {
|
|
Term tmod = ArgOfTerm(1, t);
|
|
if (IsVarTerm(tmod))
|
|
return (FALSE);
|
|
if (!IsAtomTerm(tmod))
|
|
return (FALSE);
|
|
mod = tmod;
|
|
t = ArgOfTerm(2, t);
|
|
}
|
|
out = Yap_execute_goal(t, 0, mod, true);
|
|
RECOVER_MACHINE_REGS();
|
|
return (out);
|
|
}
|
|
|
|
X_API void *YAP_ReallocSpaceFromYap(void *ptr, size_t size) {
|
|
CACHE_REGS
|
|
void *new_ptr;
|
|
BACKUP_MACHINE_REGS();
|
|
while ((new_ptr = Yap_ReallocCodeSpace(ptr, size)) == NULL) {
|
|
if (!Yap_growheap(FALSE, size, NULL)) {
|
|
Yap_Error(RESOURCE_ERROR_HEAP, TermNil, LOCAL_ErrorMessage);
|
|
return NULL;
|
|
}
|
|
}
|
|
RECOVER_MACHINE_REGS();
|
|
return new_ptr;
|
|
}
|
|
X_API void *YAP_AllocSpaceFromYap(size_t size) {
|
|
CACHE_REGS
|
|
void *ptr;
|
|
BACKUP_MACHINE_REGS();
|
|
|
|
while ((ptr = Yap_AllocCodeSpace(size)) == NULL) {
|
|
if (!Yap_growheap(FALSE, size, NULL)) {
|
|
Yap_Error(RESOURCE_ERROR_HEAP, TermNil, LOCAL_ErrorMessage);
|
|
return NULL;
|
|
}
|
|
}
|
|
RECOVER_MACHINE_REGS();
|
|
return ptr;
|
|
}
|
|
|
|
X_API void YAP_FreeSpaceFromYap(void *ptr) { Yap_FreeCodeSpace(ptr); }
|
|
|
|
/* */
|
|
/**
|
|
* copy a string to a buffer, the buffer must have been malloced
|
|
*
|
|
* @param t the text, or string
|
|
* @param buf the user-provided buffer
|
|
* @param bufsize bu
|
|
*
|
|
* @return
|
|
*/ X_API char *YAP_StringToBuffer(Term t, char *buf, unsigned int bufsize) {
|
|
CACHE_REGS
|
|
seq_tv_t inp, out;
|
|
inp.val.t = t;
|
|
inp.type = YAP_STRING_ATOMS_CODES | YAP_STRING_STRING | YAP_STRING_ATOM |
|
|
YAP_STRING_TRUNC | YAP_STRING_MALLOC;
|
|
inp.max = bufsize;
|
|
out.type = YAP_STRING_CHARS;
|
|
out.val.c = buf;
|
|
out.enc = ENC_ISO_UTF8;
|
|
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
|
|
return NULL;
|
|
return out.val.c;
|
|
}
|
|
|
|
/* copy a string to a buffer */
|
|
X_API Term YAP_BufferToString(const char *s) {
|
|
Term t;
|
|
BACKUP_H();
|
|
|
|
CACHE_REGS
|
|
seq_tv_t inp, out;
|
|
inp.val.c0 = s;
|
|
inp.type = YAP_STRING_CHARS;
|
|
out.type = YAP_STRING_CODES;
|
|
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
|
|
return 0L;
|
|
t = out.val.t;
|
|
|
|
RECOVER_H();
|
|
return t;
|
|
}
|
|
|
|
/* copy a string to a buffer */
|
|
X_API Term YAP_NBufferToString(const char *s, size_t len) {
|
|
Term t;
|
|
BACKUP_H();
|
|
|
|
CACHE_REGS
|
|
seq_tv_t inp, out;
|
|
inp.val.c0 = s;
|
|
inp.type = YAP_STRING_CHARS;
|
|
out.type = YAP_STRING_CODES | YAP_STRING_NCHARS | YAP_STRING_TRUNC;
|
|
out.sz = len;
|
|
out.max = len;
|
|
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
|
|
return 0L;
|
|
t = out.val.t;
|
|
|
|
RECOVER_H();
|
|
return t;
|
|
}
|
|
|
|
/* copy a string to a buffer */
|
|
X_API Term YAP_WideBufferToString(const wchar_t *s) {
|
|
Term t;
|
|
BACKUP_H();
|
|
|
|
CACHE_REGS
|
|
seq_tv_t inp, out;
|
|
inp.val.w0 = s;
|
|
inp.type = YAP_STRING_WCHARS;
|
|
out.type = YAP_STRING_CODES;
|
|
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
|
|
return 0L;
|
|
t = out.val.t;
|
|
|
|
RECOVER_H();
|
|
return t;
|
|
}
|
|
|
|
/* copy a string to a buffer */
|
|
X_API Term YAP_NWideBufferToString(const wchar_t *s, size_t len) {
|
|
Term t;
|
|
BACKUP_H();
|
|
|
|
CACHE_REGS
|
|
seq_tv_t inp, out;
|
|
inp.val.w0 = s;
|
|
inp.type = YAP_STRING_WCHARS;
|
|
out.type = YAP_STRING_CODES | YAP_STRING_NCHARS | YAP_STRING_TRUNC;
|
|
out.sz = len;
|
|
out.max = len;
|
|
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
|
|
return 0L;
|
|
t = out.val.t;
|
|
|
|
RECOVER_H();
|
|
return t;
|
|
}
|
|
|
|
/* copy a string to a buffer */
|
|
X_API Term YAP_ReadBuffer(const char *s, Term *tp) {
|
|
CACHE_REGS
|
|
Term t;
|
|
BACKUP_H();
|
|
|
|
LOCAL_ErrorMessage = NULL;
|
|
while (!(t = Yap_StringToTerm(s, strlen(s) + 1, &LOCAL_encoding,
|
|
GLOBAL_MaxPriority, tp))) {
|
|
if (LOCAL_ErrorMessage) {
|
|
if (!strcmp(LOCAL_ErrorMessage, "Stack Overflow")) {
|
|
if (!Yap_dogc(0, NULL PASS_REGS)) {
|
|
*tp = MkAtomTerm(Yap_LookupAtom(LOCAL_ErrorMessage));
|
|
LOCAL_ErrorMessage = NULL;
|
|
RECOVER_H();
|
|
return 0L;
|
|
}
|
|
} else if (!strcmp(LOCAL_ErrorMessage, "Heap Overflow")) {
|
|
if (!Yap_growheap(FALSE, 0, NULL)) {
|
|
*tp = MkAtomTerm(Yap_LookupAtom(LOCAL_ErrorMessage));
|
|
LOCAL_ErrorMessage = NULL;
|
|
RECOVER_H();
|
|
return 0L;
|
|
}
|
|
} else if (!strcmp(LOCAL_ErrorMessage, "Trail Overflow")) {
|
|
if (!Yap_growtrail(0, FALSE)) {
|
|
*tp = MkAtomTerm(Yap_LookupAtom(LOCAL_ErrorMessage));
|
|
LOCAL_ErrorMessage = NULL;
|
|
RECOVER_H();
|
|
return 0L;
|
|
}
|
|
} else {
|
|
RECOVER_H();
|
|
return 0L;
|
|
}
|
|
LOCAL_ErrorMessage = NULL;
|
|
continue;
|
|
} else {
|
|
break;
|
|
}
|
|
}
|
|
RECOVER_H();
|
|
return t;
|
|
}
|
|
|
|
/* copy a string to a buffer */
|
|
X_API YAP_Term YAP_BufferToAtomList(const char *s) {
|
|
Term t;
|
|
BACKUP_H();
|
|
|
|
CACHE_REGS
|
|
seq_tv_t inp, out;
|
|
inp.val.c0 = s;
|
|
inp.type = YAP_STRING_CHARS;
|
|
out.type = YAP_STRING_ATOMS;
|
|
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
|
|
return 0L;
|
|
t = out.val.t;
|
|
|
|
RECOVER_H();
|
|
return t;
|
|
}
|
|
|
|
/* copy a string of size len to a buffer */
|
|
X_API Term YAP_NBufferToAtomList(const char *s, size_t len) {
|
|
Term t;
|
|
BACKUP_H();
|
|
|
|
CACHE_REGS
|
|
seq_tv_t inp, out;
|
|
inp.val.c0 = s;
|
|
inp.type = YAP_STRING_CHARS;
|
|
out.type = YAP_STRING_ATOMS | YAP_STRING_NCHARS | YAP_STRING_TRUNC;
|
|
out.sz = len;
|
|
out.max = len;
|
|
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
|
|
return 0L;
|
|
t = out.val.t;
|
|
|
|
RECOVER_H();
|
|
return t;
|
|
}
|
|
|
|
/* copy a string to a buffer */
|
|
X_API Term YAP_WideBufferToAtomList(const wchar_t *s) {
|
|
Term t;
|
|
BACKUP_H();
|
|
|
|
CACHE_REGS
|
|
seq_tv_t inp, out;
|
|
inp.val.w0 = s;
|
|
inp.type = YAP_STRING_WCHARS;
|
|
out.type = YAP_STRING_ATOMS;
|
|
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
|
|
return 0L;
|
|
t = out.val.t;
|
|
|
|
RECOVER_H();
|
|
return t;
|
|
}
|
|
|
|
/* copy a string of size len to a buffer */
|
|
X_API Term YAP_NWideBufferToAtomList(const wchar_t *s, size_t len) {
|
|
Term t;
|
|
BACKUP_H();
|
|
|
|
CACHE_REGS
|
|
seq_tv_t inp, out;
|
|
inp.val.w0 = s;
|
|
inp.type = YAP_STRING_WCHARS;
|
|
out.type = YAP_STRING_ATOMS | YAP_STRING_NCHARS | YAP_STRING_TRUNC;
|
|
out.sz = len;
|
|
out.max = len;
|
|
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
|
|
return 0L;
|
|
t = out.val.t;
|
|
|
|
RECOVER_H();
|
|
return t;
|
|
}
|
|
|
|
/* copy a string of size len to a buffer */
|
|
X_API Term
|
|
YAP_NWideBufferToAtomDiffList(const wchar_t *s, Term t0, size_t len) {
|
|
Term t;
|
|
BACKUP_H();
|
|
|
|
CACHE_REGS
|
|
seq_tv_t inp, out;
|
|
inp.val.w0 = s;
|
|
inp.type = YAP_STRING_WCHARS;
|
|
out.type =
|
|
YAP_STRING_ATOMS | YAP_STRING_NCHARS | YAP_STRING_TRUNC | YAP_STRING_DIFF;
|
|
out.sz = len;
|
|
out.max = len;
|
|
out.dif = t0;
|
|
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
|
|
return 0L;
|
|
t = out.val.t;
|
|
|
|
RECOVER_H();
|
|
return t;
|
|
}
|
|
|
|
/* copy a string to a buffer */
|
|
X_API Term YAP_BufferToDiffList(const char *s, Term t0) {
|
|
Term t;
|
|
BACKUP_H();
|
|
|
|
CACHE_REGS
|
|
seq_tv_t inp, out;
|
|
inp.val.c0 = s;
|
|
inp.type = YAP_STRING_CHARS;
|
|
out.type = YAP_STRING_CODES | YAP_STRING_DIFF;
|
|
out.dif = t0;
|
|
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
|
|
return 0L;
|
|
t = out.val.t;
|
|
|
|
RECOVER_H();
|
|
return t;
|
|
}
|
|
|
|
/* copy a string of size len to a buffer */
|
|
X_API Term YAP_NBufferToDiffList(const char *s, Term t0, size_t len) {
|
|
Term t;
|
|
BACKUP_H();
|
|
|
|
CACHE_REGS
|
|
seq_tv_t inp, out;
|
|
inp.val.c0 = s;
|
|
inp.type = YAP_STRING_CHARS;
|
|
out.type =
|
|
YAP_STRING_CODES | YAP_STRING_NCHARS | YAP_STRING_TRUNC | YAP_STRING_DIFF;
|
|
out.sz = len;
|
|
out.max = len;
|
|
out.dif = t0;
|
|
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
|
|
return 0L;
|
|
t = out.val.t;
|
|
|
|
RECOVER_H();
|
|
return t;
|
|
}
|
|
|
|
/* copy a string to a buffer */
|
|
X_API Term YAP_WideBufferToDiffList(const wchar_t *s, Term t0) {
|
|
Term t;
|
|
BACKUP_H();
|
|
|
|
CACHE_REGS
|
|
seq_tv_t inp, out;
|
|
inp.val.w0 = s;
|
|
inp.type = YAP_STRING_WCHARS;
|
|
out.type = YAP_STRING_CODES | YAP_STRING_DIFF;
|
|
out.dif = t0;
|
|
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
|
|
return 0L;
|
|
t = out.val.t;
|
|
|
|
RECOVER_H();
|
|
return t;
|
|
}
|
|
|
|
/* copy a string of size len to a buffer */
|
|
X_API Term YAP_NWideBufferToDiffList(const wchar_t *s, Term t0, size_t len) {
|
|
Term t;
|
|
BACKUP_H();
|
|
|
|
CACHE_REGS
|
|
seq_tv_t inp, out;
|
|
inp.val.w0 = s;
|
|
inp.type = YAP_STRING_WCHARS;
|
|
out.type =
|
|
YAP_STRING_CODES | YAP_STRING_NCHARS | YAP_STRING_TRUNC | YAP_STRING_DIFF;
|
|
out.sz = len;
|
|
out.max = len;
|
|
out.dif = t0;
|
|
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
|
|
return 0L;
|
|
t = out.val.t;
|
|
|
|
RECOVER_H();
|
|
return t;
|
|
}
|
|
|
|
X_API void YAP_Error(int myerrno, Term t, const char *buf, ...) {
|
|
#define YAP_BUF_SIZE 512
|
|
va_list ap;
|
|
char tmpbuf[YAP_BUF_SIZE];
|
|
|
|
if (!myerrno)
|
|
myerrno = SYSTEM_ERROR_INTERNAL;
|
|
if (t == 0L)
|
|
t = TermNil;
|
|
if (buf != NULL) {
|
|
va_start(ap, buf);
|
|
#if HAVE_VSNPRINTF
|
|
(void)vsnprintf(tmpbuf, YAP_BUF_SIZE, buf, ap);
|
|
#else
|
|
(void)vsprintf(tmpbuf, buf, ap);
|
|
#endif
|
|
va_end(ap);
|
|
} else {
|
|
tmpbuf[0] = '\0';
|
|
}
|
|
Yap_Error(myerrno, t, tmpbuf);
|
|
}
|
|
|
|
X_API PredEntry *YAP_FunctorToPred(Functor func) {
|
|
CACHE_REGS
|
|
return RepPredProp(PredPropByFunc(func, CurrentModule));
|
|
}
|
|
|
|
X_API PredEntry *YAP_AtomToPred(Atom at) {
|
|
CACHE_REGS
|
|
return RepPredProp(PredPropByAtom(at, CurrentModule));
|
|
}
|
|
|
|
X_API PredEntry *YAP_FunctorToPredInModule(Functor func, Term mod) {
|
|
return RepPredProp(PredPropByFunc(func, mod));
|
|
}
|
|
|
|
X_API PredEntry *YAP_AtomToPredInModule(Atom at, Term mod) {
|
|
return RepPredProp(PredPropByAtom(at, mod));
|
|
}
|
|
|
|
static int run_emulator(USES_REGS1) {
|
|
int out;
|
|
|
|
LOCAL_PrologMode &= ~(UserCCallMode | CCallMode);
|
|
out = Yap_absmi(0);
|
|
LOCAL_PrologMode |= UserCCallMode;
|
|
return out;
|
|
}
|
|
|
|
X_API bool YAP_EnterGoal(PredEntry *pe, yhandle_t ptr, YAP_dogoalinfo *dgi) {
|
|
CACHE_REGS
|
|
bool out;
|
|
|
|
BACKUP_MACHINE_REGS();
|
|
LOCAL_PrologMode = UserMode;
|
|
dgi->p = P;
|
|
dgi->cp = CP;
|
|
dgi->CurSlot = LOCAL_CurSlot;
|
|
// ensure our current ENV receives current P.
|
|
|
|
Yap_PrepGoal(pe->ArityOfPE, Yap_AddressFromSlot(ptr), B PASS_REGS);
|
|
P = pe->CodeOfPred;
|
|
// __android_log_print(ANDROID_LOG_INFO, "YAP ", "ap=%p %d %x %x args=%x,%x
|
|
// slot=%d", pe, pe->CodeOfPred->opc, FAILCODE, Deref(ARG1), Deref(ARG2),
|
|
// LOCAL_CurSlot);
|
|
dgi->b = LCL0 - (CELL *)B;
|
|
out = run_emulator(PASS_REGS1);
|
|
RECOVER_MACHINE_REGS();
|
|
if (out) {
|
|
dgi->EndSlot = LOCAL_CurSlot;
|
|
Yap_StartSlots();
|
|
} else {
|
|
LOCAL_CurSlot =
|
|
dgi->CurSlot; // ignore any slots created within the called goal
|
|
}
|
|
return out;
|
|
}
|
|
|
|
X_API bool YAP_RetryGoal(YAP_dogoalinfo *dgi) {
|
|
CACHE_REGS
|
|
choiceptr myB;
|
|
bool out;
|
|
|
|
BACKUP_MACHINE_REGS();
|
|
myB = (choiceptr)(LCL0 - dgi->b);
|
|
CP = myB->cp_cp;
|
|
/* sanity check */
|
|
if (B >= myB) {
|
|
return FALSE;
|
|
}
|
|
P = FAILCODE;
|
|
/* make sure we didn't leave live slots when we backtrack */
|
|
ASP = (CELL *)B;
|
|
LOCAL_CurSlot = dgi->EndSlot;
|
|
out = run_emulator(PASS_REGS1);
|
|
RECOVER_MACHINE_REGS();
|
|
if (out) {
|
|
LOCAL_CurSlot = dgi->CurSlot;
|
|
Yap_StartSlots();
|
|
}
|
|
return out;
|
|
}
|
|
|
|
X_API bool YAP_LeaveGoal(int backtrack, YAP_dogoalinfo *dgi) {
|
|
CACHE_REGS
|
|
choiceptr myB;
|
|
|
|
BACKUP_MACHINE_REGS();
|
|
myB = (choiceptr)(LCL0 - dgi->b);
|
|
if (B > myB) {
|
|
/* someone cut us */
|
|
return FALSE;
|
|
}
|
|
/* prune away choicepoints */
|
|
if (B != myB) {
|
|
#ifdef YAPOR
|
|
CUT_prune_to(myB);
|
|
#endif
|
|
B = myB;
|
|
}
|
|
/* if backtracking asked for, recover space and bindings */
|
|
if (backtrack) {
|
|
P = FAILCODE;
|
|
Yap_exec_absmi(true, YAP_EXEC_ABSMI);
|
|
/* recover stack space */
|
|
HR = B->cp_h;
|
|
TR = B->cp_tr;
|
|
#ifdef DEPTH_LIMIT
|
|
DEPTH = B->cp_depth;
|
|
#endif /* DEPTH_LIMIT */
|
|
YENV = ENV = B->cp_env;
|
|
} else {
|
|
Yap_TrimTrail();
|
|
}
|
|
/* recover local stack */
|
|
#ifdef DEPTH_LIMIT
|
|
DEPTH = ENV[E_DEPTH];
|
|
#endif
|
|
/* make sure we prune C-choicepoints */
|
|
if (POP_CHOICE_POINT(B->cp_b)) {
|
|
POP_EXECUTE();
|
|
}
|
|
ENV = (CELL *)(ENV[E_E]);
|
|
/* ASP should be set to the top of the local stack when we
|
|
did the call */
|
|
ASP = B->cp_env;
|
|
/* YENV should be set to the current environment */
|
|
YENV = ENV = (CELL *)((B->cp_env)[E_E]);
|
|
B = B->cp_b;
|
|
// SET_BB(B);
|
|
HB = PROTECT_FROZEN_H(B);
|
|
CP = dgi->cp;
|
|
P = dgi->p;
|
|
LOCAL_CurSlot = dgi->CurSlot;
|
|
RECOVER_MACHINE_REGS();
|
|
return TRUE;
|
|
}
|
|
|
|
X_API Int YAP_RunGoal(Term t) {
|
|
CACHE_REGS
|
|
Term out;
|
|
yamop *old_CP = CP;
|
|
BACKUP_MACHINE_REGS();
|
|
|
|
LOCAL_AllowRestart = FALSE;
|
|
LOCAL_PrologMode = UserMode;
|
|
out = Yap_RunTopGoal(t);
|
|
LOCAL_PrologMode = UserCCallMode;
|
|
// should we catch the exception or pass it through?
|
|
// We'll pass it through
|
|
if (EX) {
|
|
Term ball = Yap_PopTermFromDB(EX);
|
|
EX = NULL;
|
|
Yap_JumpToEnv(ball);
|
|
return FALSE;
|
|
}
|
|
if (out) {
|
|
P = (yamop *)ENV[E_CP];
|
|
ENV = (CELL *)ENV[E_E];
|
|
CP = old_CP;
|
|
LOCAL_AllowRestart = TRUE;
|
|
// we are back to user code again, need slots */
|
|
Yap_StartSlots();
|
|
} else {
|
|
ENV = B->cp_env;
|
|
ENV = (CELL *)ENV[E_E];
|
|
CP = old_CP;
|
|
HR = B->cp_h;
|
|
TR = B->cp_tr;
|
|
B = B->cp_b;
|
|
LOCAL_AllowRestart = FALSE;
|
|
SET_ASP(ENV, E_CB * sizeof(CELL));
|
|
// make sure the slots are ok.
|
|
}
|
|
RECOVER_MACHINE_REGS();
|
|
return out;
|
|
}
|
|
|
|
X_API Term YAP_AllocExternalDataInStack(size_t bytes) {
|
|
Term t = Yap_AllocExternalDataInStack(EXTERNAL_BLOB, bytes);
|
|
if (t == TermNil)
|
|
return 0L;
|
|
return t;
|
|
}
|
|
|
|
X_API YAP_Bool YAP_IsExternalDataInStackTerm(Term t) {
|
|
return IsExternalBlobTerm(t, EXTERNAL_BLOB);
|
|
}
|
|
|
|
X_API void *YAP_ExternalDataInStackFromTerm(Term t) {
|
|
return ExternalBlobFromTerm(t);
|
|
}
|
|
|
|
X_API YAP_opaque_tag_t YAP_NewOpaqueType(struct YAP_opaque_handler_struct *f) {
|
|
int i;
|
|
if (!GLOBAL_OpaqueHandlers) {
|
|
GLOBAL_OpaqueHandlers =
|
|
malloc(sizeof(opaque_handler_t) * (USER_BLOB_END - USER_BLOB_START));
|
|
if (!GLOBAL_OpaqueHandlers) {
|
|
/* no room */
|
|
return -1;
|
|
}
|
|
} else if (GLOBAL_OpaqueHandlersCount == USER_BLOB_END - USER_BLOB_START) {
|
|
/* all types used */
|
|
return -1;
|
|
}
|
|
i = GLOBAL_OpaqueHandlersCount++;
|
|
memcpy(GLOBAL_OpaqueHandlers + i, f, sizeof(opaque_handler_t));
|
|
return i + USER_BLOB_START;
|
|
}
|
|
|
|
Term YAP_NewOpaqueObject(YAP_opaque_tag_t tag, size_t bytes) {
|
|
Term t = Yap_AllocExternalDataInStack((CELL)tag, bytes);
|
|
if (t == TermNil)
|
|
return 0L;
|
|
return t;
|
|
}
|
|
|
|
X_API YAP_Bool YAP_IsOpaqueObjectTerm(Term t, YAP_opaque_tag_t tag) {
|
|
return IsExternalBlobTerm(t, (CELL)tag);
|
|
}
|
|
|
|
X_API void *YAP_OpaqueObjectFromTerm(Term t) { return ExternalBlobFromTerm(t); }
|
|
|
|
X_API CELL *YAP_HeapStoreOpaqueTerm(Term t) {
|
|
return Yap_HeapStoreOpaqueTerm(t);
|
|
}
|
|
|
|
X_API Int YAP_RunGoalOnce(Term t) {
|
|
CACHE_REGS
|
|
Term out;
|
|
yamop *old_CP = CP;
|
|
Int oldPrologMode = LOCAL_PrologMode;
|
|
yhandle_t CSlot;
|
|
|
|
BACKUP_MACHINE_REGS();
|
|
Yap_InitYaamRegs(0);
|
|
CSlot = Yap_StartSlots();
|
|
LOCAL_PrologMode = UserMode;
|
|
// Yap_heap_regs->yap_do_low_level_trace=true;
|
|
out = Yap_RunTopGoal(t);
|
|
LOCAL_PrologMode = oldPrologMode;
|
|
Yap_CloseSlots(CSlot);
|
|
if (!(oldPrologMode & UserCCallMode)) {
|
|
/* called from top-level */
|
|
LOCAL_AllowRestart = FALSE;
|
|
RECOVER_MACHINE_REGS();
|
|
return out;
|
|
}
|
|
// should we catch the exception or pass it through?
|
|
// We'll pass it through
|
|
if (EX) {
|
|
Term ball = Yap_PopTermFromDB(EX);
|
|
EX = NULL;
|
|
Yap_JumpToEnv(ball);
|
|
return FALSE;
|
|
}
|
|
if (out) {
|
|
choiceptr cut_pt, ob;
|
|
|
|
ob = NULL;
|
|
cut_pt = B;
|
|
while (cut_pt->cp_ap != NOCODE) {
|
|
/* make sure we prune C-choicepoints */
|
|
if (POP_CHOICE_POINT(cut_pt->cp_b)) {
|
|
POP_EXECUTE();
|
|
}
|
|
ob = cut_pt;
|
|
cut_pt = cut_pt->cp_b;
|
|
}
|
|
#ifdef YAPOR
|
|
CUT_prune_to(cut_pt);
|
|
#endif
|
|
if (ob) {
|
|
B = ob;
|
|
Yap_TrimTrail();
|
|
}
|
|
B = cut_pt;
|
|
}
|
|
ASP = B->cp_env;
|
|
ENV = (CELL *)ASP[E_E];
|
|
B = (choiceptr)ASP[E_CB];
|
|
#ifdef DEPTH_LIMITxs
|
|
DEPTH = ASP[E_DEPTH];
|
|
#endif
|
|
P = (yamop *)ASP[E_CP];
|
|
CP = old_CP;
|
|
LOCAL_AllowRestart = FALSE;
|
|
RECOVER_MACHINE_REGS();
|
|
return out;
|
|
}
|
|
|
|
X_API bool YAP_RestartGoal(void) {
|
|
CACHE_REGS
|
|
bool out;
|
|
BACKUP_MACHINE_REGS();
|
|
if (LOCAL_AllowRestart) {
|
|
P = (yamop *)FAILCODE;
|
|
LOCAL_PrologMode = UserMode;
|
|
out = Yap_exec_absmi(TRUE, YAP_EXEC_ABSMI);
|
|
LOCAL_PrologMode = UserCCallMode;
|
|
if (out == FALSE) {
|
|
/* cleanup */
|
|
Yap_trust_last();
|
|
LOCAL_AllowRestart = FALSE;
|
|
}
|
|
} else {
|
|
out = FALSE;
|
|
}
|
|
RECOVER_MACHINE_REGS();
|
|
return (out);
|
|
}
|
|
|
|
X_API bool YAP_ShutdownGoal(int backtrack) {
|
|
CACHE_REGS
|
|
BACKUP_MACHINE_REGS();
|
|
|
|
if (LOCAL_AllowRestart) {
|
|
choiceptr cut_pt;
|
|
|
|
cut_pt = B;
|
|
while (cut_pt->cp_ap != NOCODE) {
|
|
/* make sure we prune C-choicepoints */
|
|
if (POP_CHOICE_POINT(cut_pt->cp_b)) {
|
|
POP_EXECUTE();
|
|
}
|
|
cut_pt = cut_pt->cp_b;
|
|
}
|
|
#ifdef YAPOR
|
|
CUT_prune_to(cut_pt);
|
|
#endif
|
|
/* just force backtrack */
|
|
B = cut_pt;
|
|
if (backtrack) {
|
|
P = FAILCODE;
|
|
Yap_exec_absmi(TRUE, YAP_EXEC_ABSMI);
|
|
/* recover stack space */
|
|
HR = cut_pt->cp_h;
|
|
TR = cut_pt->cp_tr;
|
|
}
|
|
/* we can always recover the stack */
|
|
ASP = cut_pt->cp_env;
|
|
ENV = (CELL *)ASP[E_E];
|
|
B = (choiceptr)ASP[E_CB];
|
|
Yap_TrimTrail();
|
|
#ifdef DEPTH_LIMIT
|
|
DEPTH = ASP[E_DEPTH];
|
|
#endif
|
|
LOCAL_AllowRestart = FALSE;
|
|
}
|
|
RECOVER_MACHINE_REGS();
|
|
return TRUE;
|
|
}
|
|
|
|
X_API bool YAP_ContinueGoal(void) {
|
|
CACHE_REGS
|
|
bool out;
|
|
BACKUP_MACHINE_REGS();
|
|
|
|
LOCAL_PrologMode = UserMode;
|
|
out = Yap_exec_absmi(TRUE, YAP_EXEC_ABSMI);
|
|
LOCAL_PrologMode = UserCCallMode;
|
|
|
|
RECOVER_MACHINE_REGS();
|
|
return (out);
|
|
}
|
|
|
|
X_API void YAP_PruneGoal(YAP_dogoalinfo *gi) {
|
|
CACHE_REGS
|
|
BACKUP_B();
|
|
|
|
choiceptr myB = (choiceptr)(LCL0 - gi->b);
|
|
while (B != myB) {
|
|
/* make sure we prune C-choicepoints */
|
|
if (POP_CHOICE_POINT(B->cp_b)) {
|
|
POP_EXECUTE();
|
|
}
|
|
if (!B->cp_b)
|
|
break;
|
|
B = B->cp_b;
|
|
}
|
|
Yap_TrimTrail();
|
|
|
|
RECOVER_B();
|
|
}
|
|
|
|
X_API bool YAP_GoalHasException(Term *t) {
|
|
CACHE_REGS
|
|
int out = FALSE;
|
|
BACKUP_MACHINE_REGS();
|
|
if (EX) {
|
|
do {
|
|
LOCAL_Error_TYPE = YAP_NO_ERROR;
|
|
*t = Yap_FetchTermFromDB(EX);
|
|
if (LOCAL_Error_TYPE == YAP_NO_ERROR) {
|
|
RECOVER_MACHINE_REGS();
|
|
return TRUE;
|
|
} else if (LOCAL_Error_TYPE == RESOURCE_ERROR_ATTRIBUTED_VARIABLES) {
|
|
LOCAL_Error_TYPE = YAP_NO_ERROR;
|
|
if (!Yap_growglobal(NULL)) {
|
|
Yap_Error(RESOURCE_ERROR_ATTRIBUTED_VARIABLES, TermNil,
|
|
LOCAL_ErrorMessage);
|
|
RECOVER_MACHINE_REGS();
|
|
return FALSE;
|
|
}
|
|
} else {
|
|
LOCAL_Error_TYPE = YAP_NO_ERROR;
|
|
if (!Yap_growstack(EX->NOfCells * CellSize)) {
|
|
Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
|
|
RECOVER_MACHINE_REGS();
|
|
return FALSE;
|
|
}
|
|
}
|
|
} while (*t == (CELL)0);
|
|
out = TRUE;
|
|
}
|
|
RECOVER_MACHINE_REGS();
|
|
return out;
|
|
}
|
|
|
|
X_API void YAP_ClearExceptions(void) {
|
|
CACHE_REGS
|
|
|
|
if (EX) {
|
|
LOCAL_BallTerm = EX;
|
|
}
|
|
EX = NULL;
|
|
Yap_ResetExceptionTerm(0);
|
|
LOCAL_UncaughtThrow = FALSE;
|
|
}
|
|
|
|
X_API int YAP_InitConsult(int mode, const char *filename, int *osnop) {
|
|
CACHE_REGS
|
|
FILE *f;
|
|
int sno;
|
|
BACKUP_MACHINE_REGS();
|
|
|
|
if (mode == YAP_BOOT_MODE) {
|
|
mode = YAP_CONSULT_MODE;
|
|
}
|
|
bool consulted = (mode == YAP_CONSULT_MODE);
|
|
Yap_init_consult(consulted, filename);
|
|
f = fopen(Yap_AbsoluteFile(filename, LOCAL_FileNameBuf, FILENAME_MAX - 1),
|
|
"r");
|
|
if (!f)
|
|
return -1;
|
|
sno = Yap_OpenStream(f, NULL, TermNil, Input_Stream_f);
|
|
*osnop = Yap_CheckAlias(AtomLoopStream);
|
|
if (!Yap_AddAlias(AtomLoopStream, sno)) {
|
|
Yap_CloseStream(sno);
|
|
sno = -1;
|
|
}
|
|
GLOBAL_Stream[sno].name = Yap_LookupAtom(filename);
|
|
GLOBAL_Stream[sno].user_name = MkAtomTerm(Yap_LookupAtom(filename));
|
|
RECOVER_MACHINE_REGS();
|
|
UNLOCK(GLOBAL_Stream[sno].streamlock);
|
|
return sno;
|
|
}
|
|
|
|
X_API FILE *YAP_TermToStream(Term t) {
|
|
FILE *s;
|
|
BACKUP_MACHINE_REGS();
|
|
|
|
if (IsVarTerm(t) || !IsAtomTerm(t))
|
|
return NULL;
|
|
if ((s = Yap_GetStreamHandle(t)->file)) {
|
|
RECOVER_MACHINE_REGS();
|
|
return s;
|
|
}
|
|
RECOVER_MACHINE_REGS();
|
|
return NULL;
|
|
}
|
|
|
|
X_API void YAP_EndConsult(int sno, int *osnop) {
|
|
BACKUP_MACHINE_REGS();
|
|
Yap_CloseStream(sno);
|
|
if (osnop >= 0)
|
|
Yap_AddAlias(AtomLoopStream, *osnop);
|
|
Yap_end_consult();
|
|
|
|
RECOVER_MACHINE_REGS();
|
|
}
|
|
|
|
X_API Term YAP_Read(FILE *f) {
|
|
Term o;
|
|
int sno = Yap_OpenStream(f, NULL, TermNil, Input_Stream_f);
|
|
|
|
BACKUP_MACHINE_REGS();
|
|
o = Yap_read_term(sno, TermNil, 1);
|
|
Yap_ReleaseStream(sno);
|
|
RECOVER_MACHINE_REGS();
|
|
return o;
|
|
}
|
|
|
|
X_API Term YAP_ReadFromStream(int sno) {
|
|
Term o;
|
|
|
|
BACKUP_MACHINE_REGS();
|
|
o = Yap_read_term(sno, TermNil, 1);
|
|
RECOVER_MACHINE_REGS();
|
|
return o;
|
|
}
|
|
|
|
X_API void YAP_Write(Term t, FILE *f, int flags) {
|
|
BACKUP_MACHINE_REGS();
|
|
int sno = Yap_OpenStream(f, NULL, TermNil, Output_Stream_f);
|
|
|
|
Yap_plwrite(t, GLOBAL_Stream + sno, 0, flags, GLOBAL_MaxPriority);
|
|
Yap_ReleaseStream(sno);
|
|
|
|
RECOVER_MACHINE_REGS();
|
|
}
|
|
|
|
X_API Term YAP_CopyTerm(Term t) {
|
|
Term tn;
|
|
BACKUP_MACHINE_REGS();
|
|
|
|
tn = Yap_CopyTerm(t);
|
|
|
|
RECOVER_MACHINE_REGS();
|
|
|
|
return tn;
|
|
}
|
|
|
|
X_API int YAP_WriteBuffer(Term t, char *buf, size_t sze, int flags) {
|
|
CACHE_REGS
|
|
size_t length;
|
|
char *b;
|
|
|
|
BACKUP_MACHINE_REGS();
|
|
if ((b = Yap_TermToString(t, buf, sze, &length, &LOCAL_encoding, flags)) !=
|
|
buf) {
|
|
if (b)
|
|
free(b);
|
|
RECOVER_MACHINE_REGS();
|
|
return FALSE;
|
|
}
|
|
RECOVER_MACHINE_REGS();
|
|
return TRUE;
|
|
}
|
|
|
|
X_API char *YAP_WriteDynamicBuffer(YAP_Term t, char *buf, size_t sze,
|
|
size_t *lengthp, encoding_t *encp,
|
|
int flags) {
|
|
char *b;
|
|
|
|
BACKUP_MACHINE_REGS();
|
|
b = Yap_TermToString(t, buf, sze, lengthp, encp, flags);
|
|
RECOVER_MACHINE_REGS();
|
|
return b;
|
|
}
|
|
|
|
X_API char *YAP_CompileClause(Term t) {
|
|
CACHE_REGS
|
|
yamop *codeaddr;
|
|
Term mod = CurrentModule;
|
|
Term tn = TermNil;
|
|
|
|
BACKUP_MACHINE_REGS();
|
|
|
|
/* allow expansion during stack initialization */
|
|
LOCAL_ErrorMessage = NULL;
|
|
ARG1 = t;
|
|
YAPEnterCriticalSection();
|
|
codeaddr = Yap_cclause(t, 0, mod, t);
|
|
if (codeaddr != NULL) {
|
|
t = Deref(ARG1); /* just in case there was an heap overflow */
|
|
if (!Yap_addclause(t, codeaddr, TRUE, mod, &tn)) {
|
|
YAPLeaveCriticalSection();
|
|
return LOCAL_ErrorMessage;
|
|
}
|
|
}
|
|
YAPLeaveCriticalSection();
|
|
|
|
if (Yap_get_signal(YAP_CDOVF_SIGNAL)) {
|
|
if (!Yap_locked_growheap(FALSE, 0, NULL)) {
|
|
Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "YAP failed to grow heap: %s",
|
|
LOCAL_ErrorMessage);
|
|
}
|
|
}
|
|
RECOVER_MACHINE_REGS();
|
|
return (LOCAL_ErrorMessage);
|
|
}
|
|
|
|
static int yap_lineno = 0;
|
|
|
|
static char InitFile[] = "init.yap";
|
|
static char BootFile[] = "boot.yap";
|
|
|
|
/* do initial boot by consulting the file boot.yap */
|
|
static void do_bootfile(char *bootfilename USES_REGS) {
|
|
Term t;
|
|
int bootfile, osno;
|
|
Functor functor_query = Yap_MkFunctor(Yap_LookupAtom("?-"), 1);
|
|
Functor functor_command1 = Yap_MkFunctor(Yap_LookupAtom(":-"), 1);
|
|
|
|
/* consult boot.pl */
|
|
/* the consult mode does not matter here, really */
|
|
/*
|
|
To be honest, YAP_InitConsult does not really do much,
|
|
it's here for the future. It also makes what we want to do clearer.
|
|
*/
|
|
bootfile = YAP_InitConsult(YAP_BOOT_MODE, bootfilename, &osno);
|
|
if (bootfile < 0) {
|
|
fprintf(stderr, "[ FATAL ERROR: could not open bootfile %s ]\n",
|
|
bootfilename);
|
|
exit(1);
|
|
}
|
|
do {
|
|
CACHE_REGS
|
|
YAP_Reset(YAP_FULL_RESET);
|
|
Yap_StartSlots();
|
|
t = YAP_ReadFromStream(bootfile);
|
|
// Yap_DebugPlWrite(t);fprintf(stderr, "\n");
|
|
if (t == 0) {
|
|
fprintf(stderr,
|
|
"[ SYNTAX ERROR: while parsing bootfile %s at line %d ]\n",
|
|
bootfilename, yap_lineno);
|
|
} else if (YAP_IsVarTerm(t) || t == TermNil) {
|
|
fprintf(stderr, "[ line %d: term cannot be compiled ]", yap_lineno);
|
|
} else if (YAP_IsPairTerm(t)) {
|
|
fprintf(stderr, "[ SYSTEM ERROR: consult not allowed in boot file ]\n");
|
|
fprintf(stderr, "error found at line %d and pos %d", yap_lineno,
|
|
fseek(GLOBAL_Stream[bootfile].file, 0L, SEEK_CUR));
|
|
} else if (IsApplTerm(t) && (FunctorOfTerm(t) == functor_query ||
|
|
FunctorOfTerm(t) == functor_command1)) {
|
|
YAP_RunGoalOnce(ArgOfTerm(1, t));
|
|
} else {
|
|
Term ts[2];
|
|
char *ErrorMessage;
|
|
Functor fun = Yap_MkFunctor(Yap_LookupAtom("$prepare_clause"), 2);
|
|
PredEntry *pe = RepPredProp(PredPropByFunc(fun, PROLOG_MODULE));
|
|
|
|
if (pe->OpcodeOfPred != UNDEF_OPCODE && pe->OpcodeOfPred != FAIL_OPCODE) {
|
|
ts[0] = t;
|
|
RESET_VARIABLE(ts + 1);
|
|
if (YAP_RunGoal(Yap_MkApplTerm(fun, 2, ts)))
|
|
t = ts[1];
|
|
}
|
|
ErrorMessage = YAP_CompileClause(t);
|
|
if (ErrorMessage) {
|
|
fprintf(stderr, "%s", ErrorMessage);
|
|
}
|
|
}
|
|
} while (t != TermEof);
|
|
|
|
YAP_EndConsult(bootfile, &osno);
|
|
#if DEBUG
|
|
if (Yap_output_msg)
|
|
fprintf(stderr, "Boot loaded\n");
|
|
#endif
|
|
}
|
|
|
|
static void construct_init_file(char *boot_file, char *BootFile) {
|
|
/* trust YAPSHAREDIR over YAP_PL_SRCDIR, and notice that the code is /
|
|
* dependent. */
|
|
#if HAVE_GETENV
|
|
if (getenv("YAPSHAREDIR")) {
|
|
strncpy(boot_file, getenv("YAPSHAREDIR"), 256);
|
|
strncat(boot_file, "/pl/", 255);
|
|
} else {
|
|
#endif
|
|
strncpy(boot_file, YAP_PL_SRCDIR, 256);
|
|
strncat(boot_file, "/", 255);
|
|
#if HAVE_GETENV
|
|
}
|
|
#endif
|
|
strncat(boot_file, BootFile, 255);
|
|
}
|
|
|
|
/* this routine is supposed to be called from an external program
|
|
that wants to control Yap */
|
|
|
|
#define BOOT_FROM_SAVED_STATE TRUE
|
|
|
|
X_API Int YAP_Init(YAP_init_args *yap_init) {
|
|
int restore_result;
|
|
int do_bootstrap = (yap_init->YapPrologBootFile != NULL);
|
|
CELL Trail = 0, Stack = 0, Heap = 0, Atts = 0;
|
|
char boot_file[256];
|
|
static int initialized = FALSE;
|
|
|
|
/* ignore repeated calls to YAP_Init */
|
|
if (initialized)
|
|
return YAP_BOOT_DONE_BEFOREHAND;
|
|
initialized = TRUE;
|
|
|
|
Yap_InitPageSize(); /* init memory page size, required by later functions */
|
|
#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA)
|
|
Yap_init_yapor_global_local_memory();
|
|
#endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA */
|
|
GLOBAL_PrologShouldHandleInterrupts = yap_init->PrologShouldHandleInterrupts;
|
|
Yap_InitSysbits(0); /* init signal handling and time, required by later
|
|
functions */
|
|
GLOBAL_argv = yap_init->Argv;
|
|
GLOBAL_argc = yap_init->Argc;
|
|
#if BOOT_FROM_SAVED_STATE
|
|
if (!yap_init->SavedState) {
|
|
yap_init->SavedState = YAP_STARTUP;
|
|
}
|
|
|
|
#else
|
|
if (yap_init->SavedState) {
|
|
fprintf(stderr, "[ WARNING: threaded YAP will ignore saved state %s ]\n",
|
|
yap_init->SavedState);
|
|
yap_init->SavedState = NULL;
|
|
}
|
|
#endif
|
|
if (yap_init->TrailSize == 0) {
|
|
if (yap_init->MaxTrailSize) {
|
|
Trail = yap_init->MaxTrailSize;
|
|
} else if (Trail == 0)
|
|
Trail = DefTrailSpace;
|
|
} else {
|
|
Trail = yap_init->TrailSize;
|
|
}
|
|
Atts = yap_init->AttsSize;
|
|
if (yap_init->StackSize == 0) {
|
|
if (yap_init->MaxStackSize || yap_init->MaxGlobalSize) {
|
|
if (yap_init->MaxStackSize) {
|
|
if (yap_init->MaxGlobalSize) {
|
|
Stack = yap_init->MaxStackSize + yap_init->MaxGlobalSize;
|
|
} else {
|
|
Stack = yap_init->MaxStackSize + DefStackSpace / 2;
|
|
}
|
|
} else {
|
|
Stack = yap_init->MaxGlobalSize + DefStackSpace / 2;
|
|
}
|
|
} else if (Stack == 0)
|
|
Stack = DefStackSpace;
|
|
} else {
|
|
Stack = yap_init->StackSize;
|
|
}
|
|
if (yap_init->HeapSize == 0) {
|
|
if (Heap == 0)
|
|
Heap = DefHeapSpace;
|
|
} else {
|
|
Heap = yap_init->HeapSize;
|
|
}
|
|
Yap_InitWorkspace(Heap, Stack, Trail, Atts, yap_init->MaxTableSpaceSize,
|
|
yap_init->NumberWorkers, yap_init->SchedulerLoop,
|
|
yap_init->DelayedReleaseLoad);
|
|
//
|
|
|
|
CACHE_REGS
|
|
if (yap_init->QuietMode) {
|
|
setVerbosity(TermSilent);
|
|
}
|
|
{
|
|
if (yap_init->YapPrologRCFile != NULL) {
|
|
/*
|
|
This must be done before restore, otherwise
|
|
restore will print out messages ....
|
|
*/
|
|
setBooleanGlobalPrologFlag(HALT_AFTER_CONSULT_FLAG,
|
|
yap_init->HaltAfterConsult);
|
|
}
|
|
/* tell the scystem who should cope with interrupts */
|
|
Yap_ExecutionMode = yap_init->ExecutionMode;
|
|
if (do_bootstrap) {
|
|
restore_result = YAP_BOOT_FROM_PROLOG;
|
|
} else if (BOOT_FROM_SAVED_STATE) {
|
|
restore_result = Yap_Restore(yap_init->SavedState, yap_init->YapLibDir);
|
|
if (restore_result == FAIL_RESTORE) {
|
|
yap_init->ErrorNo = LOCAL_Error_TYPE;
|
|
yap_init->ErrorCause = LOCAL_ErrorMessage;
|
|
/* shouldn't RECOVER_MACHINE_REGS(); be here ??? */
|
|
return YAP_BOOT_ERROR;
|
|
}
|
|
} else {
|
|
restore_result = YAP_BOOT_FROM_PROLOG;
|
|
}
|
|
if (BOOT_FROM_SAVED_STATE && !do_bootstrap) {
|
|
if (!Yap_SavedInfo(yap_init->SavedState, yap_init->YapLibDir, &Trail,
|
|
&Stack, &Heap)) {
|
|
yap_init->ErrorNo = LOCAL_Error_TYPE;
|
|
yap_init->ErrorCause = LOCAL_ErrorMessage;
|
|
return YAP_BOOT_ERROR;
|
|
}
|
|
}
|
|
GLOBAL_FAST_BOOT_FLAG = yap_init->FastBoot;
|
|
#if defined(YAPOR) || defined(TABLING)
|
|
Yap_init_root_frames();
|
|
#endif /* YAPOR || TABLING */
|
|
#ifdef YAPOR
|
|
Yap_init_yapor_workers();
|
|
#if YAPOR_THREADS
|
|
if (Yap_thread_self() != 0) {
|
|
#else
|
|
if (worker_id != 0) {
|
|
#endif
|
|
#if defined(YAPOR_COPY) || defined(YAPOR_SBA)
|
|
/*
|
|
In the SBA we cannot just happily inherit registers
|
|
from the other workers
|
|
*/
|
|
Yap_InitYaamRegs(worker_id);
|
|
#endif /* YAPOR_COPY || YAPOR_SBA */
|
|
#ifndef YAPOR_THREADS
|
|
Yap_InitPreAllocCodeSpace(0);
|
|
#endif /* YAPOR_THREADS */
|
|
/* slaves, waiting for work */
|
|
CurrentModule = USER_MODULE;
|
|
P = GETWORK_FIRST_TIME;
|
|
Yap_exec_absmi(FALSE, YAP_EXEC_ABSMI);
|
|
Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
|
|
"abstract machine unexpected exit (YAP_Init)");
|
|
}
|
|
#endif /* YAPOR */
|
|
RECOVER_MACHINE_REGS();
|
|
}
|
|
/* make sure we do this after restore */
|
|
if (yap_init->MaxStackSize) {
|
|
GLOBAL_AllowLocalExpansion = FALSE;
|
|
} else {
|
|
GLOBAL_AllowLocalExpansion = TRUE;
|
|
}
|
|
if (yap_init->MaxGlobalSize) {
|
|
GLOBAL_AllowGlobalExpansion = FALSE;
|
|
} else {
|
|
GLOBAL_AllowGlobalExpansion = TRUE;
|
|
}
|
|
if (yap_init->MaxTrailSize) {
|
|
GLOBAL_AllowTrailExpansion = FALSE;
|
|
} else {
|
|
GLOBAL_AllowTrailExpansion = TRUE;
|
|
}
|
|
if (yap_init->YapPrologRCFile) {
|
|
Yap_PutValue(AtomConsultOnBoot,
|
|
MkAtomTerm(Yap_LookupAtom(yap_init->YapPrologRCFile)));
|
|
/*
|
|
This must be done again after restore, as yap_flags
|
|
has been overwritten ....
|
|
*/
|
|
setBooleanGlobalPrologFlag(HALT_AFTER_CONSULT_FLAG,
|
|
yap_init->HaltAfterConsult);
|
|
}
|
|
if (yap_init->YapPrologTopLevelGoal) {
|
|
Yap_PutValue(AtomTopLevelGoal,
|
|
MkAtomTerm(Yap_LookupAtom(yap_init->YapPrologTopLevelGoal)));
|
|
}
|
|
if (yap_init->YapPrologGoal) {
|
|
Yap_PutValue(AtomInitGoal,
|
|
MkAtomTerm(Yap_LookupAtom(yap_init->YapPrologGoal)));
|
|
}
|
|
if (yap_init->YapPrologAddPath) {
|
|
Yap_PutValue(AtomExtendFileSearchPath,
|
|
MkAtomTerm(Yap_LookupAtom(yap_init->YapPrologAddPath)));
|
|
}
|
|
if (yap_init->QuietMode) {
|
|
setVerbosity(TermSilent);
|
|
}
|
|
if (BOOT_FROM_SAVED_STATE && !do_bootstrap) {
|
|
if (restore_result == FAIL_RESTORE) {
|
|
yap_init->ErrorNo = LOCAL_Error_TYPE;
|
|
yap_init->ErrorCause = LOCAL_ErrorMessage;
|
|
return YAP_BOOT_ERROR;
|
|
}
|
|
if (Atts && Atts * 1024 > 2048 * sizeof(CELL))
|
|
Yap_AttsSize = Atts * 1024;
|
|
else
|
|
Yap_AttsSize = 2048 * sizeof(CELL);
|
|
if (restore_result == DO_ONLY_CODE) {
|
|
/* first, initialize the saved state */
|
|
Term t_goal = MkAtomTerm(AtomInitProlog);
|
|
YAP_RunGoalOnce(t_goal);
|
|
return YAP_BOOT_FROM_SAVED_CODE;
|
|
} else {
|
|
CurrentModule = LOCAL_SourceModule = USER_MODULE;
|
|
return YAP_BOOT_FROM_SAVED_STACKS;
|
|
}
|
|
} else {
|
|
|
|
/* read the bootfile */
|
|
if (!do_bootstrap) {
|
|
construct_init_file(boot_file, BootFile);
|
|
yap_init->YapPrologBootFile = boot_file;
|
|
}
|
|
do_bootfile(yap_init->YapPrologBootFile ? yap_init->YapPrologBootFile
|
|
: BootFile PASS_REGS);
|
|
/* initialize the top-level */
|
|
if (!do_bootstrap) {
|
|
char init_file[256];
|
|
Atom atfile;
|
|
Functor fgoal;
|
|
YAP_Term goal, as[2];
|
|
construct_init_file(init_file, InitFile);
|
|
/* consult init file */
|
|
atfile = Yap_LookupAtom(init_file);
|
|
as[0] = MkAtomTerm(atfile);
|
|
fgoal = Yap_MkFunctor(Yap_FullLookupAtom("$silent_bootstrap"), 1);
|
|
goal = Yap_MkApplTerm(fgoal, 1, as);
|
|
/* launch consult */
|
|
YAP_RunGoalOnce(goal);
|
|
/* set default module to user */
|
|
as[0] = MkAtomTerm(AtomUser);
|
|
fgoal = Yap_MkFunctor(Yap_LookupAtom("module"), 1);
|
|
goal = Yap_MkApplTerm(fgoal, 1, as);
|
|
YAP_RunGoalOnce(goal);
|
|
}
|
|
Yap_PutValue(Yap_FullLookupAtom("$live"),
|
|
MkAtomTerm(Yap_FullLookupAtom("$true")));
|
|
}
|
|
return YAP_BOOT_FROM_PROLOG;
|
|
}
|
|
|
|
Int Yap_InitDefaults(YAP_init_args *init_args, char saved_state[]) {
|
|
init_args->SavedState = saved_state;
|
|
init_args->AttsSize = 0;
|
|
init_args->HeapSize = 0;
|
|
init_args->StackSize = 0;
|
|
init_args->TrailSize = 0;
|
|
init_args->MaxAttsSize = 0;
|
|
init_args->MaxHeapSize = 0;
|
|
init_args->MaxStackSize = 0;
|
|
init_args->MaxGlobalSize = 0;
|
|
init_args->MaxTrailSize = 0;
|
|
init_args->YapLibDir = NULL;
|
|
init_args->YapPrologBootFile = NULL;
|
|
init_args->YapPrologInitFile = NULL;
|
|
init_args->YapPrologRCFile = NULL;
|
|
init_args->YapPrologGoal = NULL;
|
|
init_args->YapPrologTopLevelGoal = NULL;
|
|
init_args->YapPrologAddPath = NULL;
|
|
init_args->HaltAfterConsult = FALSE;
|
|
init_args->FastBoot = FALSE;
|
|
init_args->NumberWorkers = 1;
|
|
init_args->SchedulerLoop = 10;
|
|
init_args->DelayedReleaseLoad = 3;
|
|
init_args->PrologShouldHandleInterrupts = FALSE;
|
|
init_args->ExecutionMode = INTERPRETED;
|
|
init_args->Argc = 1;
|
|
{
|
|
size_t l1 = 2 * sizeof(char *);
|
|
if (!(init_args->Argv = (char **)malloc(l1)))
|
|
return YAP_BOOT_ERROR;
|
|
init_args->Argv[0] = Yap_FindExecutable();
|
|
init_args->Argv[1] = NULL;
|
|
}
|
|
init_args->ErrorNo = 0;
|
|
init_args->ErrorCause = NULL;
|
|
init_args->QuietMode = FALSE;
|
|
return 0;
|
|
}
|
|
|
|
X_API Int YAP_FastInit(char saved_state[]) {
|
|
YAP_init_args init_args;
|
|
Int out;
|
|
|
|
if ((out = Yap_InitDefaults(&init_args, saved_state)) != YAP_BOOT_ERROR)
|
|
out = YAP_Init(&init_args);
|
|
if (out == YAP_BOOT_ERROR) {
|
|
Yap_Error(init_args.ErrorNo, TermNil, init_args.ErrorCause);
|
|
}
|
|
return out;
|
|
}
|
|
|
|
X_API void YAP_PutValue(Atom at, Term t) { Yap_PutValue(at, t); }
|
|
|
|
X_API Term YAP_GetValue(Atom at) { return (Yap_GetValue(at)); }
|
|
|
|
X_API int YAP_CompareTerms(Term t1, Term t2) {
|
|
return Yap_compare_terms(t1, t2);
|
|
}
|
|
|
|
X_API int YAP_Reset(yap_reset_t mode) {
|
|
int res = TRUE;
|
|
BACKUP_MACHINE_REGS();
|
|
res = Yap_Reset(mode);
|
|
RECOVER_MACHINE_REGS();
|
|
return res;
|
|
}
|
|
|
|
X_API void YAP_Exit(int retval) { Yap_exit(retval); }
|
|
|
|
X_API int YAP_InitSocks(const char *host, long port) { return 0; }
|
|
|
|
X_API void YAP_SetOutputMessage(void) {
|
|
#if DEBUG
|
|
Yap_output_msg = TRUE;
|
|
#endif
|
|
}
|
|
|
|
X_API int YAP_StreamToFileNo(Term t) { return (Yap_StreamToFileNo(t)); }
|
|
|
|
X_API void YAP_CloseAllOpenStreams(void) {
|
|
BACKUP_H();
|
|
|
|
Yap_CloseStreams(FALSE);
|
|
|
|
RECOVER_H();
|
|
}
|
|
|
|
X_API void YAP_FlushAllStreams(void) {
|
|
BACKUP_H();
|
|
|
|
// VSC?? Yap_FlushStreams();
|
|
|
|
RECOVER_H();
|
|
}
|
|
|
|
X_API void YAP_Throw(Term t) {
|
|
BACKUP_MACHINE_REGS();
|
|
Yap_JumpToEnv(t);
|
|
RECOVER_MACHINE_REGS();
|
|
}
|
|
|
|
X_API void YAP_AsyncThrow(Term t) {
|
|
CACHE_REGS
|
|
BACKUP_MACHINE_REGS();
|
|
LOCAL_PrologMode |= AsyncIntMode;
|
|
Yap_JumpToEnv(t);
|
|
LOCAL_PrologMode &= ~AsyncIntMode;
|
|
RECOVER_MACHINE_REGS();
|
|
}
|
|
|
|
X_API void YAP_Halt(int i) { Yap_exit(i); }
|
|
|
|
X_API CELL *YAP_TopOfLocalStack(void) {
|
|
CACHE_REGS
|
|
return (ASP);
|
|
}
|
|
|
|
X_API void *YAP_Predicate(Atom a, UInt arity, Term m) {
|
|
if (arity == 0) {
|
|
return ((void *)RepPredProp(PredPropByAtom(a, m)));
|
|
} else {
|
|
Functor f = Yap_MkFunctor(a, arity);
|
|
return ((void *)RepPredProp(PredPropByFunc(f, m)));
|
|
}
|
|
}
|
|
|
|
X_API void YAP_PredicateInfo(void *p, Atom *a, UInt *arity, Term *m) {
|
|
PredEntry *pd = (PredEntry *)p;
|
|
if (pd->ArityOfPE) {
|
|
*arity = pd->ArityOfPE;
|
|
*a = NameOfFunctor(pd->FunctorOfPred);
|
|
} else {
|
|
*arity = 0;
|
|
*a = (Atom)(pd->FunctorOfPred);
|
|
}
|
|
if (pd->ModuleOfPred)
|
|
*m = pd->ModuleOfPred;
|
|
else
|
|
*m = TermProlog;
|
|
}
|
|
|
|
X_API void YAP_UserCPredicate(const char *name, CPredicate def, UInt arity) {
|
|
Yap_InitCPred(name, arity, def, UserCPredFlag);
|
|
}
|
|
|
|
X_API void YAP_UserBackCPredicate(const char *name, CPredicate init,
|
|
CPredicate cont, UInt arity,
|
|
unsigned int extra) {
|
|
Yap_InitCPredBackCut(name, arity, extra, init, cont, NULL, UserCPredFlag);
|
|
}
|
|
|
|
X_API void YAP_UserBackCutCPredicate(const char *name, CPredicate init,
|
|
CPredicate cont, CPredicate cut,
|
|
UInt arity, unsigned int extra) {
|
|
Yap_InitCPredBackCut(name, arity, extra, init, cont, cut, UserCPredFlag);
|
|
}
|
|
|
|
X_API void YAP_UserCPredicateWithArgs(const char *a, CPredicate f, UInt arity,
|
|
Term mod) {
|
|
CACHE_REGS
|
|
PredEntry *pe;
|
|
Term cm = CurrentModule;
|
|
CurrentModule = mod;
|
|
YAP_UserCPredicate(a, f, arity);
|
|
if (arity == 0) {
|
|
pe = RepPredProp(PredPropByAtom(Yap_LookupAtom(a), mod));
|
|
} else {
|
|
Functor f = Yap_MkFunctor(Yap_LookupAtom(a), arity);
|
|
pe = RepPredProp(PredPropByFunc(f, mod));
|
|
}
|
|
pe->PredFlags |= CArgsPredFlag;
|
|
CurrentModule = cm;
|
|
}
|
|
|
|
X_API Term YAP_CurrentModule(void) {
|
|
CACHE_REGS
|
|
return (CurrentModule);
|
|
}
|
|
|
|
X_API Term YAP_SetCurrentModule(Term new) {
|
|
CACHE_REGS
|
|
Term omod = CurrentModule;
|
|
LOCAL_SourceModule = CurrentModule = new;
|
|
return omod;
|
|
}
|
|
|
|
X_API Term YAP_CreateModule(Atom at) {
|
|
Term t;
|
|
WRITE_LOCK(RepAtom(at)->ARWLock);
|
|
t = Yap_Module(MkAtomTerm(at));
|
|
WRITE_UNLOCK(RepAtom(at)->ARWLock);
|
|
return t;
|
|
}
|
|
|
|
X_API Term YAP_StripModule(Term t, Term *modp) {
|
|
return Yap_StripModule(t, modp);
|
|
}
|
|
|
|
X_API int YAP_ThreadSelf(void) {
|
|
#if THREADS
|
|
return Yap_thread_self();
|
|
#else
|
|
return -2;
|
|
#endif
|
|
}
|
|
|
|
X_API int YAP_ThreadCreateEngine(struct YAP_thread_attr_struct *attr) {
|
|
#if THREADS
|
|
return Yap_thread_create_engine(attr);
|
|
#else
|
|
return -1;
|
|
#endif
|
|
}
|
|
|
|
X_API int YAP_ThreadAttachEngine(int wid) {
|
|
#if THREADS
|
|
return Yap_thread_attach_engine(wid);
|
|
#else
|
|
return FALSE;
|
|
#endif
|
|
}
|
|
|
|
X_API int YAP_ThreadDetachEngine(int wid) {
|
|
#if THREADS
|
|
return Yap_thread_detach_engine(wid);
|
|
#else
|
|
return FALSE;
|
|
#endif
|
|
}
|
|
|
|
X_API int YAP_ThreadDestroyEngine(int wid) {
|
|
#if THREADS
|
|
return Yap_thread_destroy_engine(wid);
|
|
#else
|
|
return FALSE;
|
|
#endif
|
|
}
|
|
|
|
X_API Term YAP_TermNil(void) { return TermNil; }
|
|
|
|
X_API int YAP_IsTermNil(Term t) { return t == TermNil; }
|
|
|
|
X_API int YAP_AtomGetHold(Atom at) { return Yap_AtomIncreaseHold(at); }
|
|
|
|
X_API int YAP_AtomReleaseHold(Atom at) { return Yap_AtomDecreaseHold(at); }
|
|
|
|
X_API Agc_hook YAP_AGCRegisterHook(Agc_hook hook) {
|
|
Agc_hook old = GLOBAL_AGCHook;
|
|
GLOBAL_AGCHook = hook;
|
|
return old;
|
|
}
|
|
|
|
X_API int YAP_HaltRegisterHook(HaltHookFunc hook, void *closure) {
|
|
return Yap_HaltRegisterHook(hook, closure);
|
|
}
|
|
|
|
X_API char *YAP_cwd(void) {
|
|
CACHE_REGS
|
|
char *buf = NULL;
|
|
int len;
|
|
if (!Yap_getcwd(LOCAL_FileNameBuf, YAP_FILENAME_MAX))
|
|
return FALSE;
|
|
len = strlen(LOCAL_FileNameBuf);
|
|
buf = Yap_AllocCodeSpace(len + 1);
|
|
if (!buf)
|
|
return NULL;
|
|
strncpy(buf, LOCAL_FileNameBuf, len);
|
|
return buf;
|
|
}
|
|
|
|
X_API Term YAP_FloatsToList(double *dblp, size_t sz) {
|
|
CACHE_REGS
|
|
Term t;
|
|
CELL *oldH;
|
|
BACKUP_H();
|
|
|
|
if (!sz)
|
|
return TermNil;
|
|
while (ASP - 1024 < HR + sz * (2 + 2 + SIZEOF_DOUBLE / SIZEOF_INT_P)) {
|
|
if ((CELL *)dblp > H0 && (CELL *)dblp < HR) {
|
|
/* we are in trouble */
|
|
LOCAL_OpenArray = (CELL *)dblp;
|
|
}
|
|
if (!Yap_dogc(0, NULL PASS_REGS)) {
|
|
RECOVER_H();
|
|
return 0L;
|
|
}
|
|
dblp = (double *)LOCAL_OpenArray;
|
|
LOCAL_OpenArray = NULL;
|
|
}
|
|
t = AbsPair(HR);
|
|
while (sz) {
|
|
oldH = HR;
|
|
HR += 2;
|
|
oldH[0] = MkFloatTerm(*dblp++);
|
|
oldH[1] = AbsPair(HR);
|
|
sz--;
|
|
}
|
|
oldH[1] = TermNil;
|
|
RECOVER_H();
|
|
return t;
|
|
}
|
|
|
|
X_API Int YAP_ListToFloats(Term t, double *dblp, size_t sz) {
|
|
size_t i = 0;
|
|
|
|
t = Deref(t);
|
|
do {
|
|
Term hd;
|
|
if (IsVarTerm(t))
|
|
return -1;
|
|
if (t == TermNil)
|
|
return i;
|
|
if (!IsPairTerm(t))
|
|
return -1;
|
|
hd = HeadOfTerm(t);
|
|
if (IsFloatTerm(hd)) {
|
|
dblp[i++] = FloatOfTerm(hd);
|
|
} else {
|
|
extern double Yap_gmp_to_float(Term hd);
|
|
|
|
if (IsIntTerm(hd))
|
|
dblp[i++] = IntOfTerm(hd);
|
|
else if (IsLongIntTerm(hd))
|
|
dblp[i++] = LongIntOfTerm(hd);
|
|
#if USE_GMP
|
|
else if (IsBigIntTerm(hd))
|
|
dblp[i++] = Yap_gmp_to_float(hd);
|
|
#endif
|
|
else
|
|
return -1;
|
|
}
|
|
if (i == sz)
|
|
return sz;
|
|
t = TailOfTerm(t);
|
|
} while (TRUE);
|
|
}
|
|
|
|
X_API Term YAP_IntsToList(Int *dblp, size_t sz) {
|
|
CACHE_REGS
|
|
Term t;
|
|
CELL *oldH;
|
|
BACKUP_H();
|
|
|
|
if (!sz)
|
|
return TermNil;
|
|
while (ASP - 1024 < HR + sz * 3) {
|
|
if ((CELL *)dblp > H0 && (CELL *)dblp < HR) {
|
|
/* we are in trouble */
|
|
LOCAL_OpenArray = (CELL *)dblp;
|
|
}
|
|
if (!Yap_dogc(0, NULL PASS_REGS)) {
|
|
RECOVER_H();
|
|
return 0L;
|
|
}
|
|
dblp = (Int *)LOCAL_OpenArray;
|
|
LOCAL_OpenArray = NULL;
|
|
}
|
|
t = AbsPair(HR);
|
|
while (sz) {
|
|
oldH = HR;
|
|
HR += 2;
|
|
oldH[0] = MkIntegerTerm(*dblp++);
|
|
oldH[1] = AbsPair(HR);
|
|
sz--;
|
|
}
|
|
oldH[1] = TermNil;
|
|
RECOVER_H();
|
|
return t;
|
|
}
|
|
|
|
X_API Int YAP_ListToInts(Term t, Int *dblp, size_t sz) {
|
|
size_t i = 0;
|
|
|
|
t = Deref(t);
|
|
do {
|
|
Term hd;
|
|
if (IsVarTerm(t))
|
|
return -1;
|
|
if (t == TermNil)
|
|
return i;
|
|
if (!IsPairTerm(t))
|
|
return -1;
|
|
hd = HeadOfTerm(t);
|
|
if (!IsIntTerm(hd))
|
|
return -1;
|
|
dblp[i++] = IntOfTerm(hd);
|
|
if (i == sz)
|
|
return sz;
|
|
t = TailOfTerm(t);
|
|
} while (TRUE);
|
|
}
|
|
|
|
X_API Term YAP_OpenList(int n) {
|
|
CACHE_REGS
|
|
Term t;
|
|
BACKUP_H();
|
|
|
|
while (HR + 2 * n > ASP - 1024) {
|
|
if (!Yap_dogc(0, NULL PASS_REGS)) {
|
|
RECOVER_H();
|
|
return FALSE;
|
|
}
|
|
}
|
|
t = AbsPair(HR);
|
|
HR += 2 * n;
|
|
|
|
RECOVER_H();
|
|
return t;
|
|
}
|
|
|
|
X_API Term YAP_ExtendList(Term t0, Term inp) {
|
|
Term t;
|
|
CELL *ptr = RepPair(t0);
|
|
BACKUP_H();
|
|
|
|
ptr[0] = inp;
|
|
ptr[1] = AbsPair(ptr + 2);
|
|
t = AbsPair(ptr + 2);
|
|
|
|
RECOVER_H();
|
|
return t;
|
|
}
|
|
|
|
X_API int YAP_CloseList(Term t0, Term tail) {
|
|
CELL *ptr = RepPair(t0);
|
|
|
|
RESET_VARIABLE(ptr - 1);
|
|
if (!Yap_unify((Term)(ptr - 1), tail))
|
|
return FALSE;
|
|
return TRUE;
|
|
}
|
|
|
|
X_API int YAP_IsAttVar(Term t) {
|
|
CACHE_REGS
|
|
t = Deref(t);
|
|
if (!IsVarTerm(t))
|
|
return FALSE;
|
|
return IsAttVar(VarOfTerm(t));
|
|
}
|
|
|
|
X_API Term YAP_AttsOfVar(Term t) {
|
|
CACHE_REGS
|
|
attvar_record *attv;
|
|
|
|
t = Deref(t);
|
|
if (!IsVarTerm(t))
|
|
return TermNil;
|
|
if (!IsAttVar(VarOfTerm(t)))
|
|
return TermNil;
|
|
attv = RepAttVar(VarOfTerm(t));
|
|
return attv->Atts;
|
|
}
|
|
|
|
X_API int YAP_FileNoFromStream(Term t) {
|
|
|
|
t = Deref(t);
|
|
if (IsVarTerm(t))
|
|
return -1;
|
|
return Yap_StreamToFileNo(t);
|
|
}
|
|
|
|
X_API void *YAP_FileDescriptorFromStream(Term t) {
|
|
|
|
t = Deref(t);
|
|
if (IsVarTerm(t))
|
|
return NULL;
|
|
return Yap_FileDescriptorFromStream(t);
|
|
}
|
|
|
|
X_API void *YAP_Record(Term t) {
|
|
DBTerm *dbterm;
|
|
DBRecordList *dbt;
|
|
|
|
dbterm = Yap_StoreTermInDB(Deref(t), 0);
|
|
if (dbterm == NULL)
|
|
return NULL;
|
|
dbt = (struct record_list *)Yap_AllocCodeSpace(sizeof(struct record_list));
|
|
while (dbt == NULL) {
|
|
if (!Yap_growheap(FALSE, sizeof(struct record_list), NULL)) {
|
|
/* be a good neighbor */
|
|
Yap_FreeCodeSpace((void *)dbterm);
|
|
Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "using YAP_Record");
|
|
return NULL;
|
|
}
|
|
}
|
|
if (Yap_Records) {
|
|
Yap_Records->prev_rec = dbt;
|
|
}
|
|
dbt->next_rec = Yap_Records;
|
|
dbt->prev_rec = NULL;
|
|
dbt->dbrecord = dbterm;
|
|
Yap_Records = dbt;
|
|
return dbt;
|
|
}
|
|
|
|
X_API Term YAP_Recorded(void *handle) {
|
|
CACHE_REGS
|
|
Term t;
|
|
DBTerm *dbterm = ((DBRecordList *)handle)->dbrecord;
|
|
|
|
BACKUP_MACHINE_REGS();
|
|
do {
|
|
LOCAL_Error_TYPE = YAP_NO_ERROR;
|
|
t = Yap_FetchTermFromDB(dbterm);
|
|
if (LOCAL_Error_TYPE == YAP_NO_ERROR) {
|
|
RECOVER_MACHINE_REGS();
|
|
return t;
|
|
} else if (LOCAL_Error_TYPE == RESOURCE_ERROR_ATTRIBUTED_VARIABLES) {
|
|
LOCAL_Error_TYPE = YAP_NO_ERROR;
|
|
if (!Yap_growglobal(NULL)) {
|
|
Yap_Error(RESOURCE_ERROR_ATTRIBUTED_VARIABLES, TermNil,
|
|
LOCAL_ErrorMessage);
|
|
RECOVER_MACHINE_REGS();
|
|
return FALSE;
|
|
}
|
|
} else {
|
|
LOCAL_Error_TYPE = YAP_NO_ERROR;
|
|
if (!Yap_growstack(dbterm->NOfCells * CellSize)) {
|
|
Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
|
|
RECOVER_MACHINE_REGS();
|
|
return FALSE;
|
|
}
|
|
}
|
|
} while (t == (CELL)0);
|
|
RECOVER_MACHINE_REGS();
|
|
return t;
|
|
}
|
|
|
|
X_API int YAP_Erase(void *handle) {
|
|
DBRecordList *dbr = (DBRecordList *)handle;
|
|
if (dbr->next_rec)
|
|
dbr->next_rec->prev_rec = dbr->prev_rec;
|
|
if (dbr->prev_rec)
|
|
dbr->prev_rec->next_rec = dbr->next_rec;
|
|
else if (Yap_Records == dbr) {
|
|
Yap_Records = dbr->next_rec;
|
|
}
|
|
Yap_ReleaseTermFromDB(dbr->dbrecord);
|
|
Yap_FreeCodeSpace(handle);
|
|
return 1;
|
|
}
|
|
|
|
X_API yhandle_t YAP_ArgsToSlots(int n) {
|
|
CACHE_REGS
|
|
return Yap_NewSlots(n);
|
|
}
|
|
|
|
X_API void YAP_SlotsToArgs(int n, yhandle_t slot) {
|
|
CACHE_REGS
|
|
CELL *ptr0 = Yap_AddressFromSlot(slot), *ptr1 = &ARG1;
|
|
while (n--) {
|
|
*ptr1++ = *ptr0++;
|
|
}
|
|
}
|
|
|
|
X_API void YAP_signal(int sig) { Yap_signal(sig); }
|
|
|
|
X_API int YAP_SetYAPFlag(Term flag, Term val) { return setYapFlag(flag, val); }
|
|
|
|
/* yhandle_t YAP_VarSlotToNumber(yhandle_t) */
|
|
yhandle_t YAP_VarSlotToNumber(yhandle_t s) {
|
|
CACHE_REGS
|
|
Term *t = (CELL *)Deref(Yap_GetFromSlot(s));
|
|
if (t < HR)
|
|
return t - H0;
|
|
return t - LCL0;
|
|
}
|
|
|
|
/* Term YAP_ModuleUser() */
|
|
Term YAP_ModuleUser(void) { return MkAtomTerm(AtomUser); }
|
|
|
|
/* int YAP_PredicateHasClauses() */
|
|
yhandle_t YAP_NumberOfClausesForPredicate(PredEntry *pe) {
|
|
return pe->cs.p_code.NOfClauses;
|
|
}
|
|
|
|
int YAP_MaxOpPriority(Atom at, Term module) {
|
|
AtomEntry *ae = RepAtom(at);
|
|
OpEntry *info;
|
|
WRITE_LOCK(ae->ARWLock);
|
|
info = Yap_GetOpPropForAModuleHavingALock(ae, module);
|
|
if (!info) {
|
|
WRITE_UNLOCK(ae->ARWLock);
|
|
return 0;
|
|
}
|
|
int ret = info->Prefix;
|
|
if (info->Infix > ret)
|
|
ret = info->Infix;
|
|
if (info->Posfix > ret)
|
|
ret = info->Posfix;
|
|
WRITE_UNLOCK(ae->ARWLock);
|
|
return ret;
|
|
}
|
|
|
|
int YAP_OpInfo(Atom at, Term module, int opkind, int *yap_type, int *prio) {
|
|
AtomEntry *ae = RepAtom(at);
|
|
OpEntry *info;
|
|
int n;
|
|
|
|
WRITE_LOCK(ae->ARWLock);
|
|
info = Yap_GetOpPropForAModuleHavingALock(ae, module);
|
|
if (!info) {
|
|
/* try system operators */
|
|
info = Yap_GetOpPropForAModuleHavingALock(ae, PROLOG_MODULE);
|
|
if (!info) {
|
|
WRITE_UNLOCK(ae->ARWLock);
|
|
return 0;
|
|
}
|
|
}
|
|
if (opkind == PREFIX_OP) {
|
|
SMALLUNSGN p = info->Prefix;
|
|
if (!p) {
|
|
WRITE_UNLOCK(ae->ARWLock);
|
|
return FALSE;
|
|
}
|
|
if (p & DcrrpFlag) {
|
|
n = 6;
|
|
*prio = (p ^ DcrrpFlag);
|
|
} else {
|
|
n = 7;
|
|
*prio = p;
|
|
}
|
|
} else if (opkind == INFIX_OP) {
|
|
SMALLUNSGN p = info->Infix;
|
|
if (!p) {
|
|
WRITE_UNLOCK(ae->ARWLock);
|
|
return FALSE;
|
|
}
|
|
if ((p & DcrrpFlag) && (p & DcrlpFlag)) {
|
|
n = 1;
|
|
*prio = (p ^ (DcrrpFlag | DcrlpFlag));
|
|
} else if (p & DcrrpFlag) {
|
|
n = 3;
|
|
*prio = (p ^ DcrrpFlag);
|
|
} else if (p & DcrlpFlag) {
|
|
n = 2;
|
|
*prio = (p ^ DcrlpFlag);
|
|
} else {
|
|
n = 4;
|
|
*prio = p;
|
|
}
|
|
} else {
|
|
SMALLUNSGN p = info->Posfix;
|
|
if (p & DcrlpFlag) {
|
|
n = 4;
|
|
*prio = (p ^ DcrlpFlag);
|
|
} else {
|
|
n = 5;
|
|
*prio = p;
|
|
}
|
|
}
|
|
*yap_type = n;
|
|
WRITE_UNLOCK(ae->ARWLock);
|
|
return 1;
|
|
}
|
|
|
|
int YAP_Argv(char ***argvp) {
|
|
if (argvp) {
|
|
*argvp = GLOBAL_argv;
|
|
}
|
|
return GLOBAL_argc;
|
|
}
|
|
|
|
YAP_tag_t YAP_TagOfTerm(Term t) {
|
|
if (IsVarTerm(t)) {
|
|
CELL *pt = VarOfTerm(t);
|
|
if (IsUnboundVar(pt)) {
|
|
CACHE_REGS
|
|
if (IsAttVar(pt))
|
|
return YAP_TAG_ATT;
|
|
return YAP_TAG_UNBOUND;
|
|
}
|
|
return YAP_TAG_REF;
|
|
}
|
|
if (IsPairTerm(t))
|
|
return YAP_TAG_PAIR;
|
|
if (IsAtomOrIntTerm(t)) {
|
|
if (IsAtomTerm(t))
|
|
return YAP_TAG_ATOM;
|
|
return YAP_TAG_INT;
|
|
} else {
|
|
Functor f = FunctorOfTerm(t);
|
|
|
|
if (IsExtensionFunctor(f)) {
|
|
if (f == FunctorDBRef) {
|
|
return YAP_TAG_DBREF;
|
|
}
|
|
if (f == FunctorLongInt) {
|
|
return YAP_TAG_LONG_INT;
|
|
}
|
|
if (f == FunctorBigInt) {
|
|
big_blob_type bt = RepAppl(t)[1];
|
|
switch (bt) {
|
|
case BIG_INT:
|
|
return YAP_TAG_BIG_INT;
|
|
case BIG_RATIONAL:
|
|
return YAP_TAG_RATIONAL;
|
|
default:
|
|
return YAP_TAG_OPAQUE;
|
|
}
|
|
}
|
|
}
|
|
return YAP_TAG_APPL;
|
|
}
|
|
}
|
|
|
|
int YAP_BPROLOG_exception;
|
|
Term YAP_BPROLOG_curr_toam_status;
|
|
|
|
/**
|
|
* Output the number of bytes needed to represent a string in UTF-8
|
|
* Note that the terminating zero is not included. No error checking
|
|
* is performed (the programmer should have that done).
|
|
*
|
|
* @param t a list of codes, chars, string or atom.
|
|
*
|
|
* @return a positive number with the size, or 0.
|
|
*/
|
|
size_t YAP_UTF8_TextLength(Term t) {
|
|
utf8proc_uint8_t dst[8];
|
|
size_t sz = 0;
|
|
|
|
if (IsPairTerm(t)) {
|
|
while (t != TermNil) {
|
|
int c;
|
|
|
|
Term hd = HeadOfTerm(t);
|
|
if (IsAtomTerm(hd)) {
|
|
Atom at = AtomOfTerm(hd);
|
|
if (IsWideAtom(at))
|
|
c = RepAtom(at)->WStrOfAE[0];
|
|
else
|
|
c = RepAtom(at)->StrOfAE[0];
|
|
} else if (IsIntegerTerm(hd)) {
|
|
c = IntegerOfTerm(hd);
|
|
} else {
|
|
c = '\0';
|
|
}
|
|
sz += utf8proc_encode_char(c, dst);
|
|
t = TailOfTerm(t);
|
|
}
|
|
} else if (IsAtomTerm(t)) {
|
|
Atom at = AtomOfTerm(t);
|
|
if (IsWideAtom(at)) {
|
|
const wchar_t *s = RepAtom(at)->WStrOfAE;
|
|
int c;
|
|
while ((c = *s++)) {
|
|
sz += utf8proc_encode_char(c, dst);
|
|
}
|
|
} else {
|
|
const unsigned char *s = (const unsigned char *)RepAtom(at)->StrOfAE;
|
|
int c;
|
|
|
|
while ((c = *s++)) {
|
|
sz += utf8proc_encode_char(c, dst);
|
|
}
|
|
}
|
|
} else if (IsStringTerm(t)) {
|
|
sz = strlen(StringOfTerm(t));
|
|
}
|
|
return sz;
|
|
}
|
|
|
|
Int YAP_ListLength(Term t) {
|
|
Term *aux;
|
|
|
|
Int n = Yap_SkipList(&t, &aux);
|
|
if (IsVarTerm(*aux))
|
|
return -1;
|
|
if (*aux == TermNil)
|
|
return n;
|
|
return -1;
|
|
}
|
|
|
|
Int YAP_NumberVars(Term t, Int nbv) { return Yap_NumberVars(t, nbv, FALSE); }
|
|
|
|
Term YAP_UnNumberVars(Term t) {
|
|
/* don't allow sharing of ground terms */
|
|
return Yap_UnNumberTerm(t, FALSE);
|
|
}
|
|
|
|
int YAP_IsNumberedVariable(Term t) {
|
|
return IsApplTerm(t) && FunctorOfTerm(t) == FunctorDollarVar &&
|
|
IsIntegerTerm(ArgOfTerm(1, t));
|
|
}
|
|
|
|
X_API size_t YAP_ExportTerm(Term inp, char *buf, size_t len) {
|
|
if (!len)
|
|
return 0;
|
|
return Yap_ExportTerm(inp, buf, len, current_arity());
|
|
}
|
|
|
|
X_API size_t YAP_SizeOfExportedTerm(char *buf) {
|
|
if (!buf)
|
|
return 0;
|
|
return Yap_SizeOfExportedTerm(buf);
|
|
}
|
|
|
|
X_API Term YAP_ImportTerm(char *buf) { return Yap_ImportTerm(buf); }
|
|
|
|
X_API int YAP_RequiresExtraStack(size_t sz) {
|
|
CACHE_REGS
|
|
|
|
if (sz < 16 * 1024)
|
|
sz = 16 * 1024;
|
|
if (HR <= ASP - sz) {
|
|
return FALSE;
|
|
}
|
|
BACKUP_H();
|
|
while (HR > ASP - sz) {
|
|
CACHE_REGS
|
|
RECOVER_H();
|
|
if (!Yap_dogc(0, NULL PASS_REGS)) {
|
|
return -1;
|
|
}
|
|
BACKUP_H();
|
|
}
|
|
RECOVER_H();
|
|
return TRUE;
|
|
}
|
|
|
|
X_API Int YAP_AtomToInt(Atom At) {
|
|
TranslationEntry *te = Yap_GetTranslationProp(At, 0);
|
|
if (te != NIL)
|
|
return te->Translation;
|
|
SWI_Atoms[AtomTranslations] = At;
|
|
Yap_PutAtomTranslation(At, 0, AtomTranslations);
|
|
AtomTranslations++;
|
|
if (AtomTranslations == MaxAtomTranslations) {
|
|
Atom *nt = (Atom *)malloc(sizeof(Atom) * 2 * MaxAtomTranslations),
|
|
*ot = SWI_Atoms;
|
|
if (nt == NULL) {
|
|
Yap_Error(SYSTEM_ERROR_INTERNAL, MkAtomTerm(At),
|
|
"No more room for translations");
|
|
return -1;
|
|
}
|
|
memcpy(nt, ot, sizeof(Atom) * MaxAtomTranslations);
|
|
SWI_Atoms = nt;
|
|
free(ot);
|
|
MaxAtomTranslations *= 2;
|
|
}
|
|
return AtomTranslations - 1;
|
|
}
|
|
|
|
X_API Atom YAP_IntToAtom(Int i) { return SWI_Atoms[i]; }
|
|
|
|
X_API Int YAP_FunctorToInt(Functor f) {
|
|
Atom At = NameOfFunctor(f);
|
|
arity_t arity = ArityOfFunctor(f);
|
|
TranslationEntry *te = Yap_GetTranslationProp(At, arity);
|
|
if (te != NIL)
|
|
return te->Translation;
|
|
SWI_Functors[FunctorTranslations] = f;
|
|
Yap_PutAtomTranslation(At, arity, FunctorTranslations);
|
|
FunctorTranslations++;
|
|
if (FunctorTranslations == MaxFunctorTranslations) {
|
|
Functor *nt =
|
|
(Functor *)malloc(sizeof(Functor) * 2 * MaxFunctorTranslations),
|
|
*ot = SWI_Functors;
|
|
if (nt == NULL) {
|
|
Yap_Error(SYSTEM_ERROR_INTERNAL, MkAtomTerm(At),
|
|
"No more room for translations");
|
|
return -1;
|
|
}
|
|
memcpy(nt, ot, sizeof(Functor) * MaxFunctorTranslations);
|
|
SWI_Functors = nt;
|
|
free(ot);
|
|
MaxFunctorTranslations *= 2;
|
|
}
|
|
return FunctorTranslations - 1;
|
|
}
|
|
|
|
X_API Functor YAP_IntToFunctor(Int i) { return SWI_Functors[i]; }
|
|
|
|
#endif // C_INTERFACE_C
|
|
|
|
/**
|
|
@}
|
|
*/
|