From 3061844c950349aa7f37e28ae01f8fcf7b872460 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Sun, 10 Dec 2017 01:22:45 +0000 Subject: [PATCH] Fixes, mostly to the biting o --- C/c_interface.c | 4390 ++++++++++++++++++++----------------------- C/load_dl.c | 25 +- C/qlyr.c | 4 +- C/save.c | 48 +- C/stdpreds.c | 8 +- C/text.c | 2 +- C/yap-args.c | 1624 ++++++++++------ CMakeLists.txt | 7 +- H/Yap.h | 3 +- H/YapGFlagInfo.h | 2 +- H/YapTerm.h | 169 -- H/Yapproto.h | 14 +- config.h.cmake | 16 +- os/iopreds.c | 8 +- os/iopreds.h | 1 - os/sysbits.c | 339 +--- pl/CMakeLists.txt | 6 +- pl/arith.yap | 3 +- pl/boot.yap | 8 +- pl/init.yap | 1 + pl/load_foreign.yap | 2 +- pl/meta.yap | 3 + 22 files changed, 3137 insertions(+), 3546 deletions(-) delete mode 100644 H/YapTerm.h diff --git a/C/c_interface.c b/C/c_interface.c index 0ea3a2309..805c3257d 100755 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -20,7 +20,7 @@ * @file c_interface.c * * @addtogroup ChYInterface -*/ + */ #ifndef C_INTERFACE_C @@ -75,18 +75,17 @@ typedef void *atom_t; typedef void *functor_t; typedef enum { - FRG_FIRST_CALL = 0, /* Initial call */ - FRG_CUTTED = 1, /* Context was cutted */ - FRG_REDO = 2 /* Normal redo */ + FRG_FIRST_CALL = 0, /* Initial call */ + FRG_CUTTED = 1, /* Context was cutted */ + FRG_REDO = 2 /* Normal redo */ } frg_code; struct foreign_context { - uintptr_t context; /* context value */ - frg_code control; /* FRG_* action */ - struct PL_local_data *engine; /* invoking engine */ + uintptr_t context; /* context value */ + frg_code control; /* FRG_* action */ + struct PL_local_data *engine; /* invoking engine */ }; - X_API bool python_in_python; X_API int YAP_Reset(yap_reset_t mode); @@ -141,7 +140,8 @@ X_API yhandle_t YAP_CurrentSlot(void); /// @brief allocate n empty new slots /// -/// Return a handle to the system's default slo t. iX_API yhandle_t YAP_NewSlots(int NumberOfSlots); +/// Return a handle to the system's default slo t. +/// iX_API yhandle_t YAP_NewSlots(int NumberOfSlots); /// @brief allocate n empty new slots /// @@ -190,67 +190,67 @@ X_API void YAP_SlotsToArgs(int HowMany, YAP_handle_t slot); /// @} static arity_t current_arity(void) { - CACHE_REGS - if (P && PREVOP(P, Osbpp)->opc == Yap_opcode(_call_usercpred)) { - return PREVOP(P, Osbpp)->y_u.Osbpp.p->ArityOfPE; - } else { - return 0; - } + CACHE_REGS + if (P && PREVOP(P, Osbpp)->opc == Yap_opcode(_call_usercpred)) { + return PREVOP(P, Osbpp)->y_u.Osbpp.p->ArityOfPE; + } else { + return 0; + } } static int doexpand(UInt sz) { - CACHE_REGS - UInt arity; + 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; + if (P && PREVOP(P, Osbpp)->opc == Yap_opcode(_call_usercpred)) { + arity = PREVOP(P, Osbpp)->y_u.Osbpp.p->ArityOfPE; + } else { + arity = 0; + } + if (!Yap_gcl(sz, arity, ENV, gc_P(P, CP))) { + return FALSE; + } + return TRUE; } X_API YAP_Term YAP_A(int i) { - CACHE_REGS - return (Deref(XREGS[i])); + CACHE_REGS + return (Deref(XREGS[i])); } X_API YAP_Bool YAP_IsIntTerm(YAP_Term t) { return IsIntegerTerm(t); } X_API YAP_Bool YAP_IsNumberTerm(YAP_Term t) { - return IsIntegerTerm(t) || IsIntTerm(t) || IsFloatTerm(t) || IsBigIntTerm(t); + return IsIntegerTerm(t) || IsIntTerm(t) || IsFloatTerm(t) || IsBigIntTerm(t); } X_API YAP_Bool YAP_IsLongIntTerm(YAP_Term t) { return IsLongIntTerm(t); } X_API YAP_Bool YAP_IsBigNumTerm(YAP_Term t) { #if USE_GMP - CELL *pt; - if (IsVarTerm(t)) - return FALSE; - if (!IsBigIntTerm(t)) - return FALSE; - pt = RepAppl(t); - return pt[1] == BIG_INT; -#else + CELL *pt; + if (IsVarTerm(t)) return FALSE; + if (!IsBigIntTerm(t)) + return FALSE; + pt = RepAppl(t); + return pt[1] == BIG_INT; +#else + return FALSE; #endif } X_API YAP_Bool YAP_IsRationalTerm(YAP_Term t) { #if USE_GMP - CELL *pt; - if (IsVarTerm(t)) - return FALSE; - if (!IsBigIntTerm(t)) - return FALSE; - pt = RepAppl(t); - return pt[1] == BIG_RATIONAL; -#else + CELL *pt; + if (IsVarTerm(t)) return FALSE; + if (!IsBigIntTerm(t)) + return FALSE; + pt = RepAppl(t); + return pt[1] == BIG_RATIONAL; +#else + return FALSE; #endif } @@ -269,348 +269,348 @@ X_API YAP_Bool YAP_IsAtomTerm(Term t) { return (IsAtomTerm(t)); } X_API YAP_Bool YAP_IsPairTerm(Term t) { return (IsPairTerm(t)); } X_API YAP_Bool YAP_IsApplTerm(Term t) { - return IsApplTerm(t) && !IsExtensionFunctor(FunctorOfTerm(t)); + return IsApplTerm(t) && !IsExtensionFunctor(FunctorOfTerm(t)); } X_API YAP_Bool YAP_IsCompoundTerm(Term t) { - return (IsApplTerm(t) && !IsExtensionFunctor(FunctorOfTerm(t))) || - IsPairTerm(t); + return (IsApplTerm(t) && !IsExtensionFunctor(FunctorOfTerm(t))) || + IsPairTerm(t); } X_API Term YAP_MkIntTerm(Int n) { - CACHE_REGS - Term I; - BACKUP_H(); + CACHE_REGS + Term I; + BACKUP_H(); - I = MkIntegerTerm(n); - RECOVER_H(); - return I; + I = MkIntegerTerm(n); + RECOVER_H(); + return I; } X_API Term YAP_MkStringTerm(const char *n) { - CACHE_REGS - Term I; - BACKUP_H(); + CACHE_REGS + Term I; + BACKUP_H(); - I = MkStringTerm(n); - RECOVER_H(); - return I; + I = MkStringTerm(n); + RECOVER_H(); + return I; } X_API Term YAP_MkUnsignedStringTerm(const unsigned char *n) { - CACHE_REGS - Term I; - BACKUP_H(); + CACHE_REGS + Term I; + BACKUP_H(); - I = MkUStringTerm(n); - RECOVER_H(); - return I; + 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) { - return UStringOfTerm(t); + return UStringOfTerm(t); } X_API Int YAP_IntOfTerm(Term t) { - if (!IsApplTerm(t)) - return IntOfTerm(t); - else { - return LongIntOfTerm(t); - } + if (!IsApplTerm(t)) + return IntOfTerm(t); + else { + return LongIntOfTerm(t); + } } X_API Term YAP_MkBigNumTerm(void *big) { #if USE_GMP - Term I; - BACKUP_H(); - I = Yap_MkBigIntTerm(big); - RECOVER_H(); - return I; + Term I; + BACKUP_H(); + I = Yap_MkBigIntTerm(big); + RECOVER_H(); + return I; #else - return TermNil; + return TermNil; #endif /* USE_GMP */ } X_API YAP_Bool YAP_BigNumOfTerm(Term t, void *b) { #if USE_GMP - MP_INT *bz = (MP_INT *) b; - if (IsVarTerm(t)) - return FALSE; - if (!IsBigIntTerm(t)) - return FALSE; - mpz_set(bz, Yap_BigIntOfTerm(t)); - return TRUE; -#else + MP_INT *bz = (MP_INT *)b; + if (IsVarTerm(t)) return FALSE; + if (!IsBigIntTerm(t)) + return FALSE; + mpz_set(bz, Yap_BigIntOfTerm(t)); + return TRUE; +#else + return FALSE; #endif /* USE_GMP */ } X_API Term YAP_MkRationalTerm(void *big) { #if USE_GMP - Term I; - BACKUP_H(); - I = Yap_MkBigRatTerm((MP_RAT *) big); - RECOVER_H(); - return I; + Term I; + BACKUP_H(); + I = Yap_MkBigRatTerm((MP_RAT *)big); + RECOVER_H(); + return I; #else - return TermNil; + return TermNil; #endif /* USE_GMP */ } X_API YAP_Bool YAP_RationalOfTerm(Term t, void *b) { #if USE_GMP - MP_RAT *br = (MP_RAT *) b; - if (IsVarTerm(t)) - return FALSE; - if (!IsBigIntTerm(t)) - return FALSE; - mpq_set(br, Yap_BigRatOfTerm(t)); - return TRUE; -#else + MP_RAT *br = (MP_RAT *)b; + if (IsVarTerm(t)) return FALSE; + if (!IsBigIntTerm(t)) + return FALSE; + mpq_set(br, Yap_BigRatOfTerm(t)); + return TRUE; +#else + return FALSE; #endif /* USE_GMP */ } X_API Term YAP_MkBlobTerm(unsigned int sz) { - CACHE_REGS - Term I; - MP_INT *dst; - BACKUP_H(); + 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; - } + 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(); + } + 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; + return I; } X_API void *YAP_BlobOfTerm(Term t) { - MP_INT *src; + MP_INT *src; - if (IsVarTerm(t)) - return NULL; - if (!IsBigIntTerm(t)) - return NULL; - src = (MP_INT *) (RepAppl(t) + 2); - return (void *) (src + 1); + if (IsVarTerm(t)) + return NULL; + if (!IsBigIntTerm(t)) + return NULL; + src = (MP_INT *)(RepAppl(t) + 2); + return (void *)(src + 1); } X_API Term YAP_MkFloatTerm(double n) { - CACHE_REGS - Term t; - BACKUP_H(); + CACHE_REGS + Term t; + BACKUP_H(); - t = MkFloatTerm(n); + t = MkFloatTerm(n); - RECOVER_H(); - return t; + RECOVER_H(); + return t; } X_API YAP_Float YAP_FloatOfTerm(YAP_Term t) { return (FloatOfTerm(t)); } X_API Term YAP_MkAtomTerm(YAP_Atom n) { - Term t; + Term t; - t = MkAtomTerm(n); - return t; + t = MkAtomTerm(n); + return t; } X_API YAP_Atom YAP_AtomOfTerm(Term t) { return (AtomOfTerm(t)); } X_API bool YAP_IsWideAtom(YAP_Atom a) { - 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; + 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; } X_API const char *YAP_AtomName(YAP_Atom a) { - const char *o; + const char *o; - o = AtomName(a); - return (o); + o = AtomName(a); + return (o); } X_API const wchar_t *YAP_WideAtomName(YAP_Atom a) { - 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; + 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; } X_API YAP_Atom YAP_LookupAtom(const char *c) { - CACHE_REGS - Atom a; + 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; - } + while (TRUE) { + a = Yap_LookupAtom(c); + if (a == NIL || Yap_get_signal(YAP_CDOVF_SIGNAL)) { + if (!Yap_locked_growheap(FALSE, 0, NULL)) { + Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "YAP failed to grow heap: %s", + LOCAL_ErrorMessage); + } + } else { + return a; } - return NULL; + } + return NULL; } X_API YAP_Atom YAP_LookupWideAtom(const wchar_t *c) { - CACHE_REGS - Atom a; + 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; - } + 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; } - return NULL; + } + return NULL; } X_API YAP_Atom YAP_FullLookupAtom(const char *c) { - CACHE_REGS - Atom at; + 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; - } + while (TRUE) { + at = Yap_FullLookupAtom(c); + if (at == NIL || Yap_get_signal(YAP_CDOVF_SIGNAL)) { + if (!Yap_locked_growheap(FALSE, 0, NULL)) { + Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "YAP failed to grow heap: %s", + LOCAL_ErrorMessage); + } + } else { + return at; } - return NULL; + } + return NULL; } X_API size_t YAP_AtomNameLength(YAP_Atom at) { - if (IsBlob(at)) { - return RepAtom(at)->rep.blob->length; - } - unsigned char *c = RepAtom(at)->UStrOfAE; + if (IsBlob(at)) { + return RepAtom(at)->rep.blob->length; + } + unsigned char *c = RepAtom(at)->UStrOfAE; - return strlen_utf8(c); + return strlen_utf8(c); } X_API Term YAP_MkVarTerm(void) { - CACHE_REGS - CELL t; - BACKUP_H(); + CACHE_REGS + CELL t; + BACKUP_H(); - t = MkVarTerm(); + t = MkVarTerm(); - RECOVER_H(); - return t; + RECOVER_H(); + return t; } X_API Term YAP_MkPairTerm(Term t1, Term t2) { - CACHE_REGS - Term t; - BACKUP_H(); + CACHE_REGS + Term t; + BACKUP_H(); - while (HR > ASP - 1024) { - Int sl1 = Yap_InitSlot(t1); - Int sl2 = Yap_InitSlot(t2); - RECOVER_H(); - if (!Yap_dogc(0, NULL PASS_REGS)) { - return TermNil; - } - BACKUP_H(); - t1 = Yap_GetFromSlot(sl1); - t2 = Yap_GetFromSlot(sl2); - Yap_RecoverSlots(2, sl2); - } - t = MkPairTerm(t1, t2); + while (HR > ASP - 1024) { + Int sl1 = Yap_InitSlot(t1); + Int sl2 = Yap_InitSlot(t2); RECOVER_H(); - return t; + if (!Yap_dogc(0, NULL PASS_REGS)) { + return TermNil; + } + BACKUP_H(); + t1 = Yap_GetFromSlot(sl1); + t2 = Yap_GetFromSlot(sl2); + Yap_RecoverSlots(2, sl2); + } + t = MkPairTerm(t1, t2); + RECOVER_H(); + return t; } X_API Term YAP_MkListFromTerms(Term *ta, Int sz) { - CACHE_REGS - Term t; - CELL *h; - if (sz == 0) - return TermNil; - BACKUP_H(); - while (HR + sz * 2 > ASP - 1024) { - Int sl1 = Yap_InitSlot((CELL) ta); - RECOVER_H(); - if (!Yap_dogc(0, NULL PASS_REGS)) { - return TermNil; - } - BACKUP_H(); - ta = (CELL *) Yap_GetFromSlot(sl1); - Yap_RecoverSlots(1, sl1); - } - h = HR; - t = AbsPair(h); - while (sz--) { - Term ti = *ta++; - if (IsVarTerm(ti)) { - RESET_VARIABLE(h); - Yap_unify(ti, h[0]); - } else { - h[0] = ti; - } - h[1] = AbsPair(h + 2); - h += 2; - } - h[-1] = TermNil; - HR = h; + 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(); - return t; + if (!Yap_dogc(0, NULL PASS_REGS)) { + return TermNil; + } + BACKUP_H(); + ta = (CELL *)Yap_GetFromSlot(sl1); + Yap_RecoverSlots(1, sl1); + } + h = HR; + t = AbsPair(h); + while (sz--) { + Term ti = *ta++; + if (IsVarTerm(ti)) { + RESET_VARIABLE(h); + Yap_unify(ti, h[0]); + } else { + h[0] = ti; + } + h[1] = AbsPair(h + 2); + h += 2; + } + h[-1] = TermNil; + HR = h; + RECOVER_H(); + return t; } X_API Term YAP_MkNewPairTerm() { - CACHE_REGS - Term t; - BACKUP_H(); + CACHE_REGS + Term t; + BACKUP_H(); - if (HR > ASP - 1024) - t = TermNil; - else - t = Yap_MkNewPairTerm(); + if (HR > ASP - 1024) + t = TermNil; + else + t = Yap_MkNewPairTerm(); - RECOVER_H(); - return t; + RECOVER_H(); + return t; } X_API Term YAP_HeadOfTerm(Term t) { return (HeadOfTerm(t)); } @@ -618,59 +618,59 @@ X_API Term YAP_HeadOfTerm(Term t) { return (HeadOfTerm(t)); } X_API Term YAP_TailOfTerm(Term t) { return (TailOfTerm(t)); } X_API Int YAP_SkipList(Term *l, Term **tailp) { - return Yap_SkipList(l, tailp); - Int length = 0; - Term *s; /* slow */ - Term v; /* temporary */ + return Yap_SkipList(l, tailp); + Int length = 0; + Term *s; /* slow */ + Term v; /* temporary */ - do_derefa(v, l, derefa_unk, derefa_nonvar); - s = l; + 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; + 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; + return length; } X_API Term YAP_MkApplTerm(YAP_Functor f, UInt arity, Term args[]) { - CACHE_REGS - Term t; - BACKUP_H(); + CACHE_REGS + Term t; + BACKUP_H(); - if (HR + arity > ASP - 1024) - t = TermNil; - else - t = Yap_MkApplTerm(f, arity, args); + if (HR + arity > ASP - 1024) + t = TermNil; + else + t = Yap_MkApplTerm(f, arity, args); - RECOVER_H(); - return t; + RECOVER_H(); + return t; } X_API Term YAP_MkNewApplTerm(YAP_Functor f, UInt arity) { - CACHE_REGS - Term t; - BACKUP_H(); + CACHE_REGS + Term t; + BACKUP_H(); - if (HR + arity > ASP - 1024) - t = TermNil; - else - t = Yap_MkNewApplTerm(f, arity); + if (HR + arity > ASP - 1024) + t = TermNil; + else + t = Yap_MkNewApplTerm(f, arity); - RECOVER_H(); - return t; + RECOVER_H(); + return t; } X_API YAP_Functor YAP_FunctorOfTerm(Term t) { return (FunctorOfTerm(t)); } @@ -678,188 +678,190 @@ X_API YAP_Functor YAP_FunctorOfTerm(Term t) { return (FunctorOfTerm(t)); } X_API Term YAP_ArgOfTerm(UInt n, Term t) { return (ArgOfTerm(n, t)); } X_API Term *YAP_ArgsOfTerm(Term t) { - if (IsApplTerm(t)) - return RepAppl(t) + 1; - else if (IsPairTerm(t)) - return RepPair(t); - return NULL; + if (IsApplTerm(t)) + return RepAppl(t) + 1; + else if (IsPairTerm(t)) + return RepPair(t); + return NULL; } -X_API YAP_Functor YAP_MkFunctor(YAP_Atom a, UInt n) { return (Yap_MkFunctor(a, n)); } +X_API YAP_Functor YAP_MkFunctor(YAP_Atom a, UInt n) { + return (Yap_MkFunctor(a, n)); +} X_API YAP_Atom YAP_NameOfFunctor(YAP_Functor f) { return (NameOfFunctor(f)); } X_API UInt YAP_ArityOfFunctor(YAP_Functor f) { return (ArityOfFunctor(f)); } X_API void *YAP_ExtraSpaceCut(void) { - CACHE_REGS - void *ptr; - BACKUP_B(); + CACHE_REGS + void *ptr; + BACKUP_B(); - ptr = (void *) (((CELL *) (Yap_REGS.CUT_C_TOP)) - - (((yamop *) Yap_REGS.CUT_C_TOP->try_userc_cut_yamop) - ->y_u.OtapFs.extra)); + ptr = (void *)(((CELL *)(Yap_REGS.CUT_C_TOP)) - + (((yamop *)Yap_REGS.CUT_C_TOP->try_userc_cut_yamop) + ->y_u.OtapFs.extra)); - RECOVER_B(); - return (ptr); + RECOVER_B(); + return (ptr); } X_API void *YAP_ExtraSpace(void) { - CACHE_REGS - void *ptr; - BACKUP_B(); - BACKUP_H(); + CACHE_REGS + void *ptr; + BACKUP_B(); + BACKUP_H(); - /* find a pointer to extra space allocable */ - ptr = (void *) ((CELL *) (B + 1) + P->y_u.OtapFs.s); - B->cp_h = HR; + /* find a pointer to extra space allocable */ + ptr = (void *)((CELL *)(B + 1) + P->y_u.OtapFs.s); + B->cp_h = HR; - RECOVER_H(); - RECOVER_B(); - return (ptr); + RECOVER_H(); + RECOVER_B(); + return (ptr); } X_API void YAP_cut_up(void) { - CACHE_REGS - BACKUP_B(); - { - while (POP_CHOICE_POINT(B->cp_b)) { - POP_EXECUTE(); - } - } - /* This is complicated: make sure we can restore the ASP - pointer back to where cut_up called it. Slots depend on it. */ - if (ENV > B->cp_env) { - ASP = B->cp_env; + CACHE_REGS + BACKUP_B(); + { + while (POP_CHOICE_POINT(B->cp_b)) { + POP_EXECUTE(); } + } + /* This is complicated: make sure we can restore the ASP + pointer back to where cut_up called it. Slots depend on it. */ + if (ENV > B->cp_env) { + ASP = B->cp_env; + } #ifdef YAPOR - { - choiceptr cut_pt; + { + choiceptr cut_pt; - cut_pt = B->cp_b; - /* make sure we prune C-choicepoints */ - if (POP_CHOICE_POINT(B->cp_b)) { - POP_EXECUTE(); - } - CUT_prune_to(cut_pt); - Yap_TrimTrail(); - B = cut_pt; - } -#else + cut_pt = B->cp_b; /* make sure we prune C-choicepoints */ if (POP_CHOICE_POINT(B->cp_b)) { - POP_EXECUTE(); + POP_EXECUTE(); } + CUT_prune_to(cut_pt); Yap_TrimTrail(); - B = B->cp_b; /* cut_fail */ + B = cut_pt; + } +#else + /* make sure we prune C-choicepoints */ + if (POP_CHOICE_POINT(B->cp_b)) { + POP_EXECUTE(); + } + Yap_TrimTrail(); + B = B->cp_b; /* cut_fail */ #endif - HB = B->cp_h; /* cut_fail */ - RECOVER_B(); + HB = B->cp_h; /* cut_fail */ + RECOVER_B(); } X_API bool YAP_Unify(Term t1, Term t2) { - Int out; - BACKUP_MACHINE_REGS(); + Int out; + BACKUP_MACHINE_REGS(); - out = Yap_unify(t1, t2); + out = Yap_unify(t1, t2); - RECOVER_MACHINE_REGS(); - return out; + RECOVER_MACHINE_REGS(); + return out; } X_API int YAP_Unifiable(Term t1, Term t2) { - int out; - BACKUP_MACHINE_REGS(); + int out; + BACKUP_MACHINE_REGS(); - out = Yap_Unifiable(t1, t2); + out = Yap_Unifiable(t1, t2); - RECOVER_MACHINE_REGS(); - return out; + RECOVER_MACHINE_REGS(); + return out; } /* == */ X_API int YAP_ExactlyEqual(Term t1, Term t2) { - int out; - BACKUP_MACHINE_REGS(); + int out; + BACKUP_MACHINE_REGS(); - out = Yap_eq(t1, t2); + out = Yap_eq(t1, t2); - RECOVER_MACHINE_REGS(); - return out; + RECOVER_MACHINE_REGS(); + return out; } /* =@= */ X_API int YAP_Variant(Term t1, Term t2) { - int out; - BACKUP_MACHINE_REGS(); + int out; + BACKUP_MACHINE_REGS(); - out = Yap_Variant(Deref(t1), Deref(t2)); + out = Yap_Variant(Deref(t1), Deref(t2)); - RECOVER_MACHINE_REGS(); - return out; + RECOVER_MACHINE_REGS(); + return out; } /* =@= */ X_API Int YAP_TermHash(Term t, Int sz, Int depth, int variant) { - Int out; + Int out; - BACKUP_MACHINE_REGS(); + BACKUP_MACHINE_REGS(); - out = Yap_TermHash(t, sz, depth, variant); + out = Yap_TermHash(t, sz, depth, variant); - RECOVER_MACHINE_REGS(); - return out; + RECOVER_MACHINE_REGS(); + return out; } X_API Int YAP_CurrentSlot(void) { - CACHE_REGS - return Yap_CurrentSlot(); + CACHE_REGS + return Yap_CurrentSlot(); } X_API Int YAP_NewSlots(int n) { - CACHE_REGS - return Yap_NewSlots(n); + CACHE_REGS + return Yap_NewSlots(n); } X_API Int YAP_InitSlot(Term t) { - CACHE_REGS - return Yap_InitSlot(t); + CACHE_REGS + return Yap_InitSlot(t); } X_API int YAP_RecoverSlots(int n, Int top_slot) { - CACHE_REGS - return Yap_RecoverSlots(n, top_slot); + CACHE_REGS + return Yap_RecoverSlots(n, top_slot); } X_API Term YAP_GetFromSlot(Int slot) { - CACHE_REGS - return Yap_GetFromSlot(slot); + CACHE_REGS + return Yap_GetFromSlot(slot); } X_API Term *YAP_AddressFromSlot(Int slot) { - CACHE_REGS - return Yap_AddressFromSlot(slot); + CACHE_REGS + return Yap_AddressFromSlot(slot); } X_API Term *YAP_AddressOfTermInSlot(Int slot) { - CACHE_REGS - Term *b = Yap_AddressFromSlot(slot); - Term a = *b; - restart: - if (!IsVarTerm(a)) { - return (b); - } else if (a == (CELL) b) { - return (b); - } else { - b = (CELL *) a; - a = *b; - goto restart; - } + CACHE_REGS + Term *b = Yap_AddressFromSlot(slot); + Term a = *b; +restart: + if (!IsVarTerm(a)) { + return (b); + } else if (a == (CELL)b) { + return (b); + } else { + b = (CELL *)a; + a = *b; + goto restart; + } } X_API void YAP_PutInSlot(Int slot, Term t) { - CACHE_REGS - Yap_PutInSlot(slot, t); + CACHE_REGS + Yap_PutInSlot(slot, t); } typedef Int (*CPredicate0)(void); @@ -895,83 +897,73 @@ typedef Int (*CPredicate10)(yhandle_t, yhandle_t, yhandle_t, yhandle_t, typedef Int (*CPredicateV)(yhandle_t, yhandle_t, struct foreign_context *); static Int execute_cargs(PredEntry *pe, CPredicate exec_code USES_REGS) { - 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; + 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; + 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 *); @@ -1013,154 +1005,154 @@ typedef uintptr_t (*CBPredicate10)(yhandle_t, yhandle_t, yhandle_t, yhandle_t, static uintptr_t execute_cargs_back(PredEntry *pe, CPredicate exec_code, struct foreign_context *ctx USES_REGS) { - switch (pe->ArityOfPE) { - case 0: { - CBPredicate0 code0 = (CBPredicate0) exec_code; - return code0(ctx); - } - case 1: { - CBPredicate1 code1 = (CBPredicate1) exec_code; - yhandle_t a1 = Yap_InitSlots(1, &B->cp_a1); - return code1(a1, ctx); - } - case 2: { - CBPredicate2 code2 = (CBPredicate2) exec_code; - yhandle_t a1 = Yap_InitSlots(2, &B->cp_a1); - return code2(a1, a1 + 1, ctx); - } - case 3: { - CBPredicate3 code3 = (CBPredicate3) exec_code; - yhandle_t a1 = Yap_InitSlots(3, &B->cp_a1); - return code3(a1, a1 + 1, a1 + 2, ctx); - } - case 4: { - CBPredicate4 code4 = (CBPredicate4) exec_code; - yhandle_t a1 = Yap_InitSlots(4, &B->cp_a1); - return code4(a1, a1 + 1, a1 + 2, a1 + 3, ctx); - } - case 5: { - CBPredicate5 code5 = (CBPredicate5) exec_code; - yhandle_t a1 = Yap_InitSlots(5, &B->cp_a1); - return code5(a1, a1 + 1, a1 + 2, a1 + 3, a1 + 4, ctx); - } - case 6: { - CBPredicate6 code6 = (CBPredicate6) exec_code; - yhandle_t a1 = Yap_InitSlots(6, &B->cp_a1); - return code6(a1, a1 + 1, a1 + 2, a1 + 3, a1 + 4, a1 + 5, ctx); - } - case 7: { - CBPredicate7 code7 = (CBPredicate7) exec_code; - yhandle_t a1 = Yap_InitSlots(7, &B->cp_a1); - return code7(a1, a1 + 1, a1 + 2, a1 + 3, a1 + 4, a1 + 5, a1 + 6, ctx); - } - case 8: { - CBPredicate8 code8 = (CBPredicate8) exec_code; - yhandle_t a1 = Yap_InitSlots(8, &B->cp_a1); - return code8(a1, a1 + 1, a1 + 2, a1 + 3, a1 + 4, a1 + 5, a1 + 6, a1 + 7, - ctx); - } - case 9: { - CBPredicate9 code9 = (CBPredicate9) exec_code; - yhandle_t a1 = Yap_InitSlots(9, &B->cp_a1); - return code9(a1, a1 + 1, a1 + 2, a1 + 3, a1 + 4, a1 + 5, a1 + 6, a1 + 7, - a1 + 8, ctx); - } - case 10: { - CBPredicate10 code10 = (CBPredicate10) exec_code; - yhandle_t a1 = Yap_InitSlots(10, &B->cp_a1); - return code10(a1, a1 + 1, a1 + 2, a1 + 3, a1 + 4, a1 + 5, a1 + 6, a1 + 7, - a1 + 8, a1 + 9, ctx); - } - default: - YAP_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "YAP only supports SWI C-call with arity =< 10"); - return (FALSE); - } + switch (pe->ArityOfPE) { + case 0: { + CBPredicate0 code0 = (CBPredicate0)exec_code; + return code0(ctx); + } + case 1: { + CBPredicate1 code1 = (CBPredicate1)exec_code; + yhandle_t a1 = Yap_InitSlots(1, &B->cp_a1); + return code1(a1, ctx); + } + case 2: { + CBPredicate2 code2 = (CBPredicate2)exec_code; + yhandle_t a1 = Yap_InitSlots(2, &B->cp_a1); + return code2(a1, a1 + 1, ctx); + } + case 3: { + CBPredicate3 code3 = (CBPredicate3)exec_code; + yhandle_t a1 = Yap_InitSlots(3, &B->cp_a1); + return code3(a1, a1 + 1, a1 + 2, ctx); + } + case 4: { + CBPredicate4 code4 = (CBPredicate4)exec_code; + yhandle_t a1 = Yap_InitSlots(4, &B->cp_a1); + return code4(a1, a1 + 1, a1 + 2, a1 + 3, ctx); + } + case 5: { + CBPredicate5 code5 = (CBPredicate5)exec_code; + yhandle_t a1 = Yap_InitSlots(5, &B->cp_a1); + return code5(a1, a1 + 1, a1 + 2, a1 + 3, a1 + 4, ctx); + } + case 6: { + CBPredicate6 code6 = (CBPredicate6)exec_code; + yhandle_t a1 = Yap_InitSlots(6, &B->cp_a1); + return code6(a1, a1 + 1, a1 + 2, a1 + 3, a1 + 4, a1 + 5, ctx); + } + case 7: { + CBPredicate7 code7 = (CBPredicate7)exec_code; + yhandle_t a1 = Yap_InitSlots(7, &B->cp_a1); + return code7(a1, a1 + 1, a1 + 2, a1 + 3, a1 + 4, a1 + 5, a1 + 6, ctx); + } + case 8: { + CBPredicate8 code8 = (CBPredicate8)exec_code; + yhandle_t a1 = Yap_InitSlots(8, &B->cp_a1); + return code8(a1, a1 + 1, a1 + 2, a1 + 3, a1 + 4, a1 + 5, a1 + 6, a1 + 7, + ctx); + } + case 9: { + CBPredicate9 code9 = (CBPredicate9)exec_code; + yhandle_t a1 = Yap_InitSlots(9, &B->cp_a1); + return code9(a1, a1 + 1, a1 + 2, a1 + 3, a1 + 4, a1 + 5, a1 + 6, a1 + 7, + a1 + 8, ctx); + } + case 10: { + CBPredicate10 code10 = (CBPredicate10)exec_code; + yhandle_t a1 = Yap_InitSlots(10, &B->cp_a1); + return code10(a1, a1 + 1, a1 + 2, a1 + 3, a1 + 4, a1 + 5, a1 + 6, a1 + 7, + a1 + 8, a1 + 9, ctx); + } + default: + YAP_Error(SYSTEM_ERROR_INTERNAL, TermNil, + "YAP only supports SWI C-call with arity =< 10"); + return (FALSE); + } } static uintptr_t complete_fail(choiceptr ptr, int has_cp USES_REGS) { - // this case is easy, jut be sure to throw everything - // after the old B; - while (B && B->cp_b && B->cp_b <= ptr) { - B = B->cp_b; - } - if (has_cp) - return do_cut(FALSE); - return FALSE; + // 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; } static uintptr_t complete_exit(choiceptr ptr, int has_cp, int cut_all USES_REGS) { - // the user often leaves open frames, especially in forward execution - while (B && (!ptr || B < ptr)) { - if (cut_all || B->cp_ap == NOCODE) { /* separator */ - do_cut(TRUE); // pushes B up - continue; - } else if (B->cp_ap->opc == RETRY_USERC_OPCODE && B->cp_b == ptr) { - // started the current choicepoint, I hope - return do_cut(TRUE); - } else - break; // oops, there is something else + // the user often leaves open frames, especially in forward execution + while (B && (!ptr || B < ptr)) { + if (cut_all || B->cp_ap == NOCODE) { /* separator */ + do_cut(TRUE); // pushes B up + continue; + } else if (B->cp_ap->opc == RETRY_USERC_OPCODE && B->cp_b == ptr) { + // started the current choicepoint, I hope + return do_cut(TRUE); + } else + break; // oops, there is something else + } + if (!ptr || B < ptr) { + // we're still not there yet + choiceptr new = B; + while (new &&new < ptr) { + if (new->cp_ap == NOCODE) /* separator */ + new->cp_ap = FAILCODE; // there are choice-points above but at least, + // these won't harm innocent code + else if (new->cp_ap->opc == RETRY_USERC_OPCODE && new->cp_b == ptr) { + // I can't cut, but I can tag it as done + new->cp_ap = FAILCODE; // there are choice-points above but at least, + // these won't harm innocent code + } + new = new->cp_b; } - if (!ptr || B < ptr) { - // we're still not there yet - choiceptr new = B; - while (new && new < ptr) { - if (new->cp_ap == NOCODE) /* separator */ - new->cp_ap = FAILCODE; // there are choice-points above but at least, - // these won't harm innocent code - else if (new->cp_ap->opc == RETRY_USERC_OPCODE && new->cp_b == ptr) { - // I can't cut, but I can tag it as done - new->cp_ap = FAILCODE; // there are choice-points above but at least, - // these won't harm innocent code - } - new = new->cp_b; - } + } + if (has_cp) { + if (B == ptr) { + return do_cut(TRUE); + } else { + ptr->cp_ap = FAILCODE; } - if (has_cp) { - if (B == ptr) { - return do_cut(TRUE); - } else { - ptr->cp_ap = FAILCODE; - } - } - return TRUE; + } + return TRUE; } X_API Int YAP_Execute(PredEntry *pe, CPredicate exec_code) { - CACHE_REGS - Int ret; - Int OASP = LCL0 - (CELL *) B; - // Term omod = CurrentModule; - // if (pe->PredFlags & CArgsPredFlag) { - // CurrentModule = pe->ModuleOfPred; - //} - if (pe->PredFlags & SWIEnvPredFlag) { - CPredicateV codev = (CPredicateV) exec_code; - struct foreign_context ctx; + CACHE_REGS + Int ret; + Int OASP = LCL0 - (CELL *)B; + // Term omod = CurrentModule; + // if (pe->PredFlags & CArgsPredFlag) { + // CurrentModule = pe->ModuleOfPred; + //} + if (pe->PredFlags & SWIEnvPredFlag) { + CPredicateV codev = (CPredicateV)exec_code; + struct foreign_context ctx; - ctx.engine = NULL; - yhandle_t s0 = Yap_InitSlots(pe->ArityOfPE, &ARG1); - PP = pe; - ret = codev(s0, 0, &ctx); - } else if (pe->PredFlags & CArgsPredFlag) { - PP = pe; - ret = execute_cargs(pe, exec_code PASS_REGS); - } else { - PP = pe; - ret = (exec_code)(PASS_REGS1); - } - PP = NULL; - // check for junk: open frames, etc */ - if (ret) - complete_exit(((choiceptr) (LCL0 - OASP)), FALSE, FALSE PASS_REGS); - else - complete_fail(((choiceptr) (LCL0 - OASP)), FALSE PASS_REGS); - // CurrentModule = omod; - if (!ret) { - Yap_RaiseException(); - } - return ret; + 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); + else + complete_fail(((choiceptr)(LCL0 - OASP)), FALSE PASS_REGS); + // CurrentModule = omod; + if (!ret) { + Yap_RaiseException(); + } + return ret; } #define FRG_REDO_MASK 0x00000003L @@ -1169,174 +1161,174 @@ X_API Int YAP_Execute(PredEntry *pe, CPredicate exec_code) { #define REDO_PTR 0x03 /* returned a pointer */ X_API Int YAP_ExecuteFirst(PredEntry *pe, CPredicate exec_code) { - CACHE_REGS - CELL ocp = LCL0 - (CELL *) B; - /* for slots to work */ - Int CurSlot = Yap_StartSlots(); - if (pe->PredFlags & - (SWIEnvPredFlag | CArgsPredFlag | ModuleTransparentPredFlag)) { - uintptr_t val; - CPredicateV codev = (CPredicateV) exec_code; - struct foreign_context *ctx = - (struct foreign_context *) (&EXTRA_CBACK_ARG(pe->ArityOfPE, 1)); + CACHE_REGS + CELL ocp = LCL0 - (CELL *)B; + /* for slots to work */ + Int CurSlot = Yap_StartSlots(); + if (pe->PredFlags & + (SWIEnvPredFlag | CArgsPredFlag | ModuleTransparentPredFlag)) { + uintptr_t val; + CPredicateV codev = (CPredicateV)exec_code; + struct foreign_context *ctx = + (struct foreign_context *)(&EXTRA_CBACK_ARG(pe->ArityOfPE, 1)); - PP = pe; - ctx->control = FRG_FIRST_CALL; - ctx->engine = NULL; //(PL_local_data *)Yap_regp; - ctx->context = (uintptr_t) NULL; - if (pe->PredFlags & CArgsPredFlag) { - val = execute_cargs_back(pe, exec_code, ctx PASS_REGS); - } else { - val = codev(Yap_InitSlots(pe->ArityOfPE, &ARG1), 0, ctx); - } - Yap_CloseSlots(CurSlot); - PP = NULL; - if (val == 0) { - if (Yap_RaiseException()) { - return false; - } - return complete_fail(((choiceptr) (LCL0 - ocp)), TRUE PASS_REGS); - } else if (val == 1) { /* TRUE */ - return complete_exit(((choiceptr) (LCL0 - ocp)), TRUE, FALSE PASS_REGS); - } else { - if ((val & REDO_PTR) == REDO_PTR) - ctx->context = (uintptr_t) (val & ~REDO_PTR); - else - ctx->context = (uintptr_t) ((val & ~REDO_PTR) >> FRG_REDO_BITS); - /* fix dropped cps */ - return complete_exit(((choiceptr) (LCL0 - ocp)), FALSE, FALSE PASS_REGS); - } + PP = pe; + ctx->control = FRG_FIRST_CALL; + ctx->engine = NULL; //(PL_local_data *)Yap_regp; + ctx->context = (uintptr_t)NULL; + if (pe->PredFlags & CArgsPredFlag) { + val = execute_cargs_back(pe, exec_code, ctx PASS_REGS); } else { - Int ret = (exec_code)(PASS_REGS1); - Yap_CloseSlots(CurSlot); - if (!ret) { - Yap_RaiseException(); - } - return ret; + val = codev(Yap_InitSlots(pe->ArityOfPE, &ARG1), 0, ctx); } + Yap_CloseSlots(CurSlot); + PP = NULL; + if (val == 0) { + if (Yap_RaiseException()) { + return false; + } + return complete_fail(((choiceptr)(LCL0 - ocp)), TRUE PASS_REGS); + } else if (val == 1) { /* TRUE */ + return complete_exit(((choiceptr)(LCL0 - ocp)), TRUE, FALSE PASS_REGS); + } else { + if ((val & REDO_PTR) == REDO_PTR) + ctx->context = (uintptr_t)(val & ~REDO_PTR); + else + ctx->context = (uintptr_t)((val & ~REDO_PTR) >> FRG_REDO_BITS); + /* fix dropped cps */ + return complete_exit(((choiceptr)(LCL0 - ocp)), FALSE, FALSE PASS_REGS); + } + } else { + Int ret = (exec_code)(PASS_REGS1); + Yap_CloseSlots(CurSlot); + if (!ret) { + Yap_RaiseException(); + } + 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; + 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); - } + 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 { - 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; + 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; + } } X_API Int YAP_ExecuteNext(PredEntry *pe, CPredicate exec_code) { - 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)); + 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 { - 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); + PP = pe; + ctx->control = FRG_REDO; + if (pe->PredFlags & CArgsPredFlag) { + val = execute_cargs_back(pe, exec_code, ctx PASS_REGS); } else { - Int ret = (exec_code)(PASS_REGS1); - if (!ret) { - Yap_RaiseException(); - } - return ret; + 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(); + } + return ret; + } } X_API void *YAP_ReallocSpaceFromYap(void *ptr, size_t size) { - CACHE_REGS - void *new_ptr; - BACKUP_MACHINE_REGS(); - while ((new_ptr = Yap_ReallocCodeSpace(ptr, size)) == NULL) { - if (!Yap_growheap(FALSE, size, NULL)) { - Yap_Error(RESOURCE_ERROR_HEAP, TermNil, LOCAL_ErrorMessage); - return NULL; - } + CACHE_REGS + void *new_ptr; + BACKUP_MACHINE_REGS(); + while ((new_ptr = Yap_ReallocCodeSpace(ptr, size)) == NULL) { + if (!Yap_growheap(FALSE, size, NULL)) { + Yap_Error(RESOURCE_ERROR_HEAP, TermNil, LOCAL_ErrorMessage); + return NULL; } - RECOVER_MACHINE_REGS(); - return new_ptr; + } + RECOVER_MACHINE_REGS(); + return new_ptr; } X_API void *YAP_AllocSpaceFromYap(size_t size) { - CACHE_REGS - void *ptr; - BACKUP_MACHINE_REGS(); + CACHE_REGS + void *ptr; + BACKUP_MACHINE_REGS(); - while ((ptr = Yap_AllocCodeSpace(size)) == NULL) { - if (!Yap_growheap(FALSE, size, NULL)) { - Yap_Error(RESOURCE_ERROR_HEAP, TermNil, LOCAL_ErrorMessage); - return NULL; - } + while ((ptr = Yap_AllocCodeSpace(size)) == NULL) { + if (!Yap_growheap(FALSE, size, NULL)) { + Yap_Error(RESOURCE_ERROR_HEAP, TermNil, LOCAL_ErrorMessage); + return NULL; } - RECOVER_MACHINE_REGS(); - return ptr; + } + RECOVER_MACHINE_REGS(); + return ptr; } X_API void YAP_FreeSpaceFromYap(void *ptr) { Yap_FreeCodeSpace(ptr); } @@ -1352,1368 +1344,950 @@ X_API void YAP_FreeSpaceFromYap(void *ptr) { Yap_FreeCodeSpace(ptr); } * @return */ X_API char * YAP_StringToBuffer(Term t, char *buf, unsigned int bufsize) { - 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; + 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; } else { - RECOVER_MACHINE_REGS(); - if (buf == out.val.c) { - return buf; - } else { - return pop_output_text_stack(l, out.val.c); - } + return pop_output_text_stack(l, out.val.c); } + } } /* copy a string to a buffer */ X_API Term YAP_BufferToString(const char *s) { - Term t; - BACKUP_H(); + Term t; + BACKUP_H(); - CACHE_REGS - seq_tv_t inp, out; - inp.val.c0 = s; - inp.type = YAP_STRING_CHARS; - out.type = YAP_STRING_CODES; - if (!Yap_CVT_Text(&inp, &out PASS_REGS)) - return 0L; - t = out.val.t; + CACHE_REGS + seq_tv_t inp, out; + inp.val.c0 = s; + inp.type = YAP_STRING_CHARS; + out.type = YAP_STRING_CODES; + if (!Yap_CVT_Text(&inp, &out PASS_REGS)) + return 0L; + t = out.val.t; - RECOVER_H(); - return t; + RECOVER_H(); + return t; } /* copy a string to a buffer */ X_API Term YAP_NBufferToString(const char *s, size_t len) { - Term t; - BACKUP_H(); + Term t; + BACKUP_H(); - CACHE_REGS - seq_tv_t inp, out; - inp.val.c0 = s; - inp.type = YAP_STRING_CHARS; - out.type = YAP_STRING_CODES | YAP_STRING_NCHARS | YAP_STRING_TRUNC; - out.max = len; - if (!Yap_CVT_Text(&inp, &out PASS_REGS)) - return 0L; - t = out.val.t; + 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; - RECOVER_H(); - return t; + RECOVER_H(); + return t; } /* copy a string to a buffer */ X_API Term YAP_WideBufferToString(const wchar_t *s) { - Term t; - BACKUP_H(); + Term t; + BACKUP_H(); - CACHE_REGS - seq_tv_t inp, out; - inp.val.w0 = s; - inp.type = YAP_STRING_WCHARS; - out.type = YAP_STRING_CODES; - if (!Yap_CVT_Text(&inp, &out PASS_REGS)) - return 0L; - t = out.val.t; + CACHE_REGS + seq_tv_t inp, out; + inp.val.w0 = s; + inp.type = YAP_STRING_WCHARS; + out.type = YAP_STRING_CODES; + if (!Yap_CVT_Text(&inp, &out PASS_REGS)) + return 0L; + t = out.val.t; - RECOVER_H(); - return t; + RECOVER_H(); + return t; } /* copy a string to a buffer */ X_API Term YAP_NWideBufferToString(const wchar_t *s, size_t len) { - Term t; - BACKUP_H(); + Term t; + BACKUP_H(); - CACHE_REGS - seq_tv_t inp, out; - inp.val.w0 = s; - inp.type = YAP_STRING_WCHARS; - out.type = YAP_STRING_CODES | YAP_STRING_NCHARS | YAP_STRING_TRUNC; - out.max = len; - if (!Yap_CVT_Text(&inp, &out PASS_REGS)) - return 0L; - t = out.val.t; + 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; - RECOVER_H(); - return t; + RECOVER_H(); + return t; } /* copy a string to a buffer */ X_API Term YAP_ReadBuffer(const char *s, Term *tp) { - CACHE_REGS - Term tv, t; - BACKUP_H(); + CACHE_REGS + Term tv, t; + BACKUP_H(); - if (*tp) - tv = *tp; - else - tv = 0; - LOCAL_ErrorMessage = NULL; - const unsigned char *us = (const unsigned char *) s; - while (!(t = Yap_BufferToTermWithPrioBindings(us, strlen(s) + 1, TermNil, - GLOBAL_MaxPriority, tv))) { - 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; - return 0; - } else { - break; + if (*tp) + tv = *tp; + else + tv = 0; + LOCAL_ErrorMessage = NULL; + const unsigned char *us = (const unsigned char *)s; + while (!(t = Yap_BufferToTermWithPrioBindings(us, strlen(s) + 1, TermNil, + GLOBAL_MaxPriority, tv))) { + 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; + return 0; + } else { + break; } - RECOVER_H(); - return t; + } + RECOVER_H(); + return t; } /* copy a string to a buffer */ X_API YAP_Term YAP_BufferToAtomList(const char *s) { - Term t; - BACKUP_H(); + Term t; + BACKUP_H(); - CACHE_REGS - seq_tv_t inp, out; - inp.val.c0 = s; - inp.type = YAP_STRING_CHARS; - out.type = YAP_STRING_ATOMS; - if (!Yap_CVT_Text(&inp, &out PASS_REGS)) - return 0L; - t = out.val.t; + CACHE_REGS + seq_tv_t inp, out; + inp.val.c0 = s; + inp.type = YAP_STRING_CHARS; + out.type = YAP_STRING_ATOMS; + if (!Yap_CVT_Text(&inp, &out PASS_REGS)) + return 0L; + t = out.val.t; - RECOVER_H(); - return t; + RECOVER_H(); + return t; } /* copy a string of size len to a buffer */ X_API Term YAP_NBufferToAtomList(const char *s, size_t len) { - Term t; - BACKUP_H(); + Term t; + BACKUP_H(); - CACHE_REGS - seq_tv_t inp, out; - inp.val.c0 = s; - inp.type = YAP_STRING_CHARS; - out.type = YAP_STRING_ATOMS | YAP_STRING_NCHARS | YAP_STRING_TRUNC; - out.max = len; - if (!Yap_CVT_Text(&inp, &out PASS_REGS)) - return 0L; - t = out.val.t; + 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; - RECOVER_H(); - return t; + RECOVER_H(); + return t; } /* copy a string to a buffer */ X_API Term YAP_WideBufferToAtomList(const wchar_t *s) { - Term t; - BACKUP_H(); + Term t; + BACKUP_H(); - CACHE_REGS - seq_tv_t inp, out; - inp.val.w0 = s; - inp.type = YAP_STRING_WCHARS; - out.type = YAP_STRING_ATOMS; - if (!Yap_CVT_Text(&inp, &out PASS_REGS)) - return 0L; - t = out.val.t; + CACHE_REGS + seq_tv_t inp, out; + inp.val.w0 = s; + inp.type = YAP_STRING_WCHARS; + out.type = YAP_STRING_ATOMS; + if (!Yap_CVT_Text(&inp, &out PASS_REGS)) + return 0L; + t = out.val.t; - RECOVER_H(); - return t; + RECOVER_H(); + return t; } /* copy a string of size len to a buffer */ X_API Term YAP_NWideBufferToAtomList(const wchar_t *s, size_t len) { - Term t; - BACKUP_H(); + Term t; + BACKUP_H(); - CACHE_REGS - seq_tv_t inp, out; - inp.val.w0 = s; - inp.type = YAP_STRING_WCHARS; - out.type = YAP_STRING_ATOMS | YAP_STRING_NCHARS | YAP_STRING_TRUNC; - out.max = len; - if (!Yap_CVT_Text(&inp, &out PASS_REGS)) - return 0L; - t = out.val.t; + 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; - RECOVER_H(); - return t; + RECOVER_H(); + return t; } /* copy a string of size len to a buffer */ X_API Term YAP_NWideBufferToAtomDiffList(const wchar_t *s, Term t0, size_t len) { - Term t; - BACKUP_H(); + Term t; + BACKUP_H(); - CACHE_REGS - seq_tv_t inp, out; - inp.val.w0 = s; - inp.type = YAP_STRING_WCHARS; - out.type = - YAP_STRING_ATOMS | YAP_STRING_NCHARS | YAP_STRING_TRUNC | YAP_STRING_DIFF; - out.max = len; - out.dif = t0; - if (!Yap_CVT_Text(&inp, &out PASS_REGS)) - return 0L; - t = out.val.t; + 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; - RECOVER_H(); - return t; + RECOVER_H(); + return t; } /* copy a string to a buffer */ X_API Term YAP_BufferToDiffList(const char *s, Term t0) { - Term t; - BACKUP_H(); + Term t; + BACKUP_H(); - CACHE_REGS - seq_tv_t inp, out; - inp.val.c0 = s; - inp.type = YAP_STRING_CHARS; - out.type = YAP_STRING_CODES | YAP_STRING_DIFF; - out.dif = t0; - if (!Yap_CVT_Text(&inp, &out PASS_REGS)) - return 0L; - t = out.val.t; + CACHE_REGS + seq_tv_t inp, out; + inp.val.c0 = s; + inp.type = YAP_STRING_CHARS; + out.type = YAP_STRING_CODES | YAP_STRING_DIFF; + out.dif = t0; + if (!Yap_CVT_Text(&inp, &out PASS_REGS)) + return 0L; + t = out.val.t; - RECOVER_H(); - return t; + RECOVER_H(); + return t; } /* copy a string of size len to a buffer */ X_API Term YAP_NBufferToDiffList(const char *s, Term t0, size_t len) { - Term t; - BACKUP_H(); + Term t; + BACKUP_H(); - CACHE_REGS - seq_tv_t inp, out; - inp.val.c0 = s; - inp.type = YAP_STRING_CHARS; - out.type = - YAP_STRING_CODES | YAP_STRING_NCHARS | YAP_STRING_TRUNC | YAP_STRING_DIFF; - out.max = len; - out.dif = t0; - if (!Yap_CVT_Text(&inp, &out PASS_REGS)) - return 0L; - t = out.val.t; + 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; - RECOVER_H(); - return t; + RECOVER_H(); + return t; } /* copy a string to a buffer */ X_API Term YAP_WideBufferToDiffList(const wchar_t *s, Term t0) { - Term t; - BACKUP_H(); + Term t; + BACKUP_H(); - CACHE_REGS - seq_tv_t inp, out; - inp.val.w0 = s; - inp.type = YAP_STRING_WCHARS; - out.type = YAP_STRING_CODES | YAP_STRING_DIFF; - out.dif = t0; - if (!Yap_CVT_Text(&inp, &out PASS_REGS)) - return 0L; - t = out.val.t; + CACHE_REGS + seq_tv_t inp, out; + inp.val.w0 = s; + inp.type = YAP_STRING_WCHARS; + out.type = YAP_STRING_CODES | YAP_STRING_DIFF; + out.dif = t0; + if (!Yap_CVT_Text(&inp, &out PASS_REGS)) + return 0L; + t = out.val.t; - RECOVER_H(); - return t; + RECOVER_H(); + return t; } /* copy a string of size len to a buffer */ X_API Term YAP_NWideBufferToDiffList(const wchar_t *s, Term t0, size_t len) { - Term t; - BACKUP_H(); + Term t; + BACKUP_H(); - CACHE_REGS - seq_tv_t inp, out; - inp.val.w0 = s; - inp.type = YAP_STRING_WCHARS; - out.type = - YAP_STRING_CODES | YAP_STRING_NCHARS | YAP_STRING_TRUNC | YAP_STRING_DIFF; - out.max = len; - out.dif = t0; - if (!Yap_CVT_Text(&inp, &out PASS_REGS)) - return 0L; - t = out.val.t; + 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; - RECOVER_H(); - return t; + RECOVER_H(); + return t; } X_API void YAP_Error(int myerrno, Term t, const char *buf, ...) { #define YAP_BUF_SIZE 512 - va_list ap; - char tmpbuf[YAP_BUF_SIZE]; + va_list ap; + char tmpbuf[YAP_BUF_SIZE]; - if (!myerrno) - myerrno = SYSTEM_ERROR_INTERNAL; - if (t == 0L) - t = TermNil; - if (buf != NULL) { - va_start(ap, buf); + if (!myerrno) + myerrno = SYSTEM_ERROR_INTERNAL; + if (t == 0L) + t = TermNil; + if (buf != NULL) { + va_start(ap, buf); #if HAVE_VSNPRINTF - (void) vsnprintf(tmpbuf, YAP_BUF_SIZE, buf, ap); + (void)vsnprintf(tmpbuf, YAP_BUF_SIZE, buf, ap); #else - (void)vsprintf(tmpbuf, buf, ap); + (void)vsprintf(tmpbuf, buf, ap); #endif - va_end(ap); - } else { - tmpbuf[0] = '\0'; - } - Yap_Error(myerrno, t, tmpbuf); + va_end(ap); + } else { + tmpbuf[0] = '\0'; + } + Yap_Error(myerrno, t, tmpbuf); } X_API YAP_PredEntryPtr YAP_FunctorToPred(YAP_Functor func) { - CACHE_REGS - return RepPredProp(PredPropByFunc(func, CurrentModule)); + CACHE_REGS + return RepPredProp(PredPropByFunc(func, CurrentModule)); } X_API YAP_PredEntryPtr YAP_AtomToPred(YAP_Atom at) { - CACHE_REGS - return RepPredProp(PredPropByAtom(at, CurrentModule)); + CACHE_REGS + return RepPredProp(PredPropByAtom(at, CurrentModule)); } X_API YAP_PredEntryPtr YAP_FunctorToPredInModule(YAP_Functor func, Term mod) { - return RepPredProp(PredPropByFunc(func, mod)); + return RepPredProp(PredPropByFunc(func, mod)); } X_API YAP_PredEntryPtr YAP_AtomToPredInModule(YAP_Atom at, Term mod) { - return RepPredProp(PredPropByAtom(at, mod)); + return RepPredProp(PredPropByAtom(at, mod)); } static int run_emulator(USES_REGS1) { - int out; + int out; - out = Yap_absmi(0); - LOCAL_PrologMode |= UserCCallMode; - return out; + out = Yap_absmi(0); + LOCAL_PrologMode |= UserCCallMode; + return out; } X_API bool YAP_EnterGoal(YAP_PredEntryPtr ape, CELL *ptr, YAP_dogoalinfo *dgi) { - CACHE_REGS - PredEntry *pe = ape; - bool out; + CACHE_REGS + PredEntry *pe = ape; + bool out; - BACKUP_MACHINE_REGS(); - LOCAL_PrologMode = UserMode; - dgi->p = P; - dgi->cp = CP; - dgi->CurSlot = LOCAL_CurSlot; - // ensure our current ENV receives current P. + BACKUP_MACHINE_REGS(); + LOCAL_PrologMode = UserMode; + dgi->p = P; + dgi->cp = CP; + dgi->CurSlot = LOCAL_CurSlot; + // ensure our current ENV receives current P. - Yap_PrepGoal(pe->ArityOfPE, nullptr, B PASS_REGS); - P = pe->CodeOfPred; - // __android_log_print(ANDROID_LOG_INFO, "YAP ", "ap=%p %d %x %x args=%x,%x - // slot=%d", pe, pe->CodeOfPred->opc, FAILCODE, Deref(ARG1), Deref(ARG2), - // LOCAL_CurSlot); - dgi->b = LCL0 - (CELL *) B; - out = Yap_exec_absmi(true, false); - if (out) { - dgi->EndSlot = LOCAL_CurSlot; - Yap_StartSlots(); - } else { - LOCAL_CurSlot = - dgi->CurSlot; // ignore any slots created within the called goal - } - RECOVER_MACHINE_REGS(); - return out; + Yap_PrepGoal(pe->ArityOfPE, nullptr, B PASS_REGS); + P = pe->CodeOfPred; + // __android_log_print(ANDROID_LOG_INFO, "YAP ", "ap=%p %d %x %x args=%x,%x + // slot=%d", pe, pe->CodeOfPred->opc, FAILCODE, Deref(ARG1), Deref(ARG2), + // LOCAL_CurSlot); + dgi->b = LCL0 - (CELL *)B; + out = Yap_exec_absmi(true, false); + if (out) { + dgi->EndSlot = LOCAL_CurSlot; + Yap_StartSlots(); + } else { + LOCAL_CurSlot = + dgi->CurSlot; // ignore any slots created within the called goal + } + RECOVER_MACHINE_REGS(); + return out; } X_API bool YAP_RetryGoal(YAP_dogoalinfo *dgi) { - CACHE_REGS - choiceptr myB; - bool out; + CACHE_REGS + choiceptr myB; + bool out; - BACKUP_MACHINE_REGS(); - myB = (choiceptr) (LCL0 - dgi->b); - CP = myB->cp_cp; - /* sanity check */ - if (B >= myB) { - return false; - } - P = FAILCODE; - /* make sure we didn't leave live slots when we backtrack */ - ASP = (CELL *) B; - LOCAL_CurSlot = dgi->EndSlot; - out = run_emulator(PASS_REGS1); - if (out) { - dgi->EndSlot = LOCAL_CurSlot; - } else { - LOCAL_CurSlot = - dgi->CurSlot; // ignore any slots created within the called goal - } - RECOVER_MACHINE_REGS(); - return out; + BACKUP_MACHINE_REGS(); + myB = (choiceptr)(LCL0 - dgi->b); + CP = myB->cp_cp; + /* sanity check */ + if (B >= myB) { + return false; + } + P = FAILCODE; + /* make sure we didn't leave live slots when we backtrack */ + ASP = (CELL *)B; + LOCAL_CurSlot = dgi->EndSlot; + out = run_emulator(PASS_REGS1); + if (out) { + dgi->EndSlot = LOCAL_CurSlot; + } else { + LOCAL_CurSlot = + dgi->CurSlot; // ignore any slots created within the called goal + } + RECOVER_MACHINE_REGS(); + return out; } X_API bool YAP_LeaveGoal(bool backtrack, YAP_dogoalinfo *dgi) { - CACHE_REGS - choiceptr myB; + CACHE_REGS + choiceptr myB; - BACKUP_MACHINE_REGS(); - myB = (choiceptr) (LCL0 - dgi->b); - if (B > myB) { - /* someone cut us */ - return FALSE; - } - /* prune away choicepoints */ - if (B != myB) { + BACKUP_MACHINE_REGS(); + myB = (choiceptr)(LCL0 - dgi->b); + if (B > myB) { + /* someone cut us */ + return FALSE; + } + /* prune away choicepoints */ + if (B != myB) { #ifdef YAPOR - CUT_prune_to(myB); + CUT_prune_to(myB); #endif - B = myB; - } - /* if backtracking asked for, recover space and bindings */ - if (backtrack) { - P = FAILCODE; - Yap_exec_absmi(true, YAP_EXEC_ABSMI); - /* recover stack space */ - HR = B->cp_h; - TR = B->cp_tr; + B = myB; + } + /* if backtracking asked for, recover space and bindings */ + if (backtrack) { + P = FAILCODE; + Yap_exec_absmi(true, YAP_EXEC_ABSMI); + /* recover stack space */ + HR = B->cp_h; + TR = B->cp_tr; #ifdef DEPTH_LIMIT - DEPTH = B->cp_depth; + DEPTH = B->cp_depth; #endif /* DEPTH_LIMIT */ - YENV = ENV = B->cp_env; - } else { - Yap_TrimTrail(); - } + YENV = ENV = B->cp_env; + } else { + Yap_TrimTrail(); + } /* recover local stack */ #ifdef DEPTH_LIMIT - DEPTH = ENV[E_DEPTH]; + DEPTH = ENV[E_DEPTH]; #endif - /* make sure we prune C-choicepoints */ - if (POP_CHOICE_POINT(B->cp_b)) { - POP_EXECUTE(); - } - ENV = (CELL *) (ENV[E_E]); - /* ASP should be set to the top of the local stack when we - did the call */ - ASP = B->cp_env; - /* YENV should be set to the current environment */ - YENV = ENV = (CELL *) ((B->cp_env)[E_E]); - B = B->cp_b; - // SET_BB(B); - HB = PROTECT_FROZEN_H(B); - CP = dgi->cp; - P = dgi->p; - LOCAL_CurSlot = dgi->CurSlot; - RECOVER_MACHINE_REGS(); - return TRUE; + /* make sure we prune C-choicepoints */ + if (POP_CHOICE_POINT(B->cp_b)) { + POP_EXECUTE(); + } + ENV = (CELL *)(ENV[E_E]); + /* ASP should be set to the top of the local stack when we + did the call */ + ASP = B->cp_env; + /* YENV should be set to the current environment */ + YENV = ENV = (CELL *)((B->cp_env)[E_E]); + B = B->cp_b; + // SET_BB(B); + HB = PROTECT_FROZEN_H(B); + CP = dgi->cp; + P = dgi->p; + LOCAL_CurSlot = dgi->CurSlot; + RECOVER_MACHINE_REGS(); + return TRUE; } X_API Int YAP_RunGoal(Term t) { - CACHE_REGS - Term out; - yamop *old_CP = CP; - yhandle_t cslot = LOCAL_CurSlot; - BACKUP_MACHINE_REGS(); + CACHE_REGS + Term out; + yamop *old_CP = CP; + yhandle_t cslot = LOCAL_CurSlot; + BACKUP_MACHINE_REGS(); + LOCAL_AllowRestart = FALSE; + LOCAL_PrologMode = UserMode; + out = Yap_RunTopGoal(t, true); + LOCAL_PrologMode = UserCCallMode; + // should we catch the exception or pass it through? + // We'll pass it through + Yap_RaiseException(); + if (out) { + P = (yamop *)ENV[E_CP]; + ENV = (CELL *)ENV[E_E]; + CP = old_CP; + LOCAL_AllowRestart = TRUE; + // we are back to user code again, need slots */ + } else { + ENV = B->cp_env; + ENV = (CELL *)ENV[E_E]; + CP = old_CP; + HR = B->cp_h; + TR = B->cp_tr; + B = B->cp_b; LOCAL_AllowRestart = FALSE; - LOCAL_PrologMode = UserMode; - out = Yap_RunTopGoal(t, true); - LOCAL_PrologMode = UserCCallMode; - // should we catch the exception or pass it through? - // We'll pass it through - Yap_RaiseException(); - if (out) { - P = (yamop *) ENV[E_CP]; - ENV = (CELL *) ENV[E_E]; - CP = old_CP; - LOCAL_AllowRestart = TRUE; - // we are back to user code again, need slots */ - } else { - ENV = B->cp_env; - ENV = (CELL *) ENV[E_E]; - CP = old_CP; - HR = B->cp_h; - TR = B->cp_tr; - B = B->cp_b; - LOCAL_AllowRestart = FALSE; - SET_ASP(ENV, E_CB * sizeof(CELL)); - // make sure the slots are ok. - } - RECOVER_MACHINE_REGS(); - LOCAL_CurSlot = cslot; - return out; + SET_ASP(ENV, E_CB * sizeof(CELL)); + // make sure the slots are ok. + } + RECOVER_MACHINE_REGS(); + LOCAL_CurSlot = cslot; + return out; } X_API Term YAP_AllocExternalDataInStack(size_t bytes) { - CELL *pt; - Term t = Yap_AllocExternalDataInStack(EXTERNAL_BLOB, bytes, &pt); - if (t == TermNil) - return 0L; - return t; + CELL *pt; + Term t = Yap_AllocExternalDataInStack(EXTERNAL_BLOB, bytes, &pt); + if (t == TermNil) + return 0L; + return t; } X_API YAP_Bool YAP_IsExternalDataInStackTerm(Term t) { - return IsExternalBlobTerm(t, EXTERNAL_BLOB); + return IsExternalBlobTerm(t, EXTERNAL_BLOB); } X_API void *YAP_ExternalDataInStackFromTerm(Term t) { - return ExternalBlobFromTerm(t); + return ExternalBlobFromTerm(t); } X_API YAP_opaque_tag_t YAP_NewOpaqueType(struct YAP_opaque_handler_struct *f) { - 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; + int i; + if (!GLOBAL_OpaqueHandlersCount) { + GLOBAL_OpaqueHandlers = + malloc(sizeof(YAP_opaque_handler_t) * USER_BLOB_END); + if (!GLOBAL_OpaqueHandlers) { + /* no room */ + return -1; } - i = GLOBAL_OpaqueHandlersCount++; - memcpy(GLOBAL_OpaqueHandlers + i, f, sizeof(YAP_opaque_handler_t)); - return i; + GLOBAL_OpaqueHandlersCount = USER_BLOB_START; + } else if (GLOBAL_OpaqueHandlersCount == USER_BLOB_END) { + /* all types used */ + return -1; + } + i = GLOBAL_OpaqueHandlersCount++; + memcpy(GLOBAL_OpaqueHandlers + i, f, sizeof(YAP_opaque_handler_t)); + return i; } X_API Term YAP_NewOpaqueObject(YAP_opaque_tag_t blob_tag, size_t bytes) { - 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; + 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; } X_API YAP_Bool YAP_IsOpaqueObjectTerm(Term t, YAP_opaque_tag_t tag) { - return IsExternalBlobTerm(t, (CELL) tag); + return IsExternalBlobTerm(t, (CELL)tag); } X_API void *YAP_OpaqueObjectFromTerm(Term t) { return ExternalBlobFromTerm(t); } X_API CELL *YAP_HeapStoreOpaqueTerm(Term t) { - return Yap_HeapStoreOpaqueTerm(t); + return Yap_HeapStoreOpaqueTerm(t); } X_API Int YAP_RunGoalOnce(Term t) { - CACHE_REGS - Term out; - yamop *old_CP = CP; - Int oldPrologMode = LOCAL_PrologMode; - yhandle_t CSlot; + CACHE_REGS + Term out; + yamop *old_CP = CP; + Int oldPrologMode = LOCAL_PrologMode; + yhandle_t CSlot; - BACKUP_MACHINE_REGS(); - Yap_InitYaamRegs(0); - CSlot = Yap_StartSlots(); - LOCAL_PrologMode = UserMode; + BACKUP_MACHINE_REGS(); + Yap_InitYaamRegs(0); + CSlot = Yap_StartSlots(); + LOCAL_PrologMode = UserMode; - // Yap_heap_regs->yap_do_low_level_trace=true; - out = Yap_RunTopGoal(t, true); - LOCAL_PrologMode = oldPrologMode; - Yap_CloseSlots(CSlot); - if (!(oldPrologMode & UserCCallMode)) { - /* called from top-level */ - LOCAL_AllowRestart = FALSE; - RECOVER_MACHINE_REGS(); - return out; - } - // should we catch the exception or pass it through? - // We'll pass it through - Yap_RaiseException(); - if (out) { - choiceptr cut_pt, ob; - - ob = NULL; - cut_pt = B; - while (cut_pt->cp_ap != NOCODE) { - /* make sure we prune C-choicepoints */ - if (POP_CHOICE_POINT(cut_pt->cp_b)) { - POP_EXECUTE(); - } - ob = cut_pt; - cut_pt = cut_pt->cp_b; - } -#ifdef YAPOR - CUT_prune_to(cut_pt); -#endif - if (ob) { - B = ob; - Yap_TrimTrail(); - } - B = cut_pt; - } - ASP = B->cp_env; - ENV = (CELL *) ASP[E_E]; - B = (choiceptr) ASP[E_CB]; -#ifdef DEPTH_LIMITxs - DEPTH = ASP[E_DEPTH]; -#endif - P = (yamop *) ASP[E_CP]; - CP = old_CP; + // Yap_heap_regs->yap_do_low_level_trace=true; + out = Yap_RunTopGoal(t, true); + LOCAL_PrologMode = oldPrologMode; + Yap_CloseSlots(CSlot); + if (!(oldPrologMode & UserCCallMode)) { + /* called from top-level */ LOCAL_AllowRestart = FALSE; RECOVER_MACHINE_REGS(); return out; + } + // should we catch the exception or pass it through? + // We'll pass it through + Yap_RaiseException(); + if (out) { + choiceptr cut_pt, ob; + + ob = NULL; + cut_pt = B; + while (cut_pt->cp_ap != NOCODE) { + /* make sure we prune C-choicepoints */ + if (POP_CHOICE_POINT(cut_pt->cp_b)) { + POP_EXECUTE(); + } + ob = cut_pt; + cut_pt = cut_pt->cp_b; + } +#ifdef YAPOR + CUT_prune_to(cut_pt); +#endif + if (ob) { + B = ob; + Yap_TrimTrail(); + } + B = cut_pt; + } + ASP = B->cp_env; + ENV = (CELL *)ASP[E_E]; + B = (choiceptr)ASP[E_CB]; +#ifdef DEPTH_LIMITxs + DEPTH = ASP[E_DEPTH]; +#endif + P = (yamop *)ASP[E_CP]; + CP = old_CP; + LOCAL_AllowRestart = FALSE; + RECOVER_MACHINE_REGS(); + return out; } X_API bool YAP_RestartGoal(void) { - CACHE_REGS - 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; - } - } else { - out = FALSE; - } - RECOVER_MACHINE_REGS(); - return (out); -} - -X_API bool YAP_ShutdownGoal(int backtrack) { - CACHE_REGS - BACKUP_MACHINE_REGS(); - - if (LOCAL_AllowRestart) { - choiceptr cut_pt; - - cut_pt = B; - while (cut_pt->cp_ap != NOCODE) { - /* make sure we prune C-choicepoints */ - if (POP_CHOICE_POINT(cut_pt->cp_b)) { - POP_EXECUTE(); - } - cut_pt = cut_pt->cp_b; - } -#ifdef YAPOR - CUT_prune_to(cut_pt); -#endif - /* just force backtrack */ - B = cut_pt; - if (backtrack) { - P = FAILCODE; - Yap_exec_absmi(TRUE, YAP_EXEC_ABSMI); - /* recover stack space */ - HR = cut_pt->cp_h; - TR = cut_pt->cp_tr; - } - /* we can always recover the stack */ - ASP = cut_pt->cp_env; - ENV = (CELL *) ASP[E_E]; - B = (choiceptr) ASP[E_CB]; - Yap_TrimTrail(); -#ifdef DEPTH_LIMIT - DEPTH = ASP[E_DEPTH]; -#endif - LOCAL_AllowRestart = FALSE; - } - RECOVER_MACHINE_REGS(); - return TRUE; -} - -X_API bool YAP_ContinueGoal(void) { - CACHE_REGS - bool out; - BACKUP_MACHINE_REGS(); - + 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; + } + } else { + out = FALSE; + } + RECOVER_MACHINE_REGS(); + return (out); +} - RECOVER_MACHINE_REGS(); - return (out); +X_API bool YAP_ShutdownGoal(int backtrack) { + CACHE_REGS + BACKUP_MACHINE_REGS(); + + if (LOCAL_AllowRestart) { + choiceptr cut_pt; + + cut_pt = B; + while (cut_pt->cp_ap != NOCODE) { + /* make sure we prune C-choicepoints */ + if (POP_CHOICE_POINT(cut_pt->cp_b)) { + POP_EXECUTE(); + } + cut_pt = cut_pt->cp_b; + } +#ifdef YAPOR + CUT_prune_to(cut_pt); +#endif + /* just force backtrack */ + B = cut_pt; + if (backtrack) { + P = FAILCODE; + Yap_exec_absmi(TRUE, YAP_EXEC_ABSMI); + /* recover stack space */ + HR = cut_pt->cp_h; + TR = cut_pt->cp_tr; + } + /* we can always recover the stack */ + ASP = cut_pt->cp_env; + ENV = (CELL *)ASP[E_E]; + B = (choiceptr)ASP[E_CB]; + Yap_TrimTrail(); +#ifdef DEPTH_LIMIT + DEPTH = ASP[E_DEPTH]; +#endif + LOCAL_AllowRestart = FALSE; + } + RECOVER_MACHINE_REGS(); + return TRUE; +} + +X_API bool YAP_ContinueGoal(void) { + CACHE_REGS + bool out; + BACKUP_MACHINE_REGS(); + + LOCAL_PrologMode = UserMode; + out = Yap_exec_absmi(TRUE, YAP_EXEC_ABSMI); + LOCAL_PrologMode = UserCCallMode; + + RECOVER_MACHINE_REGS(); + return (out); } X_API void YAP_PruneGoal(YAP_dogoalinfo *gi) { - CACHE_REGS - BACKUP_B(); + CACHE_REGS + BACKUP_B(); - choiceptr myB = (choiceptr) (LCL0 - gi->b); - while (B != myB) { - /* make sure we prune C-choicepoints */ - if (POP_CHOICE_POINT(B->cp_b)) { - POP_EXECUTE(); - } - if (!B->cp_b) - break; - B = B->cp_b; + choiceptr myB = (choiceptr)(LCL0 - gi->b); + while (B != myB) { + /* make sure we prune C-choicepoints */ + if (POP_CHOICE_POINT(B->cp_b)) { + POP_EXECUTE(); } + if (!B->cp_b) + break; + B = B->cp_b; + } - Yap_TrimTrail(); + Yap_TrimTrail(); - RECOVER_B(); + RECOVER_B(); } X_API bool YAP_GoalHasException(Term *t) { - CACHE_REGS - BACKUP_MACHINE_REGS(); - if (t) - *t = Yap_PeekException(); - return Yap_PeekException(); + CACHE_REGS + BACKUP_MACHINE_REGS(); + if (t) + *t = Yap_PeekException(); + return Yap_PeekException(); } X_API void YAP_ClearExceptions(void) { - CACHE_REGS + CACHE_REGS - Yap_ResetException(worker_id); + Yap_ResetException(worker_id); } -X_API int YAP_InitConsult(int mode, const char *fname, char *full, - int *osnop) { - CACHE_REGS - int sno; - BACKUP_MACHINE_REGS(); - int lvl = push_text_stack(); - if (mode == YAP_BOOT_MODE) { - mode = YAP_CONSULT_MODE; - } - char *bfp = Malloc(YAP_FILENAME_MAX + 1); - bfp[0] = '\0'; - if (fname != NULL && fname[0] != '\0') - strcpy(bfp, fname); - bool consulted = (mode == YAP_CONSULT_MODE); - const char *fl = Yap_findFile(bfp, NULL, NULL, full, true, - YAP_BOOT_PL, true, true); +X_API int YAP_InitConsult(int mode, const char *fname, char *full, int *osnop) { + CACHE_REGS + int sno; + BACKUP_MACHINE_REGS(); + const char *fl = NULL; + int lvl = push_text_stack(); + if (mode == YAP_BOOT_MODE) { + mode = YAP_CONSULT_MODE; + } + char *bfp = Malloc(YAP_FILENAME_MAX + 1); + bfp[0] = '\0'; + if (fname == NULL || fname[0] == '\0') { + fname = Yap_BOOTFILE; + } + if (fname) { + fl = Yap_AbsoluteFile(fname, bfp, true); if (!fl || !fl[0]) { - pop_text_stack(lvl); - return -1; + pop_text_stack(lvl); + return -1; } - Yap_init_consult(consulted, bfp); - sno = Yap_OpenStream(fl,"r", MkAtomTerm(Yap_LookupAtom(fname))); - *osnop = Yap_CheckAlias(AtomLoopStream); - if (!Yap_AddAlias(AtomLoopStream, sno)) { - Yap_CloseStream(sno); - pop_text_stack(lvl); - sno = -1; - return sno; - } - GLOBAL_Stream[sno].name = Yap_LookupAtom(fl); - GLOBAL_Stream[sno].user_name = MkAtomTerm(Yap_LookupAtom(fname)); - GLOBAL_Stream[sno].encoding = LOCAL_encoding; - RECOVER_MACHINE_REGS(); - UNLOCK(GLOBAL_Stream[sno].streamlock); + } + bool consulted = (mode == YAP_CONSULT_MODE); + Yap_init_consult(consulted, bfp); + sno = Yap_OpenStream(fl, "r", MkAtomTerm(Yap_LookupAtom(bfp))); + *osnop = Yap_CheckAlias(AtomLoopStream); + if (!Yap_AddAlias(AtomLoopStream, sno)) { + Yap_CloseStream(sno); + pop_text_stack(lvl); + sno = -1; return sno; + } + GLOBAL_Stream[sno].name = Yap_LookupAtom(fl); + GLOBAL_Stream[sno].user_name = MkAtomTerm(Yap_LookupAtom(fname)); + GLOBAL_Stream[sno].encoding = LOCAL_encoding; + 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. -X_API void *YAP_GetStreamFromId(int no) { - return GLOBAL_Stream + no; -} +X_API void *YAP_GetStreamFromId(int no) { return GLOBAL_Stream + no; } X_API FILE *YAP_TermToStream(Term t) { - BACKUP_MACHINE_REGS(); - FILE *s; + BACKUP_MACHINE_REGS(); + FILE *s; - if (IsVarTerm(t) || !IsAtomTerm(t)) - return NULL; - if ((s = Yap_GetStreamHandle(t)->file)) { - RECOVER_MACHINE_REGS(); - return s; - } - RECOVER_MACHINE_REGS(); + if (IsVarTerm(t) || !IsAtomTerm(t)) return NULL; + if ((s = Yap_GetStreamHandle(t)->file)) { + RECOVER_MACHINE_REGS(); + return s; + } + RECOVER_MACHINE_REGS(); + return NULL; } X_API void YAP_EndConsult(int sno, int *osnop) { - BACKUP_MACHINE_REGS(); - Yap_CloseStream(sno); - if (osnop >= 0) - Yap_AddAlias(AtomLoopStream, *osnop); - Yap_end_consult(); + BACKUP_MACHINE_REGS(); + Yap_CloseStream(sno); + if (osnop >= 0) + Yap_AddAlias(AtomLoopStream, *osnop); + Yap_end_consult(); - RECOVER_MACHINE_REGS(); + RECOVER_MACHINE_REGS(); } X_API Term YAP_Read(FILE *f) { - Term o; - int sno = Yap_FileStream(f, NULL, TermNil, Input_Stream_f); + Term o; + int sno = Yap_FileStream(f, NULL, TermNil, Input_Stream_f); - BACKUP_MACHINE_REGS(); - o = Yap_read_term(sno, TermNil, 1); - Yap_ReleaseStream(sno); - RECOVER_MACHINE_REGS(); - return o; + BACKUP_MACHINE_REGS(); + o = Yap_read_term(sno, TermNil, 1); + Yap_ReleaseStream(sno); + RECOVER_MACHINE_REGS(); + return o; } X_API Term YAP_ReadFromStream(int sno) { - Term o; + Term o; - BACKUP_MACHINE_REGS(); - o = Yap_read_term(sno, TermNil, false); - RECOVER_MACHINE_REGS(); - return o; + BACKUP_MACHINE_REGS(); + o = Yap_read_term(sno, TermNil, false); + RECOVER_MACHINE_REGS(); + return o; } X_API Term YAP_ReadClauseFromStream(int sno) { - BACKUP_MACHINE_REGS(); - Term t = Yap_read_term(sno, TermNil, true); - RECOVER_MACHINE_REGS(); - return t; + BACKUP_MACHINE_REGS(); + Term t = Yap_read_term(sno, TermNil, true); + RECOVER_MACHINE_REGS(); + return t; } X_API void YAP_Write(Term t, FILE *f, int flags) { - BACKUP_MACHINE_REGS(); - int sno = Yap_FileStream(f, NULL, TermNil, Output_Stream_f); + BACKUP_MACHINE_REGS(); + int sno = Yap_FileStream(f, NULL, TermNil, Output_Stream_f); - Yap_plwrite(t, GLOBAL_Stream + sno, 0, flags, GLOBAL_MaxPriority); - Yap_ReleaseStream(sno); + Yap_plwrite(t, GLOBAL_Stream + sno, 0, flags, GLOBAL_MaxPriority); + Yap_ReleaseStream(sno); - RECOVER_MACHINE_REGS(); + RECOVER_MACHINE_REGS(); } X_API YAP_Term YAP_CopyTerm(Term t) { - Term tn; - BACKUP_MACHINE_REGS(); + Term tn; + BACKUP_MACHINE_REGS(); - tn = Yap_CopyTerm(t); + tn = Yap_CopyTerm(t); - RECOVER_MACHINE_REGS(); + RECOVER_MACHINE_REGS(); - return (tn); + return (tn); } X_API char *YAP_WriteBuffer(Term t, char *buf, size_t sze, int flags) { - CACHE_REGS - seq_tv_t inp, out; + 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; - out.val.c = buf; - 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; + 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; + out.val.c = buf; + 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) { + return buf; } else { - RECOVER_MACHINE_REGS(); - if (buf == out.val.c) { - return buf; - } else { - return pop_output_text_stack(l, out.val.c); - } + return pop_output_text_stack(l, out.val.c); } + } } - /// 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) { - char *b; + char *b; - BACKUP_MACHINE_REGS(); - b = Yap_TermToBuffer(t, enc, flags); - strncpy(buf, b, sze); - buf[sze] = 0; - RECOVER_MACHINE_REGS(); - return true; + BACKUP_MACHINE_REGS(); + b = Yap_TermToBuffer(t, enc, flags); + strncpy(buf, b, sze); + buf[sze] = 0; + RECOVER_MACHINE_REGS(); + return true; } X_API char *YAP_CompileClause(Term t) { - CACHE_REGS - yamop *codeaddr; - Term mod = CurrentModule; - Term tn = TermNil; + CACHE_REGS + yamop *codeaddr; + Term mod = CurrentModule; + Term tn = TermNil; - BACKUP_MACHINE_REGS(); + BACKUP_MACHINE_REGS(); - /* allow expansion during stack initialization */ - LOCAL_ErrorMessage = NULL; - ARG1 = t; - YAPEnterCriticalSection(); - codeaddr = Yap_cclause(t, 0, mod, t); - if (codeaddr != NULL) { - t = Deref(ARG1); /* just in case there was an heap overflow */ - if (!Yap_addclause(t, codeaddr, TermAssertz, mod, &tn)) { - YAPLeaveCriticalSection(); - return LOCAL_ErrorMessage; - } + /* allow expansion during stack initialization */ + LOCAL_ErrorMessage = NULL; + ARG1 = t; + YAPEnterCriticalSection(); + codeaddr = Yap_cclause(t, 0, mod, t); + if (codeaddr != NULL) { + t = Deref(ARG1); /* just in case there was an heap overflow */ + if (!Yap_addclause(t, codeaddr, TermAssertz, mod, &tn)) { + YAPLeaveCriticalSection(); + return LOCAL_ErrorMessage; } - YAPLeaveCriticalSection(); + } + YAPLeaveCriticalSection(); - if (Yap_get_signal(YAP_CDOVF_SIGNAL)) { - if (!Yap_locked_growheap(FALSE, 0, NULL)) { - Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "YAP failed to grow heap: %s", - LOCAL_ErrorMessage); - } + if (Yap_get_signal(YAP_CDOVF_SIGNAL)) { + if (!Yap_locked_growheap(FALSE, 0, NULL)) { + Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "YAP failed to grow heap: %s", + LOCAL_ErrorMessage); } - RECOVER_MACHINE_REGS(); - return (LOCAL_ErrorMessage); -} - -static int yap_lineno = 0; - -/* do initial boot by consulting the file boot.yap */ -static void do_bootfile(const char *b_file USES_REGS) { - Term t; - int boot_stream, osno; - Functor functor_query = Yap_MkFunctor(Yap_LookupAtom("?-"), 1); - Functor functor_command1 = Yap_MkFunctor(Yap_LookupAtom(":-"), 1); - - /* consult boot.pl */ - char *full = malloc(YAP_FILENAME_MAX + 1); - full[0] = '\0'; - /* the consult mode does not matter here, really */ - boot_stream = YAP_InitConsult(YAP_BOOT_MODE, b_file, full, &osno); - if (boot_stream < 0) { - fprintf(stderr, "[ FATAL ERROR: could not open boot_stream %s ]\n", - b_file); - exit(1); - } - free(full); - setAtomicGlobalPrologFlag( - RESOURCE_DATABASE_FLAG, - MkAtomTerm(GLOBAL_Stream[boot_stream].name)); - do { - CACHE_REGS - YAP_Reset(YAP_FULL_RESET); - Yap_StartSlots(); - t = YAP_ReadClauseFromStream(boot_stream); - - // Yap_DebugPlWriteln(t); - if (t == 0) { - fprintf(stderr, - "[ SYNTAX ERROR: while parsing boot_stream %s at line %d ]\n", - b_file, yap_lineno); - } else if (YAP_IsVarTerm(t) || t == TermNil) { - fprintf(stderr, "[ line %d: term cannot be compiled ]", yap_lineno); - } else if (YAP_IsPairTerm(t)) { - fprintf(stderr, "[ SYSTEM ERROR: consult not allowed in boot file ]\n"); - fprintf(stderr, "error found at line %d and pos %d", yap_lineno, - fseek(GLOBAL_Stream[boot_stream].file, 0L, SEEK_CUR)); - } else if (IsApplTerm(t) && (FunctorOfTerm(t) == functor_query || - FunctorOfTerm(t) == functor_command1)) { - YAP_RunGoalOnce(ArgOfTerm(1, t)); - } else { - Term ts[2]; - char *ErrorMessage; - Functor fun = Yap_MkFunctor(Yap_LookupAtom("$prepare_clause"), 2); - PredEntry *pe = RepPredProp(PredPropByFunc(fun, PROLOG_MODULE)); - - if (pe->OpcodeOfPred != UNDEF_OPCODE && pe->OpcodeOfPred != FAIL_OPCODE) { - ts[0] = t; - RESET_VARIABLE(ts + 1); - if (YAP_RunGoal(Yap_MkApplTerm(fun, 2, ts))) - t = ts[1]; - } - ErrorMessage = YAP_CompileClause(t); - if (ErrorMessage) { - fprintf(stderr, "%s", ErrorMessage); - } - } - } while (t != TermEof); - - YAP_EndConsult(boot_stream, &osno); -#if DEBUG - if (Yap_output_msg) - fprintf(stderr, "Boot loaded\n"); -#endif -} - -/** - YAP_DelayInit() - - ensures initialization is done after engine creation. - It receives a pointer to function and a string describing - the module. -*/ - -X_API bool YAP_initialized = false; -static int n_mdelays = 0; -static YAP_delaymodule_t *m_delays; - -X_API bool YAP_DelayInit(YAP_ModInit_t f, const char s[]) { - if (m_delays) { - m_delays = realloc(m_delays, (n_mdelays + 1) * sizeof(YAP_delaymodule_t)); - } else { - m_delays = malloc(sizeof(YAP_delaymodule_t)); - } - m_delays[n_mdelays].f = f; - m_delays[n_mdelays].s = s; - n_mdelays++; - return true; -} - -bool Yap_LateInit(const char s[]) { - int i; - for (i = 0; i < n_mdelays; i++) { - if (!strcmp(m_delays[i].s, s)) { - m_delays[i].f(); - return true; - } - } - return false; -} - -static void start_modules(void) { - Term cm = CurrentModule; - size_t i; - for (i = 0; i < n_mdelays; i++) { - CurrentModule = MkAtomTerm(YAP_LookupAtom(m_delays[i].s)); - m_delays[i].f(); - } - CurrentModule = cm; -} - -/// whether Yap is under control of some other system -bool Yap_embedded = true; - -/* this routine is supposed to be called from an external program - that wants to control Yap */ - -X_API YAP_file_type_t YAP_Init(YAP_init_args *yap_init) { - YAP_file_type_t restore_result = yap_init->boot_file_type; - bool do_bootstrap = (restore_result & YAP_CONSULT_MODE); - CELL Trail = 0, Stack = 0, Heap = 0, Atts = 0; - char *boot_file, *restore_file; - Int rc; - char *yroot; - if (YAP_initialized) - return YAP_FOUND_BOOT_ERROR; - if (!LOCAL_TextBuffer) - LOCAL_TextBuffer = Yap_InitTextAllocator(); - - yroot = Malloc(YAP_FILENAME_MAX + 1); - boot_file = Malloc(YAP_FILENAME_MAX + 1); - restore_file = Malloc(YAP_FILENAME_MAX + 1); - /* ignore repeated calls to YAP_Init */ - Yap_embedded = yap_init->Embedded; - Yap_page_size = Yap_InitPageSize(); /* init memory page size, required by - later functions */ -#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) - Yap_init_yapor_global_local_memory(); -#endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA */ - if (!yap_init->Embedded) { - GLOBAL_PrologShouldHandleInterrupts = - !yap_init->PrologCannotHandleInterrupts; - Yap_InitSysbits(0); /* init signal handling and time, required by later - functions */ - GLOBAL_argv = yap_init->Argv; - GLOBAL_argc = yap_init->Argc; - } - - char *tmp = NULL, *root; - if (yap_init->bootstrapping) { - restore_result = YAP_BOOT_PL; - } else if (restore_result == YAP_QLY){ - if (yap_init->SavedState == NULL) { - tmp = Malloc(strlen(YAP_STARTUP) + 1); - strncpy(tmp, YAP_STARTUP, strlen(YAP_STARTUP) + 1); - root = Malloc(YAP_FILENAME_MAX+1); - if (yap_init->YapLibDir) - strncpy( root, yap_init->YapLibDir,YAP_FILENAME_MAX ); - else - strncpy( root, YAP_LIBDIR, YAP_FILENAME_MAX ); - } else { - root = Malloc(YAP_FILENAME_MAX); - Yap_getcwd(root, YAP_FILENAME_MAX); - tmp = yap_init->SavedState; - } - } - -#if __ANDROID__ - - //if (yap_init->assetManager) - Yap_InitAssetManager(); - -#endif -#if USE_DL_MALLOC - if (yap_init->SavedState == NULL) - yap_init->SavedState = YAP_STARTUP; -#else - yap_init->SavedState = Yap_findFile(tmp, YAP_STARTUP, root, - restore_file, true, YAP_QLY, true, true); -#endif - if (restore_result == YAP_BOOT_PL) { -#if USE_DL_MALLOC - if (yap_init->YapPrologBootFile == NULL || - yap_init->YapPrologBootFile[0] == 0) - { - yap_init->YapPrologBootFile = YAP_BOOTFILE; - strcpy(boot_file, YAP_BOOTFILE); - } -#else - if (yap_init->YapPrologBootFile == NULL) { - tmp = Malloc(strlen(YAP_BOOTFILE) + 1); - strncpy(tmp,YAP_BOOTFILE, strlen(YAP_BOOTFILE) + 1); - } else { - tmp = (char*)yap_init->YapPrologBootFile; - } - const char *bpath; - if (yap_init->bootstrapping) - bpath = YAP_PL_SRCDIR; - else - bpath = yap_init->YapShareDir; - yap_init->YapPrologBootFile = Yap_findFile(tmp, yap_init->YapPrologBootFile, - bpath, boot_file, - true, YAP_BOOT_PL, true, true); -#endif - } - - if (yap_init->TrailSize == 0) { - if (Trail == 0) - Trail = DefTrailSpace; - } else { - Trail = yap_init->TrailSize; - } -// Atts = yap_init->AttsSize; - if (yap_init->StackSize == 0) { - Stack = DefStackSpace; - } else { - Stack = yap_init->StackSize; - } -#ifndef USE_SYSTEM_MALLOC - if (yap_init->HeapSize == 0) { - if (Heap == 0) - Heap = DefHeapSpace; - } else { - Heap = yap_init->HeapSize; - } -#endif - - Yap_InitWorkspace(yap_init, Heap, Stack, Trail, Atts, yap_init - ->MaxTableSpaceSize, - yap_init->NumberWorkers, yap_init->SchedulerLoop, - yap_init->DelayedReleaseLoad); -// - - CACHE_REGS - if (Yap_embedded) - if (yap_init->QuietMode) { - setVerbosity(TermSilent); - } - { - if (yap_init->YapPrologRCFile != NULL) { -/* - This must be done before restore, otherwise - restore will print out messages .... -*/ - setBooleanGlobalPrologFlag(HALT_AFTER_CONSULT_FLAG, - yap_init - ->HaltAfterConsult); - } -/* tell the system who should cope with interrupts */ - Yap_ExecutionMode = yap_init->ExecutionMode; - if (do_bootstrap) { - restore_result |= - YAP_BOOT_PL; - } else { // try always to boot from the saved state. - if (restore_result == YAP_QLY) { - if (DO_ONLY_CODE != - Yap_SavedInfo(yap_init - ->SavedState, yap_init->YapLibDir, &Trail, - &Stack, &Heap)) { - restore_result = YAP_BOOT_PL; - } else { - restore_result = - Yap_Restore(yap_init->SavedState, yap_init->YapLibDir); - } - if (restore_result == YAP_FOUND_BOOT_ERROR) { - restore_result = YAP_BOOT_PL; - } - } - } - GLOBAL_FAST_BOOT_FLAG = yap_init->FastBoot; -#if defined(YAPOR) || defined(TABLING) - - Yap_init_root_frames(); - -#endif /* YAPOR || TABLING */ -#ifdef YAPOR - Yap_init_yapor_workers(); -#if YAPOR_THREADS - if (Yap_thread_self() != 0) { -#else - if (worker_id != 0) { -#endif -#if defined(YAPOR_COPY) || defined(YAPOR_SBA) - /* - In the SBA we cannot just happily inherit registers - from the other workers - */ - Yap_InitYaamRegs(worker_id); -#endif /* YAPOR_COPY || YAPOR_SBA */ -#ifndef YAPOR_THREADS - Yap_InitPreAllocCodeSpace(0); -#endif /* YAPOR_THREADS */ - /* slaves, waiting for work */ - CurrentModule = USER_MODULE; - P = GETWORK_FIRST_TIME; - Yap_exec_absmi(FALSE, YAP_EXEC_ABSMI); - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "abstract machine unexpected exit (YAP_Init)"); - } -#endif /* YAPOR */ - RECOVER_MACHINE_REGS(); - } -/* make sure we do this after restore */ - if (yap_init->MaxStackSize) { - GLOBAL_AllowLocalExpansion = FALSE; - } else { - GLOBAL_AllowLocalExpansion = TRUE; - } - if (yap_init->MaxGlobalSize) { - GLOBAL_AllowGlobalExpansion = FALSE; - } else { - GLOBAL_AllowGlobalExpansion = TRUE; - } - if (yap_init->MaxTrailSize) { - GLOBAL_AllowTrailExpansion = FALSE; - } else { - GLOBAL_AllowTrailExpansion = TRUE; - } - if (yap_init->YapPrologRCFile) { - Yap_PutValue(AtomConsultOnBoot, - MkAtomTerm(Yap_LookupAtom(yap_init->YapPrologRCFile)) - ); -/* - This must be done again after restore, as yap_flags - has been overwritten .... -*/ - setBooleanGlobalPrologFlag(HALT_AFTER_CONSULT_FLAG, - yap_init - ->HaltAfterConsult); - } - if (yap_init->YapPrologTopLevelGoal) { - Yap_PutValue(AtomTopLevelGoal, - MkAtomTerm(Yap_LookupAtom(yap_init->YapPrologTopLevelGoal)) - ); - } - if (yap_init->YapPrologGoal) { - Yap_PutValue(AtomInitGoal, - MkAtomTerm(Yap_LookupAtom(yap_init->YapPrologGoal)) - ); - } - if (yap_init->YapPrologAddPath) { - Yap_PutValue(AtomExtendFileSearchPath, - MkAtomTerm(Yap_LookupAtom(yap_init->YapPrologAddPath)) - ); - } - if (yap_init->YapPlDir) { - setAtomicGlobalPrologFlag(PROLOG_LIBRARY_DIRECTORY_FLAG, - MkAtomTerm(Yap_LookupAtom(yap_init->YapPlDir)) - ); - } - if (yap_init->YapDLLDir) { - setAtomicGlobalPrologFlag(PROLOG_FOREIGN_DIRECTORY_FLAG, - MkAtomTerm(Yap_LookupAtom(yap_init->YapDLLDir)) - ); - } - if (yap_init->QuietMode) { - setVerbosity(TermSilent); - } - if (restore_result == YAP_QLY) { - LOCAL_PrologMode &= - ~BootMode; - CurrentModule = LOCAL_SourceModule = USER_MODULE; - setBooleanGlobalPrologFlag(SAVED_PROGRAM_FLAG, - true); - rc = YAP_QLY; - } else { - if (boot_file[0] == '\0') - strcpy(boot_file, YAP_BOOTFILE - ); - do_bootfile(boot_file PASS_REGS); - setBooleanGlobalPrologFlag(SAVED_PROGRAM_FLAG, - false); - rc = YAP_BOOT_PL; - } - - start_modules(); - - YAP_initialized = true; - return rc; -} - -#if (DefTrailSpace < MinTrailSpace) -#undef DefTrailSpace -#define DefTrailSpace MinTrailSpace -#endif - -#if (DefStackSpace < MinStackSpace) -#undef DefStackSpace -#define DefStackSpace MinStackSpace -#endif - -#if (DefHeapSpace < MinHeapSpace) -#undef DefHeapSpace -#define DefHeapSpace MinHeapSpace -#endif - -#define DEFAULT_NUMBERWORKERS 1 -#define DEFAULT_SCHEDULERLOOP 10 -#define DEFAULT_DELAYEDRELEASELOAD 3 - -X_API YAP_file_type_t YAP_FastInit(char *saved_state, int argc, char *argv[]) { - YAP_init_args init_args; - YAP_file_type_t out; - - if ((out = Yap_InitDefaults(&init_args, saved_state, argc, argv)) != - YAP_FOUND_BOOT_ERROR) - out = YAP_Init(&init_args); - if (out == YAP_FOUND_BOOT_ERROR) { - Yap_Error(init_args.ErrorNo, TermNil, init_args.ErrorCause); - } - return out; + } + RECOVER_MACHINE_REGS(); + return (LOCAL_ErrorMessage); } X_API void YAP_PutValue(YAP_Atom at, Term t) { Yap_PutValue(at, t); } @@ -2721,15 +2295,15 @@ X_API void YAP_PutValue(YAP_Atom at, Term t) { Yap_PutValue(at, t); } X_API Term YAP_GetValue(YAP_Atom at) { return (Yap_GetValue(at)); } X_API int YAP_CompareTerms(Term t1, Term t2) { - return Yap_compare_terms(t1, t2); + return Yap_compare_terms(t1, t2); } X_API int YAP_Reset(yap_reset_t mode) { - int res = TRUE; - BACKUP_MACHINE_REGS(); - res = Yap_Reset(mode); - RECOVER_MACHINE_REGS(); - return res; + int res = TRUE; + BACKUP_MACHINE_REGS(); + res = Yap_Reset(mode); + RECOVER_MACHINE_REGS(); + return res; } X_API void YAP_Exit(int retval) { Yap_exit(retval); } @@ -2738,7 +2312,7 @@ X_API int YAP_InitSocks(const char *host, long port) { return 0; } X_API void YAP_SetOutputMessage(void) { #if DEBUG - Yap_output_msg = TRUE; + Yap_output_msg = TRUE; #endif } @@ -2749,163 +2323,166 @@ X_API int YAP_StreamToFileNo(Term t) { return (Yap_StreamToFileNo(t)); } * @param sno Stream Id * @return data structure for stream */ -X_API void *YAP_RepStreamFromId(int sno) { return GLOBAL_Stream+sno; } +X_API void *YAP_RepStreamFromId(int sno) { return GLOBAL_Stream + sno; } X_API void YAP_CloseAllOpenStreams(void) { - BACKUP_H(); + BACKUP_H(); - Yap_CloseStreams(FALSE); + Yap_CloseStreams(FALSE); - RECOVER_H(); + RECOVER_H(); } X_API void YAP_FlushAllStreams(void) { - BACKUP_H(); + BACKUP_H(); - // VSC?? Yap_FlushStreams(); + // VSC?? Yap_FlushStreams(); - RECOVER_H(); + RECOVER_H(); } X_API void YAP_Throw(Term t) { - BACKUP_MACHINE_REGS(); - Yap_JumpToEnv(t); - RECOVER_MACHINE_REGS(); + BACKUP_MACHINE_REGS(); + Yap_JumpToEnv(t); + RECOVER_MACHINE_REGS(); } X_API void YAP_AsyncThrow(Term t) { - CACHE_REGS - BACKUP_MACHINE_REGS(); - LOCAL_PrologMode |= AsyncIntMode; - Yap_JumpToEnv(t); - LOCAL_PrologMode &= ~AsyncIntMode; - RECOVER_MACHINE_REGS(); + CACHE_REGS + BACKUP_MACHINE_REGS(); + LOCAL_PrologMode |= AsyncIntMode; + Yap_JumpToEnv(t); + LOCAL_PrologMode &= ~AsyncIntMode; + RECOVER_MACHINE_REGS(); } X_API void YAP_Halt(int i) { Yap_exit(i); } X_API CELL *YAP_TopOfLocalStack(void) { - CACHE_REGS - return (ASP); + CACHE_REGS + return (ASP); } X_API void *YAP_Predicate(YAP_Atom a, UInt arity, Term m) { - if (arity == 0) { - return ((void *) RepPredProp(PredPropByAtom(a, m))); - } else { - Functor f = Yap_MkFunctor(a, arity); - return ((void *) RepPredProp(PredPropByFunc(f, m))); - } + if (arity == 0) { + return ((void *)RepPredProp(PredPropByAtom(a, m))); + } else { + Functor f = Yap_MkFunctor(a, arity); + return ((void *)RepPredProp(PredPropByFunc(f, m))); + } } X_API void YAP_PredicateInfo(void *p, YAP_Atom *a, UInt *arity, Term *m) { - PredEntry *pd = (PredEntry *) p; - if (pd->ArityOfPE) { - *arity = pd->ArityOfPE; - *a = NameOfFunctor(pd->FunctorOfPred); - } else { - *arity = 0; - *a = (Atom) (pd->FunctorOfPred); - } - if (pd->ModuleOfPred) - *m = pd->ModuleOfPred; - else - *m = TermProlog; + PredEntry *pd = (PredEntry *)p; + if (pd->ArityOfPE) { + *arity = pd->ArityOfPE; + *a = NameOfFunctor(pd->FunctorOfPred); + } else { + *arity = 0; + *a = (Atom)(pd->FunctorOfPred); + } + if (pd->ModuleOfPred) + *m = pd->ModuleOfPred; + else + *m = TermProlog; } -X_API void YAP_UserCPredicate(const char *name, YAP_UserCPred def, YAP_Arity arity) { - Yap_InitCPred(name, arity, (CPredicate)def, UserCPredFlag); +X_API void YAP_UserCPredicate(const char *name, YAP_UserCPred def, + YAP_Arity arity) { + Yap_InitCPred(name, arity, (CPredicate)def, UserCPredFlag); } X_API void YAP_UserBackCPredicate_(const char *name, YAP_UserCPred init, YAP_UserCPred cont, YAP_Arity arity, YAP_Arity extra) { - Yap_InitCPredBackCut(name, arity, extra, (CPredicate)init, (CPredicate)cont, NULL, UserCPredFlag); + Yap_InitCPredBackCut(name, arity, extra, (CPredicate)init, (CPredicate)cont, + NULL, UserCPredFlag); } X_API void YAP_UserBackCutCPredicate(const char *name, YAP_UserCPred init, YAP_UserCPred cont, YAP_UserCPred cut, YAP_Arity arity, YAP_Arity extra) { - Yap_InitCPredBackCut(name, arity, extra, (CPredicate)init, - (CPredicate)cont, (CPredicate)cut, UserCPredFlag); + Yap_InitCPredBackCut(name, arity, extra, (CPredicate)init, (CPredicate)cont, + (CPredicate)cut, UserCPredFlag); } X_API void YAP_UserBackCPredicate(const char *name, YAP_UserCPred init, YAP_UserCPred cont, arity_t arity, arity_t extra) { - Yap_InitCPredBackCut(name, arity, extra, (CPredicate)init, (CPredicate)cont, NULL, UserCPredFlag); + Yap_InitCPredBackCut(name, arity, extra, (CPredicate)init, (CPredicate)cont, + NULL, UserCPredFlag); } X_API void YAP_UserCPredicateWithArgs(const char *a, YAP_UserCPred f, arity_t arity, Term mod) { - CACHE_REGS - Term cm = CurrentModule; - CurrentModule = mod; - Yap_InitCPred(a, arity, (CPredicate)f, UserCPredFlag|CArgsPredFlag ); - CurrentModule = cm; + CACHE_REGS + Term cm = CurrentModule; + CurrentModule = mod; + Yap_InitCPred(a, arity, (CPredicate)f, UserCPredFlag | CArgsPredFlag); + CurrentModule = cm; } X_API Term YAP_CurrentModule(void) { - CACHE_REGS - return (CurrentModule); + CACHE_REGS + return (CurrentModule); } X_API Term YAP_SetCurrentModule(Term new) { - CACHE_REGS - Term omod = CurrentModule; - LOCAL_SourceModule = CurrentModule = new; - return omod; + CACHE_REGS + Term omod = CurrentModule; + LOCAL_SourceModule = CurrentModule = new; + return omod; } X_API Term YAP_CreateModule(YAP_Atom at) { - Term t; - WRITE_LOCK(RepAtom(at)->ARWLock); - t = Yap_Module(MkAtomTerm(at)); - WRITE_UNLOCK(RepAtom(at)->ARWLock); - return t; + Term t; + WRITE_LOCK(RepAtom(at)->ARWLock); + t = Yap_Module(MkAtomTerm(at)); + WRITE_UNLOCK(RepAtom(at)->ARWLock); + return t; } X_API Term YAP_StripModule(Term t, Term *modp) { - return Yap_StripModule(t, modp); + return Yap_StripModule(t, modp); } X_API int YAP_ThreadSelf(void) { #if THREADS - return Yap_thread_self(); + return Yap_thread_self(); #else - return -2; + return -2; #endif } X_API int YAP_ThreadCreateEngine(struct YAP_thread_attr_struct *attr) { #if THREADS - return Yap_thread_create_engine(attr); + return Yap_thread_create_engine(attr); #else - return -1; + return -1; #endif } X_API int YAP_ThreadAttachEngine(int wid) { #if THREADS - return Yap_thread_attach_engine(wid); + return Yap_thread_attach_engine(wid); #else - return FALSE; + return FALSE; #endif } X_API int YAP_ThreadDetachEngine(int wid) { #if THREADS - return Yap_thread_detach_engine(wid); + return Yap_thread_detach_engine(wid); #else - return FALSE; + return FALSE; #endif } X_API int YAP_ThreadDestroyEngine(int wid) { #if THREADS - return Yap_thread_destroy_engine(wid); + return Yap_thread_destroy_engine(wid); #else - return FALSE; + return FALSE; #endif } @@ -2918,313 +2495,313 @@ X_API int YAP_AtomGetHold(YAP_Atom at) { return Yap_AtomIncreaseHold(at); } X_API int YAP_AtomReleaseHold(YAP_Atom at) { return Yap_AtomDecreaseHold(at); } X_API YAP_agc_hook YAP_AGCRegisterHook(YAP_agc_hook hook) { - YAP_agc_hook old = (YAP_agc_hook)GLOBAL_AGCHook; - GLOBAL_AGCHook = (Agc_hook)hook; - return old; + YAP_agc_hook old = (YAP_agc_hook)GLOBAL_AGCHook; + GLOBAL_AGCHook = (Agc_hook)hook; + return old; } X_API int YAP_HaltRegisterHook(HaltHookFunc hook, void *closure) { - return Yap_HaltRegisterHook(hook, closure); + return Yap_HaltRegisterHook(hook, closure); } X_API char *YAP_cwd(void) { - CACHE_REGS - char *buf = NULL; - int len; - if (!Yap_getcwd(LOCAL_FileNameBuf, YAP_FILENAME_MAX)) - return FALSE; - len = strlen(LOCAL_FileNameBuf); - buf = Yap_AllocCodeSpace(len + 1); - if (!buf) - return NULL; - strncpy(buf, LOCAL_FileNameBuf, len); - return buf; + CACHE_REGS + char *buf = NULL; + int len; + if (!Yap_getcwd(LOCAL_FileNameBuf, YAP_FILENAME_MAX)) + return FALSE; + len = strlen(LOCAL_FileNameBuf); + buf = Yap_AllocCodeSpace(len + 1); + if (!buf) + return NULL; + strncpy(buf, LOCAL_FileNameBuf, len); + return buf; } X_API Term YAP_FloatsToList(double *dblp, size_t sz) { - CACHE_REGS - Term t; - CELL *oldH; - BACKUP_H(); + CACHE_REGS + Term t; + CELL *oldH; + BACKUP_H(); - if (!sz) - return TermNil; - while (ASP - 1024 < HR + sz * (2 + 2 + SIZEOF_DOUBLE / SIZEOF_INT_P)) { - if ((CELL *) dblp > H0 && (CELL *) dblp < HR) { - /* we are in trouble */ - LOCAL_OpenArray = (CELL *) dblp; - } - if (!Yap_dogc(0, NULL PASS_REGS)) { - RECOVER_H(); - return 0L; - } - dblp = (double *) LOCAL_OpenArray; - LOCAL_OpenArray = NULL; + 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; } - t = AbsPair(HR); - while (sz) { - oldH = HR; - HR += 2; - oldH[0] = MkFloatTerm(*dblp++); - oldH[1] = AbsPair(HR); - sz--; + if (!Yap_dogc(0, NULL PASS_REGS)) { + RECOVER_H(); + return 0L; } - oldH[1] = TermNil; - RECOVER_H(); - return t; + dblp = (double *)LOCAL_OpenArray; + LOCAL_OpenArray = NULL; + } + t = AbsPair(HR); + while (sz) { + oldH = HR; + HR += 2; + oldH[0] = MkFloatTerm(*dblp++); + oldH[1] = AbsPair(HR); + sz--; + } + oldH[1] = TermNil; + RECOVER_H(); + return t; } X_API Int YAP_ListToFloats(Term t, double *dblp, size_t sz) { - size_t i = 0; + size_t i = 0; - t = Deref(t); - do { - Term hd; - if (IsVarTerm(t)) - return -1; - if (t == TermNil) - return i; - if (!IsPairTerm(t)) - return -1; - hd = HeadOfTerm(t); - if (IsFloatTerm(hd)) { - dblp[i++] = FloatOfTerm(hd); - } else { - extern double Yap_gmp_to_float(Term hd); + t = Deref(t); + do { + Term hd; + if (IsVarTerm(t)) + return -1; + if (t == TermNil) + return i; + if (!IsPairTerm(t)) + return -1; + hd = HeadOfTerm(t); + if (IsFloatTerm(hd)) { + dblp[i++] = FloatOfTerm(hd); + } else { + extern double Yap_gmp_to_float(Term hd); - if (IsIntTerm(hd)) - dblp[i++] = IntOfTerm(hd); - else if (IsLongIntTerm(hd)) - dblp[i++] = LongIntOfTerm(hd); + if (IsIntTerm(hd)) + dblp[i++] = IntOfTerm(hd); + else if (IsLongIntTerm(hd)) + dblp[i++] = LongIntOfTerm(hd); #if USE_GMP - else if (IsBigIntTerm(hd)) - dblp[i++] = Yap_gmp_to_float(hd); + else if (IsBigIntTerm(hd)) + dblp[i++] = Yap_gmp_to_float(hd); #endif - else - return -1; - } - if (i == sz) - return sz; - t = TailOfTerm(t); - } while (TRUE); + else + return -1; + } + if (i == sz) + return sz; + t = TailOfTerm(t); + } while (TRUE); } X_API Term YAP_IntsToList(Int *dblp, size_t sz) { - CACHE_REGS - Term t; - CELL *oldH; - BACKUP_H(); + CACHE_REGS + Term t; + CELL *oldH; + BACKUP_H(); - if (!sz) - return TermNil; - while (ASP - 1024 < HR + sz * 3) { - if ((CELL *) dblp > H0 && (CELL *) dblp < HR) { - /* we are in trouble */ - LOCAL_OpenArray = (CELL *) dblp; - } - if (!Yap_dogc(0, NULL PASS_REGS)) { - RECOVER_H(); - return 0L; - } - dblp = (Int *) LOCAL_OpenArray; - LOCAL_OpenArray = NULL; + 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; } - t = AbsPair(HR); - while (sz) { - oldH = HR; - HR += 2; - oldH[0] = MkIntegerTerm(*dblp++); - oldH[1] = AbsPair(HR); - sz--; + if (!Yap_dogc(0, NULL PASS_REGS)) { + RECOVER_H(); + return 0L; } - oldH[1] = TermNil; - RECOVER_H(); - return t; + dblp = (Int *)LOCAL_OpenArray; + LOCAL_OpenArray = NULL; + } + t = AbsPair(HR); + while (sz) { + oldH = HR; + HR += 2; + oldH[0] = MkIntegerTerm(*dblp++); + oldH[1] = AbsPair(HR); + sz--; + } + oldH[1] = TermNil; + RECOVER_H(); + return t; } X_API Int YAP_ListToInts(Term t, Int *dblp, size_t sz) { - size_t i = 0; + size_t i = 0; - t = Deref(t); - do { - Term hd; - if (IsVarTerm(t)) - return -1; - if (t == TermNil) - return i; - if (!IsPairTerm(t)) - return -1; - hd = HeadOfTerm(t); - if (!IsIntTerm(hd)) - return -1; - dblp[i++] = IntOfTerm(hd); - if (i == sz) - return sz; - t = TailOfTerm(t); - } while (TRUE); + t = Deref(t); + do { + Term hd; + if (IsVarTerm(t)) + return -1; + if (t == TermNil) + return i; + if (!IsPairTerm(t)) + return -1; + hd = HeadOfTerm(t); + if (!IsIntTerm(hd)) + return -1; + dblp[i++] = IntOfTerm(hd); + if (i == sz) + return sz; + t = TailOfTerm(t); + } while (TRUE); } X_API Term YAP_OpenList(int n) { - CACHE_REGS - Term t; - BACKUP_H(); + CACHE_REGS + Term t; + BACKUP_H(); - while (HR + 2 * n > ASP - 1024) { - if (!Yap_dogc(0, NULL PASS_REGS)) { - RECOVER_H(); - return FALSE; - } + while (HR + 2 * n > ASP - 1024) { + if (!Yap_dogc(0, NULL PASS_REGS)) { + RECOVER_H(); + return FALSE; } - t = AbsPair(HR); - HR += 2 * n; + } + t = AbsPair(HR); + HR += 2 * n; - RECOVER_H(); - return t; + RECOVER_H(); + return t; } X_API Term YAP_ExtendList(Term t0, Term inp) { - Term t; - CELL *ptr = RepPair(t0); - BACKUP_H(); + Term t; + CELL *ptr = RepPair(t0); + BACKUP_H(); - ptr[0] = inp; - ptr[1] = AbsPair(ptr + 2); - t = AbsPair(ptr + 2); + ptr[0] = inp; + ptr[1] = AbsPair(ptr + 2); + t = AbsPair(ptr + 2); - RECOVER_H(); - return t; + RECOVER_H(); + return t; } X_API int YAP_CloseList(Term t0, Term tail) { - CELL *ptr = RepPair(t0); + CELL *ptr = RepPair(t0); - RESET_VARIABLE(ptr - 1); - if (!Yap_unify((Term) (ptr - 1), tail)) - return FALSE; - return TRUE; + RESET_VARIABLE(ptr - 1); + if (!Yap_unify((Term)(ptr - 1), tail)) + return FALSE; + return TRUE; } X_API int YAP_IsAttVar(Term t) { - CACHE_REGS - t = Deref(t); - if (!IsVarTerm(t)) - return FALSE; - return IsAttVar(VarOfTerm(t)); + CACHE_REGS + t = Deref(t); + if (!IsVarTerm(t)) + return FALSE; + return IsAttVar(VarOfTerm(t)); } X_API Term YAP_AttsOfVar(Term t) { - CACHE_REGS - attvar_record *attv; + CACHE_REGS + attvar_record *attv; - t = Deref(t); - if (!IsVarTerm(t)) - return TermNil; - if (!IsAttVar(VarOfTerm(t))) - return TermNil; - attv = RepAttVar(VarOfTerm(t)); - return attv->Atts; + t = Deref(t); + if (!IsVarTerm(t)) + return TermNil; + if (!IsAttVar(VarOfTerm(t))) + return TermNil; + attv = RepAttVar(VarOfTerm(t)); + return attv->Atts; } X_API int YAP_FileNoFromStream(Term t) { - t = Deref(t); - if (IsVarTerm(t)) - return -1; - return Yap_StreamToFileNo(t); + t = Deref(t); + if (IsVarTerm(t)) + return -1; + return Yap_StreamToFileNo(t); } X_API void *YAP_FileDescriptorFromStream(Term t) { - t = Deref(t); - if (IsVarTerm(t)) - return NULL; - return Yap_FileDescriptorFromStream(t); + t = Deref(t); + if (IsVarTerm(t)) + return NULL; + return Yap_FileDescriptorFromStream(t); } X_API void *YAP_Record(Term t) { - DBTerm *dbterm; - DBRecordList *dbt; + 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; - } + 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; + } + if (Yap_Records) { + Yap_Records->prev_rec = dbt; + } + dbt->next_rec = Yap_Records; + dbt->prev_rec = NULL; + dbt->dbrecord = dbterm; + Yap_Records = dbt; + return dbt; } X_API Term YAP_Recorded(void *handle) { - CACHE_REGS - Term t; - DBTerm *dbterm = ((DBRecordList *) handle)->dbrecord; + 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; + BACKUP_MACHINE_REGS(); + do { + LOCAL_Error_TYPE = YAP_NO_ERROR; + t = Yap_FetchTermFromDB(dbterm); + if (LOCAL_Error_TYPE == YAP_NO_ERROR) { + RECOVER_MACHINE_REGS(); + return t; + } else if (LOCAL_Error_TYPE == RESOURCE_ERROR_ATTRIBUTED_VARIABLES) { + LOCAL_Error_TYPE = YAP_NO_ERROR; + if (!Yap_growglobal(NULL)) { + Yap_Error(RESOURCE_ERROR_ATTRIBUTED_VARIABLES, TermNil, + LOCAL_ErrorMessage); + RECOVER_MACHINE_REGS(); + return FALSE; + } + } else { + LOCAL_Error_TYPE = YAP_NO_ERROR; + if (!Yap_growstack(dbterm->NOfCells * CellSize)) { + Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage); + RECOVER_MACHINE_REGS(); + return FALSE; + } + } + } while (t == (CELL)0); + RECOVER_MACHINE_REGS(); + return t; } X_API int YAP_Erase(void *handle) { - DBRecordList *dbr = (DBRecordList *) handle; - if (dbr->next_rec) - dbr->next_rec->prev_rec = dbr->prev_rec; - if (dbr->prev_rec) - dbr->prev_rec->next_rec = dbr->next_rec; - else if (Yap_Records == dbr) { - Yap_Records = dbr->next_rec; - } - Yap_ReleaseTermFromDB(dbr->dbrecord); - Yap_FreeCodeSpace(handle); - return 1; + DBRecordList *dbr = (DBRecordList *)handle; + if (dbr->next_rec) + dbr->next_rec->prev_rec = dbr->prev_rec; + if (dbr->prev_rec) + dbr->prev_rec->next_rec = dbr->next_rec; + else if (Yap_Records == dbr) { + Yap_Records = dbr->next_rec; + } + Yap_ReleaseTermFromDB(dbr->dbrecord); + Yap_FreeCodeSpace(handle); + return 1; } X_API yhandle_t YAP_ArgsToSlots(int n) { - CACHE_REGS - return Yap_NewSlots(n); + CACHE_REGS + return Yap_NewSlots(n); } X_API void YAP_SlotsToArgs(int n, yhandle_t slot) { - CACHE_REGS - CELL *ptr0 = Yap_AddressFromSlot(slot), *ptr1 = &ARG1; - while (n--) { - *ptr1++ = *ptr0++; - } + CACHE_REGS + CELL *ptr0 = Yap_AddressFromSlot(slot), *ptr1 = &ARG1; + while (n--) { + *ptr1++ = *ptr0++; + } } X_API void YAP_signal(int sig) { Yap_signal(sig); } @@ -3233,11 +2810,11 @@ X_API int YAP_SetYAPFlag(Term flag, Term val) { return setYapFlag(flag, val); } /* yhandle_t YAP_VarSlotToNumber(yhandle_t) */ X_API yhandle_t YAP_VarSlotToNumber(yhandle_t s) { - CACHE_REGS - Term *t = (CELL *) Deref(Yap_GetFromSlot(s)); - if (t < HR) - return t - H0; - return t - LCL0; + CACHE_REGS + Term *t = (CELL *)Deref(Yap_GetFromSlot(s)); + if (t < HR) + return t - H0; + return t - LCL0; } /* Term YAP_ModuleUser() */ @@ -3245,138 +2822,139 @@ X_API Term YAP_ModuleUser(void) { return MkAtomTerm(AtomUser); } /* int YAP_PredicateHasClauses() */ X_API YAP_handle_t YAP_NumberOfClausesForPredicate(YAP_PredEntryPtr ape) { - PredEntry *pe = ape; - return pe->cs.p_code.NOfClauses; + PredEntry *pe = ape; + return pe->cs.p_code.NOfClauses; } X_API int YAP_MaxOpPriority(YAP_Atom at, Term module) { - AtomEntry *ae = RepAtom(at); - OpEntry *info; - WRITE_LOCK(ae->ARWLock); - info = Yap_GetOpPropForAModuleHavingALock(ae, module); - if (!info) { - WRITE_UNLOCK(ae->ARWLock); - return 0; - } - int ret = info->Prefix; - if (info->Infix > ret) - ret = info->Infix; - if (info->Posfix > ret) - ret = info->Posfix; + AtomEntry *ae = RepAtom(at); + OpEntry *info; + WRITE_LOCK(ae->ARWLock); + info = Yap_GetOpPropForAModuleHavingALock(ae, module); + if (!info) { WRITE_UNLOCK(ae->ARWLock); - return ret; + 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; +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); + WRITE_LOCK(ae->ARWLock); + info = Yap_GetOpPropForAModuleHavingALock(ae, module); + if (!info) { + /* try system operators */ + info = Yap_GetOpPropForAModuleHavingALock(ae, PROLOG_MODULE); if (!info) { - /* try system operators */ - info = Yap_GetOpPropForAModuleHavingALock(ae, PROLOG_MODULE); - if (!info) { - WRITE_UNLOCK(ae->ARWLock); - return 0; - } + WRITE_UNLOCK(ae->ARWLock); + return 0; } - if (opkind == PREFIX_OP) { - SMALLUNSGN p = info->Prefix; - if (!p) { - WRITE_UNLOCK(ae->ARWLock); - return FALSE; - } - if (p & DcrrpFlag) { - n = 6; - *prio = (p ^ DcrrpFlag); - } else { - n = 7; - *prio = p; - } - } else if (opkind == INFIX_OP) { - SMALLUNSGN p = info->Infix; - if (!p) { - WRITE_UNLOCK(ae->ARWLock); - return FALSE; - } - if ((p & DcrrpFlag) && (p & DcrlpFlag)) { - n = 1; - *prio = (p ^ (DcrrpFlag | DcrlpFlag)); - } else if (p & DcrrpFlag) { - n = 3; - *prio = (p ^ DcrrpFlag); - } else if (p & DcrlpFlag) { - n = 2; - *prio = (p ^ DcrlpFlag); - } else { - n = 4; - *prio = p; - } + } + if (opkind == PREFIX_OP) { + SMALLUNSGN p = info->Prefix; + if (!p) { + WRITE_UNLOCK(ae->ARWLock); + return FALSE; + } + if (p & DcrrpFlag) { + n = 6; + *prio = (p ^ DcrrpFlag); } else { - SMALLUNSGN p = info->Posfix; - if (p & DcrlpFlag) { - n = 4; - *prio = (p ^ DcrlpFlag); - } else { - n = 5; - *prio = p; - } + n = 7; + *prio = p; } - *yap_type = n; - WRITE_UNLOCK(ae->ARWLock); - return 1; + } else if (opkind == INFIX_OP) { + SMALLUNSGN p = info->Infix; + if (!p) { + WRITE_UNLOCK(ae->ARWLock); + return FALSE; + } + if ((p & DcrrpFlag) && (p & DcrlpFlag)) { + n = 1; + *prio = (p ^ (DcrrpFlag | DcrlpFlag)); + } else if (p & DcrrpFlag) { + n = 3; + *prio = (p ^ DcrrpFlag); + } else if (p & DcrlpFlag) { + n = 2; + *prio = (p ^ DcrlpFlag); + } else { + n = 4; + *prio = p; + } + } else { + SMALLUNSGN p = info->Posfix; + if (p & DcrlpFlag) { + n = 4; + *prio = (p ^ DcrlpFlag); + } else { + n = 5; + *prio = p; + } + } + *yap_type = n; + WRITE_UNLOCK(ae->ARWLock); + return 1; } X_API int YAP_Argv(char ***argvp) { - if (argvp) { - *argvp = GLOBAL_argv; - } - return GLOBAL_argc; + if (argvp) { + *argvp = GLOBAL_argv; + } + return GLOBAL_argc; } X_API YAP_tag_t YAP_TagOfTerm(Term t) { - if (IsVarTerm(t)) { - CELL *pt = VarOfTerm(t); - if (IsUnboundVar(pt)) { - CACHE_REGS - if (IsAttVar(pt)) - return YAP_TAG_ATT; - return YAP_TAG_UNBOUND; - } - return YAP_TAG_REF; + if (IsVarTerm(t)) { + CELL *pt = VarOfTerm(t); + if (IsUnboundVar(pt)) { + CACHE_REGS + if (IsAttVar(pt)) + return YAP_TAG_ATT; + return YAP_TAG_UNBOUND; } - 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); + 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; - } - } + if (IsExtensionFunctor(f)) { + if (f == FunctorDBRef) { + return YAP_TAG_DBREF; + } + if (f == FunctorLongInt) { + return YAP_TAG_LONG_INT; + } + if (f == FunctorBigInt) { + big_blob_type bt = RepAppl(t)[1]; + switch (bt) { + case BIG_INT: + return YAP_TAG_BIG_INT; + case BIG_RATIONAL: + return YAP_TAG_RATIONAL; + default: + return YAP_TAG_OPAQUE; } - return YAP_TAG_APPL; + } } + return YAP_TAG_APPL; + } } int YAP_BPROLOG_exception; @@ -3392,95 +2970,97 @@ Term YAP_BPROLOG_curr_toam_status; * @return a positive number with the size, or 0. */ X_API size_t YAP_UTF8_TextLength(Term t) { - utf8proc_uint8_t dst[8]; - size_t sz = 0; + utf8proc_uint8_t dst[8]; + size_t sz = 0; - if (IsPairTerm(t)) { - while (t != TermNil) { - int c; + 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'; - } + 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); - } - } else if (IsAtomTerm(t)) { - Atom at = AtomOfTerm(t); - char *s = RepAtom(at)->StrOfAE; - sz = strlen(s); - } else if (IsStringTerm(t)) { - sz = strlen(StringOfTerm(t)); + sz += utf8proc_encode_char(c, dst); + t = TailOfTerm(t); } - return sz; + } 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; } X_API Int YAP_ListLength(Term t) { - Term *aux; + Term *aux; - Int n = Yap_SkipList(&t, &aux); - if (IsVarTerm(*aux)) - return -1; - if (*aux == TermNil) - return n; + Int n = Yap_SkipList(&t, &aux); + if (IsVarTerm(*aux)) return -1; + if (*aux == TermNil) + return n; + return -1; } -X_API Int YAP_NumberVars(Term t, Int nbv) { return Yap_NumberVars(t, nbv, FALSE); } +X_API Int YAP_NumberVars(Term t, Int nbv) { + return Yap_NumberVars(t, nbv, FALSE); +} X_API Term YAP_UnNumberVars(Term t) { - /* don't allow sharing of ground terms */ - return Yap_UnNumberTerm(t, FALSE); + /* don't allow sharing of ground terms */ + return Yap_UnNumberTerm(t, FALSE); } X_API int YAP_IsNumberedVariable(Term t) { - return IsApplTerm(t) && FunctorOfTerm(t) == FunctorDollarVar && - IsIntegerTerm(ArgOfTerm(1, t)); + return IsApplTerm(t) && FunctorOfTerm(t) == FunctorDollarVar && + IsIntegerTerm(ArgOfTerm(1, t)); } X_API size_t YAP_ExportTerm(Term inp, char *buf, size_t len) { - if (!len) - return 0; - return Yap_ExportTerm(inp, buf, len, current_arity()); + if (!len) + return 0; + return Yap_ExportTerm(inp, buf, len, current_arity()); } X_API size_t YAP_SizeOfExportedTerm(char *buf) { - if (!buf) - return 0; - return Yap_SizeOfExportedTerm(buf); + if (!buf) + return 0; + return Yap_SizeOfExportedTerm(buf); } X_API Term YAP_ImportTerm(char *buf) { return Yap_ImportTerm(buf); } X_API int YAP_RequiresExtraStack(size_t sz) { - CACHE_REGS + CACHE_REGS - if (sz < 16 * 1024) - sz = 16 * 1024; - if (HR <= ASP - sz) { - return FALSE; + if (sz < 16 * 1024) + sz = 16 * 1024; + if (HR <= ASP - sz) { + return FALSE; + } + BACKUP_H(); + while (HR > ASP - sz) { + CACHE_REGS + RECOVER_H(); + if (!Yap_dogc(0, NULL PASS_REGS)) { + return -1; } BACKUP_H(); - while (HR > ASP - sz) { - CACHE_REGS - RECOVER_H(); - if (!Yap_dogc(0, NULL PASS_REGS)) { - return -1; - } - BACKUP_H(); - } - RECOVER_H(); - return TRUE; + } + RECOVER_H(); + return TRUE; } atom_t *TR_Atoms; @@ -3489,67 +3069,69 @@ size_t AtomTranslations, MaxAtomTranslations; size_t FunctorTranslations, MaxFunctorTranslations; X_API Int YAP_AtomToInt(YAP_Atom At) { - 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; - } - memcpy(nt, ot, sizeof(atom_t) * MaxAtomTranslations); - TR_Atoms = nt; - free(ot); - MaxAtomTranslations *= 2; + 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; } - return AtomTranslations - 1; + memcpy(nt, ot, sizeof(atom_t) * MaxAtomTranslations); + TR_Atoms = nt; + free(ot); + MaxAtomTranslations *= 2; + } + return AtomTranslations - 1; } X_API YAP_Atom YAP_IntToAtom(Int i) { return TR_Atoms[i]; } X_API Int YAP_FunctorToInt(YAP_Functor f) { - 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; - } - memcpy(nt, ot, sizeof(functor_t) * MaxFunctorTranslations); - TR_Functors = nt; - free(ot); - MaxFunctorTranslations *= 2; + 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; } - return FunctorTranslations - 1; + memcpy(nt, ot, sizeof(functor_t) * MaxFunctorTranslations); + 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; } +X_API void *YAP_foreign_stream(int sno) { + return GLOBAL_Stream[sno].u.private_data; +} X_API YAP_Functor YAP_IntToFunctor(Int i) { return TR_Functors[i]; } X_API void *YAP_shared(void) { return LOCAL_shared; } X_API YAP_PredEntryPtr YAP_TopGoal(void) { - Functor f = Yap_MkFunctor(Yap_LookupAtom("yap_query"), 3); - Term tmod = MkAtomTerm(Yap_LookupAtom("yapi")); - PredEntry *p = RepPredProp(Yap_GetPredPropByFunc(f, tmod)); - return p; + Functor f = Yap_MkFunctor(Yap_LookupAtom("yap_query"), 3); + Term tmod = MkAtomTerm(Yap_LookupAtom("yapi")); + PredEntry *p = RepPredProp(Yap_GetPredPropByFunc(f, tmod)); + return p; } void yap_init(void) {} diff --git a/C/load_dl.c b/C/load_dl.c index 824a889cf..c0989fde4 100755 --- a/C/load_dl.c +++ b/C/load_dl.c @@ -167,18 +167,10 @@ static Int LoadForeign(StringList while (libs) { const char *file = AtomName(libs->name); - if (!Yap_findFile(file, NULL, NULL, LOCAL_FileNameBuf, true, YAP_OBJ, true, - true)) { - LOCAL_ErrorMessage = malloc(MAX_ERROR_MSG_SIZE); - /* use LD_LIBRARY_PATH */ - strncpy(LOCAL_ErrorMessage, (char *)AtomName(libs->name), - YAP_FILENAME_MAX); - } - #ifdef __osf__ if ((libs->handle = dlopen(LOCAL_FileNameBuf, RTLD_LAZY)) == NULL) #else - if ((libs->handle = dlopen(LOCAL_FileNameBuf, RTLD_LAZY | RTLD_GLOBAL)) == + if ((libs->handle = dlopen(file, RTLD_LAZY | RTLD_GLOBAL)) == NULL) #endif { @@ -195,20 +187,9 @@ static Int LoadForeign(StringList /* load libraries first so that their symbols are available to other routines */ const char *file = AtomName(ofiles->name); - if (!Yap_findFile(file, NULL, NULL, LOCAL_FileNameBuf, true, YAP_OBJ, true, - true)) { - if (LOCAL_ErrorMessage == NULL) { - LOCAL_ErrorMessage = malloc(MAX_ERROR_MSG_SIZE); - strcpy(LOCAL_ErrorMessage, - "%% Trying to open non-existing file in LoadForeign"); - } - } -#ifdef __osf__ - if ((ofiles->handle = dlopen(LOCAL_FileNameBuf, RTLD_LAZY)) == NULL) -#else - if ((ofiles->handle = dlopen(LOCAL_FileNameBuf, RTLD_LAZY | RTLD_GLOBAL)) == + + if ((ofiles->handle = dlopen(file, RTLD_LAZY | RTLD_GLOBAL)) == NULL) -#endif { if (LOCAL_ErrorMessage == NULL) { LOCAL_ErrorMessage = malloc(MAX_ERROR_MSG_SIZE); diff --git a/C/qlyr.c b/C/qlyr.c index 1649b3ea3..a67f3109f 100755 --- a/C/qlyr.c +++ b/C/qlyr.c @@ -1097,10 +1097,10 @@ static Int qload_program(USES_REGS1) { return true; } -YAP_file_type_t Yap_Restore(const char *s, const char *lib_dir) { +YAP_file_type_t Yap_Restore(const char *s) { CACHE_REGS - FILE *stream = Yap_OpenRestore(s, lib_dir); + FILE *stream = Yap_OpenRestore(s); if (!stream) return -1; GLOBAL_RestoreFile = s; diff --git a/C/save.c b/C/save.c index 3b84075e7..fe53275d9 100755 --- a/C/save.c +++ b/C/save.c @@ -87,7 +87,7 @@ void initIO(void); static int myread(FILE *, char *, Int); static Int mywrite(FILE *, char *, Int); -static FILE *open_file(char *, int); +static FILE *open_file(const char *, int); static int close_file(void); static Int putout(CELL); static Int putcellptr(CELL *); @@ -123,7 +123,7 @@ static void restore_heap(void); static void ShowAtoms(void); static void ShowEntries(PropEntry *); #endif -static int OpenRestore(const char *, const char *, CELL *, CELL *, CELL *, +static int OpenRestore(const char *, CELL *, CELL *, CELL *, CELL *, FILE **); static void CloseRestore(void); #ifndef _WIN32 @@ -233,7 +233,7 @@ static Int OldHeapUsed; static CELL which_save; /* Open a file to read or to write */ -static FILE *open_file(char *my_file, int flag) { +static FILE *open_file(const char *my_file, int flag) { FILE *splfild; char flags[6]; int i = 0; @@ -1307,10 +1307,11 @@ static void ShowAtoms() { #include -static int commit_to_saved_state(char *s, CELL *Astate, CELL *ATrail, +static int commit_to_saved_state(const char *s, CELL *Astate, CELL *ATrail, CELL *AStack, CELL *AHeap) { CACHE_REGS int mode; + char tmp[YAP_FILENAME_MAX+1]; if ((mode = check_header(Astate, ATrail, AStack, AHeap PASS_REGS)) == FAIL_RESTORE) @@ -1318,9 +1319,8 @@ static int commit_to_saved_state(char *s, CELL *Astate, CELL *ATrail, LOCAL_PrologMode = BootMode; if (Yap_HeapBase) { if (falseGlobalPrologFlag(HALT_AFTER_CONSULT_FLAG) && !silentMode()) { - Yap_findFile(s, NULL, NULL, LOCAL_FileNameBuf2, true, YAP_QLY, true, - true); - fprintf(stderr, "%% Restoring file %s\n", LOCAL_FileNameBuf2); + Yap_AbsoluteFile(s, tmp, true); + fprintf(stderr, "%% Restoring file %s\n", tmp); } Yap_CloseStreams(TRUE); } @@ -1333,7 +1333,7 @@ static int commit_to_saved_state(char *s, CELL *Astate, CELL *ATrail, return mode; } -static int try_open(char *inpf, CELL *Astate, CELL *ATrail, CELL *AStack, +static int try_open(const char *inpf, CELL *Astate, CELL *ATrail, CELL *AStack, CELL *AHeap, FILE **streamp) { int mode; @@ -1355,18 +1355,13 @@ static int try_open(char *inpf, CELL *Astate, CELL *ATrail, CELL *AStack, return mode; } -static int OpenRestore(const char *inpf, const char *YapLibDir, CELL *Astate, +static int OpenRestore(const char *fname, CELL *Astate, CELL *ATrail, CELL *AStack, CELL *AHeap, FILE **streamp) { CACHE_REGS int mode; - char fname[YAP_FILENAME_MAX + 1]; - - if (!Yap_findFile(inpf, YAP_STARTUP, YapLibDir, fname, true, YAP_QLY, - true, true)) - return FAIL_RESTORE; - if (fname[0] && (mode = try_open(fname, Astate, ATrail, AStack, AHeap, + if (fname && fname[0] && (mode = try_open(fname, Astate, ATrail, AStack, AHeap, streamp)) != FAIL_RESTORE) { setAtomicGlobalPrologFlag(RESOURCE_DATABASE_FLAG, MkAtomTerm(Yap_LookupAtom(fname))); @@ -1378,22 +1373,19 @@ static int OpenRestore(const char *inpf, const char *YapLibDir, CELL *Astate, do_SYSTEM_ERROR_INTERNAL(PERMISSION_ERROR_OPEN_SOURCE_SINK, "incorrect saved state "); } else { - strncpy(LOCAL_FileNameBuf, inpf, YAP_FILENAME_MAX - 1); + strncpy(LOCAL_FileNameBuf, fname, YAP_FILENAME_MAX - 1); do_SYSTEM_ERROR_INTERNAL(PERMISSION_ERROR_OPEN_SOURCE_SINK, "could not open saved state"); } return FAIL_RESTORE; } -FILE *Yap_OpenRestore(const char *inpf, const char *YapLibDir) { +FILE *Yap_OpenRestore(const char *inpf) { FILE *stream = NULL; if (!inpf) inpf = "startup.yss"; - if (!YapLibDir) { - YapLibDir = YAP_LIBDIR; - } - OpenRestore(inpf, YapLibDir, NULL, NULL, NULL, NULL, &stream); + OpenRestore(inpf, NULL, NULL, NULL, NULL, &stream); return stream; } @@ -1467,14 +1459,14 @@ static void RestoreHeap(OPCODE old_ops[] USES_REGS) { * This function is called to know about the parameters of the last saved * state */ -int Yap_SavedInfo(const char *FileName, const char *YapLibDir, CELL *ATrail, +int Yap_SavedInfo(const char *FileName, CELL *ATrail, CELL *AStack, CELL *AHeap) { return DO_ONLY_CODE; CELL MyTrail, MyStack, MyHeap, MyState; int mode; - mode = OpenRestore(FileName, YapLibDir, &MyState, &MyTrail, &MyStack, &MyHeap, + mode = OpenRestore(FileName, &MyState, &MyTrail, &MyStack, &MyHeap, NULL); if (mode == FAIL_RESTORE) { return -1; @@ -1554,13 +1546,13 @@ static void FreeRecords(void) { * This function is called when wanting only to restore the heap and * associated registers */ -static int Restore(char *s, char *lib_dir USES_REGS) { +static int Restore(char *s_dir USES_REGS) { int restore_mode; OPCODE old_ops[_std_top + 1]; CELL MyTrail, MyStack, MyHeap, MyState; - if ((restore_mode = OpenRestore(s, lib_dir, &MyState, &MyTrail, &MyStack, + if ((restore_mode = OpenRestore(s_dir, &MyState, &MyTrail, &MyStack, &MyHeap, NULL)) == FAIL_RESTORE) return (FALSE); Yap_ShutdownLoadForeign(); @@ -1612,9 +1604,9 @@ static int Restore(char *s, char *lib_dir USES_REGS) { return restore_mode; } -int Yap_SavedStateRestore(char *s, char *lib_dir) { +int Yap_SavedStateRestore(char *s) { CACHE_REGS - return Restore(s, lib_dir PASS_REGS); + return Restore(s PASS_REGS); } static Int p_restore(USES_REGS1) { @@ -1640,7 +1632,7 @@ static Int p_restore(USES_REGS1) { Yap_Error(TYPE_ERROR_LIST, t1, "restore/1"); return (FALSE); } - if ((mode = Restore(s, NULL PASS_REGS)) == DO_ONLY_CODE) { + if ((mode = Restore(s PASS_REGS)) == DO_ONLY_CODE) { Yap_RestartYap(3); } return (mode != FAIL_RESTORE); diff --git a/C/stdpreds.c b/C/stdpreds.c index 10679dd18..7d25fe1e3 100755 --- a/C/stdpreds.c +++ b/C/stdpreds.c @@ -1349,13 +1349,13 @@ static Int p_statistics_lu_db_size(USES_REGS1) { } static Int p_executable(USES_REGS1) { + char tmp[YAP_FILENAME_MAX+1]; if (GLOBAL_argv && GLOBAL_argv[0]) - Yap_findFile(GLOBAL_argv[0], NULL, NULL, LOCAL_FileNameBuf, true, YAP_EXE, - true, true); + Yap_AbsoluteFile(GLOBAL_argv[0], tmp, true); else - strncpy(LOCAL_FileNameBuf, Yap_FindExecutable(), YAP_FILENAME_MAX - 1); + strncpy(tmp, Yap_FindExecutable(), YAP_FILENAME_MAX); - return Yap_unify(MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf)), ARG1); + return Yap_unify(MkAtomTerm(Yap_LookupAtom(tmp)), ARG1); } static Int p_system_mode(USES_REGS1) { diff --git a/C/text.c b/C/text.c index 8259a5456..3044212a2 100644 --- a/C/text.c +++ b/C/text.c @@ -31,7 +31,7 @@ inline static size_t min_size(size_t i, size_t j) { return (i < j ? i : j); } #define wcsnlen(S, N) min_size(N, wcslen(S)) #endif -#ifndef HAVE_STPCPY +#if !defined(HAVE_STPCPY) && !defined(__APPLE__) inline static void* __stpcpy(void * i, const void * j) { return strcpy(i,j)+strlen(j);} #define stpcpy __stpcpy #endif diff --git a/C/yap-args.c b/C/yap-args.c index 0318baec5..dd894c189 100755 --- a/C/yap-args.c +++ b/C/yap-args.c @@ -9,7 +9,8 @@ ************************************************************************** * * * File: Yap.C * Last - *Rev: * Mods: + *Rev: + * Mods: ** Comments: Yap's Main File: parse arguments * * * *************************************************************************/ @@ -18,6 +19,7 @@ #include "Yap.h" #include "YapHeap.h" #include "YapInterface.h" +#include "YapStreams.h" #include "config.h" #if HAVE_UNISTD_H @@ -61,224 +63,441 @@ #endif -const char *Yap_BINDIR, *Yap_ROOTDIR, *Yap_SHAREDIR, *Yap_LIBDIR, *Yap_DLLDIR, *Yap_PLDIR; +const char *Yap_BINDIR, *Yap_ROOTDIR, *Yap_SHAREDIR, *Yap_LIBDIR, *Yap_DLLDIR, + *Yap_PLDIR, *Yap_BOOTPLDIR, *Yap_BOOTSTRAPPLDIR, *Yap_COMMONSDIR, + *Yap_STARTUP, *Yap_BOOTFILE; -const char *rootdirs[] = { - YAP_ROOTDIR, - "(EXECUTABLE)..", - "/usr/local", - "~", - NULL -}; + +static int yap_lineno = 0; + +/* do initial boot by consulting the file boot.yap */ +static void do_bootfile(const char *b_file USES_REGS) { + Term t; + int boot_stream, osno; + Functor functor_query = Yap_MkFunctor(Yap_LookupAtom("?-"), 1); + Functor functor_command1 = Yap_MkFunctor(Yap_LookupAtom(":-"), 1); + + /* consult boot.pl */ + char *full = malloc(YAP_FILENAME_MAX + 1); + full[0] = '\0'; + /* the consult mode does not matter here, really */ + boot_stream = YAP_InitConsult(YAP_BOOT_MODE, b_file, full, &osno); + if (boot_stream < 0) { + fprintf(stderr, "[ FATAL ERROR: could not open boot_stream %s ]\n", + b_file); + exit(1); + } + free(full); + setAtomicGlobalPrologFlag( + RESOURCE_DATABASE_FLAG, + MkAtomTerm(GLOBAL_Stream[boot_stream].name)); + do { + CACHE_REGS + YAP_Reset(YAP_FULL_RESET); + Yap_StartSlots(); + t = YAP_ReadClauseFromStream(boot_stream); + + // Yap_DebugPlWriteln(t); + if (t == 0) { + fprintf(stderr, + "[ SYNTAX ERROR: while parsing boot_stream %s at line %d ]\n", + b_file, yap_lineno); + } else if (YAP_IsVarTerm(t) || t == TermNil) { + fprintf(stderr, "[ line %d: term cannot be compiled ]", yap_lineno); + } else if (YAP_IsPairTerm(t)) { + fprintf(stderr, "[ SYSTEM ERROR: consult not allowed in boot file ]\n"); + fprintf(stderr, "error found at line %d and pos %d", yap_lineno, + fseek(GLOBAL_Stream[boot_stream].file, 0L, SEEK_CUR)); + } else if (IsApplTerm(t) && (FunctorOfTerm(t) == functor_query || + FunctorOfTerm(t) == functor_command1)) { + YAP_RunGoalOnce(ArgOfTerm(1, t)); + } else { + Term ts[2]; + char *ErrorMessage; + Functor fun = Yap_MkFunctor(Yap_LookupAtom("$prepare_clause"), 2); + PredEntry *pe = RepPredProp(PredPropByFunc(fun, PROLOG_MODULE)); + + if (pe->OpcodeOfPred != UNDEF_OPCODE && pe->OpcodeOfPred != FAIL_OPCODE) { + ts[0] = t; + RESET_VARIABLE(ts + 1); + if (YAP_RunGoal(Yap_MkApplTerm(fun, 2, ts))) + t = ts[1]; + } + ErrorMessage = YAP_CompileClause(t); + if (ErrorMessage) { + fprintf(stderr, "%s", ErrorMessage); + } + } + } while (t != TermEof); + BACKUP_MACHINE_REGS(); + + YAP_EndConsult(boot_stream, &osno); +#if DEBUG + if (Yap_output_msg) + fprintf(stderr, "Boot loaded\n"); +#endif +} + +/** @brief A simple language for detecting where YAP stuff cn be found + * + * @long The options are + * `[V]` use a configuration variable YAP_XXXDIR, prefixed by "DESTDIR" + * `(V)PATH` compute V and add /PATH, + * `$V` search the envurinment + * `?V` search the WINDOWS registry + * ~` search HOME + * `@` query user option. + * + */ +const char *rootdirs[] = {"[root]", "(execdir)..", "/usr/local", "~", NULL}; + +const char *bindirs[] = {"[bin]", "(root)bin", NULL}; const char *libdirs[] = { - "$YAPLIBDIR", - "[lib]", #if __ANDROID__ - "/assets/lib", + "/assets/lib", #endif - YAP_LIBDIR, - "(root)lib", - NULL -}; + "[lib]", "(root)lib", NULL}; const char *sharedirs[] = { - "$YAPSHAREDIR", - "[share]", #if __ANDROID__ - "/assets/share", + "/assets/share", #endif - YAP_SHAREDIR, - "(root)share", - NULL -}; + "[share]", "(root)share", NULL}; -const char *dlldirs[] = { - "(lib)Yap", - NULL -}; +const char *dlldirs[] = {"$YAPLIBDIR", "(lib)Yap", ".", NULL}; -const char *pldirs[] = { - "(share)Yap", - NULL -}; +const char *ssdirs[] = {".", "$YAPLIBDIR", "(lib)Yap", NULL}; + +const char *pldirs[] = {"$YAPSHAREDIR", "?library", "(share)Yap", ".", NULL}; + +const char *bootpldirs[] = {"(pl)pl", ".", NULL}; + +const char *bootstrappldirs[] = {YAP_PL_SRCDIR, NULL}; + +const char *commonsdirs[] = {"(share)PrologCommons", ".", NULL}; + +const char *ssnames[] = {"@SavedState", YAP_STARTUP, "startup.yss", NULL}; + +const char *plnames[] = {"@YapPrologBootFile", YAP_BOOTFILE, "boot.yap", NULL}; + +/** + * Search + */ +char *location(YAP_init_args *iap, const char *inp, char *out) { + if (inp == NULL || inp[0] == '\0') { + return NULL; + } else if (inp[0] == '(') { + if (strstr(inp + 1, "root") == inp + 1) { + if (!Yap_ROOTDIR || Yap_ROOTDIR[0] == '\0') { + return NULL; + } + strcpy(out, Yap_ROOTDIR); + strcat(out, "/"); + strcat(out, inp + strlen("(root)")); + } else if (strstr(inp + 1, "bin") == inp + 1) { + if (!Yap_BINDIR || Yap_BINDIR[0] == '\0') { + return NULL; + } + strcpy(out, Yap_BINDIR); + strcat(out, "/"); + strcat(out, inp + strlen("(bin)")); + } else if (strstr(inp + 1, "lib") == inp + 1) { + if (!Yap_LIBDIR || Yap_LIBDIR[0] == '\0') { + return NULL; + } + strcpy(out, Yap_LIBDIR); + strcat(out, "/"); + strcat(out, inp + strlen("(lib)")); + } else if (strstr(inp + 1, "share") == inp + 1) { + if (!Yap_SHAREDIR || Yap_SHAREDIR[0] == '\0') { + return NULL; + } + strcpy(out, Yap_SHAREDIR); + strcat(out, "/"); + strcat(out, inp + strlen("(share)")); + } else if (strstr(inp + 1, "pl") == inp + 1) { + if (!Yap_PLDIR || Yap_PLDIR[0] == '\0') { + return NULL; + } + strcpy(out, Yap_PLDIR); + strcat(out, "/"); + strcat(out, inp + strlen("(pl)")); + }else if (strstr(inp + 1, "execdir") == inp + 1) { + const char *ex = Yap_FindExecutable(); + if (ex == NULL) + return NULL; + strcpy(out, dirname(ex)); + strcat(out, "/"); + strcat(out, inp + strlen("(execdir)")); + } else + return NULL; + } else if (inp[0] == '@') { + + if (strstr(inp + 1, "YapPrologBootFile") == inp + 1) { + const char *tmp; + tmp = iap->YapPrologBootFile; + if (tmp && tmp[0]) + strcpy(out, tmp); + } else if (strstr(inp + 1, "SavedState") == inp + 1) { + const char *tmp = iap->SavedState; + if (tmp && tmp[0]) + strcpy(out, tmp); + } + return NULL; + } else if (inp[0] == '$') { + char *e; + if ((e = getenv(inp + 1)) != NULL) { + strcpy(out, e); + } + return NULL; + } else if (inp[0] == '?') { +#if _WINDOWS_ + char *e; + if ((e = Yap_RegistryGetString(inp + 1)) != NULL) { + strcpy(out, e); + } else +#endif + return NULL; + } else if (inp[0] == '~') { + char *e; + if ((e = getenv("HOME")) != NULL) { + strcpy(out, e); + } + if (inp[1] != '\0') + strcat(out, inp + 1); + } else if (inp[0] == '[') { + char *o = out; + const char *e; + if ((e = getenv("DESTDIR"))) { + strcpy(out, e); + o += strlen(e); + } + if (strstr(inp + 1, "root") == inp + 1) { +#ifdef YAP_ROOTDIR + strcpy(o, YAP_ROOTDIR); +#else + return NULL; +#endif + } else if (strstr(inp + 1, "lib") == inp + 1) { +#ifdef YAP_LIBDIR + strcpy(o, YAP_LIBDIR); +#else + return NULL; +#endif + } else if (strstr(inp + 1, "share") == inp + 1) { +#ifdef YAP_SHAREDIR + strcpy(o, YAP_SHAREDIR); +#else + return NULL; +#endif + } else if (strstr(inp + 1, "dll") == inp + 1) { +#ifdef YAP_DLLDIR + strcpy(o, YAP_DLLDIR); +#else + return NULL; +#endif + } else if (strstr(inp + 1, "pl") == inp + 1) { +#ifdef YAP_PLDIR + strcpy(o, YAP_PLDIR); +#else + return NULL; +#endif + } else if (strstr(inp + 1, "commons") == inp + 1) { +#ifdef YAP_COMMONSDIR + strcpy(o, YAP_COMMONSDIR); +#else + return NULL; +#endif + } + } else { + strcpy(out, inp); + } + return out; +} /** * @brief find default paths for main YAP variables * - * This function is called once at boot time to set the main paths; it searches a list of paths to instantiate a number of variables. - * Paths must be directories. + * This function is called once at boot time to set the main paths; it searches + * a list of paths to instantiate a number of variables. Paths must be + * directories. * * It treats the following variables as : * ROOTDIR, SHAREDIR, LIBDIR, EXECUTABLE * * @return */ -static const char *find_directory(const char *paths[]) { - int i = 0; - const char *inp; - char *out = malloc(YAP_FILENAME_MAX + 1); +static const char *find_directory(YAP_init_args *iap, const char *paths[], + const char *names[]) { + int lvl = push_text_stack(); + char *out = Malloc(YAP_FILENAME_MAX + 1); + const char *inp; + char *full; + if (names) { + full = Malloc(YAP_FILENAME_MAX + 1); + } + int i = 0; + while ((inp = paths[i++]) != NULL) { out[0] = '\0'; - while ((inp = paths[i++]) != NULL) { - if (inp[0] == '(') { - if (strstr(inp + 1, "root") == inp + 1) { - strcpy(out, Yap_ROOTDIR); - strcat(out, "/"); - strcat(out, inp+(strlen("(root)")+1)); - } else if (strstr(inp + 1, "lib") == inp + 1) { - strcpy(out, Yap_LIBDIR); - strcat(out, "/"); - strcat(out, inp+(strlen("(lib)")+1)); - } else if (strstr(inp + 1, "share") == inp + 1) { - strcpy(out, Yap_LIBDIR); - strcat(out, "/"); - strcat(out, inp+(strlen("(share)")+1)); - } else if (strstr(inp + 1, "executable") == inp + 1) { - strcpy(out, Yap_LIBDIR); - strcat(out, "/"); - strcat(out, inp+(strlen("(executable)")+1)); - } - } else if (inp[0] == '$') { - char *e; - if ((e = getenv(inp + 1)) != NULL) { - strcpy(out, e); - return out; - } - } else if (inp[0] == '[') { - if (Yap_ROOTDIR && Yap_ROOTDIR[0] && strstr(inp + 1, "root") == inp + 1) { - strcpy(out, Yap_ROOTDIR); - } else if (Yap_LIBDIR && Yap_LIBDIR[0] && strstr(inp + 1, "lib") == inp + 1) { - strcpy(out, Yap_LIBDIR); - } else if (Yap_SHAREDIR && Yap_SHAREDIR[0] && strstr(inp + 1, "share") == inp + 1) { - strcpy(out, Yap_SHAREDIR); - } - } else { - char *e; - if ((e = getenv(inp + 1)) != NULL) { - strcpy(out, e); - } else { - out[0] = '\0'; - } - strcat(out, inp); - } - if (out[0]) { - return out; + char *o = location(iap, inp, out), *no; + if (o && o[0] && Yap_isDirectory(o)) { + if (names) { + size_t s = strlen(o); + o[s++] = '/'; + const char *p; + int j = 0; + while ((p = names[j++])) { + char *io = o + s; + if ((no = location(iap, p, io)) && io[0] != '\0' && Yap_Exists(o)) + return pop_output_text_stack(lvl, realpath(o, full)); } + } else + return pop_output_text_stack(lvl, o); } - return NULL; + } + pop_text_stack(lvl); + return NULL; +} +static void Yap_set_locations(YAP_init_args *iap) { +#if CONDA_BUILD + if (!getenv("DESTDIR")) { + char buf[YAP_FILENAME_MAX + 1]; + const char *o = Yap_FindExecutable(); + if (!o) + return; + strcpy(buf, dirname(dirname(o))); + putenv("DESTDIR", buf)k + } +#endif + Yap_ROOTDIR = find_directory(iap, rootdirs, NULL); + Yap_LIBDIR = find_directory(iap, libdirs, NULL); + Yap_BINDIR = find_directory(iap, bindirs, NULL); + Yap_SHAREDIR = find_directory(iap, sharedirs, NULL); + Yap_DLLDIR = find_directory(iap, dlldirs, NULL); + Yap_PLDIR = find_directory(iap, pldirs, NULL); + Yap_COMMONSDIR = find_directory(iap, commonsdirs, NULL); + Yap_STARTUP = find_directory(iap, ssdirs, ssnames); + if (iap->bootstrapping) + Yap_BOOTFILE = find_directory(iap, bootstrappldirs, plnames); + else + Yap_BOOTFILE = find_directory(iap, bootpldirs, plnames); + setAtomicGlobalPrologFlag( HOME_FLAG, MkAtomTerm(Yap_LookupAtom(Yap_ROOTDIR))); + setAtomicGlobalPrologFlag( PROLOG_LIBRARY_DIRECTORY_FLAG,MkAtomTerm(Yap_LookupAtom(Yap_PLDIR))); + setAtomicGlobalPrologFlag( PROLOG_FOREIGN_DIRECTORY_FLAG, MkAtomTerm(Yap_LookupAtom(Yap_DLLDIR))); + } static void print_usage(void) { - fprintf(stderr, "\n[ Valid switches for command line arguments: ]\n"); - fprintf(stderr, " -? Shows this screen\n"); - fprintf(stderr, " -b Boot file \n"); - fprintf(stderr, " -dump-runtime-variables\n"); - fprintf(stderr, " -f initialization file or \"none\"\n"); - fprintf(stderr, " -g Run Goal Before Top-Level \n"); - fprintf(stderr, " -z Run Goal Before Top-Level \n"); - fprintf(stderr, " -q start with informational messages off\n"); - fprintf(stderr, " -l load Prolog file\n"); - fprintf(stderr, " -L run Prolog file and exit\n"); - fprintf(stderr, " -p extra path for file-search-path\n"); - fprintf(stderr, " -hSize Heap area in Kbytes (default: %d, minimum: %d)\n", - DefHeapSpace, MinHeapSpace); - fprintf(stderr, - " -sSize Stack area in Kbytes (default: %d, minimum: %d)\n", - DefStackSpace, MinStackSpace); - fprintf(stderr, - " -tSize Trail area in Kbytes (default: %d, minimum: %d)\n", - DefTrailSpace, MinTrailSpace); - fprintf(stderr, " -GSize Max Area for Global Stack\n"); - fprintf(stderr, - " -LSize Max Area for Local Stack (number must follow L)\n"); - fprintf(stderr, " -TSize Max Area for Trail (number must follow T)\n"); - fprintf(stderr, " -nosignals disable signal handling from Prolog\n"); - fprintf(stderr, "\n[Execution Modes]\n"); - fprintf(stderr, " -J0 Interpreted mode (default)\n"); - fprintf(stderr, " -J1 Mixed mode only for user predicates\n"); - fprintf(stderr, " -J2 Mixed mode for all predicates\n"); - fprintf(stderr, " -J3 Compile all user predicates\n"); - fprintf(stderr, " -J4 Compile all predicates\n"); + fprintf(stderr, "\n[ Valid switches for command line arguments: ]\n"); + fprintf(stderr, " -? Shows this screen\n"); + fprintf(stderr, " -b Boot file \n"); + fprintf(stderr, " -dump-runtime-variables\n"); + fprintf(stderr, " -f initialization file or \"none\"\n"); + fprintf(stderr, " -g Run Goal Before Top-Level \n"); + fprintf(stderr, " -z Run Goal Before Top-Level \n"); + fprintf(stderr, " -q start with informational messages off\n"); + fprintf(stderr, " -l load Prolog file\n"); + fprintf(stderr, " -L run Prolog file and exit\n"); + fprintf(stderr, " -p extra path for file-search-path\n"); + fprintf(stderr, " -hSize Heap area in Kbytes (default: %d, minimum: %d)\n", + DefHeapSpace, MinHeapSpace); + fprintf(stderr, + " -sSize Stack area in Kbytes (default: %d, minimum: %d)\n", + DefStackSpace, MinStackSpace); + fprintf(stderr, + " -tSize Trail area in Kbytes (default: %d, minimum: %d)\n", + DefTrailSpace, MinTrailSpace); + fprintf(stderr, " -GSize Max Area for Global Stack\n"); + fprintf(stderr, + " -LSize Max Area for Local Stack (number must follow L)\n"); + fprintf(stderr, " -TSize Max Area for Trail (number must follow T)\n"); + fprintf(stderr, " -nosignals disable signal handling from Prolog\n"); + fprintf(stderr, "\n[Execution Modes]\n"); + fprintf(stderr, " -J0 Interpreted mode (default)\n"); + fprintf(stderr, " -J1 Mixed mode only for user predicates\n"); + fprintf(stderr, " -J2 Mixed mode for all predicates\n"); + fprintf(stderr, " -J3 Compile all user predicates\n"); + fprintf(stderr, " -J4 Compile all predicates\n"); #ifdef TABLING - fprintf(stderr, - " -ts Maximum table space area in Mbytes (default: unlimited)\n"); + fprintf(stderr, + " -ts Maximum table space area in Mbytes (default: unlimited)\n"); #endif /* TABLING */ -#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || \ +#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || \ defined(YAPOR_THREADS) - fprintf(stderr, " -w Number of workers (default: %d)\n", - DEFAULT_NUMBERWORKERS); - fprintf(stderr, - " -sl Loop scheduler executions before look for hiden " - "shared work (default: %d)\n", - DEFAULT_SCHEDULERLOOP); - fprintf(stderr, " -d Value of delayed release of load (default: %d)\n", - DEFAULT_DELAYEDRELEASELOAD); + fprintf(stderr, " -w Number of workers (default: %d)\n", + DEFAULT_NUMBERWORKERS); + fprintf(stderr, + " -sl Loop scheduler executions before look for hiden " + "shared work (default: %d)\n", + DEFAULT_SCHEDULERLOOP); + fprintf(stderr, " -d Value of delayed release of load (default: %d)\n", + DEFAULT_DELAYEDRELEASELOAD); #endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA || YAPOR_THREADS */ - /* nf: Preprocessor */ - /* fprintf(stderr," -DVar=Name Persistent definition\n"); */ - fprintf(stderr, "\n"); + /* nf: Preprocessor */ + /* fprintf(stderr," -DVar=Name Persistent definition\n"); */ + fprintf(stderr, "\n"); } static int myisblank(int c) { - switch (c) { - case ' ': - case '\t': - case '\n': - case '\r': - return TRUE; - default: - return FALSE; - } + switch (c) { + case ' ': + case '\t': + case '\n': + case '\r': + return TRUE; + default: + return FALSE; + } } static char *add_end_dot(char arg[]) { - int sz = strlen(arg), i; - i = sz; - while (i && myisblank(arg[--i])); - if (i && arg[i] != ',') { - char *p = (char *) malloc(sz + 2); - if (!p) - return NULL; - strncpy(p, arg, sz); - p[sz] = '.'; - p[sz + 1] = '\0'; - return p; - } - return arg; + int sz = strlen(arg), i; + i = sz; + while (i && myisblank(arg[--i])) + ; + if (i && arg[i] != ',') { + char *p = (char *)malloc(sz + 2); + if (!p) + return NULL; + strncpy(p, arg, sz); + p[sz] = '.'; + p[sz + 1] = '\0'; + return p; + } + return arg; } static int dump_runtime_variables(void) { - fprintf(stdout, "CC=\"%s\"\n", C_CC); - fprintf(stdout, "YAP_ROOTDIR=\"%s\"\n", YAP_ROOTDIR); - fprintf(stdout, "YAP_LIBS=\"%s\"\n", C_LIBS); - fprintf(stdout, "YAP_SHLIB_SUFFIX=\"%s\"\n", SO_EXT); - fprintf(stdout, "YAP_VERSION=%s\n", YAP_NUMERIC_VERSION); - exit(0); - return 1; + fprintf(stdout, "CC=\"%s\"\n", C_CC); + fprintf(stdout, "YAP_ROOTDIR=\"%s\"\n", YAP_ROOTDIR); + fprintf(stdout, "YAP_LIBS=\"%s\"\n", C_LIBS); + fprintf(stdout, "YAP_SHLIB_SUFFIX=\"%s\"\n", SO_EXT); + fprintf(stdout, "YAP_VERSION=%s\n", YAP_NUMERIC_VERSION); + exit(0); + return 1; } X_API YAP_file_type_t Yap_InitDefaults(void *x, char *saved_state, int argc, char *argv[]) { - YAP_init_args *iap = x; - memset(iap, 0, sizeof(YAP_init_args)); + + if (!LOCAL_TextBuffer) + LOCAL_TextBuffer = Yap_InitTextAllocator(); + YAP_init_args *iap = x; + memset(iap, 0, sizeof(YAP_init_args)); #if __ANDROID__ - iap->boot_file_type = YAP_BOOT_PL; - iap->SavedState = NULL; - iap->assetManager = NULL; + iap->boot_file_type = YAP_BOOT_PL; + iap->SavedState = NULL; + iap->assetManager = NULL; #else - iap->boot_file_type = YAP_QLY; - iap->SavedState = saved_state; + iap->boot_file_type = YAP_QLY; + iap->SavedState = saved_state; #endif - iap->Argc = argc; - iap->Argv = argv; - Yap_ROOTDIR = find_directory(rootdirs); - Yap_LIBDIR = find_directory(libdirs); - Yap_SHAREDIR = find_directory(sharedirs); - Yap_DLLDIR = find_directory(dlldirs); - Yap_PLDIR = find_directory(pldirs); - return YAP_QLY; + iap->Argc = argc; + iap->Argv = argv; + return YAP_QLY; } /** @@ -288,417 +507,660 @@ X_API YAP_file_type_t Yap_InitDefaults(void *x, char *saved_state, int argc, * @param iap options, see YAP_init_args * @return boot from saved state or restore; error */ - X_API YAP_file_type_t YAP_parse_yap_arguments(int argc, char *argv[], - YAP_init_args *iap) { - char *p; - size_t *ssize; -#ifndef YAP_ROOTDIR - { - char *b0 = Yap_FindExecutable(), *b1, *b2; - char b[YAP_FILENAME_MAX + 1]; +X_API YAP_file_type_t YAP_parse_yap_arguments(int argc, char *argv[], + YAP_init_args *iap) { + char *p; + size_t *ssize; - strncpy(b, b0, YAP_FILENAME_MAX); - b1 = dirname(b); - YAP_BINDIR = malloc(strlen(b1) + 1); - strcpy(YAP_BINDIR, b1); - b2 = dirname(b1); - YAP_ROOTDIR = malloc(strlen(b2) + 1); - strcpy(YAP_ROOTDIR, b2); - strncpy(b, YAP_ROOTDIR, YAP_FILENAME_MAX); - strncat(b, "/share", YAP_FILENAME_MAX); - YAP_SHAREDIR = malloc(strlen(b) + 1); - strcpy(YAP_SHAREDIR, b); - strncpy(b, YAP_ROOTDIR, YAP_FILENAME_MAX); - strncat(b, "/lib", YAP_FILENAME_MAX); - YAP_LIBDIR = malloc(strlen(b) + 1); - strcpy(YAP_LIBDIR, b); - strncpy(b, YAP_ROOTDIR, YAP_FILENAME_MAX); - strncat(b, "/lib/Yap", YAP_FILENAME_MAX); - }; -#endif - - Yap_InitDefaults(iap, NULL, argc, argv); - while (--argc > 0) { - p = *++argv; - if (*p == '-') - switch (*++p) { - case 'b': - iap->boot_file_type = YAP_PL; - if (p[1]) - iap->YapPrologBootFile = p + 1; - else if (argv[1] && *argv[1] != '-') { - iap->YapPrologBootFile = *++argv; - argc--; - } else { - iap->YapPrologBootFile = "boot.yap"; - } - break; - case 'B': - iap->boot_file_type = YAP_BOOT_PL; - if (p[1]) - iap->YapPrologBootFile = p + 1; - else if (argv[1] && *argv[1] != '-') { - iap->YapPrologBootFile = *++argv; - argc--; - } else { - iap->YapPrologBootFile = NULL; - } - iap->bootstrapping = true; - break; - case '?': - print_usage(); - exit(EXIT_SUCCESS); - case 'q': - iap->QuietMode = TRUE; - break; -#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || \ - defined(YAPOR_THREADS) - case 'w': - ssize = &(iap->NumberWorkers); - goto GetSize; - case 'd': - if (!strcmp("dump-runtime-variables", p)) - return dump_runtime_variables(); - ssize = &(iap->DelayedReleaseLoad); - goto GetSize; -#else - case 'd': - if (!strcmp("dump-runtime-variables", p)) - return dump_runtime_variables(); -#endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA || YAPOR_THREADS */ - case 'F': - /* just ignore for now */ - argc--; - argv++; - break; - case 'f': - iap->FastBoot = TRUE; - if (argc > 1 && argv[1][0] != '-') { - argc--; - argv++; - if (strcmp(*argv, "none")) { - iap->YapPrologRCFile = *argv; - } - break; - } - break; - // execution mode - case 'J': - switch (p[1]) { - case '0': - iap->ExecutionMode = YAPC_INTERPRETED; - break; - case '1': - iap->ExecutionMode = YAPC_MIXED_MODE_USER; - break; - case '2': - iap->ExecutionMode = YAPC_MIXED_MODE_ALL; - break; - case '3': - iap->ExecutionMode = YAPC_COMPILE_USER; - break; - case '4': - iap->ExecutionMode = YAPC_COMPILE_ALL; - break; - default: - fprintf(stderr, "[ YAP unrecoverable error: unknown switch -%c%c ]\n", - *p, p[1]); - exit(EXIT_FAILURE); - } - p++; - break; - case 'G': - ssize = &(iap->MaxGlobalSize); - goto GetSize; - break; - case 's': - case 'S': - ssize = &(iap->StackSize); -#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || \ - defined(YAPOR_THREADS) - if (p[1] == 'l') { - p++; - ssize = &(iap->SchedulerLoop); - } -#endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA || YAPOR_THREADS */ - goto GetSize; - case 'a': - case 'A': - ssize = &(iap->AttsSize); - goto GetSize; - case 'T': - ssize = &(iap->MaxTrailSize); - goto get_trail_size; - case 't': - ssize = &(iap->TrailSize); -#ifdef TABLING - if (p[1] == 's') { - p++; - ssize = &(iap->MaxTableSpaceSize); - } -#endif /* TABLING */ - get_trail_size: - if (*++p == '\0') { - if (argc > 1) - --argc, p = *++argv; - else { - fprintf(stderr, - "[ YAP unrecoverable error: missing size in flag %s ]", - argv[0]); - print_usage(); - exit(EXIT_FAILURE); - } - } - { - unsigned long int i = 0, ch; - while ((ch = *p++) >= '0' && ch <= '9') - i = i * 10 + ch - '0'; - switch (ch) { - case 'M': - case 'm': - i *= 1024; - ch = *p++; - break; - case 'g': - i *= 1024 * 1024; - ch = *p++; - break; - case 'k': - case 'K': - ch = *p++; - break; - } - if (ch) { - iap->YapPrologTopLevelGoal = add_end_dot(*argv); - } else { - *ssize = i; - } - } - break; - case 'h': - case 'H': - ssize = &(iap->HeapSize); - GetSize: - if (*++p == '\0') { - if (argc > 1) - --argc, p = *++argv; - else { - fprintf(stderr, - "[ YAP unrecoverable error: missing size in flag %s ]", - argv[0]); - print_usage(); - exit(EXIT_FAILURE); - } - } - { - unsigned long int i = 0, ch; - while ((ch = *p++) >= '0' && ch <= '9') - i = i * 10 + ch - '0'; - switch (ch) { - case 'M': - case 'm': - i *= 1024; - ch = *p++; - break; - case 'g': - case 'G': - i *= 1024 * 1024; - ch = *p++; - break; - case 'k': - case 'K': - ch = *p++; - break; - } - if (ch) { - fprintf( - stderr, - "[ YAP unrecoverable error: illegal size specification %s ]", - argv[-1]); - Yap_exit(1); - } - *ssize = i; - } - break; -#ifdef DEBUG - case 'P': - if (p[1] != '\0') { - while (p[1] != '\0') { - int ch = p[1]; - if (ch >= 'A' && ch <= 'Z') - ch += ('a' - 'A'); - if (ch >= 'a' && ch <= 'z') - GLOBAL_Option[ch - 96] = 1; - p++; - } - } else { - YAP_SetOutputMessage(); - } - break; -#endif - case 'L': - if (p[1] && p[1] >= '0' && - p[1] <= '9') /* hack to emulate SWI's L local option */ - { - ssize = &(iap->MaxStackSize); - goto GetSize; - } - iap->QuietMode = TRUE; - iap->HaltAfterConsult = TRUE; - case 'l': - p++; - if (!*++argv) { - fprintf(stderr, - "%% YAP unrecoverable error: missing load file name\n"); - exit(1); - } else if (!strcmp("--", *argv)) { - /* shell script, the next entry should be the file itself */ - iap->YapPrologRCFile = argv[1]; - argc = 1; - break; - } else { - iap->YapPrologRCFile = *argv; - argc--; - } - if (*p) { - /* we have something, usually, of the form: - -L -- - FileName - ExtraArgs - */ - /* being called from a script */ - while (*p && (*p == ' ' || *p == '\t')) - p++; - if (p[0] == '-' && p[1] == '-') { - /* ignore what is next */ - argc = 1; - } - } - break; - /* run goal before top-level */ - case 'g': - if ((*argv)[0] == '\0') - iap->YapPrologGoal = *argv; - else { - argc--; - if (argc == 0) { - fprintf(stderr, " [ YAP unrecoverable error: missing " - "initialization goal for option 'g' ]\n"); - exit(EXIT_FAILURE); - } - argv++; - iap->YapPrologGoal = *argv; - } - break; - /* run goal as top-level */ - case 'z': - if ((*argv)[0] == '\0') - iap->YapPrologTopLevelGoal = *argv; - else { - argc--; - if (argc == 0) { - fprintf( - stderr, - " [ YAP unrecoverable error: missing goal for option 'z' ]\n"); - exit(EXIT_FAILURE); - } - argv++; - iap->YapPrologTopLevelGoal = add_end_dot(*argv); - } - break; - case 'n': - if (!strcmp("nosignals", p)) { - iap->PrologCannotHandleInterrupts = true; - break; - } - break; - case '-': - if (!strcmp("-nosignals", p)) { - iap->PrologCannotHandleInterrupts = true; - break; - } else if (!strncmp("-home=", p, strlen("-home="))) { - GLOBAL_Home = p + strlen("-home="); - } else if (!strncmp("-cwd=", p, strlen("-cwd="))) { - if (!Yap_ChDir(p + strlen("-cwd="))) { - fprintf(stderr, " [ YAP unrecoverable error in setting cwd: %s ]\n", - strerror(errno)); - } - } else if (!strncmp("-stack=", p, strlen("-stack="))) { - ssize = &(iap->StackSize); - p += strlen("-stack="); - goto GetSize; - } else if (!strncmp("-trail=", p, strlen("-trail="))) { - ssize = &(iap->TrailSize); - p += strlen("-trail="); - goto GetSize; - } else if (!strncmp("-heap=", p, strlen("-heap="))) { - ssize = &(iap->HeapSize); - p += strlen("-heap="); - goto GetSize; - } else if (!strncmp("-goal=", p, strlen("-goal="))) { - iap->YapPrologGoal = p + strlen("-goal="); - } else if (!strncmp("-top-level=", p, strlen("-top-level="))) { - iap->YapPrologTopLevelGoal = p + strlen("-top-level="); - } else if (!strncmp("-table=", p, strlen("-table="))) { - ssize = &(iap->MaxTableSpaceSize); - p += strlen("-table="); - goto GetSize; - } else if (!strncmp("-", p, strlen("-="))) { - ssize = &(iap->MaxTableSpaceSize); - p += strlen("-table="); - /* skip remaining arguments */ - argc = 1; - } - break; - case 'p': - if ((*argv)[0] == '\0') - iap->YapPrologAddPath = *argv; - else { - argc--; - if (argc == 0) { - fprintf( - stderr, - " [ YAP unrecoverable error: missing paths for option 'p' ]\n"); - exit(EXIT_FAILURE); - } - argv++; - iap->YapPrologAddPath = *argv; - } - break; - /* nf: Begin preprocessor code */ - case 'D': { - char *var, *value; - ++p; - var = p; - if (var == NULL || *var == '\0') - break; - while (*p != '=' && *p != '\0') - ++p; - if (*p == '\0') - break; - *p = '\0'; - ++p; - value = p; - if (*value == '\0') - break; - if (iap->def_c == YAP_MAX_YPP_DEFS) - break; - iap->def_var[iap->def_c] = var; - iap->def_value[iap->def_c] = value; - ++(iap->def_c); - break; - } - /* End preprocessor code */ - default: { - fprintf(stderr, "[ YAP unrecoverable error: unknown switch -%c ]\n", - *p); - print_usage(); - exit(EXIT_FAILURE); - } - } - else { - iap->SavedState = p; - } + Yap_InitDefaults(iap, NULL, argc, argv); + while (--argc > 0) { + p = *++argv; + if (*p == '-') + switch (*++p) { + case 'b': + iap->boot_file_type = YAP_PL; + if (p[1]) + iap->YapPrologBootFile = p + 1; + else if (argv[1] && *argv[1] != '-') { + iap->YapPrologBootFile = *++argv; + argc--; + } else { + iap->YapPrologBootFile = "boot.yap"; } - return iap->boot_file_type; + break; + case 'B': + iap->boot_file_type = YAP_BOOT_PL; + if (p[1]) + iap->YapPrologBootFile = p + 1; + else if (argv[1] && *argv[1] != '-') { + iap->YapPrologBootFile = *++argv; + argc--; + } else { + iap->YapPrologBootFile = NULL; + } + iap->bootstrapping = true; + break; + case '?': + print_usage(); + exit(EXIT_SUCCESS); + case 'q': + iap->QuietMode = TRUE; + break; +#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || \ + defined(YAPOR_THREADS) + case 'w': + ssize = &(iap->NumberWorkers); + goto GetSize; + case 'd': + if (!strcmp("dump-runtime-variables", p)) + return dump_runtime_variables(); + ssize = &(iap->DelayedReleaseLoad); + goto GetSize; +#else + case 'd': + if (!strcmp("dump-runtime-variables", p)) + return dump_runtime_variables(); +#endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA || YAPOR_THREADS */ + case 'F': + /* just ignore for now */ + argc--; + argv++; + break; + case 'f': + iap->FastBoot = TRUE; + if (argc > 1 && argv[1][0] != '-') { + argc--; + argv++; + if (strcmp(*argv, "none")) { + iap->YapPrologRCFile = *argv; + } + break; + } + break; + // execution mode + case 'J': + switch (p[1]) { + case '0': + iap->ExecutionMode = YAPC_INTERPRETED; + break; + case '1': + iap->ExecutionMode = YAPC_MIXED_MODE_USER; + break; + case '2': + iap->ExecutionMode = YAPC_MIXED_MODE_ALL; + break; + case '3': + iap->ExecutionMode = YAPC_COMPILE_USER; + break; + case '4': + iap->ExecutionMode = YAPC_COMPILE_ALL; + break; + default: + fprintf(stderr, "[ YAP unrecoverable error: unknown switch -%c%c ]\n", + *p, p[1]); + exit(EXIT_FAILURE); + } + p++; + break; + case 'G': + ssize = &(iap->MaxGlobalSize); + goto GetSize; + break; + case 's': + case 'S': + ssize = &(iap->StackSize); +#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || \ + defined(YAPOR_THREADS) + if (p[1] == 'l') { + p++; + ssize = &(iap->SchedulerLoop); + } +#endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA || YAPOR_THREADS */ + goto GetSize; + case 'a': + case 'A': + ssize = &(iap->AttsSize); + goto GetSize; + case 'T': + ssize = &(iap->MaxTrailSize); + goto get_trail_size; + case 't': + ssize = &(iap->TrailSize); +#ifdef TABLING + if (p[1] == 's') { + p++; + ssize = &(iap->MaxTableSpaceSize); + } +#endif /* TABLING */ + get_trail_size: + if (*++p == '\0') { + if (argc > 1) + --argc, p = *++argv; + else { + fprintf(stderr, + "[ YAP unrecoverable error: missing size in flag %s ]", + argv[0]); + print_usage(); + exit(EXIT_FAILURE); + } + } + { + unsigned long int i = 0, ch; + while ((ch = *p++) >= '0' && ch <= '9') + i = i * 10 + ch - '0'; + switch (ch) { + case 'M': + case 'm': + i *= 1024; + ch = *p++; + break; + case 'g': + i *= 1024 * 1024; + ch = *p++; + break; + case 'k': + case 'K': + ch = *p++; + break; + } + if (ch) { + iap->YapPrologTopLevelGoal = add_end_dot(*argv); + } else { + *ssize = i; + } + } + break; + case 'h': + case 'H': + ssize = &(iap->HeapSize); + GetSize: + if (*++p == '\0') { + if (argc > 1) + --argc, p = *++argv; + else { + fprintf(stderr, + "[ YAP unrecoverable error: missing size in flag %s ]", + argv[0]); + print_usage(); + exit(EXIT_FAILURE); + } + } + { + unsigned long int i = 0, ch; + while ((ch = *p++) >= '0' && ch <= '9') + i = i * 10 + ch - '0'; + switch (ch) { + case 'M': + case 'm': + i *= 1024; + ch = *p++; + break; + case 'g': + case 'G': + i *= 1024 * 1024; + ch = *p++; + break; + case 'k': + case 'K': + ch = *p++; + break; + } + if (ch) { + fprintf( + stderr, + "[ YAP unrecoverable error: illegal size specification %s ]", + argv[-1]); + Yap_exit(1); + } + *ssize = i; + } + break; +#ifdef DEBUG + case 'P': + if (p[1] != '\0') { + while (p[1] != '\0') { + int ch = p[1]; + if (ch >= 'A' && ch <= 'Z') + ch += ('a' - 'A'); + if (ch >= 'a' && ch <= 'z') + GLOBAL_Option[ch - 96] = 1; + p++; + } + } else { + YAP_SetOutputMessage(); + } + break; +#endif + case 'L': + if (p[1] && p[1] >= '0' && + p[1] <= '9') /* hack to emulate SWI's L local option */ + { + ssize = &(iap->MaxStackSize); + goto GetSize; + } + iap->QuietMode = TRUE; + iap->HaltAfterConsult = TRUE; + case 'l': + p++; + if (!*++argv) { + fprintf(stderr, + "%% YAP unrecoverable error: missing load file name\n"); + exit(1); + } else if (!strcmp("--", *argv)) { + /* shell script, the next entry should be the file itself */ + iap->YapPrologRCFile = argv[1]; + argc = 1; + break; + } else { + iap->YapPrologRCFile = *argv; + argc--; + } + if (*p) { + /* we have something, usually, of the form: + -L -- + FileName + ExtraArgs + */ + /* being called from a script */ + while (*p && (*p == ' ' || *p == '\t')) + p++; + if (p[0] == '-' && p[1] == '-') { + /* ignore what is next */ + argc = 1; + } + } + break; + /* run goal before top-level */ + case 'g': + if ((*argv)[0] == '\0') + iap->YapPrologGoal = *argv; + else { + argc--; + if (argc == 0) { + fprintf(stderr, " [ YAP unrecoverable error: missing " + "initialization goal for option 'g' ]\n"); + exit(EXIT_FAILURE); + } + argv++; + iap->YapPrologGoal = *argv; + } + break; + /* run goal as top-level */ + case 'z': + if ((*argv)[0] == '\0') + iap->YapPrologTopLevelGoal = *argv; + else { + argc--; + if (argc == 0) { + fprintf( + stderr, + " [ YAP unrecoverable error: missing goal for option 'z' ]\n"); + exit(EXIT_FAILURE); + } + argv++; + iap->YapPrologTopLevelGoal = add_end_dot(*argv); + } + break; + case 'n': + if (!strcmp("nosignals", p)) { + iap->PrologCannotHandleInterrupts = true; + break; + } + break; + case '-': + if (!strcmp("-nosignals", p)) { + iap->PrologCannotHandleInterrupts = true; + break; + } else if (!strncmp("-home=", p, strlen("-home="))) { + GLOBAL_Home = p + strlen("-home="); + } else if (!strncmp("-cwd=", p, strlen("-cwd="))) { + if (!Yap_ChDir(p + strlen("-cwd="))) { + fprintf(stderr, " [ YAP unrecoverable error in setting cwd: %s ]\n", + strerror(errno)); + } + } else if (!strncmp("-stack=", p, strlen("-stack="))) { + ssize = &(iap->StackSize); + p += strlen("-stack="); + goto GetSize; + } else if (!strncmp("-trail=", p, strlen("-trail="))) { + ssize = &(iap->TrailSize); + p += strlen("-trail="); + goto GetSize; + } else if (!strncmp("-heap=", p, strlen("-heap="))) { + ssize = &(iap->HeapSize); + p += strlen("-heap="); + goto GetSize; + } else if (!strncmp("-goal=", p, strlen("-goal="))) { + iap->YapPrologGoal = p + strlen("-goal="); + } else if (!strncmp("-top-level=", p, strlen("-top-level="))) { + iap->YapPrologTopLevelGoal = p + strlen("-top-level="); + } else if (!strncmp("-table=", p, strlen("-table="))) { + ssize = &(iap->MaxTableSpaceSize); + p += strlen("-table="); + goto GetSize; + } else if (!strncmp("-", p, strlen("-="))) { + ssize = &(iap->MaxTableSpaceSize); + p += strlen("-table="); + /* skip remaining arguments */ + argc = 1; + } + break; + case 'p': + if ((*argv)[0] == '\0') + iap->YapPrologAddPath = *argv; + else { + argc--; + if (argc == 0) { + fprintf( + stderr, + " [ YAP unrecoverable error: missing paths for option 'p' ]\n"); + exit(EXIT_FAILURE); + } + argv++; + iap->YapPrologAddPath = *argv; + } + break; + /* nf: Begin preprocessor code */ + case 'D': { + char *var, *value; + ++p; + var = p; + if (var == NULL || *var == '\0') + break; + while (*p != '=' && *p != '\0') + ++p; + if (*p == '\0') + break; + *p = '\0'; + ++p; + value = p; + if (*value == '\0') + break; + if (iap->def_c == YAP_MAX_YPP_DEFS) + break; + iap->def_var[iap->def_c] = var; + iap->def_value[iap->def_c] = value; + ++(iap->def_c); + break; + } + /* End preprocessor code */ + default: { + fprintf(stderr, "[ YAP unrecoverable error: unknown switch -%c ]\n", + *p); + print_usage(); + exit(EXIT_FAILURE); + } + } + else { + iap->SavedState = p; } + } + return iap->boot_file_type; +} + +/** + YAP_DelayInit() + + ensures initialization is done after engine creation. + It receives a pointer to function and a string describing + the module. +*/ + +X_API bool YAP_initialized = false; +static int n_mdelays = 0; +static YAP_delaymodule_t *m_delays; + +X_API bool YAP_DelayInit(YAP_ModInit_t f, const char s[]) { + if (m_delays) { + m_delays = realloc(m_delays, (n_mdelays + 1) * sizeof(YAP_delaymodule_t)); + } else { + m_delays = malloc(sizeof(YAP_delaymodule_t)); + } + m_delays[n_mdelays].f = f; + m_delays[n_mdelays].s = s; + n_mdelays++; + return true; +} + +bool Yap_LateInit(const char s[]) { + int i; + for (i = 0; i < n_mdelays; i++) { + if (!strcmp(m_delays[i].s, s)) { + m_delays[i].f(); + return true; + } + } + return false; +} + +static void start_modules(void) { + Term cm = CurrentModule; + size_t i; + for (i = 0; i < n_mdelays; i++) { + CurrentModule = MkAtomTerm(YAP_LookupAtom(m_delays[i].s)); + m_delays[i].f(); + } + CurrentModule = cm; +} + +/// whether Yap is under control of some other system +bool Yap_embedded = true; + +struct ssz_t { + size_t Heap, Stack, Trail; +}; + +static void init_hw(YAP_init_args *yap_init, struct ssz_t *spt) { + Yap_page_size = Yap_InitPageSize(); /* init memory page size, required by + later functions */ +#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) + Yap_init_yapor_global_local_memory(); +#endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA */ + if (!yap_init->Embedded) { + GLOBAL_PrologShouldHandleInterrupts = + !yap_init->PrologCannotHandleInterrupts; + Yap_InitSysbits(0); /* init signal handling and time, required by later + functions */ + GLOBAL_argv = yap_init->Argv; + GLOBAL_argc = yap_init->Argc; + } + +#if __ANDROID__ + + // if (yap_init->assetManager) + Yap_InitAssetManager(); + +#endif + + if (yap_init->TrailSize == 0) { + if (spt->Trail == 0) + spt->Trail = DefTrailSpace; + } else { + spt->Trail = yap_init->TrailSize; + } + // Atts = yap_init->AttsSize; + if (yap_init->StackSize == 0) { + spt->Stack = DefStackSpace; + } else { + spt->Stack = yap_init->StackSize; + } +#ifndef USE_SYSTEM_MALLOC + if (yap_init->HeapSize == 0) { + if (spt->Heap == 0) + spt->Heap = DefHeapSpace; + } else { + spt->Heap = yap_init->HeapSize; + } +#endif +} + +static void init_globals(YAP_init_args *yap_init) { + GLOBAL_FAST_BOOT_FLAG = yap_init->FastBoot; +#if defined(YAPOR) || defined(TABLING) + + Yap_init_root_frames(); + +#endif /* YAPOR || TABLING */ +#ifdef YAPOR + Yap_init_yapor_workers(); +#if YAPOR_THREADS + if (Yap_thread_self() != 0) { +#else + if (worker_id != 0) { +#endif +#if defined(YAPOR_COPY) || defined(YAPOR_SBA) + /* + In the SBA we cannot just happily inherit registers + from the other workers + */ + Yap_InitYaamRegs(worker_id); +#endif /* YAPOR_COPY || YAPOR_SBA */ +#ifndef YAPOR_THREADS + Yap_InitPreAllocCodeSpace(0); +#endif /* YAPOR_THREADS */ + /* slaves, waiting for work */ + CurrentModule = USER_MODULE; + P = GETWORK_FIRST_TIME; + Yap_exec_absmi(FALSE, YAP_EXEC_ABSMI); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, + "abstract machine unexpected exit (YAP_Init)"); + } +#endif /* YAPOR */ + RECOVER_MACHINE_REGS(); + /* make sure we do this after restore */ + if (yap_init->MaxStackSize) { + GLOBAL_AllowLocalExpansion = FALSE; + } else { + GLOBAL_AllowLocalExpansion = TRUE; + } + if (yap_init->MaxGlobalSize) { + GLOBAL_AllowGlobalExpansion = FALSE; + } else { + GLOBAL_AllowGlobalExpansion = TRUE; + } + if (yap_init->MaxTrailSize) { + GLOBAL_AllowTrailExpansion = FALSE; + } else { + GLOBAL_AllowTrailExpansion = TRUE; + } + if (yap_init->YapPrologRCFile) { + Yap_PutValue(AtomConsultOnBoot, + MkAtomTerm(Yap_LookupAtom(yap_init->YapPrologRCFile))); + /* + This must be done again after restore, as yap_flags + has been overwritten .... + */ + setBooleanGlobalPrologFlag(HALT_AFTER_CONSULT_FLAG, + yap_init->HaltAfterConsult); + } + if (yap_init->YapPrologTopLevelGoal) { + Yap_PutValue(AtomTopLevelGoal, + MkAtomTerm(Yap_LookupAtom(yap_init->YapPrologTopLevelGoal))); + } + if (yap_init->YapPrologGoal) { + Yap_PutValue(AtomInitGoal, + MkAtomTerm(Yap_LookupAtom(yap_init->YapPrologGoal))); + } + if (yap_init->YapPrologAddPath) { + Yap_PutValue(AtomExtendFileSearchPath, + MkAtomTerm(Yap_LookupAtom(yap_init->YapPrologAddPath))); + } + + if (yap_init->QuietMode) { + setVerbosity(TermSilent); + } +} + +static YAP_file_type_t end_init(YAP_init_args *yap_init, YAP_file_type_t rc) { + init_globals(yap_init); + LOCAL_PrologMode &= ~BootMode; + + start_modules(); + + YAP_initialized = true; + return rc; +} + +/* this routine is supposed to be called from an external program + that wants to control Yap */ + +X_API YAP_file_type_t YAP_Init(YAP_init_args *yap_init) { + YAP_file_type_t restore_result = yap_init->boot_file_type; + bool do_bootstrap = (restore_result & YAP_CONSULT_MODE); + struct ssz_t minfo; + + if (YAP_initialized) + return YAP_FOUND_BOOT_ERROR; + if (!LOCAL_TextBuffer) + LOCAL_TextBuffer = Yap_InitTextAllocator(); + + /* ignore repeated calls to YAP_Init */ + Yap_embedded = yap_init->Embedded; + + minfo.Trail = 0, minfo.Stack = 0, minfo.Trail = 0; + init_hw(yap_init, &minfo); + Yap_InitWorkspace(yap_init, minfo.Heap, minfo.Stack, minfo.Trail, 0, + yap_init->MaxTableSpaceSize, yap_init->NumberWorkers, + yap_init->SchedulerLoop, yap_init->DelayedReleaseLoad); + // + + CACHE_REGS + if (Yap_embedded) + if (yap_init->QuietMode) { + setVerbosity(TermSilent); + } + if (yap_init->YapPrologRCFile != NULL) { + /* + This must be done before restore, otherwise + restore will print out messages .... + */ + setBooleanGlobalPrologFlag(HALT_AFTER_CONSULT_FLAG, + yap_init->HaltAfterConsult); + } + /* tell the system who should cope with interrupts */ + Yap_ExecutionMode = yap_init->ExecutionMode; + Yap_set_locations(yap_init); + if (!do_bootstrap && Yap_STARTUP && yap_init->boot_file_type != YAP_BOOT_PL && + Yap_SavedInfo(Yap_STARTUP, &minfo.Trail, &minfo.Stack, &minfo.Heap) && + Yap_Restore(Yap_STARTUP)) { + setBooleanGlobalPrologFlag(SAVED_PROGRAM_FLAG, true); + CurrentModule = LOCAL_SourceModule = USER_MODULE; + return end_init(yap_init, YAP_QLY); + } else { + do_bootfile(Yap_BOOTFILE PASS_REGS); + setBooleanGlobalPrologFlag(SAVED_PROGRAM_FLAG, false); + return end_init(yap_init, YAP_BOOT_PL); + } +} + +#if (DefTrailSpace < MinTrailSpace) +#undef DefTrailSpace +#define DefTrailSpace MinTrailSpace +#endif + +#if (DefStackSpace < MinStackSpace) +#undef DefStackSpace +#define DefStackSpace MinStackSpace +#endif + +#if (DefHeapSpace < MinHeapSpace) +#undef DefHeapSpace +#define DefHeapSpace MinHeapSpace +#endif + +#define DEFAULT_NUMBERWORKERS 1 +#define DEFAULT_SCHEDULERLOOP 10 +#define DEFAULT_DELAYEDRELEASELOAD 3 + +X_API YAP_file_type_t YAP_FastInit(char *saved_state, int argc, char *argv[]) { + YAP_init_args init_args; + YAP_file_type_t out; + + if ((out = Yap_InitDefaults(&init_args, saved_state, argc, argv)) != + YAP_FOUND_BOOT_ERROR) + out = YAP_Init(&init_args); + if (out == YAP_FOUND_BOOT_ERROR) { + Yap_Error(init_args.ErrorNo, TermNil, init_args.ErrorCause); + } + return out; +} diff --git a/CMakeLists.txt b/CMakeLists.txt index 72dcde353..5df095e63 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -17,8 +17,8 @@ cmake_policy(VERSION 3.4) set( CMAKE_MODULE_PATH "${CMAKE_SOURCE_DIR}" "${CMAKE_SOURCE_DIR}/cmake") - set(ANACONDA $ENV{CONDA_BUILD} CACHE BOOL "Anaconda Environment") - message(STATUS "ANACONDA found: ${ANACONDA}") +set(ANACONDA $ENV{CONDA_BUILD} CACHE BOOL "Anaconda Environment") +message(STATUS "ANACONDA found: ${ANACONDA}") include(CheckIncludeFiles) include(CheckLibraryExists) @@ -222,6 +222,7 @@ if (ANACONDA) #set( CMAKE_INSTALL_FULL_PREFIX $ENV{PREFIX} ) set( PYTHON_LIBRARY $ENV{PREFIX}/lib/libpython$ENV{PY_VER}m$ENV{SHLIB_EXT}) set( PYTHON_INCLUDE_DIR $ENV{PREFIX}/include/python$ENV{PY_VER}m) +set_property(DIRECTORY APPEND PROPERTY COMPILE_DEFINITIONS CONDA_BUILD=1) set(YAP_IS_MOVABLE 1) endif() @@ -814,7 +815,7 @@ endif(NOT ANDROID) # -install(FILES ${INCLUDE_HEADERS} ${CONFIGURATION_HEADERS} DESTINATION ${YAP_INCLUDEDIR} ) +install(FILES ${INCLUDE_HEADERS} ${CONFIGURATION_HEADERS} DESTINATION ${CMAKE_INSTALL_INCLUDEDIR}/Yap ) diff --git a/H/Yap.h b/H/Yap.h index b4a41f99e..aebd59061 100755 --- a/H/Yap.h +++ b/H/Yap.h @@ -151,7 +151,8 @@ typedef void *(*fptr_t)(void); main exports in YapInterface.h *************************************************************************************************/ -extern const char *Yap_BINDIR, *Yap_ROOTDIR, *Yap_SHAREDIR, *Yap_LIBDIR, *Yap_DLLDIR, *Yap_PLDIR; +extern const char *Yap_BINDIR, *Yap_ROOTDIR, *Yap_SHAREDIR, *Yap_LIBDIR, *Yap_DLLDIR, *Yap_PLDIR, *Yap_COMMONSDIR, *Yap_STARTUP, *Yap_BOOTFILE; + /* Basic exports */ diff --git a/H/YapGFlagInfo.h b/H/YapGFlagInfo.h index d5ba9a02b..0bb54e64c 100644 --- a/H/YapGFlagInfo.h +++ b/H/YapGFlagInfo.h @@ -236,7 +236,7 @@ process, namely, on choice-points. YAP_FLAG(GMP_VERSION_FLAG, "gmp_version", false, isatom, "4.8.12", NULL), YAP_FLAG(HALT_AFTER_CONSULT_FLAG, "halt_after_consult", false, booleanFlag, "false", NULL), - /* YAP_FLAG(HOME_FLAG, "home", false, isatom, rootdir, NULL),*/ /**< home ` + YAP_FLAG(HOME_FLAG, "home", false, isatom, rootdir, NULL), /**< home ` the root of the YAP installation, by default `/usr/local` in Unix or `c:\Yap` in Windows system. Can only be set at configure time diff --git a/H/YapTerm.h b/H/YapTerm.h deleted file mode 100644 index eea862360..000000000 --- a/H/YapTerm.h +++ /dev/null @@ -1,169 +0,0 @@ -/************************************************************************* -* * -* YAP Prolog %W% %G% * -* Yap Prolog was developed at NCCUP - Universidade do Porto * -* * -* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * -* * -************************************************************************** -* * -* File: Yap.h * -* mods: * -* comments: abstract type definitions for YAP * -* version: $Id: Yap.h,v 1.38 2008-06-18 10:02:27 vsc Exp $ * -*************************************************************************/ - -#ifndef YAP_H -#include "YapTermConfig.h" -#include "config.h" - -#endif - -#if HAVE_STDINT_H -#include -#endif -#if HAVE_INTTYPES_H -#include -#endif - -/* truth-values */ -/* stdbool defines the booleam type, bool, - and the constants false and true */ -#if HAVE_STDBOOL_H -#include -#else -#ifndef true -typedef int _Bool; -#define bool _Bool; - -#define false 0 -#define true 1 -#endif -#endif /* HAVE_STDBOOL_H */ - - -#define ALIGN_BY_TYPE(X, TYPE) \ - (((CELL)(X) + (sizeof(TYPE) - 1)) & ~(sizeof(TYPE) - 1)) - -#ifndef EXTERN -#ifdef MSC_VER -#define EXTERN -#else -#define EXTERN extern -#endif -#endif - -/* defines integer types Int and UInt (unsigned) with the same size as a ptr -** and integer types Short and UShort with half the size of a ptr */ - -#if defined(PRIdPTR) - -typedef intptr_t YAP_Int; -typedef uintptr_t YAP_UInt; - -#elif defined(_WIN64) - - -typedef int64_t YAP_Int; -typedef uint64_t YAP_UInt; - -#elif defined(_WIN32) - -typedef int32_t YAP_Int; -typedef uint32_t YAP_UInt; - -#elif SIZEOF_LONG_INT == SIZEOF_INT_P - -typedef long int YAP_Int; -typedef unsigned long int YAP_UInt; - -#elif SIZEOF_INT == SIZEOF_INT_P - -typedef int YAP_Int; -typedef unsigned int YAP_UInt; - -#else -#error Yap require integer types of the same size as a pointer -#endif - -/* */ typedef short int YAP_Short; -/* */ typedef unsigned short int YAP_UShort; - -typedef YAP_UInt YAP_CELL; -typedef YAP_UInt YAP_Term; - -/* Type definitions */ - - -#ifndef TRUE -#define TRUE true -#endif -#ifndef FALSE -#endif - -typedef bool YAP_Bool; -#define FALSE false - -typedef YAP_Int YAP_handle_t; - - -typedef double YAP_Float; - -typedef void *YAP_Atom; - -typedef void *YAP_Functor; - -#ifdef YAP_H - -typedef YAP_Int Int; -typedef YAP_UInt UInt; -typedef YAP_Short Short; -typedef YAP_UShort UShort; - -typedef uint16_t BITS16; -typedef int16_t SBITS16; -typedef uint32_t BITS32; - -typedef YAP_CELL CELL; - -typedef YAP_Term Term; - -#define WordSize sizeof(BITS16) -#define CellSize sizeof(CELL) -#define SmallSize sizeof(SMALLUNSGN) - -typedef YAP_Int Int; -typedef YAP_Float Float; -typedef YAP_handle_t yhandle_t; - -#endif - -#include "YapError.h" - -#include "../os/encoding.h" - -typedef encoding_t YAP_encoding_t; - -#include "YapFormat.h" - -/************************************************************************************************* - type casting macros -*************************************************************************************************/ - -#if SIZEOF_INT < SIZEOF_INT_P -#define SHORT_INTS 1 -#else -#define SHORT_INTS 0 -#endif - -#ifdef __GNUC__ -typedef long long int YAP_LONG_LONG; -typedef unsigned long long int YAP_ULONG_LONG; -#else -typedef long int YAP_LONG_LONG; -typedef unsigned long int YAP_ULONG_LONG; -#endif - -#define Unsigned(V) ((CELL)(V)) -#define Signed(V) ((Int)(V)) - diff --git a/H/Yapproto.h b/H/Yapproto.h index 94c1493b6..e8f8c5791 100755 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -354,16 +354,16 @@ extern void Yap_InitReadUtil(void); /* qly.c */ extern void Yap_InitQLY(void); -extern YAP_file_type_t Yap_Restore(const char *, const char *); +extern YAP_file_type_t Yap_Restore(const char *); extern void Yap_InitQLYR(void); /* range.c */ extern void Yap_InitRange(void); /* save.c */ -extern int Yap_SavedInfo(const char *, const char *, CELL *, CELL *, CELL *); -extern int Yap_SavedStateRestore(char *, char *); -extern FILE *Yap_OpenRestore(const char *, const char *); +extern int Yap_SavedInfo(const char *, CELL *, CELL *, CELL *); +extern int Yap_SavedStateRestore(char *); +extern FILE *Yap_OpenRestore(const char *); extern void Yap_InitSavePreds(void); /* scanner.c */ @@ -432,10 +432,10 @@ extern void Yap_WinError(char *); extern const char *Yap_AbsoluteFile(const char *spec, char *obuf, bool ok); extern const char *Yap_AbsoluteFileInBuffer(const char *spec, char *outp, size_t sz, bool ok); -extern const char *Yap_findFile(const char *isource, const char *idef, - const char *root, char *result, bool access, - YAP_file_type_t ftype, bool expand_root, bool in_lib); extern bool Yap_ChDir(const char *path); +bool Yap_isDirectory(const char *FileName); +extern bool Yap_Exists(const char *f); + /* threads.c */ extern void Yap_InitThreadPreds(void); diff --git a/config.h.cmake b/config.h.cmake index 0581f658a..ca33499e0 100644 --- a/config.h.cmake +++ b/config.h.cmake @@ -1971,7 +1971,6 @@ significant byte first (like Motorola and SPARC, unlike Intel). */ -#ifndef YAP_IS_MOVABLE /* name of YAP instaii */ #ifndef YAP_ROOTDIR #define YAP_ROOTDIR "${YAP_ROOTDIR}" @@ -2001,13 +2000,14 @@ significant byte first (like Motorola and SPARC, unlike Intel). */ #define YAP_SHAREDIR "${YAP_ROOTDIR}/share" #endif -#else -extern char -*YAP_BINDIR, -*YAP_ROOTDIR, -*YAP_SHAREDIR, -*YAP_LIBDIR, -*YAP_YAPLIB; +/* name of YAP PL library */ +#ifndef YAP_PLDIR +#define YAP_PLDIR "${YAP_SHAREDIR}/Yap" +#endif + +/* name of Commons library */ +#ifndef YAP_COMMONSDIR +#define YAP COMMONSDIR "${YAP_SHAREDIR}/PrologCommmons" #endif diff --git a/os/iopreds.c b/os/iopreds.c index 9bc26dc79..8193b4c8b 100644 --- a/os/iopreds.c +++ b/os/iopreds.c @@ -1370,7 +1370,7 @@ writable. */ -static Int open3(USES_REGS1) { +static Int open3(USES_RfEGS1) { /* '$open'(+File,+Mode,?Stream,-ReturnCode) */ return do_open(Deref(ARG1), Deref(ARG2), TermNil PASS_REGS); } @@ -1465,11 +1465,11 @@ static Int p_file_expansion(USES_REGS1) { /* '$file_expansion'(+File,-Name) */ PlIOError(INSTANTIATION_ERROR, file_name, "absolute_file_name/3"); return (FALSE); } - if (!Yap_findFile(RepAtom(AtomOfTerm(file_name))->StrOfAE, NULL, NULL, - LOCAL_FileNameBuf, true, YAP_ANY_FILE, true, false)) + char tmp[YAP_FILENAME_MAX+1]; + if (!Yap_AbsoluteFile(RepAtom(AtomOfTerm(file_name))->StrOfAE,tmp, false)) return (PlIOError(EXISTENCE_ERROR_SOURCE_SINK, file_name, "absolute_file_name/3")); - return (Yap_unify(ARG2, MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf)))); + return (Yap_unify(ARG2, MkAtomTerm(Yap_LookupAtom(tmp)))); } static Int p_open_null_stream(USES_REGS1) { diff --git a/os/iopreds.h b/os/iopreds.h index 736901836..753df467e 100644 --- a/os/iopreds.h +++ b/os/iopreds.h @@ -273,7 +273,6 @@ extern FILE *Yap_stderr; char *Yap_MemExportStreamPtr(int sno); -extern bool Yap_Exists(const char *f); static inline void freeBuffer(const void *ptr) { CACHE_REGS diff --git a/os/sysbits.c b/os/sysbits.c index fb3bb967e..8697ca0cb 100644 --- a/os/sysbits.c +++ b/os/sysbits.c @@ -34,7 +34,6 @@ static void FileError(yap_error_number type, Term where, const char *format, } } - static Int p_sh(USES_REGS1); static Int p_shell(USES_REGS1); static Int p_system(USES_REGS1); @@ -67,11 +66,11 @@ void Yap_WinError(char *yap_error) { /// is_directory: verifies whether an expanded file name /// points at a readable directory -static bool is_directory(const char *FileName) { +bool Yap_isDirectory(const char *FileName) { VFS_t *vfs; if ((vfs = vfs_owner(FileName))) { - return vfs->isdir(vfs,FileName); + return vfs->isdir(vfs, FileName); } #ifdef _WIN32 DWORD dwAtts = GetFileAttributes(FileName); @@ -94,10 +93,10 @@ static bool is_directory(const char *FileName) { } bool Yap_Exists(const char *f) { - VFS_t *vfs; - f = Yap_VFAlloc(f); - if ((vfs = vfs_owner(f))) { - return vfs->exists(vfs,f); + VFS_t *vfs; + f = Yap_VFAlloc(f); + if ((vfs = vfs_owner(f))) { + return vfs->exists(vfs, f); } #if _WIN32 if (_access(f, 0) == 0) @@ -108,7 +107,7 @@ bool Yap_Exists(const char *f) { return false; #elif HAVE_ACCESS if (access(f, F_OK) == 0) { - return true; + return true; } if (errno == EINVAL) { Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "bad flags to access"); @@ -145,9 +144,9 @@ bool Yap_IsAbsolutePath(const char *p0, bool expand) { // verify first if expansion is needed: ~/ or $HOME/ const char *p = p0; bool nrc; - if (expand) { - p = expandVars(p0, LOCAL_FileNameBuf); - } + if (expand) { + p = expandVars(p0, LOCAL_FileNameBuf); + } #if _WIN32 || __MINGW32__ nrc = !PathIsRelative(p); #else @@ -345,7 +344,7 @@ static char *PrologPath(const char *Y, char *X) { return (char *)Y; } char virtual_cwd[YAP_FILENAME_MAX + 1]; - bool Yap_ChDir(const char *path) { +bool Yap_ChDir(const char *path) { bool rc = false; char qp[FILENAME_MAX + 1]; const char *qpath = Yap_AbsoluteFile(path, qp, true); @@ -369,10 +368,9 @@ char virtual_cwd[YAP_FILENAME_MAX + 1]; return rc; } - static const char *myrealpath(const char *path, char *out) { - int lvl = push_text_stack(); - #if _WIN32 + int lvl = push_text_stack(); +#if _WIN32 DWORD retval = 0; // notice that the file does not need to exist @@ -388,13 +386,13 @@ static const char *myrealpath(const char *path, char *out) { char *rc = realpath(path, NULL); if (rc) { - pop_text_stack(lvl); + pop_text_stack(lvl); return rc; } // rc = NULL; if (errno == ENOENT || errno == EACCES) { - char *base= Malloc(YAP_FILENAME_MAX + 1); - strncpy(base, path, YAP_FILENAME_MAX ); + char *base = Malloc(YAP_FILENAME_MAX + 1); + strncpy(base, path, YAP_FILENAME_MAX); rc = realpath(dirname(base), out); if (rc) { @@ -418,7 +416,7 @@ static const char *myrealpath(const char *path, char *out) { } #endif strcat(rc, b); - rc = pop_output_text_stack(lvl, rc); + rc = pop_output_text_stack(lvl, rc); return rc; } } @@ -426,7 +424,7 @@ static const char *myrealpath(const char *path, char *out) { #endif out = malloc(strlen(path) + 1); strcpy(out, path); - pop_text_stack(lvl); + pop_text_stack(lvl); return out; } @@ -957,97 +955,12 @@ static bool initSysPath(Term tlib, Term tcommons, bool dir_done, bool commons_done) { CACHE_REGS int len; - char *dir; + char *dir; -#if __WINDOWS__ - { - if ((dir = Yap_RegistryGetString("library")) && is_directory(dir)) { - dir_done = true; - if (!Yap_unify(tlib, MkAtomTerm(Yap_LookupAtom(dir)))) - return false; - } - if ((dir = Yap_RegistryGetString("prolog_commons")) && is_directory(dir)) { - if (!Yap_unify(tcommons, MkAtomTerm(Yap_LookupAtom(dir)))) - return false; - commons_done = true; - } - } - if (dir_done && commons_done) - return true; -#endif + if (!Yap_unify(tlib, MkAtomTerm(Yap_LookupAtom(Yap_PLDIR)))) + return false; - if (!Yap_unify(tlib, MkAtomTerm(Yap_LookupAtom(Yap_PLDIR)))) - return false; - if (!commons_done) { - LOCAL_FileNameBuf[len] = '\0'; - strncat(LOCAL_FileNameBuf, "PrologCommons", YAP_FILENAME_MAX); - if (is_directory(LOCAL_FileNameBuf)) { - if (!Yap_unify(tcommons, MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf)))) - return FALSE; - } - commons_done = true; - } - if (dir_done && commons_done) - return TRUE; - -#if __WINDOWS__ - { - size_t buflen; - char *pt; - /* couldn't find it where it was supposed to be, - let's try using the executable */ - if (!GetModuleFileName(NULL, LOCAL_FileNameBuf, YAP_FILENAME_MAX)) { - Yap_WinError("could not find executable name"); - /* do nothing */ - return FALSE; - } - buflen = strlen(LOCAL_FileNameBuf); - pt = LOCAL_FileNameBuf + buflen; - while (*--pt != '\\') { - /* skip executable */ - if (pt == LOCAL_FileNameBuf) { - FileError(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil, - "could not find executable name"); - /* do nothing */ - return FALSE; - } - } - while (*--pt != '\\') { - /* skip parent directory "bin\\" */ - if (pt == LOCAL_FileNameBuf) { - FileError(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil, - "could not find executable name"); - /* do nothing */ - return FALSE; - } - } - /* now, this is a possible location for the ROOT_DIR, let's look for a share - * directory here */ - pt[1] = '\0'; - /* grosse */ - strncat(LOCAL_FileNameBuf, "lib\\Yap", YAP_FILENAME_MAX); - libdir = Yap_AllocCodeSpace(strlen(LOCAL_FileNameBuf) + 1); - strncpy(libdir, LOCAL_FileNameBuf, strlen(LOCAL_FileNameBuf) + 1); - pt[1] = '\0'; - strncat(LOCAL_FileNameBuf, "share", YAP_FILENAME_MAX); - } - strncat(LOCAL_FileNameBuf, "\\", YAP_FILENAME_MAX); - len = strlen(LOCAL_FileNameBuf); - strncat(LOCAL_FileNameBuf, "Yap", YAP_FILENAME_MAX); - if (!dir_done && is_directory(LOCAL_FileNameBuf)) { - if (!Yap_unify(tlib, MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf)))) - return FALSE; - dir_done = true; - } - LOCAL_FileNameBuf[len] = '\0'; - strncat(LOCAL_FileNameBuf, "PrologCommons", YAP_FILENAME_MAX); - if (!commons_done && is_directory(LOCAL_FileNameBuf)) { - if (!Yap_unify(tcommons, MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf)))) - return FALSE; - commons_done = true; - } -#endif - return dir_done && commons_done; + return Yap_unify(tcommons, MkAtomTerm(Yap_LookupAtom(Yap_COMMONSDIR))); } static Int libraries_directories(USES_REGS1) { @@ -1133,10 +1046,10 @@ int Yap_volume_header(char *file) { return volume_header(file); } const char *Yap_getcwd(char *cwd, size_t cwdlen) { if (virtual_cwd[0]) { - if (!cwd) { - cwd = malloc(cwdlen+1); + if (!cwd) { + cwd = malloc(cwdlen + 1); } - strcpy( cwd, virtual_cwd); + strcpy(cwd, virtual_cwd); return cwd; } #if _WIN32 || defined(__MINGW32__) @@ -1171,184 +1084,6 @@ static Int working_directory(USES_REGS1) { return Yap_ChDir(RepAtom(AtomOfTerm(t2))->StrOfAE); } -/** Yap_findFile(): tries to locate a file, no expansion should be performed/ - * - * - * @param isource the proper file - * @param idef the default name fothe file, ie, startup.yss - * @param root the prefix - * @param result the output - * @param access verify whether the file has access permission - * @param ftype saved state, object, saved file, prolog file - * @param expand_root expand $ ~, etc - * @param in_lib library file - * - * @return - */ -const char *Yap_findFile(const char *isource, const char *idef, - const char *iroot, char *result, bool access, - YAP_file_type_t ftype, bool expand_root, bool in_lib) { - - char *save_buffer = NULL; - char *root, *source; - int rc = FAIL_RESTORE; - int try = 0; - bool abspath = false; - - int lvl = push_text_stack(); - root = Malloc(YAP_FILENAME_MAX+1); - source= Malloc(YAP_FILENAME_MAX+1); - if (iroot && iroot[0]) - strcpy(root, iroot); - else - root[0] = 0; - if (isource && isource[0]) - strcpy(source, isource); - else - source[0] = 0; - //__android_log_print(ANDROID_LOG_ERROR, "YAPDroid " __FUNCTION__, - // "try=%d %s %s", try, isource, iroot) ; } - while (rc == FAIL_RESTORE) { - // means we failed this iteration - bool done = false; - // { CACHE_REGS - switch (try ++) { - case 0: // path or file name is given; - if (!source[0] && idef && idef[0]) { - strcpy(source, idef); - } - if (source[0]) { - abspath = Yap_IsAbsolutePath(source, expand_root); - } - if (!abspath && !root[0] && ftype == YAP_BOOT_PL) { - strcpy(root, YAP_PL_SRCDIR); - } - break; - case 1: // library directory is given in command line - if (in_lib && ftype == YAP_SAVED_STATE) { - if (iroot && iroot[0]) - strcpy(root, iroot); - else - root[0] = 0; - if (isource && isource[0]) - strcpy(source, isource); - else if (idef && idef[0]) - strcpy(source, idef); - else - source[0] = 0; - } else { - done = true; - } - break; - case 3: // use compilation variable YAPLIBDIR - if (in_lib) { - if (isource && isource[0]) - strcpy(source, isource); - else if (idef && idef[0]) - strcpy(source, idef); - else - source[0] = 0; - if (ftype == YAP_PL) { - strcpy(root,YAP_SHAREDIR); - } else if (ftype == YAP_BOOT_PL) { - strcpy(root, YAP_SHAREDIR); - strcat(root,"/pl"); - } else { - strcpy(root,YAP_LIBDIR); - } - } else - done = true; - break; - - case 4: // WIN stuff: registry -#if __WINDOWS - if (in_lib) { - const char *key = (ftype == YAP_PL || ftype == YAP_QLY ? "library" : "startup"); - strcpy( source, Yap_RegistryGetString(source) ); - root[0] = 0; - } else -#endif - done = true; - break; - - case 5: // search from the binary -#ifndef __ANDROID__ - { - done = true; - } break; -#endif - { - const char *pt = Yap_FindExecutable(); - - if (pt) { - if (ftype == YAP_BOOT_PL) { -#if __ANDROID__ - strcpy(root, "../../../files/Yap/pl"); -#else - root = "../../share/Yap/pl"; -#endif - } else { - strcpy(root, (ftype == YAP_SAVED_STATE || ftype == YAP_OBJ - ? "../../lib/Yap" - : "../../share/Yap")); - } - if (strcmp(root, iroot) == 0) { - done = true; - continue; - } - if (!save_buffer) { - save_buffer = Malloc(YAP_FILENAME_MAX + 1); - - save_buffer[0] = 0; - } - if (Yap_findFile(source, NULL, root, save_buffer, access, ftype, - expand_root, in_lib)) - strcpy(root, save_buffer); - else - done = true; - } else { - done = true; - } - if (isource && isource[0]) - strcpy(source, isource); - else if (idef && idef[0]) - strcpy(source, idef); - else - source[0] = 0; - } - break; - case 6: // default, try current directory - if (!isource && ftype == YAP_SAVED_STATE) - strcpy(source, idef); - root[0] = 0; - break; - default: - pop_text_stack(lvl); - return NULL; - } - - if (done) - continue; - // { CACHE_REGS __android_log_print(ANDROID_LOG_ERROR, __FUNCTION__, - // "root= %s %s ", root, source) ; } - const char *work = PlExpandVars(source, root, result); - - - // expand names in case you have - // to add a prefix - if (!access || Yap_Exists(work)) { - work = pop_output_text_stack(lvl,work); - return work; // done - } else if (abspath) { - pop_text_stack(lvl); - return NULL; - } - } - pop_text_stack(lvl); - - return NULL; -} - static Int true_file_name(USES_REGS1) { Term t = Deref(ARG1); const char *s; @@ -1414,10 +1149,10 @@ static Int true_file_name3(USES_REGS1) { } root = RepAtom(AtomOfTerm(t2))->StrOfAE; } - if (!Yap_findFile(RepAtom(AtomOfTerm(t))->StrOfAE, NULL, root, - LOCAL_FileNameBuf, false, YAP_PL, false, false)) + char tmp[YAP_FILENAME_MAX + 1]; + if (!Yap_AbsoluteFile(RepAtom(AtomOfTerm(t))->StrOfAE, tmp, true)) return FALSE; - return Yap_unify(ARG3, MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf))); + return Yap_unify(ARG3, MkAtomTerm(Yap_LookupAtom(tmp))); } /* Executes $SHELL under Prolog */ @@ -1644,8 +1379,8 @@ static Int p_mv(USES_REGS1) { /* rename(+OldName,+NewName) */ newname = Yap_VFAlloc((RepAtom(AtomOfTerm(t2)))->StrOfAE); if ((r = link(oldname, newname)) == 0 && (r = unlink(oldname)) != 0) unlink(newname); - free(oldname); - free(newname); + free(oldname); + free(newname); if (r != 0) { #if HAVE_STRERROR Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, t2, "%s in rename(%s,%s)", @@ -1771,18 +1506,18 @@ static Int p_host_type(USES_REGS1) { } static Int p_yap_home(USES_REGS1) { - Term out; + Term out; - out = MkAtomTerm(Yap_LookupAtom(Yap_ROOTDIR)); - return Yap_unify(out, ARG1); + out = MkAtomTerm(Yap_LookupAtom(Yap_ROOTDIR)); + return Yap_unify(out, ARG1); } static Int p_yap_paths(USES_REGS1) { Term out1, out2, out3; - out1 = MkAtomTerm(Yap_LookupAtom(Yap_LIBDIR)); - out2 = MkAtomTerm(Yap_LookupAtom(Yap_SHAREDIR)); - out3 = MkAtomTerm(Yap_LookupAtom(Yap_BINDIR)); + out1 = MkAtomTerm(Yap_LookupAtom(Yap_LIBDIR)); + out2 = MkAtomTerm(Yap_LookupAtom(Yap_SHAREDIR)); + out3 = MkAtomTerm(Yap_LookupAtom(Yap_BINDIR)); return (Yap_unify(out1, ARG1) && Yap_unify(out2, ARG2) && Yap_unify(out3, ARG3)); @@ -1864,7 +1599,7 @@ static Int p_win32(USES_REGS1) { } static Int p_ld_path(USES_REGS1) { - return Yap_unify(ARG1, MkAtomTerm(Yap_LookupAtom(YAP_DLLDIR))); + return Yap_unify(ARG1, MkAtomTerm(Yap_LookupAtom(Yap_DLLDIR))); } static Int p_address_bits(USES_REGS1) { diff --git a/pl/CMakeLists.txt b/pl/CMakeLists.txt index 01d1ae27d..a89cc0893 100644 --- a/pl/CMakeLists.txt +++ b/pl/CMakeLists.txt @@ -7,6 +7,7 @@ set(PL_BOOT_SOURCES attributes.yap boot.yap bootlists.yap + bootutils.yap callcount.yap checker.yap consult.yap @@ -84,6 +85,9 @@ install(FILES ${CMAKE_TOP_BINARY_DIR}/${YAP_STARTUP} endif() -install(FILES ${PL_SOURCES} +install(FILES ${PL_BOOT_SOURCES} DESTINATION ${libpl}/pl ) +install(FILES ../library/ypp.yap + DESTINATION ${libpl}/library + ) diff --git a/pl/arith.yap b/pl/arith.yap index e78de29c9..a6b5a78d9 100644 --- a/pl/arith.yap +++ b/pl/arith.yap @@ -22,7 +22,7 @@ :- system_module( '$_arith', [compile_expressions/0, expand_exprs/2, plus/3, - succ/2], ['$c_built_in'/3]). + succ/2], ['$c_built_in'/4]). :- private( [do_c_built_in/3, do_c_built_metacall/3, @@ -86,7 +86,6 @@ expand_exprs(Old,New) :- After a call to this predicate, arithmetical expressions will be compiled. (see example below). This is the default behavior. */ - compile_expressions :- set_value('$c_arith',true). /** @pred do_not_compile_expressions diff --git a/pl/boot.yap b/pl/boot.yap index 61dbf470b..437f8cc98 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -1305,10 +1305,10 @@ not(G) :- \+ '$execute'(G). bootstrap(F) :- yap_flag(verbose_load, Old, silent), - open(F, read, Stream), - stream_property(Stream, [file_name(File)]), - '$start_consult'(consult, File, LC), - file_directory_name(File, Dir), + open(F, read, Stream), + stream_property(Stream, [file_name(File)]), + '$start_consult'(consult, File, LC), + file_directory_name(File, Dir), working_directory(OldD, Dir), ( current_prolog_flag(verbose_load, silent) diff --git a/pl/init.yap b/pl/init.yap index 8f744b173..b86d7c006 100644 --- a/pl/init.yap +++ b/pl/init.yap @@ -118,6 +118,7 @@ otherwise. :- compile_expressions. + :- bootstrap('bootutils.yap'). :- bootstrap('bootlists.yap'). :- bootstrap('consult.yap'). diff --git a/pl/load_foreign.yap b/pl/load_foreign.yap index d9a5626ea..0d2b58dbe 100644 --- a/pl/load_foreign.yap +++ b/pl/load_foreign.yap @@ -57,7 +57,7 @@ variable: + YAPLIBDIR if defined, or in the default library. - +available as YAP supports the SWI-Prolog interface to loading foreign code, the shlib package. */ diff --git a/pl/meta.yap b/pl/meta.yap index 77dc0d0f8..5c3691422 100644 --- a/pl/meta.yap +++ b/pl/meta.yap @@ -30,6 +30,9 @@ meta_predicate declaration % directive now meta_predicate Ps :- $meta_predicate(Ps). +:- use_system_module( '$_arith', ['$c_built_in'/4]). + + :- dynamic prolog:'$meta_predicate'/4. :- multifile prolog:'$meta_predicate'/4,