From 46a9d52d2de9b7c66e631f323bd13e913d1dd722 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Fri, 4 Nov 2016 11:36:48 -0500 Subject: [PATCH] Memory management and UTF-8 for all fixes --- C/adtdefs.c | 15 +- C/alloc.c | 10 +- C/atomic.c | 611 ++++++++++++++++++++++++------------------- C/cmppreds.c | 33 ++- C/compiler.c | 16 +- C/errors.c | 21 ++ C/exec.c | 1 + C/grow.c | 2 - C/parser.c | 100 ++++--- C/scanner.c | 17 +- C/text.c | 54 ++-- C/write.c | 6 +- CXX/yapa.hh | 8 +- H/ATOMS | 2 - H/ScannerTypes.h | 5 +- H/YapGFlagInfo.h | 2 +- H/YapText.h | 2 +- H/generated/iatoms.h | 2 - H/generated/ratoms.h | 2 - H/generated/tatoms.h | 3 - include/YapError.h | 9 +- os/iopreds.c | 2 +- os/iopreds.h | 2 +- os/readterm.c | 75 +++--- pl/boot.yap | 8 +- pl/grammar.yap | 1 - 26 files changed, 526 insertions(+), 483 deletions(-) diff --git a/C/adtdefs.c b/C/adtdefs.c index c83473e5d..617027a14 100755 --- a/C/adtdefs.c +++ b/C/adtdefs.c @@ -57,10 +57,15 @@ GetFunctorProp(AtomEntry *ae, arity_t arity) { /* look property list of atom a for kind */ FunctorEntry *pp; - pp = RepFunctorProp(ae->PropsOfAE); - while (!EndOfPAEntr(pp) && (pp = RepFunctorProp(pp->NextOfPE))) - ; - return (AbsFunctorProp(pp)); + PropEntry *p = RepFunctorProp(ae->PropsOfAE); + while (p != NIL) { + if (p->KindOfPE == FunctorProperty && + RepFunctorProp(p)->ArityOfFE == arity) { + return p; + } + p = p->NextOfPE; + } + return NIL; } /* vsc: We must guarantee that IsVarTerm(functor) returns true! */ @@ -155,7 +160,6 @@ LookupAtom(const unsigned char *atom) { /* lookup atom in atom table */ hash = HashFunction(p); hash = hash % sz; - /* we'll start by holding a read lock in order to avoid contention */ READ_LOCK(HashChain[hash].AERWLock); a = HashChain[hash].Entry; @@ -199,6 +203,7 @@ LookupAtom(const unsigned char *atom) { /* lookup atom in atom table */ if (NOfAtoms > 2 * AtomHashTableSize) { Yap_signal(YAP_CDOVF_SIGNAL); } + return na; } diff --git a/C/alloc.c b/C/alloc.c index 842f96966..395d9ab5f 100644 --- a/C/alloc.c +++ b/C/alloc.c @@ -77,7 +77,7 @@ void *my_malloc(size_t sz) { p = malloc(sz); // Yap_DebugPuts(stderr,"gof\n"); - if (Yap_do_low_level_trace||1) + if (Yap_do_low_level_trace) fprintf(stderr, "+ %p : %lu\n", p, sz); if (sz > 500 && write_malloc++ > 0) __android_log_print(ANDROID_LOG_ERROR, "YAPDroid ", "+ %d %p", write_malloc, @@ -89,8 +89,8 @@ void *my_realloc(void *ptr, size_t sz) { void *p; p = realloc(ptr, sz); - if (Yap_do_low_level_trace||1) - fprintf(stderr, "+ %p -> %p : %lu\n", ptr, p, sz); + if (Yap_do_low_level_trace) + // fprintf(stderr, "+ %p -> %p : %lu\n", ptr, p, sz); // Yap_DebugPuts(stderr,"gof\n"); if (sz > 500 && write_malloc++ > 0) __android_log_print(ANDROID_LOG_ERROR, "YAPDroid ", "* %d %p", write_malloc, @@ -100,7 +100,7 @@ void *my_realloc(void *ptr, size_t sz) { void my_free(void *p) { // printf("f %p\n",p); - if (Yap_do_low_level_trace||1) + if (Yap_do_low_level_trace) fprintf(stderr, "+ %p\n", p); if (write_malloc && write_malloc++ > 0) __android_log_print(ANDROID_LOG_ERROR, "YAPDroid ", "- %d %p", write_malloc, @@ -671,7 +671,7 @@ static char *AllocHeap(size_t size) { LOCK(FreeBlocksLock); if ((b = GetBlock(size))) { if (b->b_size >= size + 24 + 1) { - n = (BlockHeader *)(((YAP_SEG_SIZE *)b) + size + 1); + n = (BlockHeader *)(((YAP_SEG_SIZE *)b) + size + 1)v; n->b_size = b->b_size - size - 1; b->b_size = size; AddToFreeList(n); diff --git a/C/atomic.c b/C/atomic.c index b0ce06e4d..2b274a134 100644 --- a/C/atomic.c +++ b/C/atomic.c @@ -68,6 +68,10 @@ static Int hide_atom(USES_REGS1); static Int hidden_atom(USES_REGS1); static Int unhide_atom(USES_REGS1); +#define ReleaseAndReturn(r) { pop_text_stack(l); return r; } +#define release_cut_fail() { pop_text_stack(l); cut_fail(); } +#define release_cut_succeed() { pop_text_stack(l); cut_succeed(); } + static int AlreadyHidden(unsigned char *name) { AtomEntry *chain; @@ -78,8 +82,8 @@ static int AlreadyHidden(unsigned char *name) { strcmp((char *)chain->StrOfAE, (char *)name) != 0) chain = RepAtom(chain->NextOfAE); if (EndOfPAEntr(chain)) - return (FALSE); - return (TRUE); + return false; + return true; } /** @pred hide_atom(+ _Atom_) @@ -237,7 +241,7 @@ static Int char_code(USES_REGS1) { return (FALSE); } size_t n = put_utf8( codes, code); - codes[0] = code; + codes[n] = code; tout = MkAtomTerm(Yap_ULookupAtom(codes)); } else { char codes[2]; @@ -270,50 +274,62 @@ static Int name(USES_REGS1) { /* name(?Atomic,?String) */ Term t = Deref(ARG2), NewT, AtomNameT = Deref(ARG1); LOCAL_MAX_SIZE = 1024; + int l = push_text_stack( ); restart_aux: if (Yap_IsGroundTerm(AtomNameT)) { if (!IsVarTerm(t) && !IsPairTerm(t) && t != TermNil) { Yap_Error(TYPE_ERROR_LIST, ARG2, "name/2"); - return FALSE; + pop_text_stack( l); + ReleaseAndReturn( FALSE ); } // verify if an atom, int, float or bi§gnnum NewT = Yap_AtomicToListOfCodes(AtomNameT PASS_REGS); - if (NewT) - return Yap_unify(NewT, ARG2); + if (NewT) { + pop_text_stack( l); + ReleaseAndReturn( Yap_unify(NewT, ARG2) ); + } // else } else if (IsVarTerm(t)) { Yap_Error(INSTANTIATION_ERROR, t, "name/2"); + pop_text_stack( l); return FALSE; } else { Term at = Yap_ListToAtomic(t PASS_REGS); - if (at) - return Yap_unify(at, ARG1); + if (at) { + pop_text_stack( l); + ReleaseAndReturn( Yap_unify(at, ARG1) ); + } } if (LOCAL_Error_TYPE && Yap_HandleError("atom/2")) { AtomNameT = Deref(ARG1); t = Deref(ARG2); goto restart_aux; } - return FALSE; + pop_text_stack( l); + ReleaseAndReturn( FALSE ); } static Int string_to_atomic( USES_REGS1) { /* string_to_atom(?String,?Atom) */ Term t2 = Deref(ARG2), t1 = Deref(ARG1); LOCAL_MAX_SIZE = 1024; - + int l = push_text_stack( ); restart_aux: if (IsStringTerm(t1)) { Term t; // verify if an atom, int, float or bignnum t = Yap_StringToAtomic(t1 PASS_REGS); - if (t != 0L) - return Yap_unify(t, t2); + if (t != 0L) { + pop_text_stack( l); + ReleaseAndReturn( Yap_unify(t, t2) ); + } // else } else if (IsVarTerm(t1)) { Term t0 = Yap_AtomicToString(t2 PASS_REGS); - if (t0) - return Yap_unify(t0, t1); + if (t0) { + pop_text_stack( l); + ReleaseAndReturn( Yap_unify(t0, t1) ); + } } else { LOCAL_Error_TYPE = TYPE_ERROR_STRING; } @@ -322,26 +338,32 @@ restart_aux: t2 = Deref(ARG2); goto restart_aux; } - return FALSE; + pop_text_stack( l); + ReleaseAndReturn( FALSE ); } static Int string_to_atom( USES_REGS1) { /* string_to_atom(?String,?Atom) */ Term t2 = Deref(ARG2), t1 = Deref(ARG1); LOCAL_MAX_SIZE = 1024; + int l = push_text_stack( ); restart_aux: if (IsStringTerm(t1)) { Atom at; // verify if an atom, int, float or bignnum at = Yap_StringSWIToAtom(t1 PASS_REGS); - if (at) - return Yap_unify(MkAtomTerm(at), t2); + if (at) { + pop_text_stack( l); + ReleaseAndReturn( Yap_unify(MkAtomTerm(at), t2) ); + } // else } else if (IsVarTerm(t1)) { Term t0 = Yap_AtomSWIToString(t2 PASS_REGS); - if (t0) - return Yap_unify(t0, t1); + if (t0) { + pop_text_stack( l); + ReleaseAndReturn( Yap_unify(t0, t1) ); + } } else { LOCAL_Error_TYPE = TYPE_ERROR_ATOM; } @@ -350,21 +372,26 @@ restart_aux: t2 = Deref(ARG2); goto restart_aux; } - return FALSE; + pop_text_stack( l); + ReleaseAndReturn( FALSE ); } static Int string_to_list(USES_REGS1) { Term list = Deref(ARG2), string = Deref(ARG1); LOCAL_MAX_SIZE = 1024; + int l = push_text_stack( ); restart_aux: if (IsVarTerm(string)) { Term t1 = Yap_ListToString(list PASS_REGS); - if (t1) - return Yap_unify(ARG1, t1); + if (t1) { + pop_text_stack( l); + ReleaseAndReturn( Yap_unify(ARG1, t1) ); + } } else if (IsStringTerm(string)) { Term tf = Yap_StringToListOfCodes(string PASS_REGS); - return Yap_unify(ARG2, tf); + pop_text_stack( l); + ReleaseAndReturn( Yap_unify(ARG2, tf) ); } else { LOCAL_Error_TYPE = TYPE_ERROR_STRING; } @@ -373,12 +400,14 @@ restart_aux: list = Deref(ARG2); goto restart_aux; } - return FALSE; + pop_text_stack( l); + ReleaseAndReturn( FALSE ); } static Int atom_string(USES_REGS1) { Term t1 = Deref(ARG1), t2 = Deref(ARG2); LOCAL_MAX_SIZE = 1024; + int l = push_text_stack( ); restart_aux: if (IsVarTerm(t1)) { @@ -386,12 +415,12 @@ restart_aux: // verify if an atom, int, float or bignnum at = Yap_StringSWIToAtom(t2 PASS_REGS); if (at) - return Yap_unify(MkAtomTerm(at), t1); + ReleaseAndReturn( Yap_unify(MkAtomTerm(at), t1) ); // else } else if (IsAtomTerm(t1)) { Term t0 = Yap_AtomSWIToString(t1 PASS_REGS); if (t0) - return Yap_unify(t0, t2); + ReleaseAndReturn( Yap_unify(t0, t2) ); } else { LOCAL_Error_TYPE = TYPE_ERROR_ATOM; } @@ -400,25 +429,26 @@ restart_aux: t2 = Deref(ARG2); goto restart_aux; } - return FALSE; + ReleaseAndReturn( FALSE ); } static Int atom_chars(USES_REGS1) { Term t1; LOCAL_MAX_SIZE = 1024; + int l = push_text_stack( ); restart_aux: t1 = Deref(ARG1); if (IsAtomTerm(t1)) { Term tf = Yap_AtomSWIToListOfAtoms(t1 PASS_REGS); if (tf) - return Yap_unify(ARG2, tf); + ReleaseAndReturn( Yap_unify(ARG2, tf) ); } else if (IsVarTerm(t1)) { /* ARG1 unbound */ Term t = Deref(ARG2); Atom af = Yap_ListOfAtomsToAtom(t PASS_REGS); if (af) - return Yap_unify(ARG1, MkAtomTerm(af)); + ReleaseAndReturn( Yap_unify(ARG1, MkAtomTerm(af)) ); /* error handling */ } else { LOCAL_Error_TYPE = TYPE_ERROR_ATOM; @@ -426,23 +456,24 @@ restart_aux: if (LOCAL_Error_TYPE && Yap_HandleError("atom_chars/2")) { goto restart_aux; } - return false; + ReleaseAndReturn( false ); } static Int atom_codes(USES_REGS1) { Term t1; t1 = Deref(ARG1); + int l = push_text_stack( ); restart_aux: if (IsAtomTerm(t1)) { Term tf = Yap_AtomToListOfCodes(t1 PASS_REGS); if (tf) - return Yap_unify(ARG2, tf); + ReleaseAndReturn( Yap_unify(ARG2, tf) ); } else if (IsVarTerm(t1)) { /* ARG1 unbound */ Term t = Deref(ARG2); Atom af = Yap_ListToAtom(t PASS_REGS); if (af) - return Yap_unify(ARG1, MkAtomTerm(af)); + ReleaseAndReturn( Yap_unify(ARG1, MkAtomTerm(af)) ); } else if (IsVarTerm(t1)) { LOCAL_Error_TYPE = TYPE_ERROR_ATOM; } @@ -451,23 +482,24 @@ restart_aux: t1 = Deref(ARG1); goto restart_aux; } - return FALSE; + ReleaseAndReturn( FALSE ); } static Int string_codes(USES_REGS1) { Term t1; t1 = Deref(ARG1); + int l = push_text_stack( ); restart_aux: if (IsStringTerm(t1)) { Term tf = Yap_StringSWIToListOfCodes(t1 PASS_REGS); if (tf) - return Yap_unify(ARG2, tf); + ReleaseAndReturn( Yap_unify(ARG2, tf) ); } else if (IsVarTerm(t1)) { /* ARG1 unbound */ Term t = Deref(ARG2); Term tf = Yap_ListSWIToString(t PASS_REGS); if (tf) - return Yap_unify(ARG1, tf); + ReleaseAndReturn( Yap_unify(ARG1, tf) ); } else { LOCAL_Error_TYPE = TYPE_ERROR_STRING; } @@ -476,23 +508,24 @@ restart_aux: t1 = Deref(ARG1); goto restart_aux; } - return FALSE; + ReleaseAndReturn( FALSE ); } static Int string_chars(USES_REGS1) { Term t1; t1 = Deref(ARG1); + int l = push_text_stack( ); restart_aux: if (IsStringTerm(t1)) { Term tf = Yap_StringSWIToListOfAtoms(t1 PASS_REGS); if (tf) - return Yap_unify(ARG2, tf); + ReleaseAndReturn( Yap_unify(ARG2, tf) ); } else if (IsVarTerm(t1)) { /* ARG1 unbound */ Term t = Deref(ARG2); Term tf = Yap_ListSWIToString(t PASS_REGS); if (tf) - return Yap_unify(ARG1, tf); + ReleaseAndReturn( Yap_unify(ARG1, tf) ); } else { LOCAL_Error_TYPE = TYPE_ERROR_STRING; } @@ -501,7 +534,7 @@ restart_aux: t1 = Deref(ARG1); goto restart_aux; } - return FALSE; + ReleaseAndReturn( FALSE ); } /** @pred number_chars(? _I_,? _L_) is iso @@ -514,6 +547,7 @@ characters of the external representation of _I_. */ static Int number_chars(USES_REGS1) { Term t1; + int l = push_text_stack( ); restart_aux: t1 = Deref(ARG1); if (IsNumTerm(t1)) { @@ -522,11 +556,11 @@ restart_aux: t1 = Yap_NumberToListOfAtoms(t1 PASS_REGS); } if (t1) { - return Yap_unify(t1, t2); + ReleaseAndReturn( Yap_unify(t1, t2) ); } else { t2 = Yap_ListToNumber(t2 PASS_REGS); if (t2) { - return Yap_unify(t1, t2); + ReleaseAndReturn( Yap_unify(t1, t2) ); } } } else if (IsVarTerm(t1)) { @@ -534,7 +568,7 @@ restart_aux: Term t = Deref(ARG2); Term tf = Yap_ListToNumber(t PASS_REGS); if (tf) { - return Yap_unify(ARG1, tf); + ReleaseAndReturn( Yap_unify(ARG1, tf) ); } } else if (IsVarTerm(t1)) { LOCAL_Error_TYPE = TYPE_ERROR_NUMBER; @@ -543,11 +577,12 @@ restart_aux: if (LOCAL_Error_TYPE && Yap_HandleError("number_chars/2")) { goto restart_aux; } - return false; + ReleaseAndReturn( false ); } static Int number_atom(USES_REGS1) { Term t1; + int l = push_text_stack( ); restart_aux: t1 = Deref(ARG1); if (IsNumTerm(t1)) { @@ -557,11 +592,11 @@ restart_aux: if (af) { if (IsVarTerm(t2)) { - return Yap_unify(t1, t2); + ReleaseAndReturn( Yap_unify(t1, t2) ); } else { t2 = Yap_AtomToNumber(t2 PASS_REGS); if (t2) { - return Yap_unify(t1, t2); + ReleaseAndReturn( Yap_unify(t1, t2) ); } } } @@ -569,31 +604,32 @@ restart_aux: /* ARG1 unbound */ Term t = Deref(ARG2); Term tf = Yap_AtomToNumber(t PASS_REGS); - return Yap_unify(ARG1, tf); + ReleaseAndReturn( Yap_unify(ARG1, tf) ); } else if (IsVarTerm(t1)) { LOCAL_Error_TYPE = TYPE_ERROR_NUMBER; } /* error handling */ if (LOCAL_Error_TYPE && Yap_HandleError("number_atom/2")) { goto restart_aux; } - return false; + ReleaseAndReturn( false ); } static Int number_string(USES_REGS1) { Term t1; + int l = push_text_stack( ); restart_aux: t1 = Deref(ARG1); if (IsNumTerm(t1)) { Term tf; tf = Yap_NumberToString(t1 PASS_REGS); if (tf) - return Yap_unify(ARG2, tf); + ReleaseAndReturn( Yap_unify(ARG2, tf) ); } else if (IsVarTerm(t1)) { /* ARG1 unbound */ Term t = Deref(ARG2); Term tf = Yap_StringToNumber(t PASS_REGS); if (tf) - return Yap_unify(ARG1, tf); + ReleaseAndReturn( Yap_unify(ARG1, tf) ); } else { LOCAL_Error_TYPE = TYPE_ERROR_NUMBER; } @@ -601,24 +637,25 @@ restart_aux: if (LOCAL_Error_TYPE && Yap_HandleError("number_string/2")) { goto restart_aux; } - return FALSE; + ReleaseAndReturn( FALSE ); } static Int number_codes(USES_REGS1) { Term t1; + int l = push_text_stack( ); restart_aux: t1 = Deref(ARG1); if (IsNumTerm(t1)) { Term tf; tf = Yap_NumberToListOfCodes(t1 PASS_REGS); if (tf) - return Yap_unify(ARG2, tf); + ReleaseAndReturn( Yap_unify(ARG2, tf) ); } else if (IsVarTerm(t1)) { /* ARG1 unbound */ Term t = Deref(ARG2); Term tf = Yap_ListToNumber(t PASS_REGS); if (tf) - return Yap_unify(ARG1, tf); + ReleaseAndReturn( Yap_unify(ARG1, tf) ); } else { LOCAL_Error_TYPE = TYPE_ERROR_NUMBER; } @@ -626,13 +663,14 @@ restart_aux: if (LOCAL_Error_TYPE && Yap_HandleError("number_codes/2")) { goto restart_aux; } - return FALSE; + ReleaseAndReturn( FALSE ); } static Int cont_atom_concat3(USES_REGS1) { Term t3; Atom ats[2]; Int i, max; + int l = push_text_stack( ); restart_aux: t3 = Deref(ARG3); i = IntOfTerm(EXTRA_CBACK_ARG(3, 1)); @@ -640,25 +678,25 @@ restart_aux: EXTRA_CBACK_ARG(3, 1) = MkIntTerm(i + 1); if (!Yap_SpliceAtom(t3, ats, i, max PASS_REGS) && LOCAL_Error_TYPE == YAP_NO_ERROR) { - cut_fail(); + release_cut_fail(); } else { - if (i < max) - return Yap_unify(ARG1, MkAtomTerm(ats[0])) && - Yap_unify(ARG2, MkAtomTerm(ats[1])); + if (i < max) { + ReleaseAndReturn( Yap_unify(ARG1, MkAtomTerm(ats[0])) && + Yap_unify(ARG2, MkAtomTerm(ats[1])) ); } if (Yap_unify(ARG1, MkAtomTerm(ats[0])) && Yap_unify(ARG2, MkAtomTerm(ats[1]))) - cut_succeed(); - cut_fail(); + release_cut_succeed(); + release_cut_fail(); } /* Error handling */ if (LOCAL_Error_TYPE) { if (Yap_HandleError("atom_concat/3")) { goto restart_aux; } else { - return false; + ReleaseAndReturn( false ); } } - cut_fail(); + release_cut_fail(); } static Int atom_concat3(USES_REGS1) { @@ -666,6 +704,7 @@ static Int atom_concat3(USES_REGS1) { Term t2, t3, ot; Atom at; bool g1, g2, g3; + int l = push_text_stack( ); restart_aux: t1 = Deref(ARG1); t2 = Deref(ARG2); @@ -685,26 +724,28 @@ restart_aux: } else if (g3) { EXTRA_CBACK_ARG(3, 1) = MkIntTerm(0); EXTRA_CBACK_ARG(3, 2) = MkIntTerm(Yap_AtomToLength(t3 PASS_REGS)); - return cont_atom_concat3(PASS_REGS1); + ReleaseAndReturn( cont_atom_concat3(PASS_REGS1) ); } else { LOCAL_Error_TYPE = INSTANTIATION_ERROR; at = NULL; } + pop_text_stack( l); if (at) { - if (Yap_unify(ot, MkAtomTerm(at))) - cut_succeed(); - else - cut_fail(); + if (Yap_unify(ot, MkAtomTerm(at))) { + release_cut_succeed(); + } else { + release_cut_fail(); + } } /* Error handling */ if (LOCAL_Error_TYPE) { if (Yap_HandleError("atom_concat/3")) { goto restart_aux; } else { - return false; + ReleaseAndReturn( false ); } } - cut_fail(); + release_cut_fail(); } #define CastToNumeric(x) CastToNumeric__(x PASS_REGS) @@ -720,31 +761,32 @@ static Int cont_atomic_concat3(USES_REGS1) { Term t3; Atom ats[2]; size_t i, max; + int l = push_text_stack( ); restart_aux: t3 = Deref(ARG3); i = IntOfTerm(EXTRA_CBACK_ARG(3, 1)); max = IntOfTerm(EXTRA_CBACK_ARG(3, 2)); EXTRA_CBACK_ARG(3, 1) = MkIntTerm(i + 1); if (!Yap_SpliceAtom(t3, ats, i, max PASS_REGS)) { - cut_fail(); + release_cut_fail(); } else { Term t1 = CastToNumeric(ats[0]); Term t2 = CastToNumeric(ats[1]); if (i < max) - return Yap_unify(ARG1, t1) && Yap_unify(ARG2, t2); + ReleaseAndReturn( Yap_unify(ARG1, t1) && Yap_unify(ARG2, t2) ); if (Yap_unify(ARG1, t1) && Yap_unify(ARG2, t2)) - cut_succeed(); - cut_fail(); + release_cut_succeed(); + release_cut_fail(); } /* Error handling */ if (LOCAL_Error_TYPE) { if (Yap_HandleError("string_concat/3")) { goto restart_aux; } else { - return FALSE; + ReleaseAndReturn( FALSE ); } } - cut_fail(); + release_cut_fail(); } static Int atomic_concat3(USES_REGS1) { @@ -752,6 +794,7 @@ static Int atomic_concat3(USES_REGS1) { Term t2, t3, ot; Atom at = NULL; bool g1, g2, g3; + int l = push_text_stack( ); restart_aux: t1 = Deref(ARG1); t2 = Deref(ARG2); @@ -777,10 +820,11 @@ restart_aux: at = NULL; } if (at) { - if (Yap_unify(ot, MkAtomTerm(at))) - cut_succeed(); - else - cut_fail(); + if (Yap_unify(ot, MkAtomTerm(at))) { + release_cut_succeed(); + } else { + release_cut_fail(); + } } /* Error handling */ if (LOCAL_Error_TYPE) { @@ -790,26 +834,27 @@ restart_aux: return false; } } - cut_fail(); + release_cut_fail(); } static Int cont_string_concat3(USES_REGS1) { Term t3; Term ts[2]; size_t i, max; + int l = push_text_stack( ); restart_aux: t3 = Deref(ARG3); i = IntOfTerm(EXTRA_CBACK_ARG(3, 1)); max = IntOfTerm(EXTRA_CBACK_ARG(3, 2)); EXTRA_CBACK_ARG(3, 1) = MkIntTerm(i + 1); if (!Yap_SpliceString(t3, ts, i, max PASS_REGS)) { - cut_fail(); + release_cut_fail(); } else { if (i < max) return Yap_unify(ARG1, ts[0]) && Yap_unify(ARG2, ts[1]); if (Yap_unify(ARG1, ts[0]) && Yap_unify(ARG2, ts[1])) - cut_succeed(); - cut_fail(); + release_cut_succeed(); + release_cut_fail(); } /* Error handling */ if (LOCAL_Error_TYPE) { @@ -819,7 +864,7 @@ restart_aux: return FALSE; } } - cut_fail(); + release_cut_fail(); } static Int string_concat3(USES_REGS1) { @@ -828,6 +873,7 @@ static Int string_concat3(USES_REGS1) { Term tf = 0; bool g1, g2, g3; Atom at; + int l = push_text_stack( ); restart_aux: t1 = Deref(ARG1); t2 = Deref(ARG2); @@ -853,20 +899,21 @@ restart_aux: at = NULL; } if (tf) { - if (Yap_unify(ot, tf)) - cut_succeed(); - else - cut_fail(); + if (Yap_unify(ot, tf)) { + release_cut_succeed(); + } else { + release_cut_fail(); + } } /* Error handling */ if (LOCAL_Error_TYPE) { if (Yap_HandleError("atom_concat/3")) { goto restart_aux; } else { - return false; + ReleaseAndReturn( false ); } } - cut_fail(); + release_cut_fail(); } static Int cont_string_code3(USES_REGS1) { @@ -875,6 +922,7 @@ static Int cont_string_code3(USES_REGS1) { utf8proc_int32_t chr; const unsigned char *s; const unsigned char *s0; + int l = push_text_stack( ); restart_aux: t2 = Deref(ARG2); s0 = UStringOfTerm(t2); @@ -886,28 +934,30 @@ restart_aux: if (s[0]) { EXTRA_CBACK_ARG(3, 1) = MkIntTerm(s - s0); EXTRA_CBACK_ARG(3, 2) = MkIntTerm(j + 1); - return Yap_unify(MkIntegerTerm(chr), ARG3) && - Yap_unify(MkIntegerTerm(j + 1), ARG1); + ReleaseAndReturn( Yap_unify(MkIntegerTerm(chr), ARG3) && + Yap_unify(MkIntegerTerm(j + 1), ARG1) ); + } + if (Yap_unify(MkIntegerTerm(chr), ARG3) && Yap_unify(MkIntegerTerm(j), ARG1)) { + release_cut_succeed(); + } else { + release_cut_fail(); } - if (Yap_unify(MkIntegerTerm(chr), ARG3) && Yap_unify(MkIntegerTerm(j), ARG1)) - cut_succeed(); - else - cut_fail(); /* Error handling */ if (LOCAL_Error_TYPE) { if (Yap_HandleError("string_code/3")) { goto restart_aux; } else { - return FALSE; + ReleaseAndReturn( FALSE ) ; } } - cut_fail(); + release_cut_fail(); } static Int string_code3(USES_REGS1) { Term t1; Term t2; const unsigned char *s; + int l = push_text_stack( ); restart_aux: t1 = Deref(ARG1); t2 = Deref(ARG2); @@ -932,18 +982,18 @@ restart_aux: if (indx < 0) { LOCAL_Error_TYPE = DOMAIN_ERROR_NOT_LESS_THAN_ZERO; } - cut_fail(); + release_cut_fail(); } ns = skip_utf8(s, indx); if (ns == NULL) { - cut_fail(); // silently fail? + release_cut_fail(); // silently fail? } get_utf8(ns, -1, &chr); if (chr == '\0') - cut_fail(); + release_cut_fail(); if (Yap_unify(ARG3, MkIntegerTerm(chr))) - cut_succeed(); - cut_fail(); + release_cut_succeed(); + release_cut_fail(); } } /* Error handling */ @@ -951,16 +1001,17 @@ restart_aux: if (Yap_HandleError("string_code/3")) { goto restart_aux; } else { - return FALSE; + ReleaseAndReturn( FALSE ); } } - cut_fail(); + release_cut_fail(); } static Int get_string_code3(USES_REGS1) { Term t1; Term t2; const unsigned char *s; + int l = push_text_stack( ); restart_aux: t1 = Deref(ARG1); t2 = Deref(ARG2); @@ -985,20 +1036,20 @@ restart_aux: if (indx < 0) { LOCAL_Error_TYPE = DOMAIN_ERROR_NOT_LESS_THAN_ZERO; } else { - return false; + ReleaseAndReturn( false ); } } else { indx -= 1; ns = skip_utf8(ns, indx); if (ns == NULL) { - return false; + ReleaseAndReturn( false ); } else { get_utf8(ns, -1, &chr); if (chr != '\0') - return Yap_unify(ARG3, MkIntegerTerm(chr)); + ReleaseAndReturn( Yap_unify(ARG3, MkIntegerTerm(chr)) ); } } - return FALSE; // replace by error code + ReleaseAndReturn( FALSE ); // replace by error cod )e } } /* Error handling */ @@ -1006,16 +1057,17 @@ restart_aux: if (Yap_HandleError("string_code/3")) { goto restart_aux; } else { - return FALSE; + ReleaseAndReturn( FALSE ); } } - cut_fail(); + release_cut_fail(); } static Int atom_concat2(USES_REGS1) { Term t1; Term *tailp; Int n; + int l = push_text_stack( ); restart_aux: t1 = Deref(ARG1); n = Yap_SkipList(&t1, &tailp); @@ -1046,7 +1098,7 @@ restart_aux: free(inpv); at = out.val.a; if (at) - return Yap_unify(ARG2, MkAtomTerm(at)); + ReleaseAndReturn( Yap_unify(ARG2, MkAtomTerm(at)) ); } error: /* Error handling */ @@ -1054,16 +1106,17 @@ error: if (Yap_HandleError("atom_concat/2")) { goto restart_aux; } else { - return FALSE; + ReleaseAndReturn( FALSE ); } } - cut_fail(); + release_cut_fail(); } static Int string_concat2(USES_REGS1) { Term t1; Term *tailp; Int n; + int l = push_text_stack( ); restart_aux: t1 = Deref(ARG1); n = Yap_SkipList(&t1, &tailp); @@ -1092,7 +1145,7 @@ restart_aux: } free(inpv); if (out.val.t) - return Yap_unify(ARG2, out.val.t); + ReleaseAndReturn( Yap_unify(ARG2, out.val.t) ); } error: /* Error handling */ @@ -1100,16 +1153,17 @@ error: if (Yap_HandleError("string_code/3")) { goto restart_aux; } else { - return FALSE; + ReleaseAndReturn( FALSE ); } } - cut_fail(); + release_cut_fail(); } static Int atomic_concat2(USES_REGS1) { Term t1; Term *tailp; Int n; + int l = push_text_stack( ); restart_aux: t1 = Deref(ARG1); n = Yap_SkipList(&t1, &tailp); @@ -1121,7 +1175,7 @@ restart_aux: Atom at; if (n == 1) - return Yap_unify(ARG2, HeadOfTerm(t1)); + ReleaseAndReturn( Yap_unify(ARG2, HeadOfTerm(t1)) ); if (!inpv) { LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP; free(inpv); @@ -1144,7 +1198,7 @@ restart_aux: free(inpv); at = out.val.a; if (at) - return Yap_unify(ARG2, MkAtomTerm(at)); + ReleaseAndReturn( Yap_unify(ARG2, MkAtomTerm(at)) ); } error: /* Error handling */ @@ -1158,6 +1212,7 @@ static Int atomics_to_string2(USES_REGS1) { Term t1; Term *tailp; Int n; + int l = push_text_stack( ); restart_aux: t1 = Deref(ARG1); n = Yap_SkipList(&t1, &tailp); @@ -1189,20 +1244,21 @@ restart_aux: free(inpv); at = out.val.a; if (at) - return Yap_unify(ARG2, MkAtomTerm(at)); + ReleaseAndReturn( Yap_unify(ARG2, MkAtomTerm(at)) ); } error: /* Error handling */ if (LOCAL_Error_TYPE && Yap_HandleError("atomics_to_string/2")) { goto restart_aux; } - return FALSE; + ReleaseAndReturn( FALSE ); } static Int atomics_to_string3(USES_REGS1) { Term t1, t2; Term *tailp; Int n; + int l = push_text_stack( ); restart_aux: t1 = Deref(ARG1); t2 = Deref(ARG2); @@ -1239,14 +1295,14 @@ restart_aux: free(inpv); at = out.val.a; if (at) - return Yap_unify(ARG3, MkAtomTerm(at)); + ReleaseAndReturn( Yap_unify(ARG3, MkAtomTerm(at)) ); } error: /* Error handling */ if (LOCAL_Error_TYPE && Yap_HandleError("atomics_to_string/3")) { goto restart_aux; } - return FALSE; + ReleaseAndReturn( FALSE ); } static Int atom_length(USES_REGS1) { @@ -1254,33 +1310,34 @@ static Int atom_length(USES_REGS1) { Term t2 = Deref(ARG2); size_t len; + int l = push_text_stack( ); if (!Yap_IsGroundTerm(t1)) { Yap_Error(INSTANTIATION_ERROR, t1, "at first argument"); - return (FALSE); + ReleaseAndReturn( FALSE ); } else if (!IsAtomTerm(t1)) { Yap_Error(TYPE_ERROR_ATOM, t1, "at first argument"); - return (FALSE); + ReleaseAndReturn( FALSE ); } if (Yap_IsGroundTerm(t2)) { if (!IsIntegerTerm(t2)) { Yap_Error(TYPE_ERROR_INTEGER, t2, "atom_length/2"); - return (FALSE); + ReleaseAndReturn( FALSE); } else if ((Int)(len = IntegerOfTerm(t2)) < 0) { Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t2, "atom_length/2"); - return (FALSE); + ReleaseAndReturn( FALSE); } } restart_aux: len = Yap_AtomicToLength(t1 PASS_REGS); if (len != (size_t)-1) - return Yap_unify(ARG2, MkIntegerTerm(len)); + ReleaseAndReturn( Yap_unify(ARG2, MkIntegerTerm(len)) ); /* error handling */ if (LOCAL_Error_TYPE && Yap_HandleError("atom_length/2")) { goto restart_aux; } - return FALSE; + ReleaseAndReturn( FALSE ); } static Int atomic_length(USES_REGS1) { @@ -1288,30 +1345,31 @@ static Int atomic_length(USES_REGS1) { Term t2 = Deref(ARG2); size_t len; + int l = push_text_stack( ); if (!Yap_IsGroundTerm(t1)) { Yap_Error(INSTANTIATION_ERROR, t1, "at first argument"); - return (FALSE); + ReleaseAndReturn( FALSE); } if (IsNonVarTerm(t2)) { if (!IsIntegerTerm(t2)) { Yap_Error(TYPE_ERROR_INTEGER, t2, "atom_length/2"); - return (FALSE); + ReleaseAndReturn( FALSE); } else if ((Int)(len = IntegerOfTerm(t2)) < 0) { Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t2, "atom_length/2"); - return (FALSE); + ReleaseAndReturn( FALSE); } } restart_aux: len = Yap_AtomicToLength(t1 PASS_REGS); if (len != (size_t)-1) - return Yap_unify(ARG2, MkIntegerTerm(len)); + ReleaseAndReturn( Yap_unify(ARG2, MkIntegerTerm(len)) ); /* error handling */ if (LOCAL_Error_TYPE && Yap_HandleError("atomic_length/2")) { goto restart_aux; } - return FALSE; + ReleaseAndReturn( FALSE ); } static Int string_length(USES_REGS1) { @@ -1319,27 +1377,28 @@ static Int string_length(USES_REGS1) { Term t2 = Deref(ARG2); size_t len; + int l = push_text_stack( ); if (Yap_IsGroundTerm(t2)) { if (!IsIntegerTerm(t2)) { Yap_Error(TYPE_ERROR_INTEGER, t2, "string_length/2"); - return (FALSE); + ReleaseAndReturn( FALSE); } if (FALSE && (Int)(len = IntegerOfTerm(t2)) < 0) { Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t2, "string_length/2"); - return (FALSE); + ReleaseAndReturn( FALSE); } } restart_aux: t1 = Deref(ARG1); len = Yap_AtomicToLength(t1 PASS_REGS); if (len != (size_t)-1) - return Yap_unify(ARG2, MkIntegerTerm(len)); + ReleaseAndReturn( Yap_unify(ARG2, MkIntegerTerm(len)) ); /* error handling */ if (LOCAL_Error_TYPE && Yap_HandleError("string_length/2")) { goto restart_aux; } - return FALSE; + ReleaseAndReturn( FALSE ); } /** @pred downcase_text_to_atom(+Text, -Atom) @@ -1352,15 +1411,16 @@ static Int downcase_text_to_atom(USES_REGS1) { Term t1 = Deref(ARG1); Term t2 = Deref(ARG2); + int l = push_text_stack( ); if (!Yap_IsGroundTerm(t1)) { Yap_Error(INSTANTIATION_ERROR, t1, "at first argument"); - return false; + ReleaseAndReturn( false ); } if (IsNonVarTerm(t2)) { if (!IsAtomTerm(t2)) { Yap_Error(TYPE_ERROR_ATOM, t2, "at second argument"); - return (FALSE); + ReleaseAndReturn( (FALSE) ); } } while (true) { @@ -1368,11 +1428,11 @@ static Int downcase_text_to_atom(USES_REGS1) { if (at == NULL) { if (LOCAL_Error_TYPE && Yap_HandleError("downcase_text_to_atom/2")) continue; - return false; + ReleaseAndReturn( false ); } - return Yap_unify(MkAtomTerm(at), t2); + ReleaseAndReturn( Yap_unify(MkAtomTerm(at), t2) ); } - return false; + ReleaseAndReturn( false ); } /** @pred upcase_text_to_atom(+Text, -Atom) @@ -1385,15 +1445,16 @@ static Int upcase_text_to_atom(USES_REGS1) { Term t1 = Deref(ARG1); Term t2 = Deref(ARG2); + int l = push_text_stack( ); if (!Yap_IsGroundTerm(t1)) { Yap_Error(INSTANTIATION_ERROR, t1, "at first argument"); - return false; + ReleaseAndReturn( false ); } if (IsNonVarTerm(t2)) { if (!IsAtomTerm(t2)) { Yap_Error(TYPE_ERROR_ATOM, t2, "at second argument"); - return (FALSE); + ReleaseAndReturn( (FALSE) ); } } while (true) { @@ -1401,11 +1462,11 @@ static Int upcase_text_to_atom(USES_REGS1) { if (at == NULL) { if (LOCAL_Error_TYPE && Yap_HandleError("upcase_text_to_atom/2")) continue; - return false; + ReleaseAndReturn( false ); } - return Yap_unify(MkAtomTerm(at), t2); + ReleaseAndReturn( Yap_unify(MkAtomTerm(at), t2) ); } - return false; + ReleaseAndReturn( false ); } /** @pred downcase_text_to_string(+Text, -String) @@ -1418,15 +1479,16 @@ static Int downcase_text_to_string(USES_REGS1) { Term t1 = Deref(ARG1); Term t2 = Deref(ARG2); + int l = push_text_stack( ); if (!Yap_IsGroundTerm(t1)) { Yap_Error(INSTANTIATION_ERROR, t1, "at first argument"); - return false; + ReleaseAndReturn( false ); } if (IsNonVarTerm(t2)) { if (!IsStringTerm(t2)) { Yap_Error(TYPE_ERROR_STRING, t2, "at second argument"); - return (FALSE); + ReleaseAndReturn( (FALSE) ); } } while (true) { @@ -1434,11 +1496,11 @@ static Int downcase_text_to_string(USES_REGS1) { if (t == TermZERO) { if (LOCAL_Error_TYPE && Yap_HandleError("downcase_text_to_string/2")) continue; - return false; + ReleaseAndReturn( false ); } - return Yap_unify(t, t2); + ReleaseAndReturn( Yap_unify(t, t2) ); } - return false; + ReleaseAndReturn( false ); } /** @pred upcase_text_to_string(+Text, -String) @@ -1451,15 +1513,16 @@ static Int upcase_text_to_string(USES_REGS1) { Term t1 = Deref(ARG1); Term t2 = Deref(ARG2); + int l = push_text_stack( ); if (!Yap_IsGroundTerm(t1)) { Yap_Error(INSTANTIATION_ERROR, t1, "at first argument"); - return false; + ReleaseAndReturn( false ); } if (IsNonVarTerm(t2)) { if (!IsStringTerm(t2)) { Yap_Error(TYPE_ERROR_STRING, t2, "at second argument"); - return (FALSE); + ReleaseAndReturn( (FALSE) ); } } while (true) { @@ -1467,11 +1530,11 @@ static Int upcase_text_to_string(USES_REGS1) { if (t == TermZERO) { if (LOCAL_Error_TYPE && Yap_HandleError("upcase_text_to_string/2")) continue; - return false; + ReleaseAndReturn( false ); } - return Yap_unify(t, t2); + ReleaseAndReturn( Yap_unify(t, t2) ); } - return false; + ReleaseAndReturn( false ); } /** @pred downcase_text_to_codes(+Text, -Codes) @@ -1484,15 +1547,16 @@ static Int downcase_text_to_codes(USES_REGS1) { Term t1 = Deref(ARG1); Term t2 = Deref(ARG2); + int l = push_text_stack( ); if (!Yap_IsGroundTerm(t1)) { Yap_Error(INSTANTIATION_ERROR, t1, "at first argument"); - return false; + ReleaseAndReturn( false ); } if (IsNonVarTerm(t2)) { if (!Yap_IsListTerm(t2)) { Yap_Error(TYPE_ERROR_LIST, t2, "at second argument"); - return false; + ReleaseAndReturn( false ); } } while (true) { @@ -1500,11 +1564,11 @@ static Int downcase_text_to_codes(USES_REGS1) { if (t == TermZERO) { if (LOCAL_Error_TYPE && Yap_HandleError("downcase_text_to_codes/2")) continue; - return false; + ReleaseAndReturn( false ); } - return Yap_unify(t, t2); + ReleaseAndReturn( Yap_unify(t, t2) ); } - return false; + ReleaseAndReturn( false ); } /** @pred upcase_text_to_codes(+Text, -Codes) @@ -1517,15 +1581,16 @@ static Int upcase_text_to_codes(USES_REGS1) { Term t1 = Deref(ARG1); Term t2 = Deref(ARG2); + int l = push_text_stack( ); if (!Yap_IsGroundTerm(t1)) { Yap_Error(INSTANTIATION_ERROR, t1, "at first argument"); - return false; + ReleaseAndReturn( false ); } if (IsNonVarTerm(t2)) { if (!Yap_IsListTerm(t2)) { Yap_Error(TYPE_ERROR_LIST, t2, "at second argument"); - return (FALSE); + ReleaseAndReturn( (FALSE) ); } } while (true) { @@ -1533,11 +1598,11 @@ static Int upcase_text_to_codes(USES_REGS1) { if (t == TermZERO) { if (LOCAL_Error_TYPE && Yap_HandleError("upcase_text_to_codes/2")) continue; - return false; + ReleaseAndReturn( false ); } - return Yap_unify(t, t2); + ReleaseAndReturn( Yap_unify(t, t2) ); } - return false; + ReleaseAndReturn( false ); } /** @pred downcase_text_to_chars(+Text, -Chars) @@ -1550,15 +1615,16 @@ static Int downcase_text_to_chars(USES_REGS1) { Term t1 = Deref(ARG1); Term t2 = Deref(ARG2); + int l = push_text_stack( ); if (!Yap_IsGroundTerm(t1)) { Yap_Error(INSTANTIATION_ERROR, t1, "at first argument"); - return false; + ReleaseAndReturn( false ); } if (IsNonVarTerm(t2)) { if (!Yap_IsListTerm(t2)) { Yap_Error(TYPE_ERROR_LIST, t2, "at second argument"); - return false; + ReleaseAndReturn( false ); } } while (true) { @@ -1566,11 +1632,11 @@ static Int downcase_text_to_chars(USES_REGS1) { if (t == TermZERO) { if (LOCAL_Error_TYPE && Yap_HandleError("downcase_text_to_to_chars/2")) continue; - return false; + ReleaseAndReturn( false ); } - return Yap_unify(t, t2); + ReleaseAndReturn( Yap_unify(t, t2) ); } - return false; + ReleaseAndReturn( false ); } /** @pred upcase_text_to_chars(+Text, -Chars) @@ -1583,15 +1649,16 @@ static Int upcase_text_to_chars(USES_REGS1) { Term t1 = Deref(ARG1); Term t2 = Deref(ARG2); + int l = push_text_stack( ); if (!Yap_IsGroundTerm(t1)) { Yap_Error(INSTANTIATION_ERROR, t1, "at first argument"); - return false; + ReleaseAndReturn( false ); } if (IsNonVarTerm(t2)) { if (!Yap_IsListTerm(t2)) { Yap_Error(TYPE_ERROR_LIST, t2, "at second argument"); - return (FALSE); + ReleaseAndReturn( (FALSE) ); } } while (true) { @@ -1599,11 +1666,11 @@ static Int upcase_text_to_chars(USES_REGS1) { if (t == TermZERO) { if (LOCAL_Error_TYPE && Yap_HandleError("upcase_text_to_chars/2")) continue; - return false; + ReleaseAndReturn( false ); } - return Yap_unify(t, t2); + ReleaseAndReturn( Yap_unify(t, t2) ); } - return false; + ReleaseAndReturn( false ); } /* split an atom into two sub-atoms */ @@ -1614,31 +1681,32 @@ static Int atom_split(USES_REGS1) { Term to1, to2; Atom at; + int l = push_text_stack( ); if (IsVarTerm(t1)) { Yap_Error(INSTANTIATION_ERROR, t1, "$atom_split/4"); - return (FALSE); + ReleaseAndReturn( (FALSE) ); } if (!IsAtomTerm(t1)) { Yap_Error(TYPE_ERROR_ATOM, t1, "$atom_split/4"); - return (FALSE); + ReleaseAndReturn( (FALSE) ); } if (IsVarTerm(t2)) { Yap_Error(INSTANTIATION_ERROR, t2, "$atom_split/4"); - return (FALSE); + ReleaseAndReturn( (FALSE) ); } if (!IsIntTerm(t2)) { Yap_Error(TYPE_ERROR_INTEGER, t2, "$atom_split/4"); - return (FALSE); + ReleaseAndReturn( (FALSE) ); } if ((Int)(len = IntOfTerm(t2)) < 0) { Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t2, "$atom_split/4"); - return (FALSE); + ReleaseAndReturn( (FALSE) ); } at = AtomOfTerm(t1); unsigned char *s, *s1, *s10; s = RepAtom(at)->UStrOfAE; if (len > (Int)strlen_utf8(s)) - return (FALSE); + ReleaseAndReturn( (FALSE) ); s1 = s10 = Malloc(len); if (s1 + len > (unsigned char *)ASP - 1024) Yap_Error(RESOURCE_ERROR_STACK, t1, "$atom_split/4"); @@ -1651,53 +1719,55 @@ static Int atom_split(USES_REGS1) { s1[0] = '\0'; to1 = MkAtomTerm(Yap_ULookupAtom(s10)); to2 = MkAtomTerm(Yap_ULookupAtom(s)); - return (Yap_unify_constant(ARG3, to1) && Yap_unify_constant(ARG4, to2)); + ReleaseAndReturn( (Yap_unify_constant(ARG3, to1) && Yap_unify_constant(ARG4, to2)) ); } static Int atom_number(USES_REGS1) { Term t1; + int l = push_text_stack( ); restart_aux: t1 = Deref(ARG1); if (Yap_IsGroundTerm(t1)) { Term tf = Yap_AtomToNumber(t1 PASS_REGS); if (tf) - return Yap_unify(ARG2, tf); + ReleaseAndReturn( Yap_unify(ARG2, tf) ); } else { /* ARG1 unbound */ Term t = Deref(ARG2); Atom af = Yap_NumberToAtom(t PASS_REGS); if (af) - return Yap_unify(ARG1, MkAtomTerm(af)); + ReleaseAndReturn( Yap_unify(ARG1, MkAtomTerm(af)) ); } /* error handling */ if (LOCAL_Error_TYPE && Yap_HandleError("atom_number/2")) { t1 = Deref(ARG1); goto restart_aux; } - return FALSE; + ReleaseAndReturn( FALSE ); } static Int string_number(USES_REGS1) { Term t1; + int l = push_text_stack( ); restart_aux: t1 = Deref(ARG1); if (Yap_IsGroundTerm(t1)) { Term tf = Yap_StringToNumber(t1 PASS_REGS); if (tf) - return Yap_unify(ARG2, tf); + ReleaseAndReturn( Yap_unify(ARG2, tf) ); } else { /* ARG1 unbound */ Term t = Deref(ARG2); Term tf = Yap_NumberToString(t PASS_REGS); if (tf) - return Yap_unify(ARG1, tf); + ReleaseAndReturn( Yap_unify(ARG1, tf) ); } /* error handling */ if (LOCAL_Error_TYPE && Yap_HandleError("string_number/2")) { t1 = Deref(ARG1); goto restart_aux; } - return FALSE; + ReleaseAndReturn( FALSE ); } #define SUB_ATOM_HAS_MIN 1 @@ -1708,30 +1778,40 @@ restart_aux: #define SUB_ATOM_HAS_UTF8 32 -static Term build_new_atomic(int mask, wchar_t *wp, const unsigned char *p, - size_t minv, size_t len USES_REGS) { - { - const unsigned char *src = p; - unsigned char *buf; - Term t = init_tstring(PASS_REGS1); - src = skip_utf8((unsigned char *)src, minv); - const unsigned char *cp = src; - - buf = buf_from_tstring(HR); - while (len) { - utf8proc_int32_t chr; - cp += get_utf8((unsigned char *)cp, -1, &chr); - buf += put_utf8((unsigned char *)buf, chr); - len--; - } - *buf++ = '\0'; -if (mask & SUB_ATOM_HAS_ATOM) - return MkAtomTerm( Yap_ULookupAtom(buf ) ); - - close_tstring(buf PASS_REGS); - return t; +static Term build_new_atomic(int mask, wchar_t *wp, const unsigned char *p, size_t minv,size_t len USES_REGS) +{ + int n; + seq_tv_t outv[5], inp; + size_t cuts[3]; + if (minv) { + cuts[0] = minv; + cuts[1] = minv+len; + cuts[2] = 0; + outv[0].type = 0; + n = 1; + } else { + cuts[0] = minv+len; + cuts[1] = 0; + n = 0; + } + inp.type = YAP_STRING_CHARS; + inp.enc = ENC_ISO_UTF8; + inp.val.uc0 = p; + outv[n+1].type = 0; + if (mask & SUB_ATOM_HAS_ATOM) { + outv[n].type = YAP_STRING_ATOM; + } else { + outv[n].type = YAP_STRING_STRING; + outv[n].val.c = Malloc(512); } - return 0L; + int lvl = push_text_stack(PASS_REGS1); +bool rc = Yap_Splice_Text(2+n, cuts, &inp, outv PASS_REGS); + pop_text_stack(lvl); + if (!rc) + return( false ); + if (mask & SUB_ATOM_HAS_ATOM) + return( MkAtomTerm(outv[n].val.a) ); + return( outv[n].val.t ); } @@ -1739,7 +1819,7 @@ static int check_sub_atom_at(int minv, Atom at, Atom nat, size_t len) { const unsigned char *p1; const unsigned char *p2 = RepAtom(nat)->UStrOfAE; p1 = skip_utf8(RepAtom(at)->UStrOfAE, minv); - return cmpn_utf8(p1, p2, len) == 0; + return cmpn_utf8(p1, p2, len) == 0 ; } static int check_sub_string_at(int minv, const unsigned char *p1, @@ -1790,8 +1870,8 @@ static Int cont_sub_atomic(USES_REGS1) { wchar_t *wp = NULL; const unsigned char *p = NULL, *p5 = NULL; Term nat; - int sub_atom = TRUE; + int l = push_text_stack( ); mask = IntegerOfTerm(EXTRA_CBACK_ARG(5, 1)); minv = IntegerOfTerm(EXTRA_CBACK_ARG(5, 2)); len = IntegerOfTerm(EXTRA_CBACK_ARG(5, 3)); @@ -1845,9 +1925,9 @@ static Int cont_sub_atomic(USES_REGS1) { } if (found) { if (minv > sz - len) - cut_succeed(); + release_cut_succeed(); } else { - cut_fail(); + release_cut_fail(); } } else if (mask & SUB_ATOM_HAS_SIZE) { nat = build_new_atomic(mask, wp, p, minv, len PASS_REGS); @@ -1856,7 +1936,7 @@ static Int cont_sub_atomic(USES_REGS1) { Yap_unify(ARG5, nat); minv++; if (after-- == 0) - cut_succeed(); + release_cut_succeed(); } else if (mask & SUB_ATOM_HAS_MIN) { after = sz - (minv + len); nat = build_new_atomic(mask, wp, p, minv, len PASS_REGS); @@ -1865,7 +1945,7 @@ static Int cont_sub_atomic(USES_REGS1) { Yap_unify(ARG5, nat); len++; if (after-- == 0) - cut_succeed(); + release_cut_succeed(); } else if (mask & SUB_ATOM_HAS_AFTER) { len = sz - (minv + after); nat = build_new_atomic(mask, wp, p, minv, len PASS_REGS); @@ -1874,7 +1954,7 @@ static Int cont_sub_atomic(USES_REGS1) { Yap_unify(ARG5, nat); minv++; if (len-- == 0) - cut_succeed(); + release_cut_succeed(); } else { nat = build_new_atomic(mask, wp, p, minv, len PASS_REGS); Yap_unify(ARG2, MkIntegerTerm(minv)); @@ -1884,7 +1964,7 @@ static Int cont_sub_atomic(USES_REGS1) { len++; if (after-- == 0) { if (minv == sz) - cut_succeed(); + release_cut_succeed(); minv++; len = 0; after = sz - minv; @@ -1895,10 +1975,10 @@ static Int cont_sub_atomic(USES_REGS1) { EXTRA_CBACK_ARG(5, 3) = MkIntegerTerm(len); EXTRA_CBACK_ARG(5, 4) = MkIntegerTerm(after); EXTRA_CBACK_ARG(5, 5) = MkIntegerTerm(sz); - return TRUE; + ReleaseAndReturn( TRUE ); } -static Int sub_atomic(bool sub_atom USES_REGS) { +static Int sub_atomic(bool sub_atom, bool sub_string USES_REGS) { Term tat1, tbef, tsize, tafter, tout; int mask = SUB_ATOM_HAS_UTF8; size_t minv, len, after, sz; @@ -1908,6 +1988,7 @@ static Int sub_atomic(bool sub_atom USES_REGS) { Term nat = 0L; Atom at = NULL; + int l = push_text_stack( ); if (sub_atom) mask |= SUB_ATOM_HAS_ATOM; @@ -1916,34 +1997,38 @@ static Int sub_atomic(bool sub_atom USES_REGS) { if (!IsVarTerm(tat1)) { if (IsAtomTerm(tat1)) { + if (sub_atom) { p = AtomOfTerm(tat1)->UStrOfAE; - } else { + sz = strlen_utf8(p); + } else { + Yap_Error(TYPE_ERROR_ATOM, tat1, "sub_atom/5"); + ReleaseAndReturn( false ); + } + } else if (IsStringTerm(tat1)) { + if (sub_string) { p = UStringOfTerm(tat1); + sz = strlen_utf8(p); + } else { + Yap_Error(TYPE_ERROR_STRING, tat1, "sub_atom/5"); + ReleaseAndReturn( false ); + } } + } else { + Yap_Error(INSTANTIATION_ERROR, tat1, "sub_atom/5: first variable\n"); + ReleaseAndReturn( false ); } - EXTRA_CBACK_ARG(5, 3) = MkIntegerTerm(0); - if (IsVarTerm(tat1)) { - Yap_Error(INSTANTIATION_ERROR, tat1, "sub_atom/5: first variable\n"); - return FALSE; - } else if (IsAtomTerm(tat1)) { - Yap_Error(TYPE_ERROR_ATOM, tat1, "sub_atom/5"); - return FALSE; - } else if (!sub_atom && !IsStringTerm(tat1)) { - Yap_Error(TYPE_ERROR_STRING, tat1, "sub_string/5"); - return FALSE; - } tbef = Deref(ARG2); if (IsVarTerm(tbef)) { minv = 0; } else if (!IsIntegerTerm(tbef)) { Yap_Error(TYPE_ERROR_INTEGER, tbef, "sub_string/5"); - return FALSE; + ReleaseAndReturn( FALSE ); } else { minv = IntegerOfTerm(tbef); if ((Int)minv < 0) { Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, tbef, "sub_string/5"); - return FALSE; + ReleaseAndReturn( FALSE ); }; mask |= SUB_ATOM_HAS_MIN; bnds++; @@ -1952,12 +2037,12 @@ static Int sub_atomic(bool sub_atom USES_REGS) { len = 0; } else if (!IsIntegerTerm(tsize)) { Yap_Error(TYPE_ERROR_INTEGER, tsize, "sub_string/5"); - return FALSE; + ReleaseAndReturn( FALSE ); } else { len = IntegerOfTerm(tsize); if ((Int)len < 0) { Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, tsize, "sub_string/5"); - return FALSE; + ReleaseAndReturn( FALSE ); }; mask |= SUB_ATOM_HAS_SIZE; bnds++; @@ -1966,12 +2051,12 @@ static Int sub_atomic(bool sub_atom USES_REGS) { after = 0; } else if (!IsIntegerTerm(tafter)) { Yap_Error(TYPE_ERROR_INTEGER, tafter, "sub_string/5"); - return FALSE; + ReleaseAndReturn( FALSE ); } else { after = IntegerOfTerm(tafter); if ((Int)after < 0) { Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, tafter, "sub_string/5"); - return FALSE; + ReleaseAndReturn( FALSE ); }; mask |= SUB_ATOM_HAS_AFTER; bnds++; @@ -1980,7 +2065,7 @@ static Int sub_atomic(bool sub_atom USES_REGS) { if (sub_atom) { if (!IsAtomTerm(tout)) { Yap_Error(TYPE_ERROR_ATOM, tout, "sub_atom/5"); - return FALSE; + ReleaseAndReturn( FALSE ); } else { Atom oat; mask |= SUB_ATOM_HAS_VAL | SUB_ATOM_HAS_SIZE; @@ -1990,20 +2075,16 @@ static Int sub_atomic(bool sub_atom USES_REGS) { } else { if (!IsStringTerm(tout)) { Yap_Error(TYPE_ERROR_STRING, tout, "sub_string/5"); - return FALSE; + ReleaseAndReturn( FALSE ); } else { mask |= SUB_ATOM_HAS_VAL | SUB_ATOM_HAS_SIZE; len = strlen_utf8(UStringOfTerm(tout)); } } if (!Yap_unify(ARG3, MkIntegerTerm(len))) - cut_fail(); + release_cut_fail(); bnds += 2; } - if (!IsVarTerm(tat1)) { - mask |= SUB_ATOM_HAS_UTF8; - sz = strlen_utf8(p); - } /* the problem is deterministic if we have two cases */ if (bnds > 1) { int out = FALSE; @@ -2011,30 +2092,30 @@ static Int sub_atomic(bool sub_atom USES_REGS) { if ((mask & (SUB_ATOM_HAS_MIN | SUB_ATOM_HAS_SIZE)) == (SUB_ATOM_HAS_MIN | SUB_ATOM_HAS_SIZE)) { if (minv + len > sz) - cut_fail(); + release_cut_fail(); if ((Int)(after = (sz - (minv + len))) < 0) - cut_fail(); + release_cut_fail(); nat = build_new_atomic(mask, wp, p, minv, len PASS_REGS); if (!nat) - cut_fail(); + release_cut_fail(); out = Yap_unify(ARG4, MkIntegerTerm(after)) && Yap_unify(ARG5, nat); } else if ((mask & (SUB_ATOM_HAS_MIN | SUB_ATOM_HAS_AFTER)) == (SUB_ATOM_HAS_MIN | SUB_ATOM_HAS_AFTER)) { if (sz < minv + after) - cut_fail(); + release_cut_fail(); len = sz - (minv + after); nat = build_new_atomic(mask, wp, p, minv, len PASS_REGS); if (!nat) - cut_fail(); + release_cut_fail(); out = Yap_unify(ARG3, MkIntegerTerm(len)) && Yap_unify(ARG5, nat); } else if ((mask & (SUB_ATOM_HAS_SIZE | SUB_ATOM_HAS_AFTER)) == (SUB_ATOM_HAS_SIZE | SUB_ATOM_HAS_AFTER)) { if (len + after > sz) - cut_fail(); + release_cut_fail(); minv = sz - (len + after); nat = build_new_atomic(mask, wp, p, minv, len PASS_REGS); if (!nat) - cut_fail(); + release_cut_fail(); out = Yap_unify(ARG2, MkIntegerTerm(minv)) && Yap_unify(ARG5, nat); } else if ((mask & (SUB_ATOM_HAS_MIN | SUB_ATOM_HAS_VAL)) == (SUB_ATOM_HAS_MIN | SUB_ATOM_HAS_VAL)) { @@ -2053,19 +2134,19 @@ static Int sub_atomic(bool sub_atom USES_REGS) { if (!sub_atom) { out = (strlen_utf8(UStringOfTerm(tout)) == len); if (!out) - cut_fail(); + release_cut_fail(); } else { out = (strlen_utf8(RepAtom(AtomOfTerm(tout))->UStrOfAE) == len); if (!out) - cut_fail(); + release_cut_fail(); } if (len == sz) { out = out && Yap_unify(ARG1, ARG5) && Yap_unify(ARG2, MkIntegerTerm(0)) && Yap_unify(ARG4, MkIntegerTerm(0)); } else if (len > sz) { - cut_fail(); + release_cut_fail(); } else { mask |= SUB_ATOM_HAS_SIZE; minv = 0; @@ -2074,8 +2155,8 @@ static Int sub_atomic(bool sub_atom USES_REGS) { } } if (out) - cut_succeed(); - cut_fail(); + release_cut_succeed(); + release_cut_fail(); } else { if (!(mask & SUB_ATOM_HAS_MIN)) minv = 0; @@ -2090,7 +2171,7 @@ backtrackable: EXTRA_CBACK_ARG(5, 3) = MkIntegerTerm(len); EXTRA_CBACK_ARG(5, 4) = MkIntegerTerm(after); EXTRA_CBACK_ARG(5, 5) = MkIntegerTerm(sz); - return cont_sub_atomic(PASS_REGS1); + ReleaseAndReturn( cont_sub_atomic(PASS_REGS1) ); } /** @pred sub_atom(+ _A_,? _Bef_, ? _Size_, ? _After_, ? _At_out_) is iso @@ -2107,7 +2188,7 @@ are unbound, the built-in will backtrack through all possible sub-strings of _A_. */ -static Int sub_atom(USES_REGS1) { return sub_atomic(true PASS_REGS); } +static Int sub_atom(USES_REGS1) { return( sub_atomic(true, false PASS_REGS) );} /** @pred sub_string(+ _S_,? _Bef_, ? _Size_, ? _After_, ? _S_out_) is iso @@ -2123,7 +2204,7 @@ are unbound, the built-in will generate all possible sub-strings of _S_. */ -static Int sub_string(USES_REGS1) { return sub_atomic(false PASS_REGS); } +static Int sub_string(USES_REGS1) { return sub_atomic(false, true PASS_REGS); } static Int cont_current_atom(USES_REGS1) { Atom catom; @@ -2176,9 +2257,9 @@ static Int cont_current_atom(USES_REGS1) { READ_UNLOCK(ap->ARWLock); } EXTRA_CBACK_ARG(1, 2) = MkIntTerm(i); - return TRUE; + return( TRUE ); } else { - return FALSE; + return( FALSE ); } } diff --git a/C/cmppreds.c b/C/cmppreds.c index a7de778d1..d650e4410 100644 --- a/C/cmppreds.c +++ b/C/cmppreds.c @@ -63,6 +63,8 @@ static char SccsId[] = "%W% %G%"; #endif #include +#include "YapError.h" + static Int compare(Term, Term); static Int p_compare(USES_REGS1); static Int p_acomp(USES_REGS1); @@ -378,9 +380,11 @@ inline static Int compare(Term t1, Term t2) /* compare terms t1 and t2 */ return 1; else { int out; - if (!(out = 2 - ArityOfFunctor(f))) - out = strcmp(".", (char *)RepAtom(NameOfFunctor(f))->StrOfAE); - return (out); + if (f != FunctorDot) + return strcmp(".", RepAtom(NameOfFunctor(f))->StrOfAE); + else { + return compare_complex(RepPair(t1) - 1, RepPair(t1) + 1, RepAppl(t2) ); + } } } if (IsPairTerm(t2)) { @@ -590,14 +594,12 @@ inline static Int flt_cmp(Float dif) { return dif = 0.0; } -static inline Int a_cmp(Term t1, Term t2 USES_REGS) { +static Int a_cmp(Term t1, Term t2 USES_REGS) { if (IsVarTerm(t1)) { - Yap_Error(INSTANTIATION_ERROR, t1, "=:=/2"); - return FALSE; + Yap_ThrowError( INSTANTIATION_ERROR, t1, "while doing arithmetic comparison" ); } if (IsVarTerm(t2)) { - Yap_Error(INSTANTIATION_ERROR, t2, "=:=/2"); - return FALSE; + Yap_ThrowError( INSTANTIATION_ERROR, t1, "while doing arithmetic comparison" ); } if (IsFloatTerm(t1) && IsFloatTerm(t2)) { return flt_cmp(FloatOfTerm(t1) - FloatOfTerm(t2)); @@ -620,8 +622,7 @@ static inline Int a_cmp(Term t1, Term t2 USES_REGS) { Float f2 = FloatOfTerm(t2); #if HAVE_ISNAN if (isnan(f2)) { - LOCAL_Error_TYPE = EVALUATION_ERROR_UNDEFINED; - LOCAL_ErrorMessage = "trying to evaluate nan"; + Yap_ThrowError( EVALUATION_ERROR_UNDEFINED, t2, "trying to evaluate nan" ); } #endif return flt_cmp(i1 - f2); @@ -636,8 +637,7 @@ static inline Int a_cmp(Term t1, Term t2 USES_REGS) { Float f1 = FloatOfTerm(t1); #if HAVE_ISNAN if (isnan(f1)) { - LOCAL_Error_TYPE = EVALUATION_ERROR_UNDEFINED; - LOCAL_ErrorMessage = "trying to evaluate nan"; + Yap_ThrowError( EVALUATION_ERROR_UNDEFINED, t1, "trying to evaluate nan" ); } #endif t2 = Yap_Eval(t2); @@ -653,9 +653,8 @@ static inline Int a_cmp(Term t1, Term t2 USES_REGS) { Float f2 = FloatOfTerm(t2); #if HAVE_ISNAN if (isnan(f2)) { - LOCAL_Error_TYPE = EVALUATION_ERROR_UNDEFINED; - LOCAL_ErrorMessage = "trying to evaluate nan"; - } + Yap_ThrowError( EVALUATION_ERROR_UNDEFINED, t2, "trying to evaluate nan" ); + } #endif return flt_cmp(f1 - f2); #ifdef USE_GMP @@ -676,8 +675,7 @@ static inline Int a_cmp(Term t1, Term t2 USES_REGS) { Float f2 = FloatOfTerm(t2); #if HAVE_ISNAN if (isnan(f2)) { - LOCAL_Error_TYPE = EVALUATION_ERROR_UNDEFINED; - LOCAL_ErrorMessage = "trying to evaluate nan"; + Yap_ThrowError( EVALUATION_ERROR_UNDEFINED, t2, "trying to evaluate nan" ); } #endif return Yap_gmp_cmp_big_float(t1, f2); @@ -744,7 +742,6 @@ static Int a_eq(Term t1, Term t2) { } } out = a_cmp(t1, t2 PASS_REGS); - Yap_Error(LOCAL_Error_TYPE, t1, LOCAL_ErrorMessage); return out == 0; } diff --git a/C/compiler.c b/C/compiler.c index b8f0f82d6..29735c82e 100644 --- a/C/compiler.c +++ b/C/compiler.c @@ -1080,10 +1080,8 @@ static void c_bifun(basic_preds Op, Term t1, Term t2, Term t3, Term Goal, } else { char s[32]; - LOCAL_Error_TYPE = TYPE_ERROR_NUMBER; - Yap_bip_name(Op, s); - sprintf(LOCAL_ErrorMessage, "compiling %s/2 with output bound", s); + Yap_ThrowError( TYPE_ERROR_NUMBER, t2, "compiling %s/2 with output bound", s); save_machine_regs(); siglongjmp(cglobs->cint.CompilerBotch, 1); } @@ -1094,9 +1092,8 @@ static void c_bifun(basic_preds Op, Term t1, Term t2, Term t3, Term Goal, if (IsNewVar(t2)) { char s[32]; - LOCAL_Error_TYPE = INSTANTIATION_ERROR; Yap_bip_name(Op, s); - sprintf(LOCAL_ErrorMessage, "compiling %s/3", s); + Yap_ThrowError(INSTANTIATION_ERROR , t2, "compiling %s/3", s); save_machine_regs(); siglongjmp(cglobs->cint.CompilerBotch, 1); } @@ -1107,10 +1104,7 @@ static void c_bifun(basic_preds Op, Term t1, Term t2, Term t3, Term Goal, if (!IsIntegerTerm(t2)) { char s[32]; - - LOCAL_Error_TYPE = TYPE_ERROR_INTEGER; - Yap_bip_name(Op, s); - sprintf(LOCAL_ErrorMessage, "compiling functor/3"); + Yap_ThrowError( TYPE_ERROR_INTEGER, t2, "compiling functor/3"); save_machine_regs(); siglongjmp(cglobs->cint.CompilerBotch, 1); } @@ -1118,9 +1112,7 @@ static void c_bifun(basic_preds Op, Term t1, Term t2, Term t3, Term Goal, if (i2 < 0) { char s[32]; - LOCAL_Error_TYPE = DOMAIN_ERROR_NOT_LESS_THAN_ZERO; - Yap_bip_name(Op, s); - sprintf(LOCAL_ErrorMessage, "compiling functor/3"); + Yap_ThrowError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO , t2, "compiling functor/3"); save_machine_regs(); siglongjmp(cglobs->cint.CompilerBotch, 1); } diff --git a/C/errors.c b/C/errors.c index 3bb7d7752..3e00393b1 100755 --- a/C/errors.c +++ b/C/errors.c @@ -310,6 +310,27 @@ yap_error_descriptor_t *Yap_popErrorContext(void) { return new_error; } +void Yap_ThrowError__(const char *file, const char *function, int lineno, + yap_error_number type, Term where, ...) { + va_list ap; + char tmpbuf[MAXPATHLEN]; + + va_start(ap, where); + char *format = va_arg(ap, char *); + if (format != NULL) { +#if HAVE_VSNPRINTF + (void)vsnprintf(tmpbuf, MAXPATHLEN - 1, format, ap); +#else + (void)vsprintf(tnpbuf, format, ap); +#endif + // fprintf(stderr, "warning: "); +Yap_Error__(file, function, lineno, type, where, tmpbuf); + } else { + Yap_Error__(file, function, lineno, type, where); + } + siglongjmp(LOCAL_RestartEnv, 2); +} + /** * @brief Yap_Error * This function handles errors in the C code. Check errors.yap for the diff --git a/C/exec.c b/C/exec.c index 7869bf728..b6f61030b 100755 --- a/C/exec.c +++ b/C/exec.c @@ -2229,6 +2229,7 @@ bool Yap_ResetException(int wid) { Yap_PopTermFromDB(REMOTE_ActiveError(wid)->errorTerm); } REMOTE_ActiveError(wid)->errorTerm = NULL; + REMOTE_ActiveError(wid)->errorTerm = NULL; return true; } diff --git a/C/grow.c b/C/grow.c index 953ea53f4..e3e373d62 100755 --- a/C/grow.c +++ b/C/grow.c @@ -749,9 +749,7 @@ AdjustScannerStacks(TokEntry **tksp, VarEntry **vep USES_REGS) break; case Var_tok: case String_tok: - case WString_tok: case BQString_tok: - case WBQString_tok: if (IsOldTrail(tks->TokInfo)) tks->TokInfo = TrailAdjust(tks->TokInfo); break; diff --git a/C/parser.c b/C/parser.c index 791ea2da1..b8c0c794e 100755 --- a/C/parser.c +++ b/C/parser.c @@ -173,12 +173,15 @@ const char *Yap_tokRep(void *tokptr, encoding_t enc); static void syntax_msg(const char *msg, ...) { CACHE_REGS va_list ap; - - if (LOCAL_toktide == LOCAL_tokptr) { - LOCAL_ErrorMessage = malloc(MAX_ERROR_MSG_SIZE + 1); + if (!LOCAL_ErrorMessage || + (LOCAL_Error_TYPE == SYNTAX_ERROR && + LOCAL_ActiveError->prologParserLine < LOCAL_tokptr->TokPos)) { + if (!LOCAL_ErrorMessage) { + LOCAL_ErrorMessage = malloc(1024 + 1); + } + LOCAL_ActiveError->prologParserLine = LOCAL_tokptr->TokPos; va_start(ap, msg); - vsnprintf(LOCAL_ErrorMessage, YAP_FILENAME_MAX, msg, ap); - LOCAL_Error_TYPE = SYNTAX_ERROR; + vsnprintf(LOCAL_ErrorMessage, MAX_ERROR_MSG_SIZE, msg, ap); va_end(ap); } } @@ -224,22 +227,18 @@ static void syntax_msg(const char *msg, ...) { #define FAIL siglongjmp(FailBuff->JmpBuff, 1) -VarEntry * -Yap_LookupVar(const char *var) /* lookup variable in variables table - * */ +VarEntry *Yap_LookupVar(const char *var) /* lookup variable in variables table + * */ { CACHE_REGS VarEntry *p; - int32_t ch; - const unsigned char *v1 = var; + Atom vat = Yap_LookupAtom(var); #if DEBUG if (GLOBAL_Option[4]) fprintf(stderr, "[LookupVar %s]", var); #endif - - v1 = v1 + get_utf8(v1, 1, &ch); - if (ch != '_' || v1[0] != '\0') { + if (var[0] != '_' || var[1] != '\0') { VarEntry **op = &LOCAL_VarTable; UInt hv; @@ -249,7 +248,7 @@ Yap_LookupVar(const char *var) /* lookup variable in variables table CELL hpv = p->hv; if (hv == hpv) { Int scmp; - if ((scmp = strcmp(var, p->VarRep)) == 0) { + if ((scmp = strcmp(var, RepAtom(p->VarRep)->StrOfAE)) == 0) { p->refs++; return (p); } else if (scmp < 0) { @@ -267,22 +266,21 @@ Yap_LookupVar(const char *var) /* lookup variable in variables table p = p->VarRight; } } - p = (VarEntry *)Yap_AllocScannerMemory(strlen(var) + 1+ sizeof(VarEntry)); + p = (VarEntry *)Yap_AllocScannerMemory(sizeof(VarEntry)); *op = p; p->VarLeft = p->VarRight = NULL; p->hv = hv; p->refs = 1L; - strcpy(p->VarRep, var); + p->VarRep = vat; } else { /* anon var */ - p = (VarEntry *)Yap_AllocScannerMemory(sizeof(VarEntry) + 3); + p = (VarEntry *)Yap_AllocScannerMemory(sizeof(VarEntry)); p->VarLeft = LOCAL_AnonVarTable; LOCAL_AnonVarTable = p; p->VarRight = NULL; p->refs = 0L; p->hv = 1L; - p->VarRep[0] = '_'; - p->VarRep[1] = '\0'; + p->VarRep = vat; } p->VarAdr = TermNil; return (p); @@ -290,11 +288,11 @@ Yap_LookupVar(const char *var) /* lookup variable in variables table static Term VarNames(VarEntry *p, Term l USES_REGS) { if (p != NULL) { - if (strcmp(p->VarRep, "_") != 0) { + if (strcmp(RepAtom(p->VarRep)->StrOfAE, "_") != 0) { Term t[2]; Term o; - t[0] = MkAtomTerm(Yap_LookupAtom(p->VarRep)); + t[0] = MkAtomTerm(p->VarRep); if (!IsVarTerm(p->VarAdr)) p->VarAdr = MkVarTerm(); t[1] = p->VarAdr; @@ -321,11 +319,11 @@ Term Yap_VarNames(VarEntry *p, Term l) { static Term Singletons(VarEntry *p, Term l USES_REGS) { if (p != NULL) { - if (p->VarRep[0] != '_' && p->refs == 1) { + if (RepAtom(p->VarRep)->StrOfAE[0] != '_' && p->refs == 1) { Term t[2]; Term o; - t[0] = MkAtomTerm(Yap_LookupAtom(p->VarRep)); + t[0] = MkAtomTerm(p->VarRep); t[1] = p->VarAdr; o = Yap_MkApplTerm(FunctorEq, 2, t); o = MkPairTerm(o, @@ -404,10 +402,10 @@ static int IsInfixOp(Atom op, int *pptr, int *lpptr, int *rpptr, OpEntry *opp = Yap_GetOpProp(op, INFIX_OP, cmod PASS_REGS); if (!opp) - return FALSE; + return false; if (opp->OpModule && opp->OpModule != cmod) { READ_UNLOCK(opp->OpRWLock); - return FALSE; + return false; } if ((p = opp->Infix) != 0) { READ_UNLOCK(opp->OpRWLock); @@ -614,7 +612,8 @@ static Term ParseArgs(Atom a, Term close, JMPBUFF *FailBuff, Term arg1, } static Term MakeAccessor(Term t, Functor f USES_REGS) { - UInt arity = ArityOfFunctor(FunctorOfTerm(t)), i; + UInt arity = ArityOfFunctor(FunctorOfTerm(t)); + int i; Term tf[2], tl = TermNil; tf[1] = ArgOfTerm(1, t); @@ -791,7 +790,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc, case '{': NextToken; if (LOCAL_tokptr->Tok == Ponctuation_tok && - (int)LOCAL_tokptr->TokInfo == TermEndSquareBracket) { + (int)LOCAL_tokptr->TokInfo == TermEndCurlyBracket) { t = MkAtomTerm(AtomBraces); NextToken; break; @@ -803,7 +802,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc, syntax_msg("line %d: Stack Overflow", LOCAL_tokptr->TokPos); FAIL; } - checkfor(TermEndSquareBracket, FailBuff, enc PASS_REGS); + checkfor(TermEndCurlyBracket, FailBuff, enc PASS_REGS); break; default: syntax_msg("line %d: unexpected ponctuation signal %s", @@ -905,15 +904,16 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc, /* main loop to parse infix and posfix operators starts here */ while (true) { + Atom name; if (LOCAL_tokptr->Tok == Ord(Name_tok) && - Yap_HasOp(AtomOfTerm(LOCAL_tokptr->TokInfo))) { - Atom save_opinfo = opinfo = AtomOfTerm(LOCAL_tokptr->TokInfo); + Yap_HasOp((name = AtomOfTerm(LOCAL_tokptr->TokInfo)))) { + Atom save_opinfo = opinfo = name; if (IsInfixOp(save_opinfo, &opprio, &oplprio, &oprprio, cmod PASS_REGS) && opprio <= prio && oplprio >= curprio) { /* try parsing as infix operator */ Volatile int oldprio = curprio; TRY3( - func = Yap_MkFunctor(AtomOfTerm(LOCAL_tokptr->TokInfo), 2); + func = Yap_MkFunctor(save_opinfo, 2); if (func == NULL) { syntax_msg("line %d: Heap Overflow", LOCAL_tokptr->TokPos); FAIL; @@ -954,7 +954,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc, break; } if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok)) { - if (LOCAL_tokptr->TokInfo == TermDot && prio >= 1000 && curprio <= 999) { + if (LOCAL_tokptr->TokInfo == TermComma && prio >= 1000 && curprio <= 999) { Volatile Term args[2]; NextToken; args[0] = t; @@ -1001,17 +1001,17 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, encoding_t enc, curprio = opprio; continue; } else if (LOCAL_tokptr->TokInfo == TermBeginCurlyBracket && - IsPosfixOp(AtomEmptyCurlyBrackets, &opprio, &oplprio, + IsPosfixOp(AtomBraces, &opprio, &oplprio, cmod PASS_REGS) && opprio <= prio && oplprio >= curprio) { - t = ParseArgs(AtomEmptyCurlyBrackets, TermEndCurlyBracket, FailBuff, t, + t = ParseArgs(AtomBraces, TermEndCurlyBracket, FailBuff, t, enc, cmod PASS_REGS); - t = MakeAccessor(t, FunctorEmptyCurlyBrackets PASS_REGS); + t = MakeAccessor(t, FunctorBraces PASS_REGS); curprio = opprio; continue; } } - if (LOCAL_tokptr->Tok <= Ord(WString_tok)) { + if (LOCAL_tokptr->Tok <= Ord(String_tok)) { syntax_msg("line %d: expected operator, got \'%s\'", LOCAL_tokptr->TokPos, Yap_tokRep(LOCAL_tokptr, enc)); FAIL; @@ -1026,6 +1026,7 @@ Term Yap_Parse(UInt prio, encoding_t enc, Term cmod) { Volatile Term t; JMPBUFF FailBuff; yhandle_t sls = Yap_StartSlots(); + LOCAL_toktide = LOCAL_tokptr; if (!sigsetjmp(FailBuff.JmpBuff, 0)) { @@ -1042,22 +1043,19 @@ Term Yap_Parse(UInt prio, encoding_t enc, Term cmod) { } #endif Yap_CloseSlots(sls); - if (LOCAL_tokptr != NULL && LOCAL_tokptr->Tok != Ord(eot_tok)) { - LOCAL_Error_TYPE = SYNTAX_ERROR; - LOCAL_ErrorMessage = "term does not end on . "; - t = 0; - } - if (t != 0 && LOCAL_Error_TYPE == SYNTAX_ERROR) { - LOCAL_Error_TYPE = YAP_NO_ERROR; - LOCAL_ErrorMessage = NULL; - } - // if (LOCAL_tokptr->Tok != Ord(eot_tok)) - // return (0L); - return t; } - Yap_CloseSlots(sls); - - return (0); + if (LOCAL_tokptr != NULL && LOCAL_tokptr->Tok != Ord(eot_tok)) { + LOCAL_Error_TYPE = SYNTAX_ERROR; + LOCAL_ErrorMessage = "term does not end on . "; + t = 0; + } + if (t != 0 && LOCAL_Error_TYPE == SYNTAX_ERROR) { + LOCAL_Error_TYPE = YAP_NO_ERROR; + LOCAL_ErrorMessage = NULL; + } + // if (LOCAL_tokptr->Tok != Ord(eot_tok)) + // return (0L); + return t; } //! @} diff --git a/C/scanner.c b/C/scanner.c index db66bba17..0b661653a 100755 --- a/C/scanner.c +++ b/C/scanner.c @@ -1202,7 +1202,8 @@ Term Yap_scan_num(StreamDesc *inp) { ef->TokNext = NULL; LOCAL_tokptr = tokptr; LOCAL_toktide = e; - LOCAL_ErrorMessage = Yap_syntax_error(e, inp - GLOBAL_Stream); + Yap_JumpToEnv( + Yap_syntax_error(e, inp - GLOBAL_Stream) ); LOCAL_Error_TYPE = SYNTAX_ERROR; } } @@ -1237,21 +1238,18 @@ const char *Yap_tokRep(void *tokptre, encoding_t encoding) { case Ponctuation_tok: case String_tok: case BQString_tok: - case WString_tok: - case WBQString_tok: { return Yap_TermToString(info, &length, encoding, flags); - } - case Var_tok: { + case Var_tok: + { VarEntry *varinfo = (VarEntry *)info; varinfo->VarAdr = TermNil; - return varinfo->VarRep; + return RepAtom(varinfo->VarRep)->StrOfAE; } case Error_tok: return ""; case eot_tok: return ""; case QuasiQuotes_tok: - case WQuasiQuotes_tok: return ""; } } @@ -1445,7 +1443,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments, } t->Tok = Ord(kind = Var_tok); } - + } break; case NU: { @@ -1923,7 +1921,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments, qq->end.byteno = fseek(inp_stream->file, 0, 0); } else { qq->end.byteno = inp_stream->charcount - 1; - } + } qq->end.lineno = inp_stream->linecount; qq->end.linepos = inp_stream->linepos - 1; qq->end.charno = inp_stream->charcount - 1; @@ -1977,7 +1975,6 @@ TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments, return (l); } -int vsc_count; void Yap_clean_tokenizer(TokEntry *tokstart, VarEntry *vartable, VarEntry *anonvartable) { diff --git a/C/text.c b/C/text.c index 5d3e440af..6034c3e1d 100644 --- a/C/text.c +++ b/C/text.c @@ -52,19 +52,16 @@ typedef struct TextBuffer_manager { } text_buffer_t; int push_text_stack(USES_REGS1) { - printf("push %d\n", LOCAL_TextBuffer->lvl); return LOCAL_TextBuffer->lvl++; } int pop_text_stack(int i) { - printf("pop %d\n", i); int lvl = LOCAL_TextBuffer->lvl; while (lvl > i) { struct mblock *p = LOCAL_TextBuffer->first[lvl]; while (p) { struct mblock *np = p->next; free(p); - printf("----------> %p free\n", p); p = np; } LOCAL_TextBuffer->first[lvl] = NULL; @@ -95,7 +92,6 @@ void *Malloc(size_t sz USES_REGS) { o->next = NULL; o->sz = sz; o->lvl = lvl; - printf("%p malloc %d\n", o, sz); return o + 1; } @@ -115,7 +111,6 @@ void *Realloc(void *pt, size_t sz USES_REGS) { if (LOCAL_TextBuffer->last[lvl] == old) { LOCAL_TextBuffer->last[lvl] = o; } - printf("%p realloc %ld\n", o, sz); return o + 1; } @@ -136,7 +131,6 @@ void Free(void *pt USES_REGS) { LOCAL_TextBuffer->last[lvl] = o->prev; } free(o); - printf("%p free\n", o); } void *Yap_InitTextAllocator(void) { @@ -392,7 +386,7 @@ unsigned char *Yap_readText(seq_tv_t *inp, size_t *lengp) { // this is a term, extract to a buffer, and representation is wide // Yap_DebugPlWriteln(inp->val.t); Atom at = AtomOfTerm(inp->val.t); - inp->val.uc = at->UStrOfAE; + return at->UStrOfAE; } if (IsStringTerm(inp->val.t) && inp->type & YAP_STRING_STRING) { // this is a term, extract to a buffer, and representation is wide @@ -636,7 +630,7 @@ static Term write_codes(void *s0, seq_tv_t *out, size_t leng USES_REGS) { static Atom write_atom(void *s0, seq_tv_t *out, size_t leng USES_REGS) { unsigned char *s = s0; int32_t ch; - if (strlen_utf8(s0) <= leng) { + if (!leng || strlen_utf8(s0) <= leng) { return Yap_LookupAtom(s0); } else { size_t n = get_utf8(s, 1, &ch); @@ -729,15 +723,17 @@ static Term write_number(unsigned char *s, seq_tv_t *out, int size USES_REGS) { static Term string_to_term(void *s, seq_tv_t *out, size_t leng USES_REGS) { Term o; - int i = push_text_stack(); o = out->val.t = Yap_StringToTerm(s, strlen(s) + 1, &out->enc, GLOBAL_MaxPriority, NULL); - pop_text_stack(i); return o; } bool write_Text(unsigned char *inp, seq_tv_t *out, size_t leng USES_REGS) { /* we know what the term is */ + if (out->type == 0) { + return true; + } + if (out->type & YAP_STRING_TERM) { if ((out->val.t = string_to_term(inp, out, leng PASS_REGS)) != 0L) return out->val.t != 0; @@ -753,7 +749,7 @@ bool write_Text(unsigned char *inp, seq_tv_t *out, size_t leng USES_REGS) { return false; } if (out->type & (YAP_STRING_ATOM)) { - if (write_atom(inp, out, leng PASS_REGS) != NIL) { + if ((out->val.a = write_atom(inp, out, leng PASS_REGS)) != NIL) { Atom at = out->val.a; if (at && (out->type & YAP_STRING_OUTPUT_TERM)) out->val.t = MkAtomTerm(at); @@ -797,7 +793,7 @@ bool write_Text(unsigned char *inp, seq_tv_t *out, size_t leng USES_REGS) { out->val.t = write_number(inp, out, leng PASS_REGS); // Yap_DebugPlWriteln(out->val.t); return out->val.t != 0; - default: {} + default: { return true ; } } return false; } @@ -833,7 +829,6 @@ bool Yap_CVT_Text(seq_tv_t *inp, seq_tv_t *out USES_REGS) { bool rc; size_t leng; - int l = push_text_stack(PASS_REGS1); /* f//printfmark(stderr, "[ %d ", n++) ; if (inp->type & (YAP_STRING_TERM|YAP_STRING_ATOM|YAP_STRING_ATOMS_CODES @@ -858,26 +853,22 @@ bool Yap_CVT_Text(seq_tv_t *inp, seq_tv_t *out USES_REGS) { } if (!buf) { - pop_text_stack( l); return 0L; } if (out->type & (YAP_STRING_UPCASE | YAP_STRING_DOWNCASE)) { if (out->type & YAP_STRING_UPCASE) { if (!upcase(buf, out)) { - pop_text_stack( l); return false; } } if (out->type & YAP_STRING_DOWNCASE) { if (!downcase(buf, out)) { - pop_text_stack( l); return false; } } } rc = write_Text(buf, out, leng PASS_REGS); - pop_text_stack(l); /* fprintf(stderr, " -> "); if (!rc) fprintf(stderr, "NULL"); else if (out->type & @@ -919,9 +910,7 @@ static unsigned char *concat(int n, unsigned char *sv[] USES_REGS) { buf = Malloc(room + 1); buf0 = (unsigned char *)buf; for (i = 0; i < n; i++) { - char *s = (char *)sv[i]; - buf = strcpy(buf, s); - buf += strlen(s); + buf = stpcpy(buf, sv[i]); } return buf0; } @@ -945,12 +934,11 @@ static void *slice(size_t min, size_t max, unsigned char *buf USES_REGS) { bool Yap_Concat_Text(int tot, seq_tv_t inp[], seq_tv_t *out USES_REGS) { unsigned char **bufv; unsigned char *buf; - size_t leng; int i; - int l = push_text_stack(PASS_REGS1); + size_t leng; + bufv = Malloc(tot * sizeof(unsigned char *)); if (!bufv) { - pop_text_stack( l); return NULL; } for (i = 0; i < tot; i++) { @@ -958,14 +946,12 @@ bool Yap_Concat_Text(int tot, seq_tv_t inp[], seq_tv_t *out USES_REGS) { unsigned char *nbuf = Yap_readText(inp + i, &leng PASS_REGS); if (!nbuf) { - pop_text_stack( l); return NULL; } bufv[i] = nbuf; } buf = concat(tot, bufv PASS_REGS); - bool rc = write_Text(buf, out, leng PASS_REGS); - pop_text_stack(l); + bool rc = write_Text(buf, out, 0 PASS_REGS); return rc; } @@ -973,14 +959,11 @@ bool Yap_Concat_Text(int tot, seq_tv_t inp[], seq_tv_t *out USES_REGS) { bool Yap_Splice_Text(int n, size_t cuts[], seq_tv_t *inp, seq_tv_t outv[] USES_REGS) { unsigned char *buf; - int lvl = push_text_stack(PASS_REGS1); size_t l; inp->type |= YAP_STRING_IN_TMP; buf = Yap_readText(inp, &l PASS_REGS); if (!buf) { - pop_text_stack( l); - return false; } if (!cuts) { @@ -991,11 +974,9 @@ bool Yap_Splice_Text(int n, size_t cuts[], seq_tv_t *inp, if (outv[0].val.t) { buf0 = Yap_readText(outv, &l0 PASS_REGS); if (!buf0) { - pop_text_stack( l); return false; } if (cmp_Text(buf, buf0, l0) != 0) { - pop_text_stack( l); return false; } l1 = l - l0; @@ -1003,26 +984,21 @@ bool Yap_Splice_Text(int n, size_t cuts[], seq_tv_t *inp, buf1 = slice(l0, l, buf PASS_REGS); bool rc = write_Text(buf1, outv + 1, l1 PASS_REGS); if (!rc) { - pop_text_stack( l); return false; } - pop_text_stack(lvl); return rc; } else /* if (outv[1].val.t) */ { buf1 = Yap_readText(outv + 1, &l1 PASS_REGS); if (!buf1) { - pop_text_stack( l); return false; } l0 = l - l1; if (cmp_Text(skip_utf8((const unsigned char *)buf, l0), buf1, l1) != 0) { - pop_text_stack( l); return false; } buf0 = slice(0, l0, buf PASS_REGS); bool rc = write_Text(buf0, outv, l0 PASS_REGS); - pop_text_stack((rc ? 0 : lvl)); return rc; } } @@ -1033,14 +1009,14 @@ bool Yap_Splice_Text(int n, size_t cuts[], seq_tv_t *inp, next = 0; else next = cuts[i - 1]; + if (cuts[i] == 0) + break; void *bufi = slice(next, cuts[i], buf PASS_REGS); if (!write_Text(bufi, outv + i, cuts[i] - next PASS_REGS)) { - pop_text_stack( l); return false; } } - pop_text_stack(l); - + return true; } diff --git a/C/write.c b/C/write.c index a0c0768e4..c9b8ada28 100644 --- a/C/write.c +++ b/C/write.c @@ -1012,7 +1012,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg, } } else if (!wglb->Ignore_ops && (Arity == 1 || - ((atom == AtomEmptyBrackets || atom == AtomEmptyCurlyBrackets || + ((atom == AtomEmptyBrackets || atom == AtomCurly || atom == AtomEmptySquareBrackets) && Yap_IsListTerm(ArgOfTerm(1, t)))) && Yap_IsPosfixOp(atom, &op, &lp)) { @@ -1047,7 +1047,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg, wrputc('(', wglb->stream); } else if (atom == AtomEmptySquareBrackets) { wrputc('[', wglb->stream); - } else if (atom == AtomEmptyCurlyBrackets) { + } else if (atom == AtomCurly) { wrputc('{', wglb->stream); } lastw = separator; @@ -1056,7 +1056,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg, wrputc(')', wglb->stream); } else if (atom == AtomEmptySquareBrackets) { wrputc(']', wglb->stream); - } else if (atom == AtomEmptyCurlyBrackets) { + } else if (atom == AtomCurly) { wrputc('}', wglb->stream); } lastw = separator; diff --git a/CXX/yapa.hh b/CXX/yapa.hh index e1b955817..924238099 100644 --- a/CXX/yapa.hh +++ b/CXX/yapa.hh @@ -23,8 +23,6 @@ enum PropTag { MUTEX_TAG = MutexProperty, // 0xFFF6, /// A typed array, may be in-db or in-stack deped ARRAY_TAG = ArrayProperty, // 0xFFF7, - /// atom does not fit ISO-LATIN-1 - WIDE_TAG = WideAtomProperty, // 0xFFF8, /// module MODULE_TAG = ModProperty, // 0xFFFA, /// the original SICStus blackboard @@ -59,14 +57,12 @@ class YAPAtom { /// construct new YAPAtom from Atom YAPAtom( Atom at ) { a = at; } public: - /// construct new YAPAtom from string + /// construct new YAPAtom from UTF-8 string YAPAtom( const char * s) { a = Yap_LookupAtom( s ); } /// construct new YAPAtom from wide string -YAPAtom( const wchar_t * s) { a = Yap_LookupMaybeWideAtom( s ); } + //YAPAtom( const wchar_t * s) { a = Yap_LookupMaybeWideAtom( s ); } /// construct new YAPAtom from max-length string YAPAtom( const char * s, size_t len) { a = Yap_LookupAtomWithLength( s, len ); } - /// construct new YAPAtom from max-length wide string - YAPAtom( const wchar_t * s, size_t len) { a = Yap_LookupMaybeWideAtomWithLength( s, len ); } /// get name of atom const char *getName(void); /// get name of (other way) diff --git a/H/ATOMS b/H/ATOMS index 71f4b341b..81f0ad055 100644 --- a/H/ATOMS +++ b/H/ATOMS @@ -37,7 +37,6 @@ A BeginCurlyBracket N "{" A EndCurlyBracket N "}" A EmptyBrackets N "()" A EmptySquareBrackets N "[]" -A EmptyCurlyBrackets N "{}" A Asserta N "asserta" A AssertaStatic N "asserta_static" A Assertz N "assertz" @@ -498,7 +497,6 @@ F Dot8 Dot 8 F Dot9 Dot 9 F DoubleSlash DoubleSlash 2 F EmptySquareBrackets EmptySquareBrackets 2 -F EmptyCurlyBrackets EmptyCurlyBrackets 2 F Eq Eq 2 F Error Error 2 F EvaluationError EvaluationError 1 diff --git a/H/ScannerTypes.h b/H/ScannerTypes.h index e760a67cb..c1667f7d9 100644 --- a/H/ScannerTypes.h +++ b/H/ScannerTypes.h @@ -3,13 +3,10 @@ typedef enum TokenKinds { Number_tok, Var_tok, String_tok, - WString_tok, BQString_tok, - WBQString_tok, Ponctuation_tok, Error_tok, QuasiQuotes_tok, - WQuasiQuotes_tok, eot_tok } tkinds; @@ -29,5 +26,5 @@ typedef struct VARSTRUCT { CELL hv; UInt refs; struct VARSTRUCT *VarLeft, *VarRight; - char VarRep[1]; + Atom VarRep; } VarEntry; diff --git a/H/YapGFlagInfo.h b/H/YapGFlagInfo.h index a544e9066..84e7a2e92 100644 --- a/H/YapGFlagInfo.h +++ b/H/YapGFlagInfo.h @@ -524,7 +524,7 @@ and _Patch_ is the patch number. */ YAP_FLAG(VERSION_DATA_FLAG, "version_data", false, ro, YAP_TVERSION, NULL), /**< -`version ` Read-only flag that returns an a compound term with the +`version ` Read-only flag that returns a compound term with the current version of YAP. The term will have the name `yap` and arity 4, the first argument will be the major version, the second the minor version, the third the patch number, and the diff --git a/H/YapText.h b/H/YapText.h index d2c5fe412..c6c501b3b 100644 --- a/H/YapText.h +++ b/H/YapText.h @@ -190,7 +190,7 @@ inline static utf8proc_ssize_t strlen_utf8(const utf8proc_uint8_t *pt) { return rc; else if (b > 0) { pt += l; - rc += l; + rc ++; } else { pt++; } diff --git a/H/generated/iatoms.h b/H/generated/iatoms.h index 8ec395dce..3507ac20e 100644 --- a/H/generated/iatoms.h +++ b/H/generated/iatoms.h @@ -32,7 +32,6 @@ AtomEndCurlyBracket = Yap_LookupAtom("}"); TermEndCurlyBracket = MkAtomTerm(AtomEndCurlyBracket); AtomEmptyBrackets = Yap_LookupAtom("()"); TermEmptyBrackets = MkAtomTerm(AtomEmptyBrackets); AtomEmptySquareBrackets = Yap_LookupAtom("[]"); TermEmptySquareBrackets = MkAtomTerm(AtomEmptySquareBrackets); - AtomEmptyCurlyBrackets = Yap_LookupAtom("{}"); TermEmptyCurlyBrackets = MkAtomTerm(AtomEmptyCurlyBrackets); AtomAsserta = Yap_LookupAtom("asserta"); TermAsserta = MkAtomTerm(AtomAsserta); AtomAssertaStatic = Yap_LookupAtom("asserta_static"); TermAssertaStatic = MkAtomTerm(AtomAssertaStatic); AtomAssertz = Yap_LookupAtom("assertz"); TermAssertz = MkAtomTerm(AtomAssertz); @@ -493,7 +492,6 @@ FunctorDot9 = Yap_MkFunctor(AtomDot,9); FunctorDoubleSlash = Yap_MkFunctor(AtomDoubleSlash,2); FunctorEmptySquareBrackets = Yap_MkFunctor(AtomEmptySquareBrackets,2); - FunctorEmptyCurlyBrackets = Yap_MkFunctor(AtomEmptyCurlyBrackets,2); FunctorEq = Yap_MkFunctor(AtomEq,2); FunctorError = Yap_MkFunctor(AtomError,2); FunctorEvaluationError = Yap_MkFunctor(AtomEvaluationError,1); diff --git a/H/generated/ratoms.h b/H/generated/ratoms.h index 84cf03699..e8f1fd332 100644 --- a/H/generated/ratoms.h +++ b/H/generated/ratoms.h @@ -32,7 +32,6 @@ AtomEndCurlyBracket = AtomAdjust(AtomEndCurlyBracket); TermEndCurlyBracket = MkAtomTerm(AtomEndCurlyBracket); AtomEmptyBrackets = AtomAdjust(AtomEmptyBrackets); TermEmptyBrackets = MkAtomTerm(AtomEmptyBrackets); AtomEmptySquareBrackets = AtomAdjust(AtomEmptySquareBrackets); TermEmptySquareBrackets = MkAtomTerm(AtomEmptySquareBrackets); - AtomEmptyCurlyBrackets = AtomAdjust(AtomEmptyCurlyBrackets); TermEmptyCurlyBrackets = MkAtomTerm(AtomEmptyCurlyBrackets); AtomAsserta = AtomAdjust(AtomAsserta); TermAsserta = MkAtomTerm(AtomAsserta); AtomAssertaStatic = AtomAdjust(AtomAssertaStatic); TermAssertaStatic = MkAtomTerm(AtomAssertaStatic); AtomAssertz = AtomAdjust(AtomAssertz); TermAssertz = MkAtomTerm(AtomAssertz); @@ -493,7 +492,6 @@ FunctorDot9 = FuncAdjust(FunctorDot9); FunctorDoubleSlash = FuncAdjust(FunctorDoubleSlash); FunctorEmptySquareBrackets = FuncAdjust(FunctorEmptySquareBrackets); - FunctorEmptyCurlyBrackets = FuncAdjust(FunctorEmptyCurlyBrackets); FunctorEq = FuncAdjust(FunctorEq); FunctorError = FuncAdjust(FunctorError); FunctorEvaluationError = FuncAdjust(FunctorEvaluationError); diff --git a/H/generated/tatoms.h b/H/generated/tatoms.h index eef642851..3f061d0ab 100644 --- a/H/generated/tatoms.h +++ b/H/generated/tatoms.h @@ -32,7 +32,6 @@ EXTERNAL Atom AtomBeginCurlyBracket; EXTERNAL Term TermBeginCurlyBracket; EXTERNAL Atom AtomEndCurlyBracket; EXTERNAL Term TermEndCurlyBracket; EXTERNAL Atom AtomEmptyBrackets; EXTERNAL Term TermEmptyBrackets; EXTERNAL Atom AtomEmptySquareBrackets; EXTERNAL Term TermEmptySquareBrackets; -EXTERNAL Atom AtomEmptyCurlyBrackets; EXTERNAL Term TermEmptyCurlyBrackets; EXTERNAL Atom AtomAsserta; EXTERNAL Term TermAsserta; EXTERNAL Atom AtomAssertaStatic; EXTERNAL Term TermAssertaStatic; EXTERNAL Atom AtomAssertz; EXTERNAL Term TermAssertz; @@ -549,8 +548,6 @@ EXTERNAL Functor FunctorDoubleSlash; EXTERNAL Functor FunctorEmptySquareBrackets; -EXTERNAL Functor FunctorEmptyCurlyBrackets; - EXTERNAL Functor FunctorEq; EXTERNAL Functor FunctorError; diff --git a/include/YapError.h b/include/YapError.h index 22ebb3628..7fdb82142 100644 --- a/include/YapError.h +++ b/include/YapError.h @@ -41,11 +41,18 @@ struct yami *Yap_Error__(const char *file, const char *function, int lineno, yap_error_number err, YAP_Term wheret, ...); +void Yap_ThrowError__(const char *file, const char *function, int lineno, + yap_error_number err, YAP_Term wheret, ...); + + #define Yap_NilError(id, ...) \ Yap_Error__(__FILE__, __FUNCTION__, __LINE__, id, TermNil, __VA_ARGS__) #define Yap_Error(id, inp, ...) \ - Yap_Error__(__FILE__, __FUNCTION__, __LINE__, id, inp, __VA_ARGS__) +Yap_Error__(__FILE__, __FUNCTION__, __LINE__, id, inp, __VA_ARGS__) + +#define Yap_ThrowError(id, inp, ...) \ +Yap_ThrowError__(__FILE__, __FUNCTION__, __LINE__, id, inp, __VA_ARGS__) #ifdef YAP_TERM_H /** diff --git a/os/iopreds.c b/os/iopreds.c index f3255cbfa..a4e534d2e 100644 --- a/os/iopreds.c +++ b/os/iopreds.c @@ -1869,7 +1869,7 @@ void Yap_InitIOPreds(void) { Yap_InitReadTPreds(); Yap_InitFormat(); Yap_InitRandomPreds(); - #if USE_READLINE +#if USE_READLINE Yap_InitReadlinePreds(); #endif Yap_InitSockets(); diff --git a/os/iopreds.h b/os/iopreds.h index b547f11c0..5a60e64bf 100644 --- a/os/iopreds.h +++ b/os/iopreds.h @@ -151,7 +151,7 @@ bool Yap_DoPrompt(StreamDesc *s); Int Yap_peek(int sno); int Yap_MemPeekc(int sno); -char *Yap_syntax_error(TokEntry *tokptr, int sno); +Term Yap_syntax_error(TokEntry *tokptr, int sno); int console_post_process_read_char(int, StreamDesc *); int console_post_process_eof(StreamDesc *); diff --git a/os/readterm.c b/os/readterm.c index c5082664e..f1fea677c 100644 --- a/os/readterm.c +++ b/os/readterm.c @@ -95,7 +95,7 @@ static char SccsId[] = "%W% %G%"; #define SYSTEM_STAT stat #endif -static char *syntax_error(TokEntry *errtok, int sno, Term cmod); +static Term syntax_error(TokEntry *errtok, int sno, Term cmod); static void clean_vars(VarEntry *p) { if (p == NULL) @@ -215,7 +215,7 @@ static const param_t read_defs[] = {READ_DEFS()}; * Implicit arguments: * + */ -static char *syntax_error(TokEntry *errtok, int sno, Term cmod) { +static Term syntax_error(TokEntry *errtok, int sno, Term cmod) { CACHE_REGS Term info; Term startline, errline, endline; @@ -270,42 +270,21 @@ static char *syntax_error(TokEntry *errtok, int sno, Term cmod) { t0[0] = MkAtomTerm(Yap_LookupAtom("")); ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, t0); } break; - case WQuasiQuotes_tok: { - Term t0[2]; - t0[0] = MkAtomTerm(Yap_LookupAtom("")); - ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, t0); - } break; case Number_tok: - ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomNumber, 1), 1, &(tok->TokInfo)); + ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomNumber, 1), 1, &info); break; case Var_tok: { Term t[2]; VarEntry *varinfo = (VarEntry *)info; - t[0] = MkIntTerm(0); t[1] = Yap_CharsToString(varinfo->VarRep, ENC_ISO_LATIN1 PASS_REGS); ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomGVar, 2), 2, t); } break; case String_tok: { - Term t0 = Yap_CharsToTDQ((char *)info, cmod, ENC_ISO_LATIN1 PASS_REGS); - if (!t0) { - return 0; - } - ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0); - } break; - case WString_tok: { - Term t0 = Yap_WCharsToTDQ((wchar_t *)info, cmod PASS_REGS); - if (!t0) - return 0; - ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0); + ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &info); } break; case BQString_tok: { - Term t0 = Yap_CharsToTBQ((char *)info, cmod, ENC_ISO_LATIN1 PASS_REGS); - ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0); - } break; - case WBQString_tok: { - Term t0 = Yap_WCharsToTBQ((wchar_t *)info, cmod PASS_REGS); - ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0); + ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &info); } break; case Error_tok: { ts[0] = MkAtomTerm(AtomError); @@ -361,10 +340,10 @@ static char *syntax_error(TokEntry *errtok, int sno, Term cmod) { Yap_DebugPlWriteln(terr); } #endif - return NULL; + return terr; } -char *Yap_syntax_error(TokEntry *errtok, int sno) { +Term Yap_syntax_error(TokEntry *errtok, int sno) { return syntax_error(errtok, sno, CurrentModule); } @@ -798,21 +777,28 @@ static parser_state_t scan(REnv *re, FEnv *fe, int inp_stream) { LOCAL_tokptr = LOCAL_toktide = Yap_tokenizer(GLOBAL_Stream + inp_stream, false, &fe->tpos); - if (LOCAL_ErrorMessage) - return YAP_SCANNING_ERROR; - if (LOCAL_tokptr->Tok != Ord(eot_tok)) { - // next step - return YAP_PARSING; +#if DEBUG + if (GLOBAL_Option[2]) { + TokEntry *t = LOCAL_tokptr; + int n = 0; + while (t) { + fprintf(stderr, "[Token %d %s %d]", Ord(t->Tok), + Yap_tokRep(t, ENC_ISO_UTF8), n++); + t = t->TokNext; + } } - if (LOCAL_tokptr->Tok == eot_tok && LOCAL_tokptr->TokInfo == TermNl) { - size_t len = strlen("Empty clause"); - char *out = malloc(len + 1); - strncpy(out, "Empty clause", len); - LOCAL_ErrorMessage = out; - LOCAL_Error_TYPE = SYNTAX_ERROR; - return YAP_PARSING_ERROR; - } - return scanEOF(fe, inp_stream); +#endif +if (LOCAL_ErrorMessage) + return YAP_SCANNING_ERROR; +if (LOCAL_tokptr->Tok != Ord(eot_tok)) { + // next step + return YAP_PARSING; +} +if (LOCAL_tokptr->Tok == eot_tok && LOCAL_tokptr->TokInfo == TermNl) { + LOCAL_Error_TYPE = SYNTAX_ERROR; + return YAP_PARSING_ERROR; +} +return scanEOF(fe, inp_stream); } static parser_state_t scanError(REnv *re, FEnv *fe, int inp_stream) { @@ -1282,13 +1268,15 @@ X_API Term Yap_StringToTerm(const char *s, size_t len, encoding_t *encp, CACHE_REGS Term bvar = MkVarTerm(), ctl; yhandle_t sl; + int lvl = push_text_stack(); if (len == 0) { Term rval = TermEof; if (rval && bindings) { *bindings = TermNil; } - return rval; + pop_text_stack(lvl); + return rval; } if (bindings) { ctl = Yap_MkApplTerm(Yap_MkFunctor(AtomVariableNames, 1), 1, &bvar); @@ -1307,6 +1295,7 @@ X_API Term Yap_StringToTerm(const char *s, size_t len, encoding_t *encp, if (rval && bindings) { *bindings = Yap_PopHandle(sl); } + pop_text_stack(lvl); return rval; } diff --git a/pl/boot.yap b/pl/boot.yap index 116261646..5b6972631 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -174,7 +174,7 @@ list, since backtracking could not "pass through" the cut. system_module(_Mod, _SysExps, _Decls). % new_system_module(Mod). -use_system_module(_init, _SysExps). +use_system_module(Module, _SysExps). private(_). @@ -251,6 +251,7 @@ private(_). :- use_system_module( '$_strict_iso', ['$check_iso_strict_clause'/1, '$iso_check_goal'/2]). + '$early_print_message'(Level, Msg) :- '$pred_exists'(print_message(_,_), prolog), !, print_message( Level, Msg). @@ -658,7 +659,7 @@ number of steps. '$execute_command'(G, VL, Pos, Option, Source) :- '$continue_with_command'(Option, VL, Pos, G, Source). - + '$continue_with_command'(Where,V,'$stream_position'(C,_P,A1,A2,A3),'$source_location'(_F,L):G,Source) :- !, '$continue_with_command'(Where,V,'$stream_position'(C,L,A1,A2,A3),G,Source). @@ -1648,6 +1649,3 @@ log_event( String, Args ) :- /** @} */ - - - \ No newline at end of file diff --git a/pl/grammar.yap b/pl/grammar.yap index ec8a9382e..f073a3b73 100644 --- a/pl/grammar.yap +++ b/pl/grammar.yap @@ -109,7 +109,6 @@ prolog:'$translate_rule'(Rule, (NH :- B) ) :- ), t_tidy(B1, B). - t_head(V, _, _, _, _, G0) :- var(V), !, '$do_error'(instantiation_error,G0). t_head((H,List), NH, NGs, S, S1, G0) :- !,