This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/C/c_interface.c

3203 lines
75 KiB
C
Raw Normal View History

2019-04-27 17:55:22 +01:00
/************************************************************************* *
2016-01-31 10:13:14 +00:00
* 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 $
* *
* *
*************************************************************************/
2014-05-25 20:48:06 +01:00
/**
2017-04-13 21:42:34 +01:00
* @file c_interface.c
*
2017-05-14 11:36:09 +01:00
* @addtogroup ChYInterface
2017-12-10 01:22:45 +00:00
*/
2014-05-25 20:48:06 +01:00
2015-01-26 04:02:46 +00:00
#ifndef C_INTERFACE_C
2014-05-25 20:48:06 +01:00
2015-01-26 04:02:46 +00:00
#define C_INTERFACE_C 1
2017-06-12 18:00:47 +01:00
#define _EXPORT_KERNEL 1
2016-03-29 01:55:12 +01:00
#include <stdlib.h>
2015-06-18 08:09:31 +01:00
#if HAVE_UNISTD_H
#include <unistd.h>
#endif
#include <string.h>
#if HAVE_STDARG_H
#include <stdarg.h>
#endif
2015-04-13 13:15:30 +01:00
#if _MSC_VER || defined(__MINGW32__)
#include <windows.h>
#endif
// we cannot consult YapInterface.h, that conflicts with what we declare, though
// it shouldn't
2016-04-18 16:40:17 +01:00
#include "Yap.h"
2014-05-25 20:48:06 +01:00
#include "YapInterface.h"
2013-12-08 19:12:24 +00:00
#include "YapText.h"
2016-04-18 16:40:17 +01:00
#include "attvar.h"
#include "clause.h"
#include "yapio.h"
#ifdef TABLING
#include "tab.macros.h"
#endif /* TABLING */
#ifdef YAPOR
#include "or.macros.h"
2015-10-22 00:45:47 +01:00
#endif /* YAPOR */
#include "cut_c.h"
#if HAVE_MALLOC_H
#include <malloc.h>
#endif
2016-04-18 16:40:17 +01:00
#include "iopreds.h"
2016-07-31 05:10:39 +01:00
#include <libgen.h>
typedef void *atom_t;
typedef void *functor_t;
2016-03-29 01:55:12 +01:00
typedef enum {
2017-12-10 01:22:45 +00:00
FRG_FIRST_CALL = 0, /* Initial call */
FRG_CUTTED = 1, /* Context was cutted */
FRG_REDO = 2 /* Normal redo */
2016-03-29 01:55:12 +01:00
} frg_code;
2015-06-19 00:45:54 +01:00
2015-10-22 00:45:47 +01:00
struct foreign_context {
2017-12-10 01:22:45 +00:00
uintptr_t context; /* context value */
frg_code control; /* FRG_* action */
struct PL_local_data *engine; /* invoking engine */
2015-06-19 00:45:54 +01:00
};
2017-06-15 22:40:55 +01:00
X_API bool python_in_python;
2018-01-18 14:47:27 +00:00
X_API int YAP_Reset(yap_reset_t mode, bool reset_global);
2015-01-26 04:02:46 +00:00
#if !HAVE_STRNCPY
2015-10-22 00:45:47 +01:00
#define strncpy(X, Y, Z) strcpy(X, Y)
#endif
#if !HAVE_STRNCAT
2015-10-22 00:45:47 +01:00
#define strncat(X, Y, Z) strcat(X, Y)
#endif
#if defined(_WIN32) && !defined(X_API)
#define X_API __declspec(dllexport)
#endif
2019-01-09 09:32:09 +00:00
#define SOURCEBOOTPath NULL
2016-07-31 05:10:39 +01:00
#if __ANDROID__
#define BOOT_FROM_SAVED_STATE true
#endif
/**
2015-01-18 01:32:13 +00:00
@defgroup slotInterface Term Handles or Slots
2014-09-11 20:06:57 +01:00
@ingroup ChYInterface
@{
2015-10-22 00:45:47 +01:00
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.
2015-10-22 00:45:47 +01:00
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.
2015-10-22 00:45:47 +01:00
For implementation details and more information, please check term_t_slots in
the implementation section.
*/
2015-10-22 00:45:47 +01:00
/// @brief report the current position of the slots, assuming that they occupy
/// the top of the stack.
///
///
2015-10-22 00:45:47 +01:00
X_API yhandle_t YAP_CurrentSlot(void);
/// @brief allocate n empty new slots
///
2017-12-10 01:22:45 +00:00
/// Return a handle to the system's default slo t.
/// iX_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.
2015-10-22 00:45:47 +01:00
X_API yhandle_t YAP_InitSlot(YAP_Term t);
/// @brief read from a slot.
///
///
2015-10-22 00:45:47 +01:00
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.
2015-10-22 00:45:47 +01:00
X_API YAP_Term *YAP_AddressFromSlot(YAP_handle_t);
/// @brief get the memory address of the term actually stored in a slot
///
///
2015-10-22 00:45:47 +01:00
X_API YAP_Term *YAP_AddressOfTermInSlot(YAP_handle_t);
/// @brief store term in a slot
///
///
2015-10-22 00:45:47 +01:00
X_API void YAP_PutInSlot(YAP_handle_t slot, YAP_Term t);
2015-10-22 00:45:47 +01:00
/// @brief Succeeds if it recovers the space allocated for $n$ contiguous slots
/// starting at topSlot.
///
/// Set the contents of slot _slot_ to _t_.
2015-10-22 00:45:47 +01:00
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.
2015-10-22 00:45:47 +01:00
X_API YAP_handle_t YAP_ArgsToSlots(int HowMany);
2015-10-22 00:45:47 +01:00
/// @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_.
2015-10-22 00:45:47 +01:00
X_API void YAP_SlotsToArgs(int HowMany, YAP_handle_t slot);
/// @}
2015-10-22 00:45:47 +01:00
static arity_t current_arity(void) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
if (P && PREVOP(P, Osbpp)->opc == Yap_opcode(_call_usercpred)) {
return PREVOP(P, Osbpp)->y_u.Osbpp.p->ArityOfPE;
} else {
return 0;
}
2012-02-02 23:25:09 +00:00
}
2015-10-22 00:45:47 +01:00
static int doexpand(UInt sz) {
2017-12-10 01:22:45 +00:00
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;
}
2015-10-22 00:45:47 +01:00
X_API YAP_Term YAP_A(int i) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
return (Deref(XREGS[i]));
}
2018-10-07 14:27:01 +01:00
X_API YAP_Term YAP_SetA(int i, YAP_Term t) {
CACHE_REGS
return (Deref(XREGS[i]));
}
2015-10-22 00:45:47 +01:00
X_API YAP_Bool YAP_IsIntTerm(YAP_Term t) { return IsIntegerTerm(t); }
2015-10-22 00:45:47 +01:00
X_API YAP_Bool YAP_IsNumberTerm(YAP_Term t) {
2017-12-10 01:22:45 +00:00
return IsIntegerTerm(t) || IsIntTerm(t) || IsFloatTerm(t) || IsBigIntTerm(t);
}
2015-10-22 00:45:47 +01:00
X_API YAP_Bool YAP_IsLongIntTerm(YAP_Term t) { return IsLongIntTerm(t); }
2015-10-22 00:45:47 +01:00
X_API YAP_Bool YAP_IsBigNumTerm(YAP_Term t) {
#if USE_GMP
2017-12-10 01:22:45 +00:00
CELL *pt;
if (IsVarTerm(t))
return FALSE;
2017-12-10 01:22:45 +00:00
if (!IsBigIntTerm(t))
return FALSE;
pt = RepAppl(t);
return pt[1] == BIG_INT;
#else
return FALSE;
2011-02-27 10:13:25 +00:00
#endif
}
2015-10-22 00:45:47 +01:00
X_API YAP_Bool YAP_IsRationalTerm(YAP_Term t) {
2011-02-27 10:13:25 +00:00
#if USE_GMP
2017-12-10 01:22:45 +00:00
CELL *pt;
if (IsVarTerm(t))
return FALSE;
2017-12-10 01:22:45 +00:00
if (!IsBigIntTerm(t))
return FALSE;
pt = RepAppl(t);
return pt[1] == BIG_RATIONAL;
#else
return FALSE;
#endif
}
X_API YAP_Bool YAP_IsStringTerm(YAP_Term t) { return (IsStringTerm(t)); }
2015-10-22 00:45:47 +01:00
X_API YAP_Bool YAP_IsVarTerm(YAP_Term t) { return (IsVarTerm(t)); }
2015-10-22 00:45:47 +01:00
X_API YAP_Bool YAP_IsNonVarTerm(YAP_Term t) { return (IsNonVarTerm(t)); }
2015-10-22 00:45:47 +01:00
X_API YAP_Bool YAP_IsFloatTerm(Term t) { return (IsFloatTerm(t)); }
2015-10-22 00:45:47 +01:00
X_API YAP_Bool YAP_IsDbRefTerm(Term t) { return (IsDBRefTerm(t)); }
2015-10-22 00:45:47 +01:00
X_API YAP_Bool YAP_IsAtomTerm(Term t) { return (IsAtomTerm(t)); }
2015-10-22 00:45:47 +01:00
X_API YAP_Bool YAP_IsPairTerm(Term t) { return (IsPairTerm(t)); }
2015-10-22 00:45:47 +01:00
X_API YAP_Bool YAP_IsApplTerm(Term t) {
2017-12-10 01:22:45 +00:00
return IsApplTerm(t) && !IsExtensionFunctor(FunctorOfTerm(t));
}
2015-10-22 00:45:47 +01:00
X_API YAP_Bool YAP_IsCompoundTerm(Term t) {
2017-12-10 01:22:45 +00:00
return (IsApplTerm(t) && !IsExtensionFunctor(FunctorOfTerm(t))) ||
IsPairTerm(t);
}
2015-10-22 00:45:47 +01:00
X_API Term YAP_MkIntTerm(Int n) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
Term I;
BACKUP_H();
2017-12-10 01:22:45 +00:00
I = MkIntegerTerm(n);
RECOVER_H();
return I;
}
X_API Term YAP_MkStringTerm(const char *n) {
2018-10-07 14:27:01 +01:00
CACHE_REGS
Term I;
BACKUP_H();
2018-10-07 14:27:01 +01:00
I = MkStringTerm(n);
RECOVER_H();
return I;
2018-07-03 00:54:34 +01:00
}
2018-10-07 14:27:01 +01:00
X_API Term YAP_MkCharPTerm(char *n) {
CACHE_REGS
Term I;
BACKUP_H();
2018-07-03 00:54:34 +01:00
2018-10-07 14:27:01 +01:00
I = MkStringTerm(n);
RECOVER_H();
return I;
}
X_API Term YAP_MkUnsignedStringTerm(const unsigned char *n) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
Term I;
BACKUP_H();
2017-12-10 01:22:45 +00:00
I = MkUStringTerm(n);
RECOVER_H();
return I;
}
X_API const char *YAP_StringOfTerm(Term t) { return StringOfTerm(t); }
X_API const unsigned char *YAP_UnsignedStringOfTerm(Term t) {
2017-12-10 01:22:45 +00:00
return UStringOfTerm(t);
}
2015-10-22 00:45:47 +01:00
X_API Int YAP_IntOfTerm(Term t) {
2017-12-10 01:22:45 +00:00
if (!IsApplTerm(t))
return IntOfTerm(t);
else {
return LongIntOfTerm(t);
}
}
2017-11-29 13:47:57 +00:00
X_API Term YAP_MkBigNumTerm(void *big) {
#if USE_GMP
2017-12-10 01:22:45 +00:00
Term I;
BACKUP_H();
I = Yap_MkBigIntTerm(big);
RECOVER_H();
return I;
#else
2017-12-10 01:22:45 +00:00
return TermNil;
#endif /* USE_GMP */
}
2015-10-22 00:45:47 +01:00
X_API YAP_Bool YAP_BigNumOfTerm(Term t, void *b) {
#if USE_GMP
2017-12-10 01:22:45 +00:00
MP_INT *bz = (MP_INT *)b;
if (IsVarTerm(t))
return FALSE;
if (!IsBigIntTerm(t))
return FALSE;
2017-12-10 01:22:45 +00:00
mpz_set(bz, Yap_BigIntOfTerm(t));
return TRUE;
#else
return FALSE;
#endif /* USE_GMP */
}
2015-10-22 00:45:47 +01:00
X_API Term YAP_MkRationalTerm(void *big) {
2011-02-27 10:13:25 +00:00
#if USE_GMP
2017-12-10 01:22:45 +00:00
Term I;
BACKUP_H();
I = Yap_MkBigRatTerm((MP_RAT *)big);
RECOVER_H();
return I;
2011-02-27 10:13:25 +00:00
#else
2017-12-10 01:22:45 +00:00
return TermNil;
2011-02-27 10:13:25 +00:00
#endif /* USE_GMP */
}
2015-10-22 00:45:47 +01:00
X_API YAP_Bool YAP_RationalOfTerm(Term t, void *b) {
2011-02-27 10:13:25 +00:00
#if USE_GMP
2017-12-10 01:22:45 +00:00
MP_RAT *br = (MP_RAT *)b;
if (IsVarTerm(t))
return FALSE;
2017-12-10 01:22:45 +00:00
if (!IsBigIntTerm(t))
return FALSE;
mpq_set(br, Yap_BigRatOfTerm(t));
return TRUE;
#else
return FALSE;
2011-02-27 10:13:25 +00:00
#endif /* USE_GMP */
}
2015-10-22 00:45:47 +01:00
X_API Term YAP_MkBlobTerm(unsigned int sz) {
2017-12-10 01:22:45 +00:00
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;
}
2015-10-22 00:45:47 +01:00
X_API void *YAP_BlobOfTerm(Term t) {
2017-12-10 01:22:45 +00:00
MP_INT *src;
2017-12-10 01:22:45 +00:00
if (IsVarTerm(t))
return NULL;
2019-04-24 12:10:06 +01:00
if (!IsBigIntTerm(t))
2017-12-10 01:22:45 +00:00
return NULL;
src = (MP_INT *)(RepAppl(t) + 2);
return (void *)(src + 1);
}
2015-10-22 00:45:47 +01:00
X_API Term YAP_MkFloatTerm(double n) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
Term t;
BACKUP_H();
2017-12-10 01:22:45 +00:00
t = MkFloatTerm(n);
2017-12-10 01:22:45 +00:00
RECOVER_H();
return t;
}
2015-10-22 00:45:47 +01:00
X_API YAP_Float YAP_FloatOfTerm(YAP_Term t) { return (FloatOfTerm(t)); }
2017-11-29 13:47:57 +00:00
X_API Term YAP_MkAtomTerm(YAP_Atom n) {
2017-12-10 01:22:45 +00:00
Term t;
2017-12-10 01:22:45 +00:00
t = MkAtomTerm(n);
return t;
}
2017-11-29 13:47:57 +00:00
X_API YAP_Atom YAP_AtomOfTerm(Term t) { return (AtomOfTerm(t)); }
2017-11-29 13:47:57 +00:00
X_API bool YAP_IsWideAtom(YAP_Atom a) {
2017-12-10 01:22:45 +00:00
const unsigned char *s = RepAtom(a)->UStrOfAE;
int32_t v;
while (*s) {
size_t n = get_utf8(s, 1, &v);
if (n > 1)
return true;
}
return false;
}
2017-11-29 13:47:57 +00:00
X_API const char *YAP_AtomName(YAP_Atom a) {
2017-12-10 01:22:45 +00:00
const char *o;
2017-12-10 01:22:45 +00:00
o = AtomName(a);
return (o);
}
2017-11-29 13:47:57 +00:00
X_API const wchar_t *YAP_WideAtomName(YAP_Atom a) {
2017-12-10 01:22:45 +00:00
int32_t v;
const unsigned char *s = RepAtom(a)->UStrOfAE;
size_t n = strlen_utf8(s);
wchar_t *dest = Malloc((n + 1) * sizeof(wchar_t)), *o = dest;
while (*s) {
size_t n = get_utf8(s, 1, &v);
if (n == 0)
return NULL;
*o++ = v;
}
o[0] = '\0';
return dest;
}
2017-11-29 13:47:57 +00:00
X_API YAP_Atom YAP_LookupAtom(const char *c) {
2017-12-10 01:22:45 +00:00
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;
}
2017-12-10 01:22:45 +00:00
}
return NULL;
}
2017-11-29 13:47:57 +00:00
X_API YAP_Atom YAP_LookupWideAtom(const wchar_t *c) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
Atom a;
while (TRUE) {
a = Yap_NWCharsToAtom(c, -1 USES_REGS);
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;
}
2017-12-10 01:22:45 +00:00
}
return NULL;
}
2017-11-29 13:47:57 +00:00
X_API YAP_Atom YAP_FullLookupAtom(const char *c) {
2017-12-10 01:22:45 +00:00
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;
}
2017-12-10 01:22:45 +00:00
}
return NULL;
}
2017-11-29 13:47:57 +00:00
X_API size_t YAP_AtomNameLength(YAP_Atom at) {
2017-12-10 01:22:45 +00:00
if (IsBlob(at)) {
return RepAtom(at)->rep.blob->length;
}
unsigned char *c = RepAtom(at)->UStrOfAE;
2017-12-10 01:22:45 +00:00
return strlen_utf8(c);
}
2015-10-22 00:45:47 +01:00
X_API Term YAP_MkVarTerm(void) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
CELL t;
BACKUP_H();
2017-12-10 01:22:45 +00:00
t = MkVarTerm();
2017-12-10 01:22:45 +00:00
RECOVER_H();
return t;
}
2015-10-22 00:45:47 +01:00
X_API Term YAP_MkPairTerm(Term t1, Term t2) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
Term t;
BACKUP_H();
2017-12-10 01:22:45 +00:00
while (HR > ASP - 1024) {
Int sl1 = Yap_InitSlot(t1);
Int sl2 = Yap_InitSlot(t2);
RECOVER_H();
2017-12-10 01:22:45 +00:00
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;
}
2015-10-22 00:45:47 +01:00
X_API Term YAP_MkListFromTerms(Term *ta, Int sz) {
2017-12-10 01:22:45 +00:00
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;
}
2017-12-10 01:22:45 +00:00
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;
}
2017-12-10 01:22:45 +00:00
h[1] = AbsPair(h + 2);
h += 2;
}
h[-1] = TermNil;
HR = h;
RECOVER_H();
return t;
}
2015-10-22 00:45:47 +01:00
X_API Term YAP_MkNewPairTerm() {
2017-12-10 01:22:45 +00:00
CACHE_REGS
Term t;
BACKUP_H();
2017-12-10 01:22:45 +00:00
if (HR > ASP - 1024)
t = TermNil;
else
t = Yap_MkNewPairTerm();
2015-04-13 13:15:30 +01:00
2017-12-10 01:22:45 +00:00
RECOVER_H();
return t;
}
2015-10-22 00:45:47 +01:00
X_API Term YAP_HeadOfTerm(Term t) { return (HeadOfTerm(t)); }
2015-10-22 00:45:47 +01:00
X_API Term YAP_TailOfTerm(Term t) { return (TailOfTerm(t)); }
2015-10-22 00:45:47 +01:00
X_API Int YAP_SkipList(Term *l, Term **tailp) {
2017-12-10 01:22:45 +00:00
return Yap_SkipList(l, tailp);
Int length = 0;
Term *s; /* slow */
Term v; /* temporary */
2011-02-10 00:01:19 +00:00
2017-12-10 01:22:45 +00:00
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;
2011-02-10 00:01:19 +00:00
}
2017-11-29 13:47:57 +00:00
X_API Term YAP_MkApplTerm(YAP_Functor f, UInt arity, Term args[]) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
Term t;
BACKUP_H();
2017-12-10 01:22:45 +00:00
if (HR + arity > ASP - 1024)
t = TermNil;
else
t = Yap_MkApplTerm(f, arity, args);
2017-12-10 01:22:45 +00:00
RECOVER_H();
return t;
}
2017-11-29 13:47:57 +00:00
X_API Term YAP_MkNewApplTerm(YAP_Functor f, UInt arity) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
Term t;
BACKUP_H();
2017-12-10 01:22:45 +00:00
if (HR + arity > ASP - 1024)
t = TermNil;
else
t = Yap_MkNewApplTerm(f, arity);
2017-12-10 01:22:45 +00:00
RECOVER_H();
return t;
}
2017-11-29 13:47:57 +00:00
X_API YAP_Functor YAP_FunctorOfTerm(Term t) { return (FunctorOfTerm(t)); }
2015-10-22 00:45:47 +01:00
X_API Term YAP_ArgOfTerm(UInt n, Term t) { return (ArgOfTerm(n, t)); }
2015-10-22 00:45:47 +01:00
X_API Term *YAP_ArgsOfTerm(Term t) {
2017-12-10 01:22:45 +00:00
if (IsApplTerm(t))
return RepAppl(t) + 1;
else if (IsPairTerm(t))
return RepPair(t);
return NULL;
}
2017-12-10 01:22:45 +00:00
X_API YAP_Functor YAP_MkFunctor(YAP_Atom a, UInt n) {
return (Yap_MkFunctor(a, n));
}
2017-11-29 13:47:57 +00:00
X_API YAP_Atom YAP_NameOfFunctor(YAP_Functor f) { return (NameOfFunctor(f)); }
2017-11-29 13:47:57 +00:00
X_API UInt YAP_ArityOfFunctor(YAP_Functor f) { return (ArityOfFunctor(f)); }
2015-10-22 00:45:47 +01:00
X_API void *YAP_ExtraSpaceCut(void) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
void *ptr;
BACKUP_B();
2017-12-10 01:22:45 +00:00
ptr = (void *)(((CELL *)(Yap_REGS.CUT_C_TOP)) -
(((yamop *)Yap_REGS.CUT_C_TOP->try_userc_cut_yamop)
->y_u.OtapFs.extra));
2017-12-10 01:22:45 +00:00
RECOVER_B();
return (ptr);
}
2015-10-22 00:45:47 +01:00
X_API void *YAP_ExtraSpace(void) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
void *ptr;
BACKUP_B();
BACKUP_H();
2017-12-10 01:22:45 +00:00
/* find a pointer to extra space allocable */
ptr = (void *)((CELL *)(B + 1) + P->y_u.OtapFs.s);
B->cp_h = HR;
2017-12-10 01:22:45 +00:00
RECOVER_H();
RECOVER_B();
return (ptr);
}
2015-10-22 00:45:47 +01:00
X_API void YAP_cut_up(void) {
2017-12-10 01:22:45 +00:00
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
2017-12-10 01:22:45 +00:00
{
choiceptr cut_pt;
2017-12-10 01:22:45 +00:00
cut_pt = B->cp_b;
/* make sure we prune C-choicepoints */
2015-10-22 00:45:47 +01:00
if (POP_CHOICE_POINT(B->cp_b)) {
2017-12-10 01:22:45 +00:00
POP_EXECUTE();
2015-10-22 00:45:47 +01:00
}
2017-12-10 01:22:45 +00:00
CUT_prune_to(cut_pt);
Yap_TrimTrail();
2017-12-10 01:22:45 +00:00
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
2017-12-10 01:22:45 +00:00
HB = B->cp_h; /* cut_fail */
RECOVER_B();
}
2015-10-22 00:45:47 +01:00
X_API bool YAP_Unify(Term t1, Term t2) {
2017-12-10 01:22:45 +00:00
Int out;
BACKUP_MACHINE_REGS();
2017-12-10 01:22:45 +00:00
out = Yap_unify(t1, t2);
2017-12-10 01:22:45 +00:00
RECOVER_MACHINE_REGS();
return out;
}
2015-10-22 00:45:47 +01:00
X_API int YAP_Unifiable(Term t1, Term t2) {
2017-12-10 01:22:45 +00:00
int out;
BACKUP_MACHINE_REGS();
2011-10-27 11:35:40 +01:00
2017-12-10 01:22:45 +00:00
out = Yap_Unifiable(t1, t2);
2011-10-27 11:35:40 +01:00
2017-12-10 01:22:45 +00:00
RECOVER_MACHINE_REGS();
return out;
2011-10-27 11:35:40 +01:00
}
/* == */
2015-10-22 00:45:47 +01:00
X_API int YAP_ExactlyEqual(Term t1, Term t2) {
2017-12-10 01:22:45 +00:00
int out;
BACKUP_MACHINE_REGS();
2017-12-10 01:22:45 +00:00
out = Yap_eq(t1, t2);
2017-12-10 01:22:45 +00:00
RECOVER_MACHINE_REGS();
return out;
}
/* =@= */
2015-10-22 00:45:47 +01:00
X_API int YAP_Variant(Term t1, Term t2) {
2017-12-10 01:22:45 +00:00
int out;
BACKUP_MACHINE_REGS();
2017-12-10 01:22:45 +00:00
out = Yap_Variant(Deref(t1), Deref(t2));
2017-12-10 01:22:45 +00:00
RECOVER_MACHINE_REGS();
return out;
}
/* =@= */
2015-10-22 00:45:47 +01:00
X_API Int YAP_TermHash(Term t, Int sz, Int depth, int variant) {
2017-12-10 01:22:45 +00:00
Int out;
2017-12-10 01:22:45 +00:00
BACKUP_MACHINE_REGS();
2017-12-10 01:22:45 +00:00
out = Yap_TermHash(t, sz, depth, variant);
2017-12-10 01:22:45 +00:00
RECOVER_MACHINE_REGS();
return out;
}
2015-10-22 00:45:47 +01:00
X_API Int YAP_CurrentSlot(void) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
return Yap_CurrentSlot();
}
2015-10-22 00:45:47 +01:00
X_API Int YAP_NewSlots(int n) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
return Yap_NewSlots(n);
}
2015-10-22 00:45:47 +01:00
X_API Int YAP_InitSlot(Term t) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
return Yap_InitSlot(t);
}
2015-10-22 00:45:47 +01:00
X_API int YAP_RecoverSlots(int n, Int top_slot) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
return Yap_RecoverSlots(n, top_slot);
}
2015-10-22 00:45:47 +01:00
X_API Term YAP_GetFromSlot(Int slot) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
return Yap_GetFromSlot(slot);
}
2015-10-22 00:45:47 +01:00
X_API Term *YAP_AddressFromSlot(Int slot) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
return Yap_AddressFromSlot(slot);
}
2015-10-22 00:45:47 +01:00
X_API Term *YAP_AddressOfTermInSlot(Int slot) {
2017-12-10 01:22:45 +00:00
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;
}
2011-02-10 00:01:19 +00:00
}
2015-10-22 00:45:47 +01:00
X_API void YAP_PutInSlot(Int slot, Term t) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
Yap_PutInSlot(slot, t);
}
typedef Int (*CPredicate0)(void);
typedef Int (*CPredicate1)(yhandle_t);
2015-10-22 00:45:47 +01:00
typedef Int (*CPredicate2)(yhandle_t, yhandle_t);
2015-10-22 00:45:47 +01:00
typedef Int (*CPredicate3)(yhandle_t, yhandle_t, yhandle_t);
2015-10-22 00:45:47 +01:00
typedef Int (*CPredicate4)(yhandle_t, yhandle_t, yhandle_t, yhandle_t);
2015-10-22 00:45:47 +01:00
typedef Int (*CPredicate5)(yhandle_t, yhandle_t, yhandle_t, yhandle_t,
yhandle_t);
2015-10-22 00:45:47 +01:00
typedef Int (*CPredicate6)(yhandle_t, yhandle_t, yhandle_t, yhandle_t,
yhandle_t, yhandle_t);
2015-10-22 00:45:47 +01:00
typedef Int (*CPredicate7)(yhandle_t, yhandle_t, yhandle_t, yhandle_t,
yhandle_t, yhandle_t, yhandle_t);
2015-10-22 00:45:47 +01:00
typedef Int (*CPredicate8)(yhandle_t, yhandle_t, yhandle_t, yhandle_t,
yhandle_t, yhandle_t, yhandle_t, yhandle_t);
2015-10-22 00:45:47 +01:00
typedef Int (*CPredicate9)(yhandle_t, yhandle_t, yhandle_t, yhandle_t,
yhandle_t, yhandle_t, yhandle_t, yhandle_t,
yhandle_t);
2015-10-22 00:45:47 +01:00
typedef Int (*CPredicate10)(yhandle_t, yhandle_t, yhandle_t, yhandle_t,
yhandle_t, yhandle_t, yhandle_t, yhandle_t,
yhandle_t, yhandle_t);
2015-10-22 00:45:47 +01:00
typedef Int (*CPredicateV)(yhandle_t, yhandle_t, struct foreign_context *);
static Int execute_cargs(PredEntry *pe, CPredicate exec_code USES_REGS) {
2017-12-10 01:22:45 +00:00
Int rc;
yhandle_t a1;
switch (pe->ArityOfPE) {
case 0: {
CPredicate0 code0 = (CPredicate0)exec_code;
return code0();
}
case 1: {
CPredicate1 code1 = (CPredicate1)exec_code;
a1 = Yap_InitSlots(1, &ARG1);
rc = code1(a1);
} break;
case 2: {
CPredicate2 code2 = (CPredicate2)exec_code;
a1 = Yap_InitSlots(2, &ARG1);
rc = code2(a1, a1 + 1);
} break;
case 3: {
CPredicate3 code3 = (CPredicate3)exec_code;
a1 = Yap_InitSlots(3, &ARG1);
rc = code3(a1, a1 + 1, a1 + 2);
} break;
case 4: {
CPredicate4 code4 = (CPredicate4)exec_code;
a1 = Yap_InitSlots(4, &ARG1);
rc = code4(a1, a1 + 1, a1 + 2, a1 + 3);
} break;
case 5: {
CPredicate5 code5 = (CPredicate5)exec_code;
a1 = Yap_InitSlots(5, &ARG1);
rc = code5(a1, a1 + 1, a1 + 2, a1 + 3, a1 + 4);
} break;
case 6: {
CPredicate6 code6 = (CPredicate6)exec_code;
a1 = Yap_InitSlots(6, &ARG1);
rc = code6(a1, a1 + 1, a1 + 2, a1 + 3, a1 + 4, a1 + 5);
} break;
case 7: {
CPredicate7 code7 = (CPredicate7)exec_code;
a1 = Yap_InitSlots(7, &ARG1);
rc = code7(a1, a1 + 1, a1 + 2, a1 + 3, a1 + 4, a1 + 5, a1 + 6);
} break;
case 8: {
CPredicate8 code8 = (CPredicate8)exec_code;
a1 = Yap_InitSlots(8, &ARG1);
rc = code8(a1, a1 + 1, a1 + 2, a1 + 3, a1 + 4, a1 + 5, a1 + 6, a1 + 7);
} break;
case 9: {
CPredicate9 code9 = (CPredicate9)exec_code;
a1 = Yap_InitSlots(9, &ARG1);
rc = code9(a1, a1 + 1, a1 + 2, a1 + 3, a1 + 4, a1 + 5, a1 + 6, a1 + 7,
a1 + 8);
} break;
case 10: {
CPredicate10 code10 = (CPredicate10)exec_code;
a1 = Yap_InitSlots(10, &ARG1);
rc = code10(a1, a1 + 1, a1 + 2, a1 + 3, a1 + 4, a1 + 5, a1 + 6, a1 + 7,
a1 + 8, a1 + 9);
} break;
default:
YAP_Error(SYSTEM_ERROR_INTERNAL, TermNil,
"YAP only supports SWI C-call with arity =< 10");
return false;
}
Yap_RecoverSlots(pe->ArityOfPE, a1);
return rc;
}
typedef uintptr_t (*CBPredicate0)(struct foreign_context *);
2015-10-22 00:45:47 +01:00
typedef uintptr_t (*CBPredicate1)(yhandle_t, struct foreign_context *);
2015-10-22 00:45:47 +01:00
typedef uintptr_t (*CBPredicate2)(yhandle_t, yhandle_t,
struct foreign_context *);
2015-10-22 00:45:47 +01:00
typedef uintptr_t (*CBPredicate3)(yhandle_t, yhandle_t, yhandle_t,
struct foreign_context *);
2015-10-22 00:45:47 +01:00
typedef uintptr_t (*CBPredicate4)(yhandle_t, yhandle_t, yhandle_t, yhandle_t,
struct foreign_context *);
2015-10-22 00:45:47 +01:00
typedef uintptr_t (*CBPredicate5)(yhandle_t, yhandle_t, yhandle_t, yhandle_t,
yhandle_t, struct foreign_context *);
2015-10-22 00:45:47 +01:00
typedef uintptr_t (*CBPredicate6)(yhandle_t, yhandle_t, yhandle_t, yhandle_t,
yhandle_t, yhandle_t,
struct foreign_context *);
2015-10-22 00:45:47 +01:00
typedef uintptr_t (*CBPredicate7)(yhandle_t, yhandle_t, yhandle_t, yhandle_t,
yhandle_t, yhandle_t, yhandle_t,
struct foreign_context *);
2015-10-22 00:45:47 +01:00
typedef uintptr_t (*CBPredicate8)(yhandle_t, yhandle_t, yhandle_t, yhandle_t,
yhandle_t, yhandle_t, yhandle_t, yhandle_t,
struct foreign_context *);
2015-10-22 00:45:47 +01:00
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 *);
2015-10-22 00:45:47 +01:00
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) {
2017-12-10 01:22:45 +00:00
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);
}
}
2015-10-22 00:45:47 +01:00
static uintptr_t complete_fail(choiceptr ptr, int has_cp USES_REGS) {
2017-12-10 01:22:45 +00:00
// this case is easy, jut be sure to throw everything
// after the old B;
while (B && B->cp_b && B->cp_b <= ptr) {
B = B->cp_b;
}
if (has_cp)
return do_cut(FALSE);
return FALSE;
2013-11-20 22:20:51 +00:00
}
2015-10-22 00:45:47 +01:00
static uintptr_t complete_exit(choiceptr ptr, int has_cp,
int cut_all USES_REGS) {
2017-12-10 01:22:45 +00:00
// 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;
}
2017-12-10 01:22:45 +00:00
}
if (has_cp) {
if (B == ptr) {
return do_cut(TRUE);
} else {
ptr->cp_ap = FAILCODE;
2013-11-20 22:20:51 +00:00
}
2017-12-10 01:22:45 +00:00
}
return TRUE;
2013-11-20 22:20:51 +00:00
}
2017-06-12 18:00:47 +01:00
X_API Int YAP_Execute(PredEntry *pe, CPredicate exec_code) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
Int ret;
Int OASP = LCL0 - (CELL *)B;
// Term omod = CurrentModule;
// if (pe->PredFlags & CArgsPredFlag) {
// CurrentModule = pe->ModuleOfPred;
//}
2019-05-01 01:34:58 +01:00
int lvl = push_text_stack();
yhandle_t hdl = Yap_CurrentHandle();
2017-12-10 01:22:45 +00:00
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 */
if (ret)
complete_exit(((choiceptr)(LCL0 - OASP)), FALSE, FALSE PASS_REGS);
2019-05-01 01:34:58 +01:00
else {
2017-12-10 01:22:45 +00:00
complete_fail(((choiceptr)(LCL0 - OASP)), FALSE PASS_REGS);
2019-05-01 01:34:58 +01:00
}
2017-12-10 01:22:45 +00:00
// CurrentModule = omod;
if (!ret) {
Yap_RaiseException();
}
2019-05-01 01:34:58 +01:00
Yap_RecoverHandles(0, hdl);
pop_text_stack( lvl );
2017-12-10 01:22:45 +00:00
return ret;
}
2015-10-22 00:45:47 +01:00
#define FRG_REDO_MASK 0x00000003L
#define FRG_REDO_BITS 2
#define REDO_INT 0x02 /* Returned an integer */
#define REDO_PTR 0x03 /* returned a pointer */
2017-06-12 18:00:47 +01:00
X_API Int YAP_ExecuteFirst(PredEntry *pe, CPredicate exec_code) {
2017-12-10 01:22:45 +00:00
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;
2017-12-10 01:22:45 +00:00
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 {
2017-12-10 01:22:45 +00:00
val = codev(Yap_InitSlots(pe->ArityOfPE, &ARG1), 0, ctx);
}
2015-02-03 02:36:51 +00:00
Yap_CloseSlots(CurSlot);
PP = NULL;
2017-12-10 01:22:45 +00:00
if (val == 0) {
if (Yap_RaiseException()) {
2016-03-29 01:55:12 +01:00
return false;
2017-12-10 01:22:45 +00:00
}
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) {
Yap_RaiseException();
2016-04-05 02:20:16 +01:00
}
2017-12-10 01:22:45 +00:00
return ret;
}
}
X_API Int YAP_ExecuteOnCut(PredEntry *pe, CPredicate exec_code,
struct cut_c_str *top) {
CACHE_REGS
Int oB = LCL0 - (CELL *)B;
Int val;
/* for slots to work */
yhandle_t CurSlot = Yap_StartSlots();
/* find out where we belong */
while (B < (choiceptr)top) {
oB = LCL0 - (CELL *)B;
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 = (choiceptr)(LCL0 - 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 {
Int oYENV = LCL0 - YENV;
yamop *oP = P, *oCP = CP;
// YAP Native
B = (choiceptr)(LCL0 - oB);
val = exec_code(PASS_REGS1);
YENV = LCL0 - oYENV;
P = oP;
CP = oCP;
}
Yap_CloseSlots(CurSlot);
PP = NULL;
// B = LCL0-(CELL*)oB;
if (!val && Yap_RaiseException()) {
return false;
} else { /* TRUE */
return val;
}
2011-02-14 14:59:15 +00:00
}
2017-06-12 18:00:47 +01:00
X_API Int YAP_ExecuteNext(PredEntry *pe, CPredicate exec_code) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
/* for slots to work */
Yap_StartSlots();
UInt ocp = LCL0 - (CELL *)B;
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 {
2017-12-10 01:22:45 +00:00
val = codev(Yap_InitSlots(pe->ArityOfPE, &ARG1), 0, ctx);
}
/* we are below the original choice point ?? */
/* make sure we clean up the frames left by the user */
PP = NULL;
if (val == 0) {
if (Yap_RaiseException()) {
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);
if (!ret) {
Yap_RaiseException();
2016-04-05 02:20:16 +01:00
}
2017-12-10 01:22:45 +00:00
return ret;
}
}
2015-10-22 00:45:47 +01:00
X_API void *YAP_ReallocSpaceFromYap(void *ptr, size_t size) {
2017-12-10 01:22:45 +00:00
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;
}
2017-12-10 01:22:45 +00:00
}
RECOVER_MACHINE_REGS();
return new_ptr;
}
2016-03-29 01:55:12 +01:00
2015-10-22 00:45:47 +01:00
X_API void *YAP_AllocSpaceFromYap(size_t size) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
void *ptr;
BACKUP_MACHINE_REGS();
2017-12-10 01:22:45 +00:00
while ((ptr = Yap_AllocCodeSpace(size)) == NULL) {
if (!Yap_growheap(FALSE, size, NULL)) {
Yap_Error(RESOURCE_ERROR_HEAP, TermNil, LOCAL_ErrorMessage);
return NULL;
}
2017-12-10 01:22:45 +00:00
}
RECOVER_MACHINE_REGS();
return ptr;
}
2015-10-22 00:45:47 +01:00
X_API void YAP_FreeSpaceFromYap(void *ptr) { Yap_FreeCodeSpace(ptr); }
2015-11-05 16:59:30 +00:00
/* */
2015-11-09 18:22:43 +00:00
/**
2015-11-05 16:59:30 +00:00
* copy a string to a buffer, the buffer must have been malloced
2015-11-09 18:22:43 +00:00
*
2015-11-05 16:59:30 +00:00
* @param t the text, or string
* @param buf the user-provided buffer
* @param bufsize bu
2015-11-09 18:22:43 +00:00
*
* @return
2018-10-07 14:27:01 +01:00
*/
X_API char *YAP_StringToBuffer(Term t, char *buf, unsigned int bufsize) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
BACKUP_MACHINE_REGS();
seq_tv_t inp, out;
int l = push_text_stack();
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)) {
pop_text_stack(l);
RECOVER_MACHINE_REGS();
return NULL;
} else {
RECOVER_MACHINE_REGS();
if (buf == out.val.c) {
return buf;
2017-10-27 13:48:07 +01:00
} else {
2017-12-10 01:22:45 +00:00
return pop_output_text_stack(l, out.val.c);
2017-10-27 13:48:07 +01:00
}
2017-12-10 01:22:45 +00:00
}
}
/* copy a string to a buffer */
2015-10-22 00:45:47 +01:00
X_API Term YAP_BufferToString(const char *s) {
2017-12-10 01:22:45 +00:00
Term t;
BACKUP_H();
2017-12-10 01:22:45 +00:00
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;
2017-12-10 01:22:45 +00:00
RECOVER_H();
return t;
}
/* copy a string to a buffer */
2015-10-22 00:45:47 +01:00
X_API Term YAP_NBufferToString(const char *s, size_t len) {
2017-12-10 01:22:45 +00:00
Term t;
BACKUP_H();
2017-12-10 01:22:45 +00:00
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.max = len;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return 0L;
t = out.val.t;
2017-12-10 01:22:45 +00:00
RECOVER_H();
return t;
}
/* copy a string to a buffer */
2015-10-22 00:45:47 +01:00
X_API Term YAP_WideBufferToString(const wchar_t *s) {
2017-12-10 01:22:45 +00:00
Term t;
BACKUP_H();
2017-12-10 01:22:45 +00:00
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;
2017-12-10 01:22:45 +00:00
RECOVER_H();
return t;
}
/* copy a string to a buffer */
2015-10-22 00:45:47 +01:00
X_API Term YAP_NWideBufferToString(const wchar_t *s, size_t len) {
2017-12-10 01:22:45 +00:00
Term t;
BACKUP_H();
2017-12-10 01:22:45 +00:00
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.max = len;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return 0L;
t = out.val.t;
2017-12-10 01:22:45 +00:00
RECOVER_H();
return t;
}
/* copy a string to a buffer */
2015-10-22 00:45:47 +01:00
X_API Term YAP_ReadBuffer(const char *s, Term *tp) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
Term tv, t;
BACKUP_H();
if (*tp)
tv = *tp;
else
2018-03-19 15:41:06 +00:00
tv = (Term)0;
2017-12-10 01:22:45 +00:00
LOCAL_ErrorMessage = NULL;
2018-10-07 14:27:01 +01:00
while (!(t = Yap_BufferToTermWithPrioBindings(s, TermNil, tv, strlen(s) + 1,
GLOBAL_MaxPriority))) {
2017-12-10 01:22:45 +00:00
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;
2018-10-07 14:27:01 +01:00
RECOVER_H();
2017-12-10 01:22:45 +00:00
return 0;
} else {
break;
}
2017-12-10 01:22:45 +00:00
}
RECOVER_H();
return t;
}
/* copy a string to a buffer */
2015-10-22 00:45:47 +01:00
X_API YAP_Term YAP_BufferToAtomList(const char *s) {
2017-12-10 01:22:45 +00:00
Term t;
BACKUP_H();
2017-12-10 01:22:45 +00:00
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;
2017-12-10 01:22:45 +00:00
RECOVER_H();
return t;
}
/* copy a string of size len to a buffer */
2015-10-22 00:45:47 +01:00
X_API Term YAP_NBufferToAtomList(const char *s, size_t len) {
2017-12-10 01:22:45 +00:00
Term t;
BACKUP_H();
2017-12-10 01:22:45 +00:00
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.max = len;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return 0L;
t = out.val.t;
2017-12-10 01:22:45 +00:00
RECOVER_H();
return t;
}
/* copy a string to a buffer */
2015-10-22 00:45:47 +01:00
X_API Term YAP_WideBufferToAtomList(const wchar_t *s) {
2017-12-10 01:22:45 +00:00
Term t;
BACKUP_H();
2017-12-10 01:22:45 +00:00
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;
2017-12-10 01:22:45 +00:00
RECOVER_H();
return t;
}
/* copy a string of size len to a buffer */
2015-10-22 00:45:47 +01:00
X_API Term YAP_NWideBufferToAtomList(const wchar_t *s, size_t len) {
2017-12-10 01:22:45 +00:00
Term t;
BACKUP_H();
2017-12-10 01:22:45 +00:00
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.max = len;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return 0L;
t = out.val.t;
2017-12-10 01:22:45 +00:00
RECOVER_H();
return t;
}
/* copy a string of size len to a buffer */
2016-03-29 01:55:12 +01:00
X_API Term YAP_NWideBufferToAtomDiffList(const wchar_t *s, Term t0,
size_t len) {
2017-12-10 01:22:45 +00:00
Term t;
BACKUP_H();
2017-12-10 01:22:45 +00:00
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.max = len;
out.dif = t0;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return 0L;
t = out.val.t;
2017-12-10 01:22:45 +00:00
RECOVER_H();
return t;
}
/* copy a string to a buffer */
2015-10-22 00:45:47 +01:00
X_API Term YAP_BufferToDiffList(const char *s, Term t0) {
2017-12-10 01:22:45 +00:00
Term t;
BACKUP_H();
2017-12-10 01:22:45 +00:00
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;
2017-12-10 01:22:45 +00:00
RECOVER_H();
return t;
}
/* copy a string of size len to a buffer */
2015-10-22 00:45:47 +01:00
X_API Term YAP_NBufferToDiffList(const char *s, Term t0, size_t len) {
2017-12-10 01:22:45 +00:00
Term t;
BACKUP_H();
2017-12-10 01:22:45 +00:00
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.max = len;
out.dif = t0;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return 0L;
t = out.val.t;
2017-12-10 01:22:45 +00:00
RECOVER_H();
return t;
}
/* copy a string to a buffer */
2015-10-22 00:45:47 +01:00
X_API Term YAP_WideBufferToDiffList(const wchar_t *s, Term t0) {
2017-12-10 01:22:45 +00:00
Term t;
BACKUP_H();
2017-12-10 01:22:45 +00:00
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;
2017-12-10 01:22:45 +00:00
RECOVER_H();
return t;
}
/* copy a string of size len to a buffer */
2015-10-22 00:45:47 +01:00
X_API Term YAP_NWideBufferToDiffList(const wchar_t *s, Term t0, size_t len) {
2017-12-10 01:22:45 +00:00
Term t;
BACKUP_H();
2017-12-10 01:22:45 +00:00
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.max = len;
out.dif = t0;
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
return 0L;
t = out.val.t;
2017-12-10 01:22:45 +00:00
RECOVER_H();
return t;
}
2015-10-22 00:45:47 +01:00
X_API void YAP_Error(int myerrno, Term t, const char *buf, ...) {
#define YAP_BUF_SIZE 512
2017-12-10 01:22:45 +00:00
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);
2015-10-22 00:45:47 +01:00
#if HAVE_VSNPRINTF
2017-12-10 01:22:45 +00:00
(void)vsnprintf(tmpbuf, YAP_BUF_SIZE, buf, ap);
#else
2017-12-10 01:22:45 +00:00
(void)vsprintf(tmpbuf, buf, ap);
#endif
2017-12-10 01:22:45 +00:00
va_end(ap);
} else {
tmpbuf[0] = '\0';
}
Yap_Error(myerrno, t, tmpbuf);
}
2017-11-29 13:47:57 +00:00
X_API YAP_PredEntryPtr YAP_FunctorToPred(YAP_Functor func) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
return RepPredProp(PredPropByFunc(func, CurrentModule));
}
2017-11-29 13:47:57 +00:00
X_API YAP_PredEntryPtr YAP_AtomToPred(YAP_Atom at) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
return RepPredProp(PredPropByAtom(at, CurrentModule));
}
2017-11-29 13:47:57 +00:00
X_API YAP_PredEntryPtr YAP_FunctorToPredInModule(YAP_Functor func, Term mod) {
2017-12-10 01:22:45 +00:00
return RepPredProp(PredPropByFunc(func, mod));
}
2017-11-29 13:47:57 +00:00
X_API YAP_PredEntryPtr YAP_AtomToPredInModule(YAP_Atom at, Term mod) {
2017-12-10 01:22:45 +00:00
return RepPredProp(PredPropByAtom(at, mod));
}
2019-01-21 01:11:42 +00:00
/*
2015-10-22 00:45:47 +01:00
static int run_emulator(USES_REGS1) {
2017-12-10 01:22:45 +00:00
int out;
2016-08-07 15:45:17 +01:00
2017-12-10 01:22:45 +00:00
out = Yap_absmi(0);
LOCAL_PrologMode |= UserCCallMode;
return out;
}
2019-01-21 01:11:42 +00:00
*/
2017-11-29 13:47:57 +00:00
X_API bool YAP_EnterGoal(YAP_PredEntryPtr ape, CELL *ptr, YAP_dogoalinfo *dgi) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
PredEntry *pe = ape;
2019-04-24 12:10:06 +01:00
bool out;
2019-05-01 01:34:58 +01:00
// fprintf(stderr,"1EnterGoal: H=%d ENV=%p B=%d TR=%d P=%p CP=%p
2019-04-24 12:10:06 +01:00
// Slots=%d\n",HR-H0,LCL0-ENV,LCL0-(CELL*)B,(CELL*)TR-LCL0, P, CP,
// LOCAL_CurSlot);
2017-12-10 01:22:45 +00:00
BACKUP_MACHINE_REGS();
2019-05-01 01:34:58 +01:00
dgi->lvl = push_text_stack();
2018-05-24 12:00:10 +01:00
LOCAL_ActiveError->errorNo = YAP_NO_ERROR;
2017-12-10 01:22:45 +00:00
LOCAL_PrologMode = UserMode;
2018-05-30 08:12:51 +01:00
dgi->p = P;
2017-12-10 01:22:45 +00:00
dgi->cp = CP;
2019-04-24 12:10:06 +01:00
dgi->b0 = LCL0 - (CELL *)B;
2019-05-01 01:34:58 +01:00
dgi->env0 = LCL0 - ENV;
2017-12-10 01:22:45 +00:00
// ensure our current ENV receives current P.
2019-04-24 12:10:06 +01:00
Yap_PrepGoal(pe->ArityOfPE, nullptr, B PASS_REGS);
2017-12-10 01:22:45 +00:00
P = pe->CodeOfPred;
2019-04-24 12:10:06 +01:00
// __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),
2017-12-10 01:22:45 +00:00
// LOCAL_CurSlot);
2019-04-27 17:55:22 +01:00
dgi->b_entry = LCL0 - (CELL *)B;
2018-10-07 14:27:01 +01:00
dgi->h = HR - H0;
dgi->tr = (CELL *)TR - LCL0;
2019-04-24 12:10:06 +01:00
// fprintf(stderr,"PrepGoal: H=%d ENV=%p B=%d TR=%d P=%p CP=%p Slots=%d\n",
// HR-H0,LCL0-ENV,LCL0-(CELL*)B,(CELL*)TR-LCL0, P, CP, LOCAL_CurSlot);
out = Yap_exec_absmi(true, false);
// fprintf(stderr,"EnterGoal success=%d: H=%d ENV=%p B=%d TR=%d P=%p CP=%p
// Slots=%d\n", out,HR-H0,LCL0-ENV,LCL0-(CELL*)B,(CELL*)TR-LCL0, P, CP,
// LOCAL_CurSlot);
2019-04-27 17:55:22 +01:00
dgi->b_exit = LCL0 - (CELL *)B;
2017-12-10 01:22:45 +00:00
if (out) {
dgi->EndSlot = LOCAL_CurSlot;
Yap_StartSlots();
} else {
LOCAL_CurSlot =
dgi->CurSlot; // ignore any slots created within the called goal
}
2019-05-01 01:34:58 +01:00
pop_text_stack(dgi->lvl);
2017-12-10 01:22:45 +00:00
RECOVER_MACHINE_REGS();
return out;
}
2015-10-22 00:45:47 +01:00
X_API bool YAP_RetryGoal(YAP_dogoalinfo *dgi) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
2018-10-07 14:27:01 +01:00
choiceptr myB, myB0;
2017-12-10 01:22:45 +00:00
bool out;
BACKUP_MACHINE_REGS();
2019-05-01 01:34:58 +01:00
dgi->lvl = push_text_stack();
2019-04-27 17:55:22 +01:00
myB = (choiceptr)(LCL0 - dgi->b_exit);
myB0 = (choiceptr)(LCL0 - dgi->b_entry);
2018-10-07 14:27:01 +01:00
CP = myB->cp_cp;
2017-12-10 01:22:45 +00:00
/* sanity check */
2018-05-24 12:00:10 +01:00
if (B >= myB0) {
2017-12-10 01:22:45 +00:00
return false;
}
2018-05-24 12:00:10 +01:00
if (B < myB) {
2018-05-29 09:59:28 +01:00
// get rid of garbage choice-points
2018-05-24 12:00:10 +01:00
B = myB;
}
2019-04-24 12:10:06 +01:00
// fprintf(stderr,"RetryGoal: H=%d ENV=%p B=%d TR=%d P=%p CP=%p Slots=%d\n",
2018-10-07 14:27:01 +01:00
// HR-H0,LCL0-ENV,LCL0-(CELL*)B,(CELL*)TR-LCL0, P, CP, LOCAL_CurSlot);
2017-12-10 01:22:45 +00:00
P = FAILCODE;
/* make sure we didn't leave live slots when we backtrack */
2019-04-24 12:10:06 +01:00
ASP = (CELL *)B;
2017-12-10 01:22:45 +00:00
LOCAL_CurSlot = dgi->EndSlot;
2019-01-09 09:32:09 +00:00
out = Yap_exec_absmi(true, true );
2017-12-10 01:22:45 +00:00
if (out) {
dgi->EndSlot = LOCAL_CurSlot;
2019-04-27 17:55:22 +01:00
dgi->b_exit = LCL0 - (CELL *)B;
2017-12-10 01:22:45 +00:00
} else {
2019-04-27 17:55:22 +01:00
printf("F %ld\n", dgi->CurSlot);
2017-12-10 01:22:45 +00:00
LOCAL_CurSlot =
dgi->CurSlot; // ignore any slots created within the called goal
}
2019-05-01 01:34:58 +01:00
pop_text_stack(dgi->lvl);
2017-12-10 01:22:45 +00:00
RECOVER_MACHINE_REGS();
return out;
}
2018-05-24 12:00:10 +01:00
X_API bool YAP_LeaveGoal(bool successful, YAP_dogoalinfo *dgi) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
2019-04-24 12:10:06 +01:00
// fprintf(stderr,"LeaveGoal success=%d: H=%d ENV=%p B=%ld myB=%ld TR=%d
// P=%p CP=%p Slots=%d\n",
2018-10-07 14:27:01 +01:00
// successful,HR-H0,LCL0-ENV,LCL0-(CELL*)B,dgi->b0,(CELL*)TR-LCL0, P, CP,
// LOCAL_CurSlot);
2017-12-10 01:22:45 +00:00
BACKUP_MACHINE_REGS();
2019-05-01 01:34:58 +01:00
dgi->lvl = push_text_stack();
2018-10-07 14:27:01 +01:00
if (successful) {
2019-04-27 17:55:22 +01:00
choiceptr nB = (choiceptr)(LCL0 - dgi->b_entry);
if (B <= nB) {
B = nB;
}
2018-10-07 14:27:01 +01:00
Yap_TrimTrail();
2019-04-27 17:55:22 +01:00
B = B->cp_b;
} else if (LOCAL_PrologMode & AsyncIntMode) {
2018-09-18 19:27:10 +01:00
Yap_signal(YAP_FAIL_SIGNAL);
2018-05-29 09:59:28 +01:00
}
2019-04-27 17:55:22 +01:00
B = (choiceptr)(LCL0 - dgi->b0);
2019-05-01 01:34:58 +01:00
#ifdef DEPTH_LIMIT
DEPTH = B->cp_depth;
#endif
2018-10-07 14:27:01 +01:00
P = dgi->p;
2018-09-21 13:31:22 +01:00
CP = dgi->cp;
2019-05-01 01:34:58 +01:00
YENV = ENV = LCL0-dgi->env0;
2019-04-27 17:55:22 +01:00
LOCAL_CurSlot =
dgi->CurSlot; // ignore any slots created within the called goal
2019-05-01 01:34:58 +01:00
pop_text_stack(dgi->lvl);
2017-12-10 01:22:45 +00:00
RECOVER_MACHINE_REGS();
2019-05-01 01:34:58 +01:00
// fprintf(stderr," LeftGoal success=%d: H=%d ENV=%p B=%d TR=%d P=%p CP=%p
2019-04-24 12:10:06 +01:00
// Slots=%d\n", successful,HR-H0,LCL0-ENV,LCL0-(CELL*)B,(CELL*)TR-LCL0, P,
// CP, LOCAL_CurSlot);
2017-12-10 01:22:45 +00:00
return TRUE;
}
2015-10-22 00:45:47 +01:00
X_API Int YAP_RunGoal(Term t) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
Term out;
2019-04-24 12:10:06 +01:00
yhandle_t cslot = LOCAL_CurSlot;
2017-12-10 01:22:45 +00:00
BACKUP_MACHINE_REGS();
2019-05-01 01:34:58 +01:00
int lvl = push_text_stack();
2017-12-10 01:22:45 +00:00
LOCAL_AllowRestart = FALSE;
LOCAL_PrologMode = UserMode;
2019-04-24 12:10:06 +01:00
out = Yap_RunTopGoal(t, true);
2017-12-10 01:22:45 +00:00
LOCAL_PrologMode = UserCCallMode;
// should we catch the exception or pass it through?
// We'll pass it through
2018-10-07 14:27:01 +01:00
RECOVER_MACHINE_REGS();
2017-12-10 01:22:45 +00:00
LOCAL_CurSlot = cslot;
2019-05-01 01:34:58 +01:00
pop_text_stack(lvl);
2017-12-10 01:22:45 +00:00
return out;
}
2015-10-22 00:45:47 +01:00
X_API Term YAP_AllocExternalDataInStack(size_t bytes) {
2017-12-10 01:22:45 +00:00
CELL *pt;
Term t = Yap_AllocExternalDataInStack(EXTERNAL_BLOB, bytes, &pt);
if (t == TermNil)
return 0L;
return t;
2011-07-21 14:32:49 +01:00
}
2015-10-22 00:45:47 +01:00
X_API YAP_Bool YAP_IsExternalDataInStackTerm(Term t) {
2017-12-10 01:22:45 +00:00
return IsExternalBlobTerm(t, EXTERNAL_BLOB);
2011-07-21 14:32:49 +01:00
}
2015-10-22 00:45:47 +01:00
X_API void *YAP_ExternalDataInStackFromTerm(Term t) {
2017-12-10 01:22:45 +00:00
return ExternalBlobFromTerm(t);
2011-07-21 14:32:49 +01:00
}
2015-10-22 00:45:47 +01:00
X_API YAP_opaque_tag_t YAP_NewOpaqueType(struct YAP_opaque_handler_struct *f) {
2017-12-10 01:22:45 +00:00
int i;
if (!GLOBAL_OpaqueHandlersCount) {
GLOBAL_OpaqueHandlers =
malloc(sizeof(YAP_opaque_handler_t) * USER_BLOB_END);
if (!GLOBAL_OpaqueHandlers) {
/* no room */
return -1;
}
GLOBAL_OpaqueHandlersCount = USER_BLOB_START;
} else if (GLOBAL_OpaqueHandlersCount == USER_BLOB_END) {
/* all types used */
return -1;
}
i = GLOBAL_OpaqueHandlersCount++;
2018-06-30 14:33:32 +01:00
memmove(GLOBAL_OpaqueHandlers + i, f, sizeof(YAP_opaque_handler_t));
2017-12-10 01:22:45 +00:00
return i;
}
2017-07-30 21:53:07 +01:00
X_API Term YAP_NewOpaqueObject(YAP_opaque_tag_t blob_tag, size_t bytes) {
2017-12-10 01:22:45 +00:00
CELL *pt;
Term t = Yap_AllocExternalDataInStack((CELL)blob_tag, bytes, &pt);
if (t == TermNil)
return 0L;
pt = RepAppl(t);
blob_tag = pt[1];
if (blob_tag < USER_BLOB_START || blob_tag >= USER_BLOB_END) {
Yap_Error(SYSTEM_ERROR_INTERNAL, AbsAppl(pt),
"clean opaque: bad blob with tag " UInt_FORMAT, blob_tag);
return FALSE;
}
YAP_opaque_tag_t blob_info = blob_tag;
if (GLOBAL_OpaqueHandlers[blob_info].cut_handler ||
GLOBAL_OpaqueHandlers[blob_info].fail_handler) {
*HR++ = t;
*HR++ = TermNil;
TrailTerm(TR) = AbsPair(HR - 2);
}
return t;
}
2015-10-22 00:45:47 +01:00
X_API YAP_Bool YAP_IsOpaqueObjectTerm(Term t, YAP_opaque_tag_t tag) {
2017-12-10 01:22:45 +00:00
return IsExternalBlobTerm(t, (CELL)tag);
}
2015-10-22 00:45:47 +01:00
X_API void *YAP_OpaqueObjectFromTerm(Term t) { return ExternalBlobFromTerm(t); }
2015-10-22 00:45:47 +01:00
X_API CELL *YAP_HeapStoreOpaqueTerm(Term t) {
2017-12-10 01:22:45 +00:00
return Yap_HeapStoreOpaqueTerm(t);
}
2015-10-22 00:45:47 +01:00
X_API Int YAP_RunGoalOnce(Term t) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
Term out;
2019-04-27 17:55:22 +01:00
yamop *old_CP = CP, *old_P = P;
2019-04-24 12:10:06 +01:00
Int oldPrologMode = LOCAL_PrologMode;
yhandle_t CSlot;
2017-12-10 01:22:45 +00:00
BACKUP_MACHINE_REGS();
2019-05-01 01:34:58 +01:00
int lvl = push_text_stack();
2019-04-24 12:10:06 +01:00
CSlot = Yap_StartSlots();
2017-12-10 01:22:45 +00:00
LOCAL_PrologMode = UserMode;
// Yap_heap_regs->yap_do_low_level_trace=true;
2019-04-24 12:10:06 +01:00
out = Yap_RunTopGoal(t, true);
2017-12-10 01:22:45 +00:00
LOCAL_PrologMode = oldPrologMode;
2018-01-18 14:47:27 +00:00
// Yap_CloseSlots(CSlot);
2017-12-10 01:22:45 +00:00
if (!(oldPrologMode & UserCCallMode)) {
/* called from top-level */
2019-05-01 01:34:58 +01:00
pop_text_stack( lvl);
2017-12-10 01:22:45 +00:00
LOCAL_AllowRestart = FALSE;
RECOVER_MACHINE_REGS();
return out;
}
// should we catch the exception or pass it through?
// We'll pass it through
2018-04-04 15:55:45 +01:00
// Yap_RaiseException();
2019-04-24 12:10:06 +01:00
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;
} else {
Yap_CloseSlots(CSlot);
}
ASP = B->cp_env;
ENV = (CELL *)ASP[E_E];
B = (choiceptr)ASP[E_CB];
2019-04-27 17:55:22 +01:00
#ifdef DEPTH_LIMIT
2019-04-24 12:10:06 +01:00
DEPTH = ASP[E_DEPTH];
#endif
2019-04-27 17:55:22 +01:00
P = old_P;
2019-04-24 12:10:06 +01:00
CP = old_CP;
2017-12-10 01:22:45 +00:00
LOCAL_AllowRestart = FALSE;
RECOVER_MACHINE_REGS();
2019-05-01 01:34:58 +01:00
pop_text_stack( lvl);
2017-12-10 01:22:45 +00:00
return out;
}
2015-10-22 00:45:47 +01:00
X_API bool YAP_RestartGoal(void) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
BACKUP_MACHINE_REGS();
bool out;
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;
}
2017-12-10 01:22:45 +00:00
} else {
out = FALSE;
}
RECOVER_MACHINE_REGS();
return (out);
}
2015-10-22 00:45:47 +01:00
X_API bool YAP_ShutdownGoal(int backtrack) {
2017-12-10 01:22:45 +00:00
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
2017-12-10 01:22:45 +00:00
CUT_prune_to(cut_pt);
#endif
2017-12-10 01:22:45 +00:00
/* 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();
2015-10-22 00:45:47 +01:00
#ifdef DEPTH_LIMIT
2017-12-10 01:22:45 +00:00
DEPTH = ASP[E_DEPTH];
#endif
2017-12-10 01:22:45 +00:00
LOCAL_AllowRestart = FALSE;
}
RECOVER_MACHINE_REGS();
return TRUE;
}
2015-10-22 00:45:47 +01:00
X_API bool YAP_ContinueGoal(void) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
bool out;
BACKUP_MACHINE_REGS();
2017-12-10 01:22:45 +00:00
LOCAL_PrologMode = UserMode;
out = Yap_exec_absmi(TRUE, YAP_EXEC_ABSMI);
LOCAL_PrologMode = UserCCallMode;
2017-12-10 01:22:45 +00:00
RECOVER_MACHINE_REGS();
return (out);
}
2015-10-22 00:45:47 +01:00
X_API void YAP_PruneGoal(YAP_dogoalinfo *gi) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
BACKUP_B();
2019-04-27 17:55:22 +01:00
choiceptr myB = (choiceptr)(LCL0 - gi->b_entry);
2017-12-10 01:22:45 +00:00
while (B != myB) {
/* make sure we prune C-choicepoints */
if (POP_CHOICE_POINT(B->cp_b)) {
POP_EXECUTE();
2015-10-22 00:45:47 +01:00
}
2017-12-10 01:22:45 +00:00
if (!B->cp_b)
break;
B = B->cp_b;
}
2017-12-10 01:22:45 +00:00
Yap_TrimTrail();
2017-12-10 01:22:45 +00:00
RECOVER_B();
}
2015-10-22 00:45:47 +01:00
X_API bool YAP_GoalHasException(Term *t) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
BACKUP_MACHINE_REGS();
2018-04-02 14:49:45 +01:00
return LOCAL_ActiveError->errorNo != YAP_NO_ERROR;
2016-04-05 02:20:16 +01:00
}
2015-10-22 00:45:47 +01:00
X_API void YAP_ClearExceptions(void) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
Yap_ResetException(worker_id);
}
2018-10-07 14:27:01 +01:00
X_API int YAP_InitConsult(int mode, const char *fname, char **full,
int *osnop) {
2018-12-14 10:29:12 +00:00
CACHE_REGS
2019-01-27 10:11:56 +00:00
int sno;
int lvl = push_text_stack();
2018-12-14 10:29:12 +00:00
BACKUP_MACHINE_REGS();
const char *fl = NULL;
if (mode == YAP_BOOT_MODE) {
mode = YAP_CONSULT_MODE;
2017-12-10 01:22:45 +00:00
}
2018-12-14 10:29:12 +00:00
if (fname == NULL || fname[0] == '\0') {
2019-01-09 09:32:09 +00:00
fl = Yap_SOURCEBOOT;
2018-12-14 10:29:12 +00:00
}
if (!fname || !(fl = Yap_AbsoluteFile(fname, true)) || !fl[0]) {
__android_log_print(
ANDROID_LOG_INFO, "YAPDroid", "failed ABSOLUTEFN %s ", fl);
*full = NULL;
return -1;
2017-12-10 01:22:45 +00:00
}
2018-12-14 10:29:12 +00:00
__android_log_print(
ANDROID_LOG_INFO, "YAPDroid", "done init_ consult %s ",fl);
2018-10-07 14:27:01 +01:00
char *d = Malloc(strlen(fl) + 1);
strcpy(d, fl);
bool consulted = (mode == YAP_CONSULT_MODE);
2018-07-02 16:48:00 +01:00
Term tat = MkAtomTerm(Yap_LookupAtom(d));
2018-10-07 14:27:01 +01:00
sno = Yap_OpenStream(tat, "r", MkAtomTerm(Yap_LookupAtom(fname)),
LOCAL_encoding);
2018-12-14 10:29:12 +00:00
__android_log_print(
2019-04-24 12:10:06 +01:00
ANDROID_LOG_INFO, "YAPDroid", "OpenStream got %d ",sno);
2018-12-14 10:29:12 +00:00
if (sno < 0 || !Yap_ChDir(dirname((char *)d))) {
2018-10-07 14:27:01 +01:00
*full = NULL;
2019-01-27 10:11:56 +00:00
pop_text_stack(lvl);
2018-10-07 14:27:01 +01:00
return -1;
}
LOCAL_PrologMode = UserMode;
2018-12-14 10:29:12 +00:00
*full = pop_output_text_stack__(lvl, fl);
Yap_init_consult(consulted,*full);
2017-12-10 01:22:45 +00:00
RECOVER_MACHINE_REGS();
UNLOCK(GLOBAL_Stream[sno].streamlock);
return sno;
}
/// given a stream descriptor or stream alias (see open/3),
/// return YAP's internal handle.
2017-12-10 01:22:45 +00:00
X_API void *YAP_GetStreamFromId(int no) { return GLOBAL_Stream + no; }
2015-10-22 00:45:47 +01:00
X_API FILE *YAP_TermToStream(Term t) {
2017-12-10 01:22:45 +00:00
BACKUP_MACHINE_REGS();
FILE *s;
2011-05-25 13:10:39 +01:00
2017-12-10 01:22:45 +00:00
if (IsVarTerm(t) || !IsAtomTerm(t))
return NULL;
2017-12-10 01:22:45 +00:00
if ((s = Yap_GetStreamHandle(t)->file)) {
RECOVER_MACHINE_REGS();
return s;
}
RECOVER_MACHINE_REGS();
return NULL;
2011-05-25 13:10:39 +01:00
}
2018-01-18 14:47:27 +00:00
X_API void YAP_EndConsult(int sno, int *osnop, const char *full) {
2017-12-10 01:22:45 +00:00
BACKUP_MACHINE_REGS();
Yap_CloseStream(sno);
2018-06-26 11:07:07 +01:00
int lvl = push_text_stack();
2018-10-07 14:27:01 +01:00
char *d = Malloc(strlen(full) + 1);
strcpy(d, full);
2018-06-26 11:07:07 +01:00
Yap_ChDir(dirname(d));
2017-12-10 01:22:45 +00:00
if (osnop >= 0)
Yap_AddAlias(AtomLoopStream, *osnop);
Yap_end_consult();
2019-04-24 12:10:06 +01:00
__android_log_print(ANDROID_LOG_INFO, "YAPDroid ", " closing %s:%s(%d), %d",
2018-10-07 14:27:01 +01:00
CurrentModule == 0
? "prolog"
: RepAtom(AtomOfTerm(CurrentModule))->StrOfAE,
full, *osnop, sno);
// LOCAL_CurSlot);
pop_text_stack(lvl);
2017-12-10 01:22:45 +00:00
RECOVER_MACHINE_REGS();
}
2015-10-22 00:45:47 +01:00
X_API Term YAP_Read(FILE *f) {
2017-12-10 01:22:45 +00:00
Term o;
int sno = Yap_FileStream(f, NULL, TermNil, Input_Stream_f, NULL);
2017-12-10 01:22:45 +00:00
BACKUP_MACHINE_REGS();
o = Yap_read_term(sno, TermNil, 1);
Yap_ReleaseStream(sno);
RECOVER_MACHINE_REGS();
return o;
2015-06-19 00:45:54 +01:00
}
2015-10-22 00:45:47 +01:00
X_API Term YAP_ReadFromStream(int sno) {
2017-12-10 01:22:45 +00:00
Term o;
2011-02-15 07:39:27 +00:00
2017-12-10 01:22:45 +00:00
BACKUP_MACHINE_REGS();
2019-01-31 11:52:03 +00:00
sigjmp_buf signew;
if (sigsetjmp(signew, 0)) {
Yap_syntax_error(LOCAL_toktide, sno, "ReadFromStream");
2019-04-24 12:10:06 +01:00
RECOVER_MACHINE_REGS();
return 0;
2019-01-31 11:52:03 +00:00
} else {
2017-12-10 01:22:45 +00:00
o = Yap_read_term(sno, TermNil, false);
2019-01-31 11:52:03 +00:00
}
2017-12-10 01:22:45 +00:00
RECOVER_MACHINE_REGS();
return o;
}
2018-01-22 13:53:17 +00:00
X_API Term YAP_ReadClauseFromStream(int sno, Term vs, Term pos) {
2017-12-10 01:22:45 +00:00
BACKUP_MACHINE_REGS();
2018-10-07 14:27:01 +01:00
Term t = Yap_read_term(
sno,
2019-01-21 01:11:42 +00:00
MkPairTerm(
Yap_MkApplTerm(Yap_MkFunctor(AtomVariableNames, 1), 1, &vs),
MkPairTerm(
Yap_MkApplTerm(Yap_MkFunctor(AtomTermPosition, 1),
2018-10-07 14:27:01 +01:00
1, &pos),
TermNil)),
true);
2017-12-10 01:22:45 +00:00
RECOVER_MACHINE_REGS();
return t;
}
2015-10-22 00:45:47 +01:00
X_API void YAP_Write(Term t, FILE *f, int flags) {
2017-12-10 01:22:45 +00:00
BACKUP_MACHINE_REGS();
int sno = Yap_FileStream(f, NULL, TermNil, Output_Stream_f, NULL);
2017-12-10 01:22:45 +00:00
Yap_plwrite(t, GLOBAL_Stream + sno, 0, flags, GLOBAL_MaxPriority);
Yap_ReleaseStream(sno);
2017-12-10 01:22:45 +00:00
RECOVER_MACHINE_REGS();
}
2016-12-03 16:34:09 +00:00
X_API YAP_Term YAP_CopyTerm(Term t) {
2017-12-10 01:22:45 +00:00
Term tn;
BACKUP_MACHINE_REGS();
2017-12-10 01:22:45 +00:00
tn = Yap_CopyTerm(t);
2017-12-10 01:22:45 +00:00
RECOVER_MACHINE_REGS();
2017-12-10 01:22:45 +00:00
return (tn);
}
X_API char *YAP_WriteBuffer(Term t, char *buf, size_t sze, int flags) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
seq_tv_t inp, out;
BACKUP_MACHINE_REGS();
int l = push_text_stack();
inp.val.t = t;
inp.type = YAP_STRING_TERM | YAP_STRING_DATUM;
out.type = YAP_STRING_CHARS;
2019-01-09 09:32:09 +00:00
out.val.c = NULL;
2017-12-10 01:22:45 +00:00
out.max = sze - 1;
out.enc = LOCAL_encoding;
if (!Yap_CVT_Text(&inp, &out PASS_REGS)) {
RECOVER_MACHINE_REGS();
pop_text_stack(l);
return NULL;
} else {
RECOVER_MACHINE_REGS();
if (buf == out.val.c) {
2019-05-01 01:34:58 +01:00
pop_text_stack(l);
2017-12-10 01:22:45 +00:00
return buf;
2017-10-27 13:48:07 +01:00
} else {
2019-01-09 09:32:09 +00:00
if ( strlen(out.val.c ) < sze) {
strcpy( buf, out.val.c);
pop_text_stack(l);
return buf;
}
2017-11-29 13:47:57 +00:00
}
2017-12-10 01:22:45 +00:00
}
2019-01-21 01:11:42 +00:00
return out.val.c = pop_output_text_stack(l,buf);
2017-11-29 13:47:57 +00:00
}
2017-10-27 13:48:07 +01:00
/// write a a term to n user-provided buffer: make sure not tp
/// overflow the buffer even if the text is much larger.
X_API int YAP_WriteDynamicBuffer(YAP_Term t, char *buf, size_t sze,
size_t *lengthp, encoding_t enc, int flags) {
2017-12-10 01:22:45 +00:00
char *b;
2017-12-10 01:22:45 +00:00
BACKUP_MACHINE_REGS();
2018-07-10 23:21:19 +01:00
b = Yap_TermToBuffer(t, flags);
2018-10-07 14:27:01 +01:00
strncpy(buf, b, sze - 1);
2017-12-10 01:22:45 +00:00
buf[sze] = 0;
RECOVER_MACHINE_REGS();
return true;
}
2018-04-02 14:49:45 +01:00
X_API bool YAP_CompileClause(Term t) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
yamop *codeaddr;
Term mod = CurrentModule;
Term tn = TermNil;
2018-04-02 14:49:45 +01:00
bool ok = true;
2018-05-29 09:59:28 +01:00
2017-12-10 01:22:45 +00:00
BACKUP_MACHINE_REGS();
2017-11-29 13:47:57 +00:00
2017-12-10 01:22:45 +00:00
/* allow expansion during stack initialization */
LOCAL_ErrorMessage = NULL;
ARG1 = t;
YAPEnterCriticalSection();
codeaddr = Yap_cclause(t, 0, mod, t);
2018-04-02 14:49:45 +01:00
ok = (codeaddr != NULL);
if (ok) {
2017-12-10 01:22:45 +00:00
t = Deref(ARG1); /* just in case there was an heap overflow */
if (!Yap_addclause(t, codeaddr, TermAssertz, mod, &tn)) {
2018-04-02 14:49:45 +01:00
ok = false;
}
2018-04-02 14:49:45 +01:00
} else {
ok = false;
2017-12-10 01:22:45 +00:00
}
YAPLeaveCriticalSection();
2017-12-10 01:22:45 +00:00
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);
2018-04-02 14:49:45 +01:00
ok = false;
2017-11-29 13:47:57 +00:00
}
2017-12-10 01:22:45 +00:00
}
RECOVER_MACHINE_REGS();
2018-04-02 14:49:45 +01:00
if (!ok) {
2018-10-07 14:27:01 +01:00
return NULL;
2018-04-02 14:49:45 +01:00
}
return ok;
2017-11-29 13:47:57 +00:00
}
2017-11-29 13:47:57 +00:00
X_API void YAP_PutValue(YAP_Atom at, Term t) { Yap_PutValue(at, t); }
2017-11-29 13:47:57 +00:00
X_API Term YAP_GetValue(YAP_Atom at) { return (Yap_GetValue(at)); }
2017-11-29 13:47:57 +00:00
X_API int YAP_CompareTerms(Term t1, Term t2) {
2017-12-10 01:22:45 +00:00
return Yap_compare_terms(t1, t2);
2017-11-29 13:47:57 +00:00
}
2018-01-18 14:47:27 +00:00
X_API int YAP_Reset(yap_reset_t mode, bool reset_global) {
2017-12-10 01:22:45 +00:00
int res = TRUE;
BACKUP_MACHINE_REGS();
2018-01-18 14:47:27 +00:00
res = Yap_Reset(mode, reset_global);
2017-12-10 01:22:45 +00:00
RECOVER_MACHINE_REGS();
return res;
2017-11-29 13:47:57 +00:00
}
2017-11-29 13:47:57 +00:00
X_API void YAP_Exit(int retval) { Yap_exit(retval); }
2017-11-29 13:47:57 +00:00
X_API int YAP_InitSocks(const char *host, long port) { return 0; }
2017-11-29 13:47:57 +00:00
X_API void YAP_SetOutputMessage(void) {
#if DEBUG
2017-12-10 01:22:45 +00:00
Yap_output_msg = TRUE;
#endif
2017-11-29 13:47:57 +00:00
}
2017-11-29 13:47:57 +00:00
X_API int YAP_StreamToFileNo(Term t) { return (Yap_StreamToFileNo(t)); }
2017-12-05 15:14:57 +00:00
/**
* Obtain a pointer to the YAP representation of a stream.
* @param sno Stream Id
* @return data structure for stream
*/
2017-12-10 01:22:45 +00:00
X_API void *YAP_RepStreamFromId(int sno) { return GLOBAL_Stream + sno; }
2017-12-05 15:14:57 +00:00
2017-11-29 13:47:57 +00:00
X_API void YAP_CloseAllOpenStreams(void) {
2017-12-10 01:22:45 +00:00
BACKUP_H();
2018-05-14 16:03:02 +01:00
Yap_CloseStreams();
2017-12-10 01:22:45 +00:00
RECOVER_H();
2017-11-29 13:47:57 +00:00
}
2017-11-29 13:47:57 +00:00
X_API void YAP_FlushAllStreams(void) {
2017-12-10 01:22:45 +00:00
BACKUP_H();
2017-12-10 01:22:45 +00:00
// VSC?? Yap_FlushStreams();
2017-12-10 01:22:45 +00:00
RECOVER_H();
2017-11-29 13:47:57 +00:00
}
2017-11-29 13:47:57 +00:00
X_API void YAP_Throw(Term t) {
2017-12-10 01:22:45 +00:00
BACKUP_MACHINE_REGS();
2018-04-02 14:49:45 +01:00
LOCAL_ActiveError->errorNo = THROW_EVENT;
2018-07-10 23:21:19 +01:00
LOCAL_ActiveError->errorGoal = Yap_TermToBuffer(t, 0);
2018-04-02 14:49:45 +01:00
Yap_JumpToEnv();
2017-12-10 01:22:45 +00:00
RECOVER_MACHINE_REGS();
2017-11-29 13:47:57 +00:00
}
2017-11-29 13:47:57 +00:00
X_API void YAP_AsyncThrow(Term t) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
BACKUP_MACHINE_REGS();
LOCAL_PrologMode |= AsyncIntMode;
2018-04-02 14:49:45 +01:00
LOCAL_ActiveError->errorNo = THROW_EVENT;
2018-07-10 23:21:19 +01:00
LOCAL_ActiveError->errorGoal = Yap_TermToBuffer(t, 0);
2018-04-02 14:49:45 +01:00
Yap_JumpToEnv();
2017-12-10 01:22:45 +00:00
LOCAL_PrologMode &= ~AsyncIntMode;
RECOVER_MACHINE_REGS();
2017-11-29 13:47:57 +00:00
}
2017-11-29 13:47:57 +00:00
X_API void YAP_Halt(int i) { Yap_exit(i); }
2017-11-29 13:47:57 +00:00
X_API CELL *YAP_TopOfLocalStack(void) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
return (ASP);
2017-11-29 13:47:57 +00:00
}
2017-11-29 13:47:57 +00:00
X_API void *YAP_Predicate(YAP_Atom a, UInt arity, Term m) {
2017-12-10 01:22:45 +00:00
if (arity == 0) {
return ((void *)RepPredProp(PredPropByAtom(a, m)));
} else {
Functor f = Yap_MkFunctor(a, arity);
return ((void *)RepPredProp(PredPropByFunc(f, m)));
}
2017-11-29 13:47:57 +00:00
}
2017-11-29 13:47:57 +00:00
X_API void YAP_PredicateInfo(void *p, YAP_Atom *a, UInt *arity, Term *m) {
2017-12-10 01:22:45 +00:00
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;
2017-11-29 13:47:57 +00:00
}
2017-12-10 01:22:45 +00:00
X_API void YAP_UserCPredicate(const char *name, YAP_UserCPred def,
YAP_Arity arity) {
Yap_InitCPred(name, arity, (CPredicate)def, UserCPredFlag);
2017-11-29 13:47:57 +00:00
}
2017-11-29 13:47:57 +00:00
X_API void YAP_UserBackCPredicate_(const char *name, YAP_UserCPred init,
YAP_UserCPred cont, YAP_Arity arity,
YAP_Arity extra) {
2017-12-10 01:22:45 +00:00
Yap_InitCPredBackCut(name, arity, extra, (CPredicate)init, (CPredicate)cont,
NULL, UserCPredFlag);
2017-11-29 13:47:57 +00:00
}
2017-11-29 13:47:57 +00:00
X_API void YAP_UserBackCutCPredicate(const char *name, YAP_UserCPred init,
YAP_UserCPred cont, YAP_UserCPred cut,
YAP_Arity arity, YAP_Arity extra) {
2017-12-10 01:22:45 +00:00
Yap_InitCPredBackCut(name, arity, extra, (CPredicate)init, (CPredicate)cont,
(CPredicate)cut, UserCPredFlag);
2017-11-29 13:47:57 +00:00
}
2017-11-29 13:47:57 +00:00
X_API void YAP_UserBackCPredicate(const char *name, YAP_UserCPred init,
YAP_UserCPred cont, arity_t arity,
arity_t extra) {
2017-12-10 01:22:45 +00:00
Yap_InitCPredBackCut(name, arity, extra, (CPredicate)init, (CPredicate)cont,
NULL, UserCPredFlag);
2017-11-29 13:47:57 +00:00
}
2016-03-29 01:55:12 +01:00
2017-11-29 13:47:57 +00:00
X_API void YAP_UserCPredicateWithArgs(const char *a, YAP_UserCPred f,
arity_t arity, Term mod) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
Term cm = CurrentModule;
CurrentModule = mod;
Yap_InitCPred(a, arity, (CPredicate)f, UserCPredFlag | CArgsPredFlag);
CurrentModule = cm;
2017-11-29 13:47:57 +00:00
}
2017-11-29 13:47:57 +00:00
X_API Term YAP_CurrentModule(void) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
return (CurrentModule);
2017-11-29 13:47:57 +00:00
}
2017-11-29 13:47:57 +00:00
X_API Term YAP_SetCurrentModule(Term new) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
Term omod = CurrentModule;
LOCAL_SourceModule = CurrentModule = new;
return omod;
2017-11-29 13:47:57 +00:00
}
2011-02-14 22:13:45 +00:00
2017-11-29 13:47:57 +00:00
X_API Term YAP_CreateModule(YAP_Atom at) {
2017-12-10 01:22:45 +00:00
Term t;
WRITE_LOCK(RepAtom(at)->ARWLock);
t = Yap_Module(MkAtomTerm(at));
WRITE_UNLOCK(RepAtom(at)->ARWLock);
return t;
2017-11-29 13:47:57 +00:00
}
2017-11-29 13:47:57 +00:00
X_API Term YAP_StripModule(Term t, Term *modp) {
2017-12-10 01:22:45 +00:00
return Yap_StripModule(t, modp);
2017-11-29 13:47:57 +00:00
}
2017-11-29 13:47:57 +00:00
X_API int YAP_ThreadSelf(void) {
2010-06-08 10:40:55 +01:00
#if THREADS
2017-12-10 01:22:45 +00:00
return Yap_thread_self();
#else
2017-12-10 01:22:45 +00:00
return -2;
#endif
2017-11-29 13:47:57 +00:00
}
2017-11-29 13:47:57 +00:00
X_API int YAP_ThreadCreateEngine(struct YAP_thread_attr_struct *attr) {
2010-06-08 10:40:55 +01:00
#if THREADS
2017-12-10 01:22:45 +00:00
return Yap_thread_create_engine(attr);
#else
2017-12-10 01:22:45 +00:00
return -1;
#endif
2017-11-29 13:47:57 +00:00
}
2017-11-29 13:47:57 +00:00
X_API int YAP_ThreadAttachEngine(int wid) {
2010-06-08 10:40:55 +01:00
#if THREADS
2017-12-10 01:22:45 +00:00
return Yap_thread_attach_engine(wid);
#else
2017-12-10 01:22:45 +00:00
return FALSE;
#endif
2017-11-29 13:47:57 +00:00
}
2017-11-29 13:47:57 +00:00
X_API int YAP_ThreadDetachEngine(int wid) {
2010-06-08 10:40:55 +01:00
#if THREADS
2017-12-10 01:22:45 +00:00
return Yap_thread_detach_engine(wid);
#else
2017-12-10 01:22:45 +00:00
return FALSE;
#endif
2017-11-29 13:47:57 +00:00
}
2017-11-29 13:47:57 +00:00
X_API int YAP_ThreadDestroyEngine(int wid) {
2010-06-08 10:40:55 +01:00
#if THREADS
2017-12-10 01:22:45 +00:00
return Yap_thread_destroy_engine(wid);
#else
2017-12-10 01:22:45 +00:00
return FALSE;
#endif
2017-11-29 13:47:57 +00:00
}
2017-11-29 13:47:57 +00:00
X_API Term YAP_TermNil(void) { return TermNil; }
2017-11-29 13:47:57 +00:00
X_API int YAP_IsTermNil(Term t) { return t == TermNil; }
2011-10-24 22:46:16 +01:00
2017-11-29 13:47:57 +00:00
X_API int YAP_AtomGetHold(YAP_Atom at) { return Yap_AtomIncreaseHold(at); }
2017-11-29 13:47:57 +00:00
X_API int YAP_AtomReleaseHold(YAP_Atom at) { return Yap_AtomDecreaseHold(at); }
2017-11-29 13:47:57 +00:00
X_API YAP_agc_hook YAP_AGCRegisterHook(YAP_agc_hook hook) {
2017-12-10 01:22:45 +00:00
YAP_agc_hook old = (YAP_agc_hook)GLOBAL_AGCHook;
GLOBAL_AGCHook = (Agc_hook)hook;
return old;
2017-11-29 13:47:57 +00:00
}
2017-11-29 13:47:57 +00:00
X_API int YAP_HaltRegisterHook(HaltHookFunc hook, void *closure) {
2017-12-10 01:22:45 +00:00
return Yap_HaltRegisterHook(hook, closure);
2017-11-29 13:47:57 +00:00
}
2017-11-29 13:47:57 +00:00
X_API char *YAP_cwd(void) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
2018-10-07 14:27:01 +01:00
char *buf = Yap_AllocCodeSpace(FILENAME_MAX + 1);
2017-12-10 01:22:45 +00:00
int len;
2018-02-22 08:18:45 +00:00
if (!Yap_getcwd(buf, FILENAME_MAX))
2017-12-10 01:22:45 +00:00
return FALSE;
2018-02-22 08:18:45 +00:00
len = strlen(buf);
2018-10-07 14:27:01 +01:00
buf = Yap_ReallocCodeSpace(buf, len + 1);
2017-12-10 01:22:45 +00:00
return buf;
2017-11-29 13:47:57 +00:00
}
2017-11-29 13:47:57 +00:00
X_API Term YAP_FloatsToList(double *dblp, size_t sz) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
Term t;
CELL *oldH;
BACKUP_H();
2017-12-10 01:22:45 +00:00
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;
2017-11-29 13:47:57 +00:00
}
2017-11-29 13:47:57 +00:00
X_API Int YAP_ListToFloats(Term t, double *dblp, size_t sz) {
2017-12-10 01:22:45 +00:00
size_t i = 0;
2017-12-10 01:22:45 +00:00
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);
2012-04-05 20:50:27 +01:00
#if USE_GMP
2017-12-10 01:22:45 +00:00
else if (IsBigIntTerm(hd))
dblp[i++] = Yap_gmp_to_float(hd);
2012-04-05 20:50:27 +01:00
#endif
2017-12-10 01:22:45 +00:00
else
return -1;
}
if (i == sz)
return sz;
t = TailOfTerm(t);
} while (TRUE);
2017-11-29 13:47:57 +00:00
}
2017-11-29 13:47:57 +00:00
X_API Term YAP_IntsToList(Int *dblp, size_t sz) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
Term t;
CELL *oldH;
BACKUP_H();
2017-12-10 01:22:45 +00:00
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;
2017-11-29 13:47:57 +00:00
}
2017-11-29 13:47:57 +00:00
X_API Int YAP_ListToInts(Term t, Int *dblp, size_t sz) {
2017-12-10 01:22:45 +00:00
size_t i = 0;
2017-12-10 01:22:45 +00:00
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);
2017-11-29 13:47:57 +00:00
}
2017-11-29 13:47:57 +00:00
X_API Term YAP_OpenList(int n) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
Term t;
BACKUP_H();
2017-12-10 01:22:45 +00:00
while (HR + 2 * n > ASP - 1024) {
if (!Yap_dogc(0, NULL PASS_REGS)) {
RECOVER_H();
return FALSE;
2017-11-29 13:47:57 +00:00
}
2017-12-10 01:22:45 +00:00
}
t = AbsPair(HR);
HR += 2 * n;
2017-12-10 01:22:45 +00:00
RECOVER_H();
return t;
2017-11-29 13:47:57 +00:00
}
2017-11-29 13:47:57 +00:00
X_API Term YAP_ExtendList(Term t0, Term inp) {
2017-12-10 01:22:45 +00:00
Term t;
CELL *ptr = RepPair(t0);
BACKUP_H();
2017-12-10 01:22:45 +00:00
ptr[0] = inp;
ptr[1] = AbsPair(ptr + 2);
t = AbsPair(ptr + 2);
2017-12-10 01:22:45 +00:00
RECOVER_H();
return t;
2017-11-29 13:47:57 +00:00
}
2017-11-29 13:47:57 +00:00
X_API int YAP_CloseList(Term t0, Term tail) {
2017-12-10 01:22:45 +00:00
CELL *ptr = RepPair(t0);
2017-12-10 01:22:45 +00:00
RESET_VARIABLE(ptr - 1);
if (!Yap_unify((Term)(ptr - 1), tail))
return FALSE;
return TRUE;
2017-11-29 13:47:57 +00:00
}
2017-11-29 13:47:57 +00:00
X_API int YAP_IsAttVar(Term t) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
t = Deref(t);
if (!IsVarTerm(t))
return FALSE;
return IsAttVar(VarOfTerm(t));
2017-11-29 13:47:57 +00:00
}
2015-04-13 13:15:30 +01:00
2017-11-29 13:47:57 +00:00
X_API Term YAP_AttsOfVar(Term t) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
attvar_record *attv;
2017-12-10 01:22:45 +00:00
t = Deref(t);
if (!IsVarTerm(t))
return TermNil;
if (!IsAttVar(VarOfTerm(t)))
return TermNil;
attv = RepAttVar(VarOfTerm(t));
return attv->Atts;
2017-11-29 13:47:57 +00:00
}
2009-04-23 03:42:15 +01:00
2017-11-29 13:47:57 +00:00
X_API int YAP_FileNoFromStream(Term t) {
2009-04-23 03:42:15 +01:00
2017-12-10 01:22:45 +00:00
t = Deref(t);
if (IsVarTerm(t))
return -1;
return Yap_StreamToFileNo(t);
2017-11-29 13:47:57 +00:00
}
2015-04-13 13:15:30 +01:00
2017-11-29 13:47:57 +00:00
X_API void *YAP_FileDescriptorFromStream(Term t) {
2017-12-10 01:22:45 +00:00
t = Deref(t);
if (IsVarTerm(t))
return NULL;
return Yap_FileDescriptorFromStream(t);
2017-11-29 13:47:57 +00:00
}
2017-11-29 13:47:57 +00:00
X_API void *YAP_Record(Term t) {
2017-12-10 01:22:45 +00:00
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;
2017-11-29 13:47:57 +00:00
}
2017-11-29 13:47:57 +00:00
X_API Term YAP_Recorded(void *handle) {
2017-12-10 01:22:45 +00:00
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;
2017-11-29 13:47:57 +00:00
}
2017-11-29 13:47:57 +00:00
X_API int YAP_Erase(void *handle) {
2017-12-10 01:22:45 +00:00
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;
2017-11-29 13:47:57 +00:00
}
2017-11-29 13:47:57 +00:00
X_API yhandle_t YAP_ArgsToSlots(int n) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
return Yap_NewSlots(n);
2017-11-29 13:47:57 +00:00
}
2017-11-29 13:47:57 +00:00
X_API void YAP_SlotsToArgs(int n, yhandle_t slot) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
CELL *ptr0 = Yap_AddressFromSlot(slot), *ptr1 = &ARG1;
while (n--) {
*ptr1++ = *ptr0++;
}
2017-11-29 13:47:57 +00:00
}
2010-08-31 04:25:56 +01:00
2017-11-29 13:47:57 +00:00
X_API void YAP_signal(int sig) { Yap_signal(sig); }
2010-08-31 04:25:56 +01:00
2017-11-29 13:47:57 +00:00
X_API int YAP_SetYAPFlag(Term flag, Term val) { return setYapFlag(flag, val); }
2011-02-10 00:01:19 +00:00
2017-11-29 13:47:57 +00:00
/* yhandle_t YAP_VarSlotToNumber(yhandle_t) */
X_API yhandle_t YAP_VarSlotToNumber(yhandle_t s) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
Term *t = (CELL *)Deref(Yap_GetFromSlot(s));
if (t < HR)
return t - H0;
return t - LCL0;
2017-11-29 13:47:57 +00:00
}
2011-02-10 00:01:19 +00:00
2017-11-29 13:47:57 +00:00
/* Term YAP_ModuleUser() */
X_API Term YAP_ModuleUser(void) { return MkAtomTerm(AtomUser); }
2017-11-29 13:47:57 +00:00
/* int YAP_PredicateHasClauses() */
X_API YAP_handle_t YAP_NumberOfClausesForPredicate(YAP_PredEntryPtr ape) {
2017-12-10 01:22:45 +00:00
PredEntry *pe = ape;
return pe->cs.p_code.NOfClauses;
2017-11-29 13:47:57 +00:00
}
2017-11-29 13:47:57 +00:00
X_API int YAP_MaxOpPriority(YAP_Atom at, Term module) {
2017-12-10 01:22:45 +00:00
AtomEntry *ae = RepAtom(at);
OpEntry *info;
WRITE_LOCK(ae->ARWLock);
info = Yap_GetOpPropForAModuleHavingALock(ae, module);
if (!info) {
2017-11-29 13:47:57 +00:00
WRITE_UNLOCK(ae->ARWLock);
2017-12-10 01:22:45 +00:00
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;
}
X_API int YAP_OpInfo(YAP_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);
2017-11-29 13:47:57 +00:00
if (!info) {
2017-12-10 01:22:45 +00:00
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);
2017-11-29 13:47:57 +00:00
} else {
2017-12-10 01:22:45 +00:00
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;
2017-11-29 13:47:57 +00:00
}
2017-12-10 01:22:45 +00:00
}
*yap_type = n;
WRITE_UNLOCK(ae->ARWLock);
return 1;
2017-11-29 13:47:57 +00:00
}
2017-11-29 13:47:57 +00:00
X_API int YAP_Argv(char ***argvp) {
2017-12-10 01:22:45 +00:00
if (argvp) {
*argvp = GLOBAL_argv;
}
return GLOBAL_argc;
2017-11-29 13:47:57 +00:00
}
2011-10-27 11:35:40 +01:00
2017-11-29 13:47:57 +00:00
X_API YAP_tag_t YAP_TagOfTerm(Term t) {
2017-12-10 01:22:45 +00:00
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;
2017-11-29 13:47:57 +00:00
}
2017-12-10 01:22:45 +00:00
}
2017-11-29 13:47:57 +00:00
}
2017-12-10 01:22:45 +00:00
return YAP_TAG_APPL;
}
2017-11-29 13:47:57 +00:00
}
2017-11-29 13:47:57 +00:00
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.
*/
X_API size_t YAP_UTF8_TextLength(Term t) {
2017-12-10 01:22:45 +00:00
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);
unsigned char *s = RepAtom(at)->UStrOfAE;
int32_t ch;
get_utf8(s, 1, &ch);
c = ch;
} else if (IsIntegerTerm(hd)) {
c = IntegerOfTerm(hd);
} else {
c = '\0';
}
sz += utf8proc_encode_char(c, dst);
t = TailOfTerm(t);
2017-11-29 13:47:57 +00:00
}
2017-12-10 01:22:45 +00:00
} else if (IsAtomTerm(t)) {
Atom at = AtomOfTerm(t);
char *s = RepAtom(at)->StrOfAE;
sz = strlen(s);
} else if (IsStringTerm(t)) {
sz = strlen(StringOfTerm(t));
}
return sz;
2017-11-29 13:47:57 +00:00
}
2017-11-29 13:47:57 +00:00
X_API Int YAP_ListLength(Term t) {
2017-12-10 01:22:45 +00:00
Term *aux;
2017-12-10 01:22:45 +00:00
Int n = Yap_SkipList(&t, &aux);
if (IsVarTerm(*aux))
2017-11-29 13:47:57 +00:00
return -1;
2017-12-10 01:22:45 +00:00
if (*aux == TermNil)
return n;
return -1;
2017-11-29 13:47:57 +00:00
}
2017-12-10 01:22:45 +00:00
X_API Int YAP_NumberVars(Term t, Int nbv) {
return Yap_NumberVars(t, nbv, FALSE);
}
2017-11-29 13:47:57 +00:00
X_API Term YAP_UnNumberVars(Term t) {
2017-12-10 01:22:45 +00:00
/* don't allow sharing of ground terms */
return Yap_UnNumberTerm(t, FALSE);
2017-11-29 13:47:57 +00:00
}
2012-02-03 16:31:49 +00:00
2017-11-29 13:47:57 +00:00
X_API int YAP_IsNumberedVariable(Term t) {
2017-12-10 01:22:45 +00:00
return IsApplTerm(t) && FunctorOfTerm(t) == FunctorDollarVar &&
IsIntegerTerm(ArgOfTerm(1, t));
2017-11-29 13:47:57 +00:00
}
2017-11-29 13:47:57 +00:00
X_API size_t YAP_ExportTerm(Term inp, char *buf, size_t len) {
2017-12-10 01:22:45 +00:00
if (!len)
return 0;
return Yap_ExportTerm(inp, buf, len, current_arity());
2017-11-29 13:47:57 +00:00
}
2017-11-29 13:47:57 +00:00
X_API size_t YAP_SizeOfExportedTerm(char *buf) {
2017-12-10 01:22:45 +00:00
if (!buf)
return 0;
return Yap_SizeOfExportedTerm(buf);
2017-11-29 13:47:57 +00:00
}
X_API Term YAP_ImportTerm(char *buf) { return Yap_ImportTerm(buf); }
X_API int YAP_RequiresExtraStack(size_t sz) {
2017-12-10 01:22:45 +00:00
CACHE_REGS
2017-12-10 01:22:45 +00:00
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;
2017-11-29 13:47:57 +00:00
}
BACKUP_H();
2017-12-10 01:22:45 +00:00
}
RECOVER_H();
return TRUE;
2017-11-29 13:47:57 +00:00
}
2013-10-04 13:22:00 +01:00
2017-11-29 13:47:57 +00:00
atom_t *TR_Atoms;
functor_t *TR_Functors;
size_t AtomTranslations, MaxAtomTranslations;
size_t FunctorTranslations, MaxFunctorTranslations;
X_API Int YAP_AtomToInt(YAP_Atom At) {
2017-12-10 01:22:45 +00:00
TranslationEntry *te = Yap_GetTranslationProp(At, 0);
if (te != NIL)
return te->Translation;
TR_Atoms[AtomTranslations] = At;
Yap_PutAtomTranslation(At, 0, AtomTranslations);
AtomTranslations++;
if (AtomTranslations == MaxAtomTranslations) {
atom_t *ot = TR_Atoms;
atom_t *nt = (atom_t *)malloc(sizeof(atom_t) * 2 * MaxAtomTranslations);
if (nt == NULL) {
Yap_Error(SYSTEM_ERROR_INTERNAL, MkAtomTerm(At),
"No more room for translations");
return -1;
}
2018-06-30 14:33:32 +01:00
memmove(nt, ot, sizeof(atom_t) * MaxAtomTranslations);
2017-12-10 01:22:45 +00:00
TR_Atoms = nt;
free(ot);
MaxAtomTranslations *= 2;
}
return AtomTranslations - 1;
2017-11-29 13:47:57 +00:00
}
X_API YAP_Atom YAP_IntToAtom(Int i) { return TR_Atoms[i]; }
X_API Int YAP_FunctorToInt(YAP_Functor f) {
2017-12-10 01:22:45 +00:00
YAP_Atom At = NameOfFunctor(f);
arity_t arity = ArityOfFunctor(f);
TranslationEntry *te = Yap_GetTranslationProp(At, arity);
if (te != NIL)
return te->Translation;
TR_Functors[FunctorTranslations] = f;
Yap_PutAtomTranslation(At, arity, FunctorTranslations);
FunctorTranslations++;
if (FunctorTranslations == MaxFunctorTranslations) {
functor_t *nt = (functor_t *)malloc(sizeof(functor_t) * 2 *
MaxFunctorTranslations),
*ot = TR_Functors;
if (nt == NULL) {
Yap_Error(SYSTEM_ERROR_INTERNAL, MkAtomTerm(At),
"No more room for translations");
return -1;
}
2018-06-30 14:33:32 +01:00
memmove(nt, ot, sizeof(functor_t) * MaxFunctorTranslations);
2017-12-10 01:22:45 +00:00
TR_Functors = nt;
free(ot);
MaxFunctorTranslations *= 2;
}
return FunctorTranslations - 1;
}
X_API void *YAP_foreign_stream(int sno) {
return GLOBAL_Stream[sno].u.private_data;
2017-11-29 13:47:57 +00:00
}
2017-11-29 13:47:57 +00:00
X_API YAP_Functor YAP_IntToFunctor(Int i) { return TR_Functors[i]; }
2015-08-07 22:57:53 +01:00
2017-11-29 13:47:57 +00:00
X_API void *YAP_shared(void) { return LOCAL_shared; }
2016-09-30 23:11:13 +01:00
2017-11-29 13:47:57 +00:00
X_API YAP_PredEntryPtr YAP_TopGoal(void) {
2017-12-10 01:22:45 +00:00
Functor f = Yap_MkFunctor(Yap_LookupAtom("yap_query"), 3);
Term tmod = MkAtomTerm(Yap_LookupAtom("yapi"));
PredEntry *p = RepPredProp(Yap_GetPredPropByFunc(f, tmod));
return p;
2017-11-29 13:47:57 +00:00
}
2017-11-29 13:47:57 +00:00
void yap_init(void) {}
2016-07-31 05:10:39 +01:00
2015-01-26 04:02:46 +00:00
#endif // C_INTERFACE_C
2015-04-13 13:15:30 +01:00
2017-11-29 13:47:57 +00:00
/**
@}
*/