diff --git a/C/atomic.c b/C/atomic.c index ea2aee3c0..d143de186 100755 --- a/C/atomic.c +++ b/C/atomic.c @@ -1,19 +1,20 @@ + /************************************************************************* -* * -* YAP Prolog * -* * -* Yap Prolog was developed at NCCUP - Universidade do Porto * -* * -* Copyright L.Damas, V. Santos Costa and Universidade do Porto 1985-- * -* * -************************************************************************** -* * -* File: atoms.c * -* comments: General-purpose C implemented system predicates * -* * -* Last rev: $Date: 2008-07-24 16:02:00 $,$Author: vsc $ * -* * -*************************************************************************/ + * * + * YAP Prolog * + * * + * Yap Prolog was developed at NCCUP - Universidade do Porto * + * * + * Copyright L.Damas, V. Santos Costa and Universidade do Porto 1985-- * + * * + ************************************************************************** + * * + * File: atoms.c * + * comments: General-purpose C implemented system predicates * + * * + * Last rev: $Date: 2008-07-24 16:02:00 $,$Author: vsc $ * + * * + *************************************************************************/ #ifdef SCCS static char SccsId[] = "%W% %G%"; #endif @@ -25,9 +26,10 @@ static char SccsId[] = "%W% %G%"; * @ingroup builtins * @{ -@brief The following predicates are used to manipulate atoms, strings, lists of codes and lists of chars: + @brief The following predicates are used to manipulate atoms, strings, lists of + codes and lists of chars: -\toc + \toc */ @@ -91,7 +93,7 @@ static int AlreadyHidden(unsigned char *name) { Notice that defining a new atom with the same characters will result in a different atom.xs - **/ +**/ static Int hide_atom(USES_REGS1) { /* hide(+Atom) */ Atom atomToInclude; Term t1 = Deref(ARG1); @@ -141,7 +143,7 @@ static Int hide_atom(USES_REGS1) { /* hide(+Atom) */ /** @pred hidden_atom( +Atom ) Is the atom _Ãtom_ visible to Prolog? - **/ +**/ static Int hidden_atom(USES_REGS1) { /* '$hidden_atom'(+F) */ Atom at; AtomEntry *chain; @@ -169,9 +171,9 @@ static Int hidden_atom(USES_REGS1) { /* '$hidden_atom'(+F) */ Make hidden atom _Atom_ visible Note that the operation fails if another atom with name _Atom_ was defined - since. + since. - **/ +**/ static Int unhide_atom(USES_REGS1) { /* unhide_atom(+Atom) */ AtomEntry *atom, *old, *chain; Term t1 = Deref(ARG1); @@ -210,16 +212,16 @@ static Int unhide_atom(USES_REGS1) { /* unhide_atom(+Atom) */ return (TRUE); } - /** @pred char_code(? _A_,? _I_) is iso +/** @pred char_code(? _A_,? _I_) is iso - The built-in succeeds with _A_ bound to character represented as an - atom, and _I_ bound to the character code represented as an - integer. At least, one of either _A_ or _I_ must be bound before - the call. + The built-in succeeds with _A_ bound to character represented as an + atom, and _I_ bound to the character code represented as an + integer. At least, one of either _A_ or _I_ must be bound before + the call. - */ +*/ static Int char_code(USES_REGS1) { Int t0 = Deref(ARG1); if (IsVarTerm(t0)) { @@ -278,50 +280,52 @@ static Int char_code(USES_REGS1) { } } - /** @pred name( _A_, _L_) +/** @pred name( _A_, _L_) - The predicate holds when at least one of the arguments is ground - (otherwise, an error message will be displayed). The argument _A_ will - be unified with an atomic symbol and _L_ with the list of the ASCII - codes for the characters of the external representation of _A_. + The predicate holds when at least one of the arguments is ground + (otherwise, an error message will be displayed). The argument _A_ will + be unified with an atomic symbol and _L_ with the list of the ASCII + codes for the characters of the external representation of _A_. - ~~~~~{.prolog} - name(yap,L). - ~~~~~ - will return: + ~~~~~{.prolog} + name(yap,L). + ~~~~~ + will return: - ~~~~~{.prolog} - L = [121,97,112]. - ~~~~~ - and + ~~~~~{.prolog} + L = [121,97,112]. + ~~~~~ + and - ~~~~~{.prolog} - name(3,L). - ~~~~~ - will return: + ~~~~~{.prolog} + name(3,L). + ~~~~~ + will return: - ~~~~~{.prolog} - L = [51]. - ~~~~~ + ~~~~~{.prolog} + L = [51]. + ~~~~~ - */ +*/ static Int name(USES_REGS1) { /* name(?Atomic,?String) */ Term t2 = Deref(ARG2), NewT, t1 = Deref(ARG1); LOCAL_MAX_SIZE = 1024; - int l = push_text_stack(); - restart_aux: + +restart_aux: if (Yap_IsGroundTerm(t1)) { if (!IsVarTerm(t2) && !IsPairTerm(t2) && t2 != TermNil) { Yap_Error(TYPE_ERROR_LIST, ARG2, "name/2"); - ReleaseAndReturn(FALSE); + pop_text_stack(l); + return false; } // verify if an atom, int, float or bi§gnnum NewT = Yap_AtomicToListOfCodes(t1 PASS_REGS); if (NewT) { - ReleaseAndReturn(Yap_unify(NewT, ARG2)); + pop_text_stack(l); + return Yap_unify(NewT, ARG2); } // else } else if (IsVarTerm(t2)) { @@ -332,7 +336,7 @@ static Int name(USES_REGS1) { /* name(?Atomic,?String) */ Term at = Yap_ListToAtomic(t2 PASS_REGS); if (at) { pop_text_stack(l); - ReleaseAndReturn(Yap_unify(at, ARG1)); + return Yap_unify(at, ARG1); } } if (LOCAL_Error_TYPE && Yap_HandleError("atom/2")) { @@ -341,7 +345,7 @@ static Int name(USES_REGS1) { /* name(?Atomic,?String) */ goto restart_aux; } pop_text_stack(l); - ReleaseAndReturn(false); + return false; } static Int string_to_atomic( @@ -356,14 +360,14 @@ restart_aux: t = Yap_StringToAtomic(t1 PASS_REGS); if (t != 0L) { pop_text_stack(l); - ReleaseAndReturn(Yap_unify(t, t2)); + return Yap_unify(t, t2); } // else } else if (IsVarTerm(t1)) { Term t0 = Yap_AtomicToString(t2 PASS_REGS); if (t0) { pop_text_stack(l); - ReleaseAndReturn(Yap_unify(t0, t1)); + return Yap_unify(t0, t1); } } else { LOCAL_Error_TYPE = TYPE_ERROR_STRING; @@ -374,35 +378,35 @@ restart_aux: goto restart_aux; } pop_text_stack(l); - ReleaseAndReturn(FALSE); + return false; } - /// @pred atomic_to_string(?Atomic.?String) // // reverse to string_to_atomic(_Atomic_, _String_). // The second argument may be a sequence of codes or atoms. // -static Int atomic_to_string( - USES_REGS1) { - Term t1 = ARG1; ARG1 = ARG2, ARG2 = t1; +static Int atomic_to_string(USES_REGS1) { + Term t1 = ARG1; + ARG1 = ARG2, ARG2 = t1; return string_to_atomic(PASS_REGS1); } /// @pred string_to_atom(?String, ?Atom) // -// Verifies if (a) at least one of the argument is bound. If _String_ -// is bound it must be a string term, list if codes, or list of atoms, -// and _Atom_ musr be bound to a symbol with the same text. Otherwise, -// _Atom_ must be an _Atom_ and _String_ will unify with a string term -// of the same text. +// Verifies if (a) at least one of the argument is bound. If +// _String_ is bound it must be a string term, list if codes, or +// list of atoms, and _Atom_ musr be bound to a symbol with the +// same text. Otherwise, _Atom_ must be an _Atom_ and _String_ +// will unify with a string term of the same text. // // Notes: -// - some versions of YAP allow the first argument to be a number. Please use -// atomic_to_string/2 in this YAP. -// -static Int string_to_atom( - USES_REGS1) { /* string_to_atom(?String,?Atom) */ +// - some versions of YAP allow the first argument to be a +// number. Please use +// atomic_to_string/2 in this YAP. +// +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(); @@ -414,14 +418,14 @@ restart_aux: at = Yap_StringSWIToAtom(t1 PASS_REGS); if (at) { pop_text_stack(l); - ReleaseAndReturn(Yap_unify(MkAtomTerm(at), t2)); + return Yap_unify(MkAtomTerm(at), t2); } // else } else if (IsVarTerm(t1)) { Term t0 = Yap_AtomSWIToString(t2 PASS_REGS); if (t0) { pop_text_stack(l); - ReleaseAndReturn(Yap_unify(t0, t1)); + return Yap_unify(t0, t1); } } else { LOCAL_Error_TYPE = TYPE_ERROR_ATOM; @@ -432,21 +436,22 @@ restart_aux: goto restart_aux; } pop_text_stack(l); - ReleaseAndReturn(FALSE); + return false; } - /// @pred atom_to_string(?Atom.?String) // -// reverse to string_to_atom(_Atom_, _String_). -// The second argument may be a sequence of codes or atoms. -// -static Int atom_to_string( - USES_REGS1) { /* string_to_atom(?String,?Atom) */ - Term t2 = ARG1; ARG1 = ARG2; ARG2 = t2; +// reverse to string_to_atom(_Atom_, _String_). +// The second argument may be a sequence of codes or +// atoms. +// +static Int atom_to_string(USES_REGS1) { /* string_to_atom(?String,?Atom) + */ + Term t2 = ARG1; + ARG1 = ARG2; + ARG2 = t2; return string_to_atom(PASS_REGS1); - } - +} static Int string_to_list(USES_REGS1) { Term list = Deref(ARG2), string = Deref(ARG1); @@ -458,12 +463,14 @@ restart_aux: Term t1 = Yap_ListToString(list PASS_REGS); if (t1) { pop_text_stack(l); - ReleaseAndReturn(Yap_unify(ARG1, t1)); + return Yap_unify(ARG1, t1); } } else if (IsStringTerm(string)) { Term tf = Yap_StringToListOfCodes(string PASS_REGS); - pop_text_stack(l); - ReleaseAndReturn(Yap_unify(ARG2, tf)); + { + pop_text_stack(l); + return Yap_unify(ARG2, tf); + } } else { LOCAL_Error_TYPE = TYPE_ERROR_STRING; } @@ -472,16 +479,18 @@ restart_aux: list = Deref(ARG2); goto restart_aux; } - pop_text_stack(l); - ReleaseAndReturn(FALSE); + { + pop_text_stack(l); + return false; + } } - /// @pred atom_string(?Atom.?String) // -// reverse to string_to_atom(_Atom_, _String_). -// The second argument may be a sequence of codes or atoms. -// +// reverse to string_to_atom(_Atom_, _String_). +// The second argument may be a sequence of codes or +// atoms. +// static Int atom_string(USES_REGS1) { Term t1 = Deref(ARG1), t2 = Deref(ARG2); LOCAL_MAX_SIZE = 1024; @@ -493,14 +502,19 @@ restart_aux: // verify if an atom, int, float or bignnum at = Yap_StringSWIToAtom(t2 PASS_REGS); if (at) { - ReleaseAndReturn(Yap_unify(MkAtomTerm(at), t1)); + { + pop_text_stack(l); + return Yap_unify(MkAtomTerm(at), t1); + } } - LOCAL_Error_TYPE = YAP_NO_ERROR; + LOCAL_Error_TYPE = YAP_NO_ERROR; // else } else if (IsAtomTerm(t1)) { Term t0 = Yap_AtomSWIToString(t1 PASS_REGS); - if (t0) - ReleaseAndReturn(Yap_unify(t0, t2)); + if (t0) { + pop_text_stack(l); + return Yap_unify(t0, t2); + } } else { LOCAL_Error_TYPE = TYPE_ERROR_ATOM; } @@ -509,28 +523,33 @@ restart_aux: t2 = Deref(ARG2); goto restart_aux; } - ReleaseAndReturn(FALSE); + { + pop_text_stack(l); + return false; + } } -// The second argument may be a sequence of codes or atoms. -// -static Int string_atom( - USES_REGS1) { /* string_to_atom(?String,?Atom) */ - Term t2 = ARG1; ARG1 = ARG2; ARG2 = t2; +// The second argument may be a sequence of codes or +// atoms. +// +static Int string_atom(USES_REGS1) { /* string_to_atom(?String,?Atom) + */ + Term t2 = ARG1; + ARG1 = ARG2; + ARG2 = t2; return atom_string(PASS_REGS1); - } +} + +/** @pred atom_chars(? _A_,? _L_) is iso - /** @pred atom_chars(? _A_,? _L_) is iso + The predicate holds when at least one of the arguments is + ground (otherwise, an error message will be displayed). + The argument _A_ must be unifiable with an atom, and the + argument _L_ with the list of the characters of _A_. - The predicate holds when at least one of the arguments is ground - (otherwise, an error message will be displayed). The argument _A_ must - be unifiable with an atom, and the argument _L_ with the list of the - characters of _A_. - - - */ +*/ static Int atom_chars(USES_REGS1) { Term t1; LOCAL_MAX_SIZE = 1024; @@ -540,14 +559,18 @@ restart_aux: t1 = Deref(ARG1); if (IsAtomTerm(t1)) { Term tf = Yap_AtomSWIToListOfAtoms(t1 PASS_REGS); - if (tf) - ReleaseAndReturn(Yap_unify(ARG2, tf)); + if (tf) { + pop_text_stack(l); + return Yap_unify(ARG2, tf); + } } else if (IsVarTerm(t1)) { /* ARG1 unbound */ Term t = Deref(ARG2); Atom af = Yap_ListOfAtomsToAtom(t PASS_REGS); - if (af) - ReleaseAndReturn(Yap_unify(ARG1, MkAtomTerm(af))); + if (af) { + pop_text_stack(l); + return Yap_unify(ARG1, MkAtomTerm(af)); + } /* error handling */ } else { LOCAL_Error_TYPE = TYPE_ERROR_ATOM; @@ -555,7 +578,10 @@ restart_aux: if (LOCAL_Error_TYPE && Yap_HandleError("atom_chars/2")) { goto restart_aux; } - ReleaseAndReturn(false); + { + pop_text_stack(l); + return false; + } } static Int atom_codes(USES_REGS1) { @@ -565,14 +591,18 @@ static Int atom_codes(USES_REGS1) { restart_aux: if (IsAtomTerm(t1)) { Term tf = Yap_AtomToListOfCodes(t1 PASS_REGS); - if (tf) - ReleaseAndReturn(Yap_unify(ARG2, tf)); + if (tf) { + pop_text_stack(l); + return Yap_unify(ARG2, tf); + } } else if (IsVarTerm(t1)) { /* ARG1 unbound */ Term t = Deref(ARG2); Atom af = Yap_ListToAtom(t PASS_REGS); - if (af) - ReleaseAndReturn(Yap_unify(ARG1, MkAtomTerm(af))); + if (af) { + pop_text_stack(l); + return Yap_unify(ARG1, MkAtomTerm(af)); + } } else if (IsVarTerm(t1)) { LOCAL_Error_TYPE = TYPE_ERROR_ATOM; } @@ -581,7 +611,10 @@ restart_aux: t1 = Deref(ARG1); goto restart_aux; } - ReleaseAndReturn(FALSE); + { + pop_text_stack(l); + return false; + } } static Int string_codes(USES_REGS1) { @@ -591,14 +624,18 @@ static Int string_codes(USES_REGS1) { restart_aux: if (IsStringTerm(t1)) { Term tf = Yap_StringSWIToListOfCodes(t1 PASS_REGS); - if (tf) - ReleaseAndReturn(Yap_unify(ARG2, tf)); + if (tf) { + pop_text_stack(l); + return Yap_unify(ARG2, tf); + } } else if (IsVarTerm(t1)) { /* ARG1 unbound */ Term t = Deref(ARG2); Term tf = Yap_ListSWIToString(t PASS_REGS); - if (tf) - ReleaseAndReturn(Yap_unify(ARG1, tf)); + if (tf) { + pop_text_stack(l); + return Yap_unify(ARG1, tf); + } } else { LOCAL_Error_TYPE = TYPE_ERROR_STRING; } @@ -607,7 +644,10 @@ restart_aux: t1 = Deref(ARG1); goto restart_aux; } - ReleaseAndReturn(FALSE); + { + pop_text_stack(l); + return false; + } } static Int string_chars(USES_REGS1) { @@ -617,14 +657,18 @@ static Int string_chars(USES_REGS1) { restart_aux: if (IsStringTerm(t1)) { Term tf = Yap_StringSWIToListOfAtoms(t1 PASS_REGS); - if (tf) - ReleaseAndReturn(Yap_unify(ARG2, tf)); + if (tf) { + pop_text_stack(l); + return Yap_unify(ARG2, tf); + } } else if (IsVarTerm(t1)) { /* ARG1 unbound */ Term t = Deref(ARG2); Term tf = Yap_ListSWIToString(t PASS_REGS); - if (tf) - ReleaseAndReturn(Yap_unify(ARG1, tf)); + if (tf) { + pop_text_stack(l); + return Yap_unify(ARG1, tf); + } } else { LOCAL_Error_TYPE = TYPE_ERROR_STRING; } @@ -633,15 +677,19 @@ restart_aux: t1 = Deref(ARG1); goto restart_aux; } - ReleaseAndReturn(FALSE); + { + pop_text_stack(l); + return false; + } } /** @pred number_chars(? _I_,? _L_) is iso -The predicate holds when at least one of the arguments is ground -(otherwise, an error message will be displayed). The argument _I_ must -be unifiable with a number, and the argument _L_ with the list of the -characters of the external representation of _I_. + The predicate holds when at least one of the arguments is + ground (otherwise, an error message will be displayed). + The argument _I_ must be unifiable with a number, and the + argument _L_ with the list of the characters of the + external representation of _I_. */ static Int number_chars(USES_REGS1) { @@ -655,11 +703,9 @@ restart_aux: t1 = Yap_NumberToListOfAtoms(t1 PASS_REGS); } if (t1) { - ReleaseAndReturn(Yap_unify(t1, t2)); - } else { - t2 = Yap_ListToNumber(t2 PASS_REGS); - if (t2) { - ReleaseAndReturn(Yap_unify(t1, t2)); + { + pop_text_stack(l); + return Yap_unify(t1, t2); } } } else if (IsVarTerm(t1)) { @@ -667,7 +713,10 @@ restart_aux: Term t = Deref(ARG2); Term tf = Yap_ListToNumber(t PASS_REGS); if (tf) { - ReleaseAndReturn(Yap_unify(ARG1, tf)); + { + pop_text_stack(l); + return Yap_unify(ARG1, tf); + } } } else if (IsVarTerm(t1)) { LOCAL_Error_TYPE = TYPE_ERROR_NUMBER; @@ -676,20 +725,24 @@ restart_aux: if (LOCAL_Error_TYPE && Yap_HandleError("number_chars/2")) { goto restart_aux; } - ReleaseAndReturn(false); + { + pop_text_stack(l); + return false; + } } - /** @pred number_atom(? _I_,? _A_) +/** @pred number_atom(? _I_,? _A_) - The predicate holds when at least one of the arguments is ground - (otherwise, an error message will be displayed). The argument _I_ must - be unifiable with a number, and the argument _A_ must be unifiable - with an atom representing the number. + The predicate holds when at least one of the arguments is + ground (otherwise, an error message will be displayed). + The argument _I_ must be unifiable with a number, and the + argument _A_ must be unifiable with an atom representing + the number. - */ +*/ static Int number_atom(USES_REGS1) { Term t1; int l = push_text_stack(); @@ -702,11 +755,17 @@ restart_aux: if (af) { if (IsVarTerm(t2)) { - ReleaseAndReturn(Yap_unify(t1, t2)); + { + pop_text_stack(l); + return Yap_unify(t1, t2); + } } else { t2 = Yap_AtomToNumber(t2 PASS_REGS); if (t2) { - ReleaseAndReturn(Yap_unify(t1, t2)); + { + pop_text_stack(l); + return Yap_unify(t1, t2); + } } } } @@ -714,26 +773,33 @@ restart_aux: /* ARG1 unbound */ Term t = Deref(ARG2); Term tf = Yap_AtomToNumber(t PASS_REGS); - ReleaseAndReturn(Yap_unify(ARG1, tf)); + { + pop_text_stack(l); + return 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; } - ReleaseAndReturn(false); + { + pop_text_stack(l); + return false; + } } - /** @pred number_string(? _I_,? _L_) +/** @pred number_string(? _I_,? _L_) - The predicate holds when at least one of the arguments is ground - (otherwise, an error message will be displayed). The argument _I_ must - be unifiable with a number, and the argument _L_ must be unifiable - with a term string representing the number. + The predicate holds when at least one of the arguments is + ground (otherwise, an error message will be displayed). + The argument _I_ must be unifiable with a number, and the + argument _L_ must be unifiable with a term string + representing the number. - */ +*/ static Int number_string(USES_REGS1) { Term t1; @@ -743,14 +809,18 @@ restart_aux: if (IsNumTerm(t1)) { Term tf; tf = Yap_NumberToString(t1 PASS_REGS); - if (tf) - ReleaseAndReturn(Yap_unify(ARG2, tf)); + if (tf) { + pop_text_stack(l); + return Yap_unify(ARG2, tf); + } } else if (IsVarTerm(t1)) { /* ARG1 unbound */ Term t = Deref(ARG2); Term tf = Yap_StringToNumber(t PASS_REGS); - if (tf) - ReleaseAndReturn(Yap_unify(ARG1, tf)); + if (tf) { + pop_text_stack(l); + return Yap_unify(ARG1, tf); + } } else { LOCAL_Error_TYPE = TYPE_ERROR_NUMBER; } @@ -758,19 +828,23 @@ restart_aux: if (LOCAL_Error_TYPE && Yap_HandleError("number_string/2")) { goto restart_aux; } - ReleaseAndReturn(FALSE); + { + pop_text_stack(l); + return false; + } } - /** @pred number_codes(? _I_,? _L_) +/** @pred number_codes(? _I_,? _L_) - The predicate holds when at least one of the arguments is ground - (otherwise, an error message will be displayed). The argument _I_ must - be unifiable with a number, and the argument _L_ must be unifiable - with a list of UNICODE numbers representing the number. + The predicate holds when at least one of the arguments is + ground (otherwise, an error message will be displayed). + The argument _I_ must be unifiable with a number, and the + argument _L_ must be unifiable with a list of UNICODE + numbers representing the number. - */ +*/ static Int number_codes(USES_REGS1) { Term t1; int l = push_text_stack(); @@ -779,14 +853,18 @@ restart_aux: if (IsNumTerm(t1)) { Term tf; tf = Yap_NumberToListOfCodes(t1 PASS_REGS); - if (tf) - ReleaseAndReturn(Yap_unify(ARG2, tf)); + if (tf) { + pop_text_stack(l); + return Yap_unify(ARG2, tf); + } } else if (IsVarTerm(t1)) { /* ARG1 unbound */ Term t = Deref(ARG2); Term tf = Yap_ListToNumber(t PASS_REGS); - if (tf) - ReleaseAndReturn(Yap_unify(ARG1, tf)); + if (tf) { + pop_text_stack(l); + return Yap_unify(ARG1, tf); + } } else { LOCAL_Error_TYPE = TYPE_ERROR_NUMBER; } @@ -794,11 +872,13 @@ restart_aux: if (LOCAL_Error_TYPE && Yap_HandleError("number_codes/2")) { goto restart_aux; } - ReleaseAndReturn(FALSE); + { + pop_text_stack(l); + return false; + } } -static Int -cont_atom_concat3(USES_REGS1) { +static Int cont_atom_concat3(USES_REGS1) { Term t3; Atom ats[2]; Int i, max; @@ -810,26 +890,27 @@ 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) { - release_cut_fail(); + pop_text_stack(l); + cut_fail(); } else { + pop_text_stack(l); if (i < max) { - ReleaseAndReturn(Yap_unify(ARG1, MkAtomTerm(ats[0])) && - Yap_unify(ARG2, MkAtomTerm(ats[1]))); + return (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]))) - release_cut_succeed(); - release_cut_fail(); + cut_succeed(); + cut_fail(); } /* Error handling */ if (LOCAL_Error_TYPE) { if (Yap_HandleError("atom_concat/3")) { goto restart_aux; - } else { - ReleaseAndReturn(false); } + return false; } - release_cut_fail(); + cut_fail(); } static Int atom_concat3(USES_REGS1) { @@ -855,19 +936,27 @@ restart_aux: at = Yap_SubtractTailAtom(t3, t2 PASS_REGS); ot = ARG1; } else if (g3) { + Int len = Yap_AtomToUnicodeLength(t3 PASS_REGS); + if (len <= 0) { + pop_text_stack(l); + cut_fail(); + } EXTRA_CBACK_ARG(3, 1) = MkIntTerm(0); - EXTRA_CBACK_ARG(3, 2) = MkIntTerm(Yap_AtomToUnicodeLength(t3 PASS_REGS)); - ReleaseAndReturn(cont_atom_concat3(PASS_REGS1)); + EXTRA_CBACK_ARG(3, 2) = MkIntTerm(len); + { + pop_text_stack(l); + return cont_atom_concat3(PASS_REGS1); + } } else { LOCAL_Error_TYPE = INSTANTIATION_ERROR; at = NULL; } - pop_text_stack(l); if (at) { + pop_text_stack(l); if (Yap_unify(ot, MkAtomTerm(at))) { - release_cut_succeed(); + cut_succeed(); } else { - release_cut_fail(); + cut_fail(); } } /* Error handling */ @@ -875,19 +964,25 @@ restart_aux: if (Yap_HandleError("atom_concat/3")) { goto restart_aux; } else { - ReleaseAndReturn(false); + { + pop_text_stack(l); + return false; + } } } - release_cut_fail(); + pop_text_stack(l); + cut_fail(); } #define CastToNumeric(x) CastToNumeric__(x PASS_REGS) static Term CastToNumeric__(Atom at USES_REGS) { Term t; - if ((t = Yap_AtomToNumber(MkAtomTerm(at) PASS_REGS))) + if ((t = Yap_AtomToNumber(MkAtomTerm(at) PASS_REGS))) { return t; - return MkAtomTerm(at); + } else { + return MkAtomTerm(at); + } } static Int cont_atomic_concat3(USES_REGS1) { @@ -901,25 +996,30 @@ restart_aux: max = IntOfTerm(EXTRA_CBACK_ARG(3, 2)); EXTRA_CBACK_ARG(3, 1) = MkIntTerm(i + 1); if (!Yap_SpliceAtom(t3, ats, i, max PASS_REGS)) { - release_cut_fail(); + cut_fail(); } else { Term t1 = CastToNumeric(ats[0]); Term t2 = CastToNumeric(ats[1]); - if (i < max) - ReleaseAndReturn(Yap_unify(ARG1, t1) && Yap_unify(ARG2, t2)); + if (i < max) { + pop_text_stack(l); + return Yap_unify(ARG1, t1) && Yap_unify(ARG2, t2); + } if (Yap_unify(ARG1, t1) && Yap_unify(ARG2, t2)) - release_cut_succeed(); - release_cut_fail(); + cut_succeed(); + cut_fail(); } /* Error handling */ if (LOCAL_Error_TYPE) { if (Yap_HandleError("string_concat/3")) { goto restart_aux; } else { - ReleaseAndReturn(FALSE); + { + pop_text_stack(l); + return false; + } } } - release_cut_fail(); + cut_fail(); } static Int atomic_concat3(USES_REGS1) { @@ -945,18 +1045,27 @@ restart_aux: at = Yap_SubtractTailAtom(t3, t2 PASS_REGS); ot = ARG1; } else if (g3) { + Int len = Yap_AtomicToUnicodeLength(t3 PASS_REGS); + if (len <= 0) { + pop_text_stack(l); + cut_fail(); + } EXTRA_CBACK_ARG(3, 1) = MkIntTerm(0); - EXTRA_CBACK_ARG(3, 2) = MkIntTerm(Yap_AtomicToUnicodeLength(t3 PASS_REGS)); - return cont_atomic_concat3(PASS_REGS1); + EXTRA_CBACK_ARG(3, 2) = MkIntTerm(len); + { + pop_text_stack(l); + return cont_atomic_concat3(PASS_REGS1); + } } else { LOCAL_Error_TYPE = INSTANTIATION_ERROR; at = NULL; } if (at) { + pop_text_stack(l); if (Yap_unify(ot, MkAtomTerm(at))) { - release_cut_succeed(); + cut_succeed(); } else { - release_cut_fail(); + cut_fail(); } } /* Error handling */ @@ -964,10 +1073,14 @@ restart_aux: if (Yap_HandleError("atomic_concat/3")) { goto restart_aux; } else { - return false; + { + pop_text_stack(l); + return false; + } } } - release_cut_fail(); + pop_text_stack(l); + cut_fail(); } static Int cont_string_concat3(USES_REGS1) { @@ -975,33 +1088,35 @@ static Int cont_string_concat3(USES_REGS1) { Term ts[2]; size_t i, max; int l; + l = push_text_stack(); restart_aux: - l = push_text_stack(); 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)) { - pop_text_stack(l); - release_cut_fail(); + cut_fail(); } else { - pop_text_stack(l); - if (i < max) + if (i < max) { + pop_text_stack(l); return Yap_unify(ARG1, ts[0]) && Yap_unify(ARG2, ts[1]); + } if (Yap_unify(ARG1, ts[0]) && Yap_unify(ARG2, ts[1])) - release_cut_succeed(); - release_cut_fail(); + cut_succeed(); + cut_fail(); } - pop_text_stack(l); /* Error handling */ if (LOCAL_Error_TYPE) { if (Yap_HandleError("string_concat/3")) { goto restart_aux; } else { - return FALSE; + { + pop_text_stack(l); + return FALSE; + } } } - release_cut_fail(); + cut_fail(); } static Int string_concat3(USES_REGS1) { @@ -1010,8 +1125,8 @@ static Int string_concat3(USES_REGS1) { Term tf = 0; bool g1, g2, g3; int l; + l = push_text_stack(); restart_aux: - l = push_text_stack(); t1 = Deref(ARG1); t2 = Deref(ARG2); t3 = Deref(ARG3); @@ -1020,28 +1135,35 @@ restart_aux: g3 = Yap_IsGroundTerm(t3); if (g1 && g2) { - tf = Yap_ConcatStrings(t1, t2 PASS_REGS); + tf = Yap_ConcatStrings(t1, t2 PASS_REGS); ot = ARG3; } else if (g1 && g3) { - tf = Yap_SubtractHeadString(t3, t1 PASS_REGS); + tf = Yap_SubtractHeadString(t3, t1 PASS_REGS); ot = ARG2; } else if (g2 && g3) { - tf = Yap_SubtractTailString(t3, t2 PASS_REGS); + tf = Yap_SubtractTailString(t3, t2 PASS_REGS); ot = ARG1; } else if (g3) { + Int len = Yap_StringToUnicodeLength(t3 PASS_REGS); + if (len <= 0) { + pop_text_stack(l); + cut_fail(); + } EXTRA_CBACK_ARG(3, 1) = MkIntTerm(0); - EXTRA_CBACK_ARG(3, 2) = MkIntTerm(Yap_StringToUnicodeLength(t3 PASS_REGS)); - pop_text_stack(l); - return cont_string_concat3(PASS_REGS1); + EXTRA_CBACK_ARG(3, 2) = MkIntTerm(len); + { + pop_text_stack(l); + return cont_string_concat3(PASS_REGS1); + } } else { - LOCAL_Error_TYPE = INSTANTIATION_ERROR; + LOCAL_Error_TYPE = INSTANTIATION_ERROR; } - pop_text_stack(l); if (tf) { + pop_text_stack(l); if (Yap_unify(ot, tf)) { - release_cut_succeed(); + cut_succeed(); } else { - release_cut_fail(); + cut_fail(); } } /* Error handling */ @@ -1049,10 +1171,14 @@ restart_aux: if (Yap_HandleError("atom_concat/3")) { goto restart_aux; } else { - ReleaseAndReturn(false); + { + pop_text_stack(l); + return false; + } } } - release_cut_fail(); + pop_text_stack(l); + cut_fail(); } static Int cont_string_code3(USES_REGS1) { @@ -1062,36 +1188,40 @@ static Int cont_string_code3(USES_REGS1) { const unsigned char *s; const unsigned char *s0; int l; -restart_aux: l = push_text_stack(); +restart_aux: t2 = Deref(ARG2); s0 = UStringOfTerm(t2); i = IntOfTerm( EXTRA_CBACK_ARG(3, 1)); // offset in coded string, increases by 1..6 - j = IntOfTerm( - EXTRA_CBACK_ARG(3, 2)); // offset in UNICODE string, always increases by 1 + j = IntOfTerm(EXTRA_CBACK_ARG(3, 2)); // offset in UNICODE + // string, always + // increases by 1 s = (s0 + i) + get_utf8((unsigned char *)s0 + i, -1, &chr); if (s[0]) { EXTRA_CBACK_ARG(3, 1) = MkIntTerm(s - s0); EXTRA_CBACK_ARG(3, 2) = MkIntTerm(j + 1); - ReleaseAndReturn(Yap_unify(MkIntegerTerm(chr), ARG3) && - Yap_unify(MkIntegerTerm(j + 1), ARG1)); + return (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(); + cut_succeed(); } else { - release_cut_fail(); + cut_fail(); } /* Error handling */ if (LOCAL_Error_TYPE) { if (Yap_HandleError("string_code/3")) { goto restart_aux; } else { - ReleaseAndReturn(FALSE); + { + pop_text_stack(l); + return false; + } } } - release_cut_fail(); + cut_fail(); } static Int string_code3(USES_REGS1) { @@ -1112,7 +1242,10 @@ restart_aux: if (IsVarTerm(t1)) { EXTRA_CBACK_ARG(3, 1) = MkIntTerm(0); EXTRA_CBACK_ARG(3, 2) = MkIntTerm(0); - return cont_string_code3(PASS_REGS1); + { + pop_text_stack(l); + return cont_string_code3(PASS_REGS1); + } } else if (!IsIntegerTerm(t1)) { LOCAL_Error_TYPE = TYPE_ERROR_INTEGER; } else { @@ -1123,18 +1256,18 @@ restart_aux: if (indx < 0) { LOCAL_Error_TYPE = DOMAIN_ERROR_NOT_LESS_THAN_ZERO; } - release_cut_fail(); + cut_fail(); } ns = skip_utf8(s, indx); if (ns == NULL) { - release_cut_fail(); // silently fail? + cut_fail(); // silently fail? } get_utf8(ns, -1, &chr); if (chr == '\0') - release_cut_fail(); + cut_fail(); if (Yap_unify(ARG3, MkIntegerTerm(chr))) - release_cut_succeed(); - release_cut_fail(); + cut_succeed(); + cut_fail(); } } /* Error handling */ @@ -1142,17 +1275,19 @@ restart_aux: if (Yap_HandleError("string_code/3")) { goto restart_aux; } else { - ReleaseAndReturn(FALSE); + { + pop_text_stack(l); + return false; + } } } - release_cut_fail(); + 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); @@ -1170,38 +1305,38 @@ restart_aux: LOCAL_Error_TYPE = TYPE_ERROR_INTEGER; } else { const unsigned char *ns = s; - utf8proc_int32_t chr; Int indx = IntegerOfTerm(t1); if (indx <= 0) { if (indx < 0) { LOCAL_Error_TYPE = DOMAIN_ERROR_NOT_LESS_THAN_ZERO; } else { - ReleaseAndReturn(false); + return false; } } else { indx -= 1; ns = skip_utf8(ns, indx); if (ns == NULL) { - ReleaseAndReturn(false); - } else { - get_utf8(ns, -1, &chr); - if (chr != '\0') - ReleaseAndReturn(Yap_unify(ARG3, MkIntegerTerm(chr))); + return false; } } - ReleaseAndReturn(FALSE); // replace by error cod )e + utf8proc_int32_t chr; + get_utf8(ns, -1, &chr); + if (chr != '\0') { + return Yap_unify(ARG3, MkIntegerTerm(chr)); + } + return false; } - } + } // replace by error cod )e /* Error handling */ if (LOCAL_Error_TYPE) { if (Yap_HandleError("string_code/3")) { goto restart_aux; } else { - ReleaseAndReturn(FALSE); + return false; } } - release_cut_fail(); + cut_fail(); } static Int atom_concat2(USES_REGS1) { @@ -1215,13 +1350,12 @@ restart_aux: if (*tailp != TermNil) { LOCAL_Error_TYPE = TYPE_ERROR_LIST; } else { - seq_tv_t *inpv = (seq_tv_t *)malloc(n * sizeof(seq_tv_t)), out; + seq_tv_t *inpv = (seq_tv_t *)Malloc(n * sizeof(seq_tv_t)), out; int i = 0; Atom at; if (!inpv) { LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP; - free(inpv); goto error; } @@ -1233,13 +1367,13 @@ restart_aux: } out.type = YAP_STRING_ATOM; if (!Yap_Concat_Text(n, inpv, &out PASS_REGS)) { - free(inpv); goto error; } - free(inpv); at = out.val.a; - if (at) - ReleaseAndReturn(Yap_unify(ARG2, MkAtomTerm(at))); + if (at) { + pop_text_stack(l); + return Yap_unify(ARG2, MkAtomTerm(at)); + } } error: /* Error handling */ @@ -1247,10 +1381,11 @@ error: if (Yap_HandleError("atom_concat/2")) { goto restart_aux; } else { - ReleaseAndReturn(FALSE); + pop_text_stack(l); + return false; } } - release_cut_fail(); + cut_fail(); } static Int string_concat2(USES_REGS1) { @@ -1285,8 +1420,10 @@ restart_aux: goto error; } free(inpv); - if (out.val.t) - ReleaseAndReturn(Yap_unify(ARG2, out.val.t)); + if (out.val.t) { + pop_text_stack(l); + return Yap_unify(ARG2, out.val.t); + } } error: /* Error handling */ @@ -1294,10 +1431,13 @@ error: if (Yap_HandleError("string_code/3")) { goto restart_aux; } else { - ReleaseAndReturn(FALSE); + { + pop_text_stack(l); + return false; + } } } - release_cut_fail(); + cut_fail(); } static Int atomic_concat2(USES_REGS1) { @@ -1315,8 +1455,10 @@ restart_aux: int i = 0; Atom at; - if (n == 1) - ReleaseAndReturn(Yap_unify(ARG2, HeadOfTerm(t1))); + if (n == 1) { + pop_text_stack(l); + return Yap_unify(ARG2, HeadOfTerm(t1)); + } if (!inpv) { LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP; free(inpv); @@ -1338,15 +1480,20 @@ restart_aux: } free(inpv); at = out.val.a; - if (at) - ReleaseAndReturn(Yap_unify(ARG2, MkAtomTerm(at))); + if (at) { + pop_text_stack(l); + return Yap_unify(ARG2, MkAtomTerm(at)); + } } error: /* Error handling */ if (LOCAL_Error_TYPE && Yap_HandleError("atom_concat/3")) { goto restart_aux; } - return FALSE; + { + pop_text_stack(l); + return FALSE; + } } static Int atomics_to_string2(USES_REGS1) { @@ -1384,15 +1531,20 @@ restart_aux: } free(inpv); at = out.val.a; - if (at) - ReleaseAndReturn(Yap_unify(ARG2, MkAtomTerm(at))); + if (at) { + pop_text_stack(l); + return Yap_unify(ARG2, MkAtomTerm(at)); + } } error: /* Error handling */ if (LOCAL_Error_TYPE && Yap_HandleError("atomics_to_string/2")) { goto restart_aux; } - ReleaseAndReturn(FALSE); + { + pop_text_stack(l); + return false; + } } static Int atomics_to_string3(USES_REGS1) { @@ -1435,26 +1587,29 @@ restart_aux: } free(inpv); at = out.val.a; - if (at) - ReleaseAndReturn(Yap_unify(ARG3, MkAtomTerm(at))); + if (at) { + pop_text_stack(l); + return Yap_unify(ARG3, MkAtomTerm(at)); + } } error: /* Error handling */ if (LOCAL_Error_TYPE && Yap_HandleError("atomics_to_string/3")) { goto restart_aux; } - ReleaseAndReturn(FALSE); + pop_text_stack(l); + return false; } - /** @pred atom_length(+ _A_,? _I_) is iso +/** @pred atom_length(+ _A_,? _I_) is iso - The predicate holds when the first argument is an atom, and the - second unifies with the number of characters forming that atom. If - bound, _I_ must be a non-negative integer. + The predicate holds when the first argument is an atom, and + the second unifies with the number of characters forming that + atom. If bound, _I_ must be a non-negative integer. - */ +*/ static Int atom_length(USES_REGS1) { Term t1 = Deref(ARG1); Term t2 = Deref(ARG2); @@ -1463,42 +1618,53 @@ static Int atom_length(USES_REGS1) { int l = push_text_stack(); if (!Yap_IsGroundTerm(t1)) { Yap_Error(INSTANTIATION_ERROR, t1, "at first argument"); - ReleaseAndReturn(FALSE); + return false; } else if (!IsAtomTerm(t1)) { Yap_Error(TYPE_ERROR_ATOM, t1, "at first argument"); - ReleaseAndReturn(FALSE); + return false; } if (Yap_IsGroundTerm(t2)) { if (!IsIntegerTerm(t2)) { Yap_Error(TYPE_ERROR_INTEGER, t2, "atom_length/2"); - ReleaseAndReturn(FALSE); + { + pop_text_stack(l); + return false; + }; } else if ((Int)(len = IntegerOfTerm(t2)) < 0) { Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t2, "atom_length/2"); - ReleaseAndReturn(FALSE); + { + pop_text_stack(l); + return false; + }; } } restart_aux: len = Yap_AtomToUnicodeLength(t1 PASS_REGS); - if (len != (size_t)-1) - ReleaseAndReturn(Yap_unify(ARG2, MkIntegerTerm(len))); + if (len != (size_t)-1) { + pop_text_stack(l); + return Yap_unify(ARG2, MkIntegerTerm(len)); + }; /* error handling */ if (LOCAL_Error_TYPE && Yap_HandleError("atom_length/2")) { goto restart_aux; } - ReleaseAndReturn(FALSE); + { + pop_text_stack(l); + return false; + }; } - /** @pred atomic_length(+ _A_,? _I_) is iso +/** @pred atomic_length(+ _A_,? _I_) is iso - The predicate holds when the first argument is a number or atom, and - the second unifies with the number of characters needed to represent - the number, or atom. + The predicate holds when the first argument is a number or + atom, and the second unifies with the number of characters + needed to represent the number, or atom. - */ +*/ static Int atomic_length(USES_REGS1) { Term t1 = Deref(ARG1); Term t2 = Deref(ARG2); @@ -1507,28 +1673,42 @@ static Int atomic_length(USES_REGS1) { int l = push_text_stack(); if (!Yap_IsGroundTerm(t1)) { Yap_Error(INSTANTIATION_ERROR, t1, "at first argument"); - ReleaseAndReturn(FALSE); + { + pop_text_stack(l); + return false; + }; } if (IsNonVarTerm(t2)) { if (!IsIntegerTerm(t2)) { Yap_Error(TYPE_ERROR_INTEGER, t2, "atom_length/2"); - ReleaseAndReturn(FALSE); + { + pop_text_stack(l); + return false; + }; } else if ((Int)(len = IntegerOfTerm(t2)) < 0) { Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t2, "atom_length/2"); - ReleaseAndReturn(FALSE); + { + pop_text_stack(l); + return false; + }; } } restart_aux: len = Yap_AtomicToUnicodeLength(t1 PASS_REGS); - if (len != (size_t)-1) - ReleaseAndReturn(Yap_unify(ARG2, MkIntegerTerm(len))); + if (len != (size_t)-1) { + pop_text_stack(l); + return Yap_unify(ARG2, MkIntegerTerm(len)); + }; /* error handling */ if (LOCAL_Error_TYPE && Yap_HandleError("atomic_length/2")) { goto restart_aux; } - ReleaseAndReturn(FALSE); + { + pop_text_stack(l); + return false; + }; } static Int string_length(USES_REGS1) { @@ -1541,29 +1721,41 @@ static Int string_length(USES_REGS1) { if (!IsIntegerTerm(t2)) { Yap_Error(TYPE_ERROR_INTEGER, t2, "string_length/2"); - ReleaseAndReturn(FALSE); + { + pop_text_stack(l); + return false; + }; } if (FALSE && (Int)(len = IntegerOfTerm(t2)) < 0) { Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t2, "string_length/2"); - ReleaseAndReturn(FALSE); + { + pop_text_stack(l); + return false; + }; } } restart_aux: t1 = Deref(ARG1); len = Yap_StringToUnicodeLength(t1 PASS_REGS); - if (len != (size_t)-1) - ReleaseAndReturn(Yap_unify(ARG2, MkIntegerTerm(len))); + if (len != (size_t)-1) { + pop_text_stack(l); + return Yap_unify(ARG2, MkIntegerTerm(len)); + }; /* error handling */ if (LOCAL_Error_TYPE && Yap_HandleError("string_length/2")) { goto restart_aux; } - ReleaseAndReturn(FALSE); + { + pop_text_stack(l); + return false; + }; } /** @pred downcase_text_to_atom(+Text, -Atom) * - * Convert all upper case code-points in text _Text_ to downcase. Unify the - * result as atom _Atom_ with the second argument. + * Convert all upper case code-points in text _Text_ to + * downcase. Unify the result as atom _Atom_ with the second + * argument. * */ static Int downcase_text_to_atom(USES_REGS1) { @@ -1573,13 +1765,19 @@ static Int downcase_text_to_atom(USES_REGS1) { int l = push_text_stack(); if (!Yap_IsGroundTerm(t1)) { Yap_Error(INSTANTIATION_ERROR, t1, "at first argument"); - ReleaseAndReturn(false); + { + pop_text_stack(l); + return false; + }; } if (IsNonVarTerm(t2)) { if (!IsAtomTerm(t2)) { Yap_Error(TYPE_ERROR_ATOM, t2, "at second argument"); - ReleaseAndReturn((FALSE)); + { + pop_text_stack(l); + return (FALSE); + }; } } while (true) { @@ -1587,17 +1785,23 @@ static Int downcase_text_to_atom(USES_REGS1) { if (at == NULL) { if (LOCAL_Error_TYPE && Yap_HandleError("downcase_text_to_atom/2")) continue; - ReleaseAndReturn(false); + + pop_text_stack(l); + return false; } - ReleaseAndReturn(Yap_unify(MkAtomTerm(at), t2)); + + pop_text_stack(l); + return Yap_unify(MkAtomTerm(at), t2); } - ReleaseAndReturn(false); + pop_text_stack(l); + return false; } /** @pred upcase_text_to_atom(+Text, -Atom) * - * Convert all lower case code-points in text _Text_ to up case. Unify the - * result as atom _Atom_ with the second argument. + * Convert all lower case code-points in text _Text_ to up + * case. Unify the result as atom _Atom_ with the second + * argument. * */ static Int upcase_text_to_atom(USES_REGS1) { @@ -1607,13 +1811,19 @@ static Int upcase_text_to_atom(USES_REGS1) { int l = push_text_stack(); if (!Yap_IsGroundTerm(t1)) { Yap_Error(INSTANTIATION_ERROR, t1, "at first argument"); - ReleaseAndReturn(false); + { + pop_text_stack(l); + return false; + }; } if (IsNonVarTerm(t2)) { if (!IsAtomTerm(t2)) { Yap_Error(TYPE_ERROR_ATOM, t2, "at second argument"); - ReleaseAndReturn((FALSE)); + { + pop_text_stack(l); + return (FALSE); + }; } } while (true) { @@ -1621,215 +1831,247 @@ static Int upcase_text_to_atom(USES_REGS1) { if (at == NULL) { if (LOCAL_Error_TYPE && Yap_HandleError("upcase_text_to_atom/2")) continue; - ReleaseAndReturn(false); + { + pop_text_stack(l); + return false; + }; } - ReleaseAndReturn(Yap_unify(MkAtomTerm(at), t2)); + pop_text_stack(l); + return Yap_unify(MkAtomTerm(at), t2); } - ReleaseAndReturn(false); + { + pop_text_stack(l); + return false; + }; } /** @pred downcase_text_to_string(+Text, -String) * - * Convert all upper case code-points in text _Text_ to downcase. Unify the - * result as string _String_ with the second argument. + * Convert all upper case code-points in text _Text_ to + * downcase. Unify the result as string _String_ with the + * second argument. * */ 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"); - ReleaseAndReturn(false); + return false; } if (IsNonVarTerm(t2)) { if (!IsStringTerm(t2)) { Yap_Error(TYPE_ERROR_STRING, t2, "at second argument"); - ReleaseAndReturn((FALSE)); + return (FALSE); + } + while (true) { + Term t = Yap_AtomicToLowString(t1); + if (t == TermZERO) { + if (LOCAL_Error_TYPE && Yap_HandleError("downcase_text_to_string/2")) + continue; + { return false; }; + } + + return Yap_unify(t, t2); } } - while (true) { - Term t = Yap_AtomicToLowString(t1); - if (t == TermZERO) { - if (LOCAL_Error_TYPE && Yap_HandleError("downcase_text_to_string/2")) - continue; - ReleaseAndReturn(false); - } - ReleaseAndReturn(Yap_unify(t, t2)); - } - ReleaseAndReturn(false); + return false; } /** @pred upcase_text_to_string(+Text, -String) * - * Convert all lower case code-points in text _Text_ to up case. Unify the - * result as string _String_ with the second argument. + * Convert all lower case code-points in text _Text_ to up + * case. Unify the result as string _String_ with the second + * argument. * */ 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"); - ReleaseAndReturn(false); + return false; } if (IsNonVarTerm(t2)) { if (!IsStringTerm(t2)) { Yap_Error(TYPE_ERROR_STRING, t2, "at second argument"); - ReleaseAndReturn((FALSE)); + return (FALSE); } } + int l = push_text_stack(); while (true) { Term t = Yap_AtomicToUpString(t1); + if (t == TermZERO) { if (LOCAL_Error_TYPE && Yap_HandleError("upcase_text_to_string/2")) continue; - ReleaseAndReturn(false); + + pop_text_stack(l); + + return false; } - ReleaseAndReturn(Yap_unify(t, t2)); + pop_text_stack(l); + return Yap_unify(t, t2); } - ReleaseAndReturn(false); + pop_text_stack(l); + return false; } /** @pred downcase_text_to_codes(+Text, -Codes) * - * Convert all upper case code-points in text _Text_ to downcase. Unify the - * result as a sequence of codes _Codes_ with the second argument. + * Convert all upper case code-points in text _Text_ to + * downcase. Unify the result as a sequence of codes _Codes_ + * with the second argument. * */ 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"); - ReleaseAndReturn(false); + return false; } if (IsNonVarTerm(t2)) { if (!Yap_IsListTerm(t2)) { Yap_Error(TYPE_ERROR_LIST, t2, "at second argument"); - ReleaseAndReturn(false); + return false; } } + int l = push_text_stack(); while (true) { Term t = Yap_AtomicToLowListOfCodes(t1); if (t == TermZERO) { if (LOCAL_Error_TYPE && Yap_HandleError("downcase_text_to_codes/2")) continue; - ReleaseAndReturn(false); + pop_text_stack(l); + return false; } - ReleaseAndReturn(Yap_unify(t, t2)); + pop_text_stack(l); + return Yap_unify(t, t2); } - ReleaseAndReturn(false); + pop_text_stack(l); + return false; } /** @pred upcase_text_to_codes(+Text, -Codes) * - * Convert all lower case code-points in text _Text_ to up case. Unify the - * result as a sequence of codes _Codes_ with the second argument. + * Convert all lower case code-points in text _Text_ to up + * case. Unify the result as a sequence of codes _Codes_ with + * the second argument. * */ 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"); - ReleaseAndReturn(false); + return false; } if (IsNonVarTerm(t2)) { if (!Yap_IsListTerm(t2)) { Yap_Error(TYPE_ERROR_LIST, t2, "at second argument"); - ReleaseAndReturn((FALSE)); + return (FALSE); } } + int l = push_text_stack(); while (true) { Term t = Yap_AtomicToUpListOfCodes(t1); if (t == TermZERO) { if (LOCAL_Error_TYPE && Yap_HandleError("upcase_text_to_codes/2")) continue; - ReleaseAndReturn(false); + pop_text_stack(l); + return false; } - ReleaseAndReturn(Yap_unify(t, t2)); + pop_text_stack(l); + return Yap_unify(t, t2); } - ReleaseAndReturn(false); + pop_text_stack(l); + return false; } /** @pred downcase_text_to_chars(+Text, -Chars) * - * Convert all upper case code-points in text _Text_ to downcase. Unify the - * result as a sequence of chars _Chars_ with the second argument. + * Convert all upper case code-points in text _Text_ to + * downcase. Unify the result as a sequence of chars _Chars_ + * with the second argument. * */ 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"); - ReleaseAndReturn(false); + return false; } if (IsNonVarTerm(t2)) { if (!Yap_IsListTerm(t2)) { Yap_Error(TYPE_ERROR_LIST, t2, "at second argument"); - ReleaseAndReturn(false); + return false; } } + int l = push_text_stack(); while (true) { Term t = Yap_AtomicToLowListOfAtoms(t1); + if (t == TermZERO) { if (LOCAL_Error_TYPE && Yap_HandleError("downcase_text_to_to_chars/2")) continue; - ReleaseAndReturn(false); + pop_text_stack(l); + return false; } - ReleaseAndReturn(Yap_unify(t, t2)); + pop_text_stack(l); + return Yap_unify(t, t2); } - ReleaseAndReturn(false); + pop_text_stack(l); + return false; } /** @pred upcase_text_to_chars(+Text, -Chars) * - * Convert all lower case code-points in text _Text_ to up case. Unify the - * result as a sequence of chars _Chars_ with the second argument. + * Convert all lower case code-points in text _Text_ to up + * case. Unify the result as a sequence of chars _Chars_ with + * the second argument. * */ 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"); - ReleaseAndReturn(false); + return false; } if (IsNonVarTerm(t2)) { if (!Yap_IsListTerm(t2)) { Yap_Error(TYPE_ERROR_LIST, t2, "at second argument"); - ReleaseAndReturn((FALSE)); + return (FALSE); } } + int l = push_text_stack(); while (true) { Term t = Yap_AtomicToUpListOfAtoms(t1); if (t == TermZERO) { if (LOCAL_Error_TYPE && Yap_HandleError("upcase_text_to_chars/2")) continue; - ReleaseAndReturn(false); + pop_text_stack(l); + return false; } - ReleaseAndReturn(Yap_unify(t, t2)); + pop_text_stack(l); + return Yap_unify(t, t2); } - ReleaseAndReturn(false); + pop_text_stack(l); + return false; } /* split an atom into two sub-atoms */ @@ -1840,58 +2082,54 @@ 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"); - ReleaseAndReturn((FALSE)); + return (FALSE); } if (!IsAtomTerm(t1)) { Yap_Error(TYPE_ERROR_ATOM, t1, "$atom_split/4"); - ReleaseAndReturn((FALSE)); + return (FALSE); } if (IsVarTerm(t2)) { Yap_Error(INSTANTIATION_ERROR, t2, "$atom_split/4"); - ReleaseAndReturn((FALSE)); + return (FALSE); } if (!IsIntTerm(t2)) { Yap_Error(TYPE_ERROR_INTEGER, t2, "$atom_split/4"); - ReleaseAndReturn((FALSE)); + return (FALSE); } if ((Int)(u_mid = IntOfTerm(t2)) < 0) { Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t2, "atom_split/4"); - ReleaseAndReturn((FALSE)); + return (FALSE); } at = AtomOfTerm(t1); - const char *s = RepAtom(at)->StrOfAE; - const unsigned char *s0 = RepAtom(at)->UStrOfAE; - unsigned char *s1, *s10; - size_t u_len = strlen_utf8(s0); - if (u_mid > u_len) { - ReleaseAndReturn(false); - } - size_t b_mid = skip_utf8(s0, u_mid)-s0; - s1 = s10 = Malloc(b_mid +1); + const char *s = RepAtom(at)->StrOfAE; + const unsigned char *s0 = RepAtom(at)->UStrOfAE; + unsigned char *s1, *s10; + size_t u_len = strlen_utf8(s0); + if (u_mid > u_len) { + return false; + } + size_t b_mid = skip_utf8(s0, u_mid) - s0; + s1 = s10 = Malloc(b_mid + 1); memcpy(s1, s, b_mid); - s1[b_mid] ='\0'; + s1[b_mid] = '\0'; to1 = MkAtomTerm(Yap_ULookupAtom(s10)); - to2 = MkAtomTerm(Yap_ULookupAtom(s0+b_mid)); - Yap_DebugPlWriteln(to1); - Yap_DebugPlWriteln(to2); - ReleaseAndReturn( - (Yap_unify_constant(ARG3, to1) && Yap_unify_constant(ARG4, to2))); + to2 = MkAtomTerm(Yap_ULookupAtom(s0 + b_mid)); + return Yap_unify_constant(ARG3, to1) && Yap_unify_constant(ARG4, to2); } - /** @pred atom_number(? _Atom_,? _Number_) +/** @pred atom_number(? _Atom_,? _Number_) - The predicate holds when at least one of the arguments is ground - (otherwise, an error message will be displayed). If the argument - _Atom_ is an atom, _Number_ must be the number corresponding - to the characters in _Atom_, otherwise the characters in - _Atom_ must encode a number _Number_. + The predicate holds when at least one of the arguments is + ground (otherwise, an error message will be displayed). If the + argument _Atom_ is an atom, _Number_ must be the number + corresponding to the characters in _Atom_, otherwise the + characters in _Atom_ must encode a number _Number_. - */ +*/ static Int atom_number(USES_REGS1) { Term t1; int l = push_text_stack(); @@ -1899,34 +2137,39 @@ restart_aux: t1 = Deref(ARG1); if (Yap_IsGroundTerm(t1)) { Term tf = Yap_AtomToNumber(t1 PASS_REGS); - if (tf) - ReleaseAndReturn(Yap_unify(ARG2, tf)); + if (tf) { + pop_text_stack(l); + return Yap_unify(ARG2, tf); + } } else { /* ARG1 unbound */ Term t = Deref(ARG2); Atom af = Yap_NumberToAtom(t PASS_REGS); - if (af) - ReleaseAndReturn(Yap_unify(ARG1, MkAtomTerm(af))); + if (af) { + pop_text_stack(l); + return Yap_unify(ARG1, MkAtomTerm(af)); + } } /* error handling */ if (LOCAL_Error_TYPE && Yap_HandleError("atom_number/2")) { t1 = Deref(ARG1); goto restart_aux; } - ReleaseAndReturn(FALSE); + pop_text_stack(l); + return false; } - /** @pred atom_number(? _String_,? _Number_) +/** @pred atom_number(? _String_,? _Number_) - The predicate holds when at least one of the arguments is ground - (otherwise, an error message will be displayed). If the argument - _String_ is a string term, _String_ must be the number corresponding - to the characters in _Atom_, otherwise the characters in - _String_ must encode the number _Number_. + The predicate holds when at least one of the arguments is + ground (otherwise, an error message will be displayed). If the + argument _String_ is a string term, _String_ must be the + number corresponding to the characters in _Atom_, otherwise + the characters in _String_ must encode the number _Number_. - */ +*/ static Int string_number(USES_REGS1) { Term t1; int l = push_text_stack(); @@ -1934,21 +2177,28 @@ restart_aux: t1 = Deref(ARG1); if (Yap_IsGroundTerm(t1)) { Term tf = Yap_StringToNumber(t1 PASS_REGS); - if (tf) - ReleaseAndReturn(Yap_unify(ARG2, tf)); + if (tf) { + + pop_text_stack(l); + return Yap_unify(ARG2, tf); + } } else { /* ARG1 unbound */ Term t = Deref(ARG2); Term tf = Yap_NumberToString(t PASS_REGS); - if (tf) - ReleaseAndReturn(Yap_unify(ARG1, tf)); + if (tf) { + pop_text_stack(l); + return Yap_unify(ARG1, tf); + } } + /* error handling */ if (LOCAL_Error_TYPE && Yap_HandleError("string_number/2")) { t1 = Deref(ARG1); goto restart_aux; } - ReleaseAndReturn(FALSE); + pop_text_stack(l); + return false; } #define SUB_ATOM_HAS_MIN 1 @@ -1982,58 +2232,39 @@ static Term build_new_atomic(int mask, const unsigned char *p, size_t minv, outv[n].type = YAP_STRING_ATOM; } else { outv[n].type = YAP_STRING_STRING; - outv[n].val.c = Malloc(512); } - int lvl = push_text_stack(PASS_REGS1); + int l = push_text_stack(); bool rc = Yap_Splice_Text(2 + n, cuts, &inp, outv PASS_REGS); - pop_text_stack(lvl); - if (!rc) + pop_text_stack(l); + if (!rc) { return (false); - if (mask & SUB_ATOM_HAS_ATOM) + } + if (mask & SUB_ATOM_HAS_ATOM) { return (MkAtomTerm(outv[n].val.a)); + } return (outv[n].val.t); } -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; -} - -static int check_sub_string_at(int minv, const unsigned char *p1, - const unsigned char *p2, size_t len) { +static bool check_sub_string_at(int minv, const unsigned char *p1, + const unsigned char *p2, size_t len) { p1 = skip_utf8((unsigned char *)p1, minv); if (p1 == NULL || p2 == NULL) return p1 == p2; return cmpn_utf8(p1, p2, len) == 0; } -static int check_sub_string_bef(int max, Term at, Term nat) { - size_t len = strlen_utf8(UStringOfTerm(nat)); - int minv = max - len; - const unsigned char *p1, *p2; - int c1; - - if ((Int)(minv - len) < 0) - return FALSE; - - p1 = skip_utf8((unsigned char *)UStringOfTerm(at), minv); - p2 = UStringOfTerm(nat); - while ((c1 = *p1++) == *p2++ && c1) - ; - return c1 == 0; -} - -static int check_sub_atom_bef(int max, Atom at, Atom nat) { - const unsigned char *p1, *p2 = RepAtom(nat)->UStrOfAE; +static bool check_sub_string_bef(int max, const unsigned char *p1, + const unsigned char *p2) { size_t len = strlen_utf8(p2); int minv = max - len; int c1; if ((Int)(minv - len) < 0) - return false; - p1 = skip_utf8(RepAtom(at)->UStrOfAE, minv); + return FALSE; + + p1 = skip_utf8(p1, minv); + if (p1 == NULL || p2 == NULL) + return p1 == p2; while ((c1 = *p1++) == *p2++ && c1) ; return c1 == 0; @@ -2108,8 +2339,9 @@ static Int cont_sub_atomic(USES_REGS1) { Yap_unify(ARG4, MkIntegerTerm(after)); Yap_unify(ARG5, nat); minv++; - if (after-- == 0) + if (after-- == 0) { cut_succeed(); + } } else if (mask & SUB_ATOM_HAS_MIN) { after = sz - (minv + len); Term nat = build_new_atomic(mask, p, minv, len PASS_REGS); @@ -2117,8 +2349,9 @@ static Int cont_sub_atomic(USES_REGS1) { Yap_unify(ARG4, MkIntegerTerm(after)); Yap_unify(ARG5, nat); len++; - if (after-- == 0) + if (after-- == 0) { cut_succeed(); + } } else if (mask & SUB_ATOM_HAS_AFTER) { len = sz - (minv + after); Term nat = build_new_atomic(mask, p, minv, len PASS_REGS); @@ -2126,8 +2359,9 @@ static Int cont_sub_atomic(USES_REGS1) { Yap_unify(ARG3, MkIntegerTerm(len)); Yap_unify(ARG5, nat); minv++; - if (len-- == 0) + if (len-- == 0) { cut_succeed(); + } } else { Term nat = build_new_atomic(mask, p, minv, len PASS_REGS); Yap_unify(ARG2, MkIntegerTerm(minv)); @@ -2136,8 +2370,9 @@ static Int cont_sub_atomic(USES_REGS1) { Yap_unify(ARG5, nat); len++; if (after-- == 0) { - if (minv == sz) + if (minv == sz) { cut_succeed(); + } minv++; len = 0; after = sz - minv; @@ -2148,6 +2383,7 @@ 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; } @@ -2158,9 +2394,7 @@ static Int sub_atomic(bool sub_atom, bool sub_string USES_REGS) { const unsigned char *p = NULL; int bnds = 0; Term nat = 0L; - Atom at = NULL; - int l = push_text_stack(); if (sub_atom) mask |= SUB_ATOM_HAS_ATOM; @@ -2173,7 +2407,7 @@ static Int sub_atomic(bool sub_atom, bool sub_string USES_REGS) { sz = strlen_utf8(p); } else { Yap_Error(TYPE_ERROR_ATOM, tat1, "sub_atom/5"); - ReleaseAndReturn(false); + { return false; } } } else if (sub_string) { if (IsStringTerm(tat1)) { @@ -2181,19 +2415,22 @@ static Int sub_atomic(bool sub_atom, bool sub_string USES_REGS) { sz = strlen_utf8(p); } else { Yap_Error(TYPE_ERROR_STRING, tat1, "sub_string/5"); - ReleaseAndReturn(false); + { return false; } } } else { + int l = push_text_stack(); if ((p = Yap_TextToUTF8Buffer(tat1 PASS_REGS))) { + pop_text_stack(l); sz = strlen_utf8(p); } else { - ReleaseAndReturn(false) + pop_text_stack(l); + return false; } } } else { Yap_Error(INSTANTIATION_ERROR, tat1, "sub_atom/5: first variable\n"); - ReleaseAndReturn(false); + return false; } EXTRA_CBACK_ARG(5, 3) = MkIntegerTerm(0); tbef = Deref(ARG2); @@ -2201,12 +2438,12 @@ static Int sub_atomic(bool sub_atom, bool sub_string USES_REGS) { minv = 0; } else if (!IsIntegerTerm(tbef)) { Yap_Error(TYPE_ERROR_INTEGER, tbef, "sub_string/5"); - ReleaseAndReturn(FALSE); + { return false; } } else { minv = IntegerOfTerm(tbef); if ((Int)minv < 0) { Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, tbef, "sub_string/5"); - ReleaseAndReturn(FALSE); + { return false; } }; mask |= SUB_ATOM_HAS_MIN; bnds++; @@ -2215,12 +2452,12 @@ static Int sub_atomic(bool sub_atom, bool sub_string USES_REGS) { len = 0; } else if (!IsIntegerTerm(tsize)) { Yap_Error(TYPE_ERROR_INTEGER, tsize, "sub_string/5"); - ReleaseAndReturn(FALSE); + { return false; } } else { len = IntegerOfTerm(tsize); if ((Int)len < 0) { Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, tsize, "sub_string/5"); - ReleaseAndReturn(FALSE); + { return false; } }; mask |= SUB_ATOM_HAS_SIZE; bnds++; @@ -2229,12 +2466,12 @@ static Int sub_atomic(bool sub_atom, bool sub_string USES_REGS) { after = 0; } else if (!IsIntegerTerm(tafter)) { Yap_Error(TYPE_ERROR_INTEGER, tafter, "sub_string/5"); - ReleaseAndReturn(FALSE); + { return false; } } else { after = IntegerOfTerm(tafter); if ((Int)after < 0) { Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, tafter, "sub_string/5"); - ReleaseAndReturn(FALSE); + { return false; } }; mask |= SUB_ATOM_HAS_AFTER; bnds++; @@ -2243,7 +2480,7 @@ static Int sub_atomic(bool sub_atom, bool sub_string USES_REGS) { if (sub_atom) { if (!IsAtomTerm(tout)) { Yap_Error(TYPE_ERROR_ATOM, tout, "sub_atom/5"); - ReleaseAndReturn(FALSE); + { return false; } } else { Atom oat; mask |= SUB_ATOM_HAS_VAL | SUB_ATOM_HAS_SIZE; @@ -2253,87 +2490,107 @@ static Int sub_atomic(bool sub_atom, bool sub_string USES_REGS) { } else { if (!IsStringTerm(tout)) { Yap_Error(TYPE_ERROR_STRING, tout, "sub_string/5"); - ReleaseAndReturn(FALSE); + { return false; } } else { mask |= SUB_ATOM_HAS_VAL | SUB_ATOM_HAS_SIZE; len = strlen_utf8(UStringOfTerm(tout)); } } - if (!Yap_unify(ARG3, MkIntegerTerm(len))) - release_cut_fail(); + if (!Yap_unify(ARG3, MkIntegerTerm(len))) { + cut_fail(); + } bnds += 2; } /* the problem is deterministic if we have two cases */ if (bnds > 1) { int out = FALSE; - if ((mask & (SUB_ATOM_HAS_MIN | SUB_ATOM_HAS_SIZE)) == - (SUB_ATOM_HAS_MIN | SUB_ATOM_HAS_SIZE)) { - if (minv + len > sz) - release_cut_fail(); - if ((Int)(after = (sz - (minv + len))) < 0) - release_cut_fail(); - nat = build_new_atomic(mask, p, minv, len PASS_REGS); - if (!nat) - 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) - release_cut_fail(); - len = sz - (minv + after); - nat = build_new_atomic(mask, p, minv, len PASS_REGS); - if (!nat) - 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) - release_cut_fail(); - minv = sz - (len + after); - nat = build_new_atomic(mask, p, minv, len PASS_REGS); - if (!nat) - 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)) { + if ((mask & (SUB_ATOM_HAS_MIN | SUB_ATOM_HAS_VAL)) == + (SUB_ATOM_HAS_MIN | SUB_ATOM_HAS_VAL)) { if (sub_atom) - out = check_sub_atom_at(minv, at, AtomOfTerm(nat), len); + return do_cut(check_sub_string_at( + minv, p, RepAtom(AtomOfTerm(tout))->UStrOfAE, len)); else - out = check_sub_string_at(minv, p, UStringOfTerm(nat), len); + return do_cut(check_sub_string_at(minv, p, UStringOfTerm(tout), len)); } else if ((mask & (SUB_ATOM_HAS_AFTER | SUB_ATOM_HAS_VAL)) == (SUB_ATOM_HAS_AFTER | SUB_ATOM_HAS_VAL)) { if (sub_atom) - out = check_sub_atom_bef(sz - after, at, AtomOfTerm(nat)); + return do_cut(check_sub_string_bef( + sz - after, p, RepAtom(AtomOfTerm(tout))->UStrOfAE)); else - out = check_sub_string_bef(sz - after, tat1, tout); + return do_cut(check_sub_string_bef(sz - after, p, UStringOfTerm(tout))); + } else if ((mask & (SUB_ATOM_HAS_MIN | SUB_ATOM_HAS_SIZE)) == + (SUB_ATOM_HAS_MIN | SUB_ATOM_HAS_SIZE)) { + if (minv + len > sz) { + cut_fail(); + } + if ((Int)(after = (sz - (minv + len))) < 0) { + cut_fail(); + } + nat = build_new_atomic(mask, p, minv, len PASS_REGS); + if (!nat) { + cut_fail(); + } + return do_cut(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(); + } + len = sz - (minv + after); + int l = push_text_stack(); + nat = build_new_atomic(mask, p, minv, len PASS_REGS); + pop_text_stack(l); + if (!nat) { + cut_fail(); + } + return do_cut(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(); + } + minv = sz - (len + after); + int l = push_text_stack(); + nat = build_new_atomic(mask, p, minv, len PASS_REGS); + pop_text_stack(l); + if (!nat) { + cut_fail(); + } + return do_cut(Yap_unify(ARG2, MkIntegerTerm(minv)) && + Yap_unify(ARG5, nat)); } else if ((mask & (SUB_ATOM_HAS_SIZE | SUB_ATOM_HAS_VAL)) == (SUB_ATOM_HAS_SIZE | SUB_ATOM_HAS_VAL)) { if (!sub_atom) { out = (strlen_utf8(UStringOfTerm(tout)) == len); - if (!out) - release_cut_fail(); + if (!out) { + cut_fail(); + } } else { out = (strlen(RepAtom(AtomOfTerm(tout))->StrOfAE) == len); - if (!out) - 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) { - release_cut_fail(); - } else { - mask |= SUB_ATOM_HAS_SIZE; - minv = 0; - after = sz - len; - goto backtrackable; + if (!out) { + 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(); + } else { + mask |= SUB_ATOM_HAS_SIZE; + minv = 0; + after = sz - len; + goto backtrackable; + } } } - if (out) - release_cut_succeed(); - release_cut_fail(); + if (out) { + cut_succeed(); + } + cut_fail(); } else { if (!(mask & SUB_ATOM_HAS_MIN)) minv = 0; @@ -2348,40 +2605,41 @@ backtrackable: EXTRA_CBACK_ARG(5, 3) = MkIntegerTerm(len); EXTRA_CBACK_ARG(5, 4) = MkIntegerTerm(after); EXTRA_CBACK_ARG(5, 5) = MkIntegerTerm(sz); - ReleaseAndReturn(cont_sub_atomic(PASS_REGS1)); + return cont_sub_atomic(PASS_REGS1); } -/** @pred sub_atom(+ _A_,? _Bef_, ? _Size_, ? _After_, ? _At_out_) is iso +/** @pred sub_atom(+ _A_,? _Bef_, ? _Size_, ? _After_, ? + _At_out_) is iso -True when _A_ and _At_out_ are atoms such that the name of - _At_out_ has size _Size_ and is a sub-string of the name of - _A_, such that _Bef_ is the number of characters before and - _After_ the number of characters afterwards. + True when _A_ and _At_out_ are atoms such that the name of + _At_out_ has size _Size_ and is a sub-string of the name of + _A_, such that _Bef_ is the number of characters before and + _After_ the number of characters afterwards. -Note that _A_ must always be known, but _At_out_ can be unbound when -calling this built-in. If all the arguments for sub_atom/5 but _A_ -are unbound, the built-in will backtrack through all possible -sub-strings of _A_. + Note that _A_ must always be known, but _At_out_ can be + unbound when calling this built-in. If all the arguments for + sub_atom/5 but _A_ are unbound, the built-in will backtrack + through all possible sub-strings of _A_. - */ +*/ static Int sub_atom(USES_REGS1) { return (sub_atomic(true, false PASS_REGS)); } -/** @pred sub_string(+ _S_,? _Bef_, ? _Size_, ? _After_, ? _S_out_) is -iso +/** @pred sub_string(+ _S_,? _Bef_, ? _Size_, ? _After_, ? + _S_out_) is iso -True when _S_ and _S_out_ are strings such that the - _S_out_ has size _Size_ and is a sub-string of - _S_, _Bef_ is the number of characters before, and - _After_ the number of characters afterwards. + True when _S_ and _S_out_ are strings such that the + _S_out_ has size _Size_ and is a sub-string of + _S_, _Bef_ is the number of characters before, and + _After_ the number of characters afterwards. -Note that _S_ must always be known, but _S_out_ can be unbound when -calling this built-in. If all the arguments for sub_string/5 but _S_ -are unbound, the built-in will generate all possible -sub-strings of _S_. + Note that _S_ must always be known, but _S_out_ can be + unbound when calling this built-in. If all the arguments for + sub_string/5 but _S_ are unbound, the built-in will generate + all possible sub-strings of _S_. - */ +*/ static Int sub_string(USES_REGS1) { return sub_atomic(false, true PASS_REGS); } static Int cont_current_atom(USES_REGS1) { @@ -2442,12 +2700,12 @@ static Int cont_current_atom(USES_REGS1) { } static Int current_atom(USES_REGS1) { /* current_atom(?Atom) - */ + */ Term t1 = Deref(ARG1); if (!IsVarTerm(t1)) { - if (IsAtomTerm(t1)) + if (IsAtomTerm(t1)) { cut_succeed(); - else + } else cut_fail(); } READ_LOCK(HashChain[0].AERWLock); @@ -2525,5 +2783,5 @@ void Yap_InitAtomPreds(void) { } /** -@} + @} */ diff --git a/C/exec.c b/C/exec.c index 69c4bc987..c381f158d 100755 --- a/C/exec.c +++ b/C/exec.c @@ -2006,9 +2006,11 @@ static Int JumpToEnv() { handler->cp_b != NULL) { handler = handler->cp_b; } + pop_text_stack(1); if (LOCAL_PrologMode & AsyncIntMode) { Yap_signal(YAP_FAIL_SIGNAL); } + B = handler; P = FAILCODE; return true; @@ -2016,7 +2018,7 @@ static Int JumpToEnv() { bool Yap_JumpToEnv(Term t) { CACHE_REGS - LOCAL_BallTerm = Yap_StoreTermInDB(t, 0); + LOCAL_BallTerm = Yap_StoreTermInDB(t, 0); if (!LOCAL_BallTerm) return false; if (LOCAL_PrologMode & TopGoalMode) @@ -2038,259 +2040,259 @@ static Int jump_env(USES_REGS1) { Term t1 = ArgOfTerm(1, t); if (IsApplTerm(t1) && IsAtomTerm((t2 = ArgOfTerm(1, t1)))) { LOCAL_ActiveError->errorAsText = AtomOfTerm(t2); - LOCAL_ActiveError->classAsText = NameOfFunctor(FunctorOfTerm(t1)); - } else if (IsAtomTerm(t)) { - LOCAL_ActiveError->errorAsText = AtomOfTerm(t1); - LOCAL_ActiveError->classAsText = NULL; - } - } else { + LOCAL_ActiveError->classAsText = NameOfFunctor(FunctorOfTerm(t1)); + } else if (IsAtomTerm(t)) { + LOCAL_ActiveError->errorAsText = AtomOfTerm(t1); + LOCAL_ActiveError->classAsText = NULL; + } + } else { Yap_find_prolog_culprit(PASS_REGS1); LOCAL_ActiveError->errorAsText = NULL; LOCAL_ActiveError->classAsText = NULL; - //return true; + //return true; + } + LOCAL_ActiveError->prologPredName = NULL; + Yap_PutException(t); + bool out = JumpToEnv(PASS_REGS1); + if (B != NULL && P == FAILCODE && B->cp_ap == NOCODE && + LCL0 - (CELL *)B > LOCAL_CBorder) { + // we're failing up to the top layer + } + return out; } - LOCAL_ActiveError->prologPredName = NULL; - Yap_PutException(t); - bool out = JumpToEnv(PASS_REGS1); - if (B != NULL && P == FAILCODE && B->cp_ap == NOCODE && - LCL0 - (CELL *)B > LOCAL_CBorder) { - // we're failing up to the top layer + + /* set up a meta-call based on . context info */ + static Int generate_pred_info(USES_REGS1) { + ARG1 = ARG3 = ENV[-EnvSizeInCells - 1]; + ARG4 = ENV[-EnvSizeInCells - 3]; + ARG2 = cp_as_integer((choiceptr)ENV[E_CB] PASS_REGS); + return TRUE; } - return out; -} -/* set up a meta-call based on . context info */ -static Int generate_pred_info(USES_REGS1) { - ARG1 = ARG3 = ENV[-EnvSizeInCells - 1]; - ARG4 = ENV[-EnvSizeInCells - 3]; - ARG2 = cp_as_integer((choiceptr)ENV[E_CB] PASS_REGS); - return TRUE; -} - -void Yap_InitYaamRegs(int myworker_id) { - Term h0var; -// getchar(); + void Yap_InitYaamRegs(int myworker_id) { + Term h0var; + // getchar(); #if PUSH_REGS -/* Guarantee that after a longjmp we go back to the original abstract - machine registers */ + /* Guarantee that after a longjmp we go back to the original abstract + machine registers */ #ifdef THREADS - if (myworker_id) { - REGSTORE *rs = REMOTE_ThreadHandle(myworker_id).default_yaam_regs; - pthread_setspecific(Yap_yaamregs_key, (const void *)rs); - REMOTE_ThreadHandle(myworker_id).current_yaam_regs = rs; - } -/* may be run by worker_id on behalf on myworker_id */ + if (myworker_id) { + REGSTORE *rs = REMOTE_ThreadHandle(myworker_id).default_yaam_regs; + pthread_setspecific(Yap_yaamregs_key, (const void *)rs); + REMOTE_ThreadHandle(myworker_id).current_yaam_regs = rs; + } + /* may be run by worker_id on behalf on myworker_id */ #else - Yap_regp = &Yap_standard_regs; + Yap_regp = &Yap_standard_regs; #endif #endif /* PUSH_REGS */ - CACHE_REGS - Yap_ResetException(worker_id); - Yap_PutValue(AtomBreak, MkIntTerm(0)); - TR = (tr_fr_ptr)REMOTE_TrailBase(myworker_id); - HR = H0 = ((CELL *)REMOTE_GlobalBase(myworker_id)) + - 1; // +1: hack to ensure the gc does not try to mark mistakenly - LCL0 = ASP = (CELL *)REMOTE_LocalBase(myworker_id); - CurrentTrailTop = (tr_fr_ptr)(REMOTE_TrailTop(myworker_id) - MinTrailGap); - /* notice that an initial choice-point and environment - *must* be created for the garbage collector to work */ - B = NULL; - ENV = NULL; - P = CP = YESCODE; + CACHE_REGS + Yap_ResetException(worker_id); + Yap_PutValue(AtomBreak, MkIntTerm(0)); + TR = (tr_fr_ptr)REMOTE_TrailBase(myworker_id); + HR = H0 = ((CELL *)REMOTE_GlobalBase(myworker_id)) + + 1; // +1: hack to ensure the gc does not try to mark mistakenly + LCL0 = ASP = (CELL *)REMOTE_LocalBase(myworker_id); + CurrentTrailTop = (tr_fr_ptr)(REMOTE_TrailTop(myworker_id) - MinTrailGap); + /* notice that an initial choice-point and environment + *must* be created for the garbage collector to work */ + B = NULL; + ENV = NULL; + P = CP = YESCODE; #ifdef DEPTH_LIMIT - DEPTH = RESET_DEPTH(); + DEPTH = RESET_DEPTH(); #endif - STATIC_PREDICATES_MARKED = FALSE; - if (REMOTE_GlobalArena(myworker_id) == 0L || - REMOTE_GlobalArena(myworker_id) == TermNil) { - } else { - HR = RepAppl(REMOTE_GlobalArena(myworker_id)); - } - REMOTE_GlobalArena(myworker_id) = TermNil; - Yap_InitPreAllocCodeSpace(myworker_id); + STATIC_PREDICATES_MARKED = FALSE; + if (REMOTE_GlobalArena(myworker_id) == 0L || + REMOTE_GlobalArena(myworker_id) == TermNil) { + } else { + HR = RepAppl(REMOTE_GlobalArena(myworker_id)); + } + REMOTE_GlobalArena(myworker_id) = TermNil; + Yap_InitPreAllocCodeSpace(myworker_id); #ifdef FROZEN_STACKS - H_FZ = HR; + H_FZ = HR; #ifdef YAPOR_SBA - BSEG = + BSEG = #endif /* YAPOR_SBA */ BBREG = B_FZ = (choiceptr)REMOTE_LocalBase(myworker_id); - TR = TR_FZ = (tr_fr_ptr)REMOTE_TrailBase(myworker_id); + TR = TR_FZ = (tr_fr_ptr)REMOTE_TrailBase(myworker_id); #endif /* FROZEN_STACKS */ - CalculateStackGap(PASS_REGS1); -/* the first real choice-point will also have AP=FAIL */ -/* always have an empty slots for people to use */ + CalculateStackGap(PASS_REGS1); + /* the first real choice-point will also have AP=FAIL */ + /* always have an empty slots for people to use */ #if defined(YAPOR) || defined(THREADS) - LOCAL = REMOTE(myworker_id); - worker_id = myworker_id; + LOCAL = REMOTE(myworker_id); + worker_id = myworker_id; #endif /* THREADS */ #if COROUTINING - REMOTE_WokenGoals(myworker_id) = Yap_NewTimedVar(TermNil); - h0var = MkVarTerm(); - REMOTE_AttsMutableList(myworker_id) = Yap_NewTimedVar(h0var); + REMOTE_WokenGoals(myworker_id) = Yap_NewTimedVar(TermNil); + h0var = MkVarTerm(); + REMOTE_AttsMutableList(myworker_id) = Yap_NewTimedVar(h0var); #endif - Yap_RebootSlots(myworker_id); - h0var = MkVarTerm(); - REMOTE_GcGeneration(myworker_id) = Yap_NewTimedVar(h0var); - REMOTE_GcCurrentPhase(myworker_id) = 0L; - REMOTE_GcPhase(myworker_id) = + Yap_RebootSlots(myworker_id); + h0var = MkVarTerm(); + REMOTE_GcGeneration(myworker_id) = Yap_NewTimedVar(h0var); + REMOTE_GcCurrentPhase(myworker_id) = 0L; + REMOTE_GcPhase(myworker_id) = Yap_NewTimedVar(MkIntTerm(REMOTE_GcCurrentPhase(myworker_id))); #if defined(YAPOR) || defined(THREADS) - PP = NULL; - PREG_ADDR = NULL; + PP = NULL; + PREG_ADDR = NULL; #endif - Yap_AllocateDefaultArena(128 * 1024, 2, myworker_id); - cut_c_initialize(myworker_id); - Yap_PrepGoal(0, NULL, NULL PASS_REGS); + Yap_AllocateDefaultArena(128 * 1024, 2, myworker_id); + cut_c_initialize(myworker_id); + Yap_PrepGoal(0, NULL, NULL PASS_REGS); #ifdef FROZEN_STACKS - H_FZ = HR; + H_FZ = HR; #ifdef YAPOR_SBA - BSEG = + BSEG = #endif /* YAPOR_SBA */ BBREG = B_FZ = (choiceptr)REMOTE_LocalBase(myworker_id); - TR = TR_FZ = (tr_fr_ptr)REMOTE_TrailBase(myworker_id); + TR = TR_FZ = (tr_fr_ptr)REMOTE_TrailBase(myworker_id); #endif /* FROZEN_STACKS */ - CalculateStackGap(PASS_REGS1); + CalculateStackGap(PASS_REGS1); #ifdef TABLING - /* ensure that LOCAL_top_dep_fr is always valid */ - if (REMOTE_top_dep_fr(myworker_id)) - DepFr_cons_cp(REMOTE_top_dep_fr(myworker_id)) = NORM_CP(B); + /* ensure that LOCAL_top_dep_fr is always valid */ + if (REMOTE_top_dep_fr(myworker_id)) + DepFr_cons_cp(REMOTE_top_dep_fr(myworker_id)) = NORM_CP(B); #endif -} - -Term Yap_GetException(void) { - CACHE_REGS - Term t = 0; - - if (LOCAL_BallTerm) { - t = Yap_PopTermFromDB(LOCAL_BallTerm); } - LOCAL_BallTerm = NULL; - return t; -} -Term Yap_PeekException(void) { return Yap_FetchTermFromDB(LOCAL_BallTerm); } + Term Yap_GetException(void) { + CACHE_REGS + Term t = 0; + + if (LOCAL_BallTerm) { + t = Yap_PopTermFromDB(LOCAL_BallTerm); + } + LOCAL_BallTerm = NULL; + return t; + } + + Term Yap_PeekException(void) { return Yap_FetchTermFromDB(LOCAL_BallTerm); } + + bool Yap_RaiseException(void) { + if (LOCAL_BallTerm == NULL) + return false; + return JumpToEnv(); + } + + bool Yap_PutException(Term t) { + CACHE_REGS + if ((LOCAL_BallTerm = Yap_StoreTermInDB(t, 0)) != NULL) + return true; -bool Yap_RaiseException(void) { - if (LOCAL_BallTerm == NULL) return false; - return JumpToEnv(); -} + } -bool Yap_PutException(Term t) { - CACHE_REGS - if ((LOCAL_BallTerm = Yap_StoreTermInDB(t, 0)) != NULL) + bool Yap_ResetException(int wid) { + if (REMOTE_ActiveError(wid)->errorTerm) { + Yap_PopTermFromDB(REMOTE_ActiveError(wid)->errorTerm); + } + REMOTE_ActiveError(wid)->errorTerm = NULL; return true; - - return false; -} - -bool Yap_ResetException(int wid) { - if (REMOTE_ActiveError(wid)->errorTerm) { - Yap_PopTermFromDB(REMOTE_ActiveError(wid)->errorTerm); } - REMOTE_ActiveError(wid)->errorTerm = NULL; - return true; -} -static Int reset_exception(USES_REGS1) { return Yap_ResetException(worker_id); } + static Int reset_exception(USES_REGS1) { return Yap_ResetException(worker_id); } -static Int get_exception(USES_REGS1) { - Term t = Yap_GetException(); - if (t == 0) - return false; - return Yap_unify(t, ARG1); -} - -int Yap_dogc(int extra_args, Term *tp USES_REGS) { - UInt arity; - yamop *nextpc; - int i; - - if (P && PREVOP(P, Osbpp)->opc == Yap_opcode(_call_usercpred)) { - arity = PREVOP(P, Osbpp)->y_u.Osbpp.p->ArityOfPE; - nextpc = P; - } else { - arity = 0; - nextpc = CP; + static Int get_exception(USES_REGS1) { + Term t = Yap_GetException(); + if (t == 0) + return false; + return Yap_unify(t, ARG1); } - for (i = 0; i < extra_args; i++) { - XREGS[arity + i + 1] = tp[i]; - } - if (!Yap_gc(arity + extra_args, ENV, nextpc)) { - return FALSE; - } - for (i = 0; i < extra_args; i++) { - tp[i] = XREGS[arity + i + 1]; - } - return TRUE; -} -void Yap_InitExecFs(void) { - CACHE_REGS - YAP_opaque_handler_t catcher_ops; - memset(&catcher_ops, 0, sizeof(catcher_ops)); - catcher_ops.cut_handler = watch_cut; - catcher_ops.fail_handler = watch_retry; - setup_call_catcher_cleanup_tag = YAP_NewOpaqueType(&catcher_ops); + int Yap_dogc(int extra_args, Term *tp USES_REGS) { + UInt arity; + yamop *nextpc; + int i; - Term cm = CurrentModule; - Yap_InitComma(); - Yap_InitCPred("$execute", 1, execute, 0); - Yap_InitCPred("$execute", 2, execute2, 0); - Yap_InitCPred("$execute", 3, execute3, 0); - Yap_InitCPred("$execute", 4, execute4, 0); - Yap_InitCPred("$execute", 5, execute5, 0); - Yap_InitCPred("$execute", 6, execute6, 0); - Yap_InitCPred("$execute", 7, execute7, 0); - Yap_InitCPred("$execute", 8, execute8, 0); - Yap_InitCPred("$execute", 9, execute9, 0); - Yap_InitCPred("$execute", 10, execute10, 0); - Yap_InitCPred("$execute", 11, execute11, 0); - Yap_InitCPred("$execute", 12, execute12, 0); - Yap_InitCPred("$execute_in_mod", 2, execute_in_mod, 0); - Yap_InitCPred("$execute_wo_mod", 2, execute_in_mod, 0); - Yap_InitCPred("call_with_args", 1, execute_0, 0); - Yap_InitCPred("call_with_args", 2, execute_1, 0); - Yap_InitCPred("call_with_args", 3, execute_2, 0); - Yap_InitCPred("call_with_args", 4, execute_3, 0); - Yap_InitCPred("call_with_args", 5, execute_4, 0); - Yap_InitCPred("call_with_args", 6, execute_5, 0); - Yap_InitCPred("call_with_args", 7, execute_6, 0); - Yap_InitCPred("call_with_args", 8, execute_7, 0); - Yap_InitCPred("call_with_args", 9, execute_8, 0); - Yap_InitCPred("call_with_args", 10, execute_9, 0); - Yap_InitCPred("call_with_args", 11, execute_10, 0); + if (P && PREVOP(P, Osbpp)->opc == Yap_opcode(_call_usercpred)) { + arity = PREVOP(P, Osbpp)->y_u.Osbpp.p->ArityOfPE; + nextpc = P; + } else { + arity = 0; + nextpc = CP; + } + for (i = 0; i < extra_args; i++) { + XREGS[arity + i + 1] = tp[i]; + } + if (!Yap_gc(arity + extra_args, ENV, nextpc)) { + return FALSE; + } + for (i = 0; i < extra_args; i++) { + tp[i] = XREGS[arity + i + 1]; + } + return TRUE; + } + + void Yap_InitExecFs(void) { + CACHE_REGS + YAP_opaque_handler_t catcher_ops; + memset(&catcher_ops, 0, sizeof(catcher_ops)); + catcher_ops.cut_handler = watch_cut; + catcher_ops.fail_handler = watch_retry; + setup_call_catcher_cleanup_tag = YAP_NewOpaqueType(&catcher_ops); + + Term cm = CurrentModule; + Yap_InitComma(); + Yap_InitCPred("$execute", 1, execute, 0); + Yap_InitCPred("$execute", 2, execute2, 0); + Yap_InitCPred("$execute", 3, execute3, 0); + Yap_InitCPred("$execute", 4, execute4, 0); + Yap_InitCPred("$execute", 5, execute5, 0); + Yap_InitCPred("$execute", 6, execute6, 0); + Yap_InitCPred("$execute", 7, execute7, 0); + Yap_InitCPred("$execute", 8, execute8, 0); + Yap_InitCPred("$execute", 9, execute9, 0); + Yap_InitCPred("$execute", 10, execute10, 0); + Yap_InitCPred("$execute", 11, execute11, 0); + Yap_InitCPred("$execute", 12, execute12, 0); + Yap_InitCPred("$execute_in_mod", 2, execute_in_mod, 0); + Yap_InitCPred("$execute_wo_mod", 2, execute_in_mod, 0); + Yap_InitCPred("call_with_args", 1, execute_0, 0); + Yap_InitCPred("call_with_args", 2, execute_1, 0); + Yap_InitCPred("call_with_args", 3, execute_2, 0); + Yap_InitCPred("call_with_args", 4, execute_3, 0); + Yap_InitCPred("call_with_args", 5, execute_4, 0); + Yap_InitCPred("call_with_args", 6, execute_5, 0); + Yap_InitCPred("call_with_args", 7, execute_6, 0); + Yap_InitCPred("call_with_args", 8, execute_7, 0); + Yap_InitCPred("call_with_args", 9, execute_8, 0); + Yap_InitCPred("call_with_args", 10, execute_9, 0); + Yap_InitCPred("call_with_args", 11, execute_10, 0); #ifdef DEPTH_LIMIT - Yap_InitCPred("$execute_under_depth_limit", 2, execute_depth_limit, 0); + Yap_InitCPred("$execute_under_depth_limit", 2, execute_depth_limit, 0); #endif - Yap_InitCPred("$execute0", 2, execute0, NoTracePredFlag); - Yap_InitCPred("$execute_nonstop", 2, execute_nonstop, NoTracePredFlag); - Yap_InitCPred("$creep_step", 2, creep_step, NoTracePredFlag); - Yap_InitCPred("$execute_clause", 4, execute_clause, NoTracePredFlag); - Yap_InitCPred("$current_choice_point", 1, current_choice_point, 0); - Yap_InitCPred("$ ", 1, - current_choice_point, 0); - CurrentModule = HACKS_MODULE; - Yap_InitCPred("current_choice_point", 1, current_choice_point, 0); - Yap_InitCPred("current_choicepoint", 1, current_choice_point, 0); - Yap_InitCPred("env_choice_point", 1, save_env_b, 0); - Yap_InitCPred("cut_at", 1, clean_ifcp, SafePredFlag); - CurrentModule = cm; - Yap_InitCPred("$restore_regs", 1, restore_regs, - NoTracePredFlag | SafePredFlag); - Yap_InitCPred("$restore_regs", 2, restore_regs2, - NoTracePredFlag | SafePredFlag); - Yap_InitCPred("$clean_ifcp", 1, clean_ifcp, SafePredFlag); - Yap_InitCPred("qpack_clean_up_to_disjunction", 0, cut_up_to_next_disjunction, - SafePredFlag); - Yap_InitCPred("$jump_env_and_store_ball", 1, jump_env, 0); - Yap_InitCPred("$generate_pred_info", 4, generate_pred_info, 0); - Yap_InitCPred("$reset_exception", 1, reset_exception, 0); - Yap_InitCPred("_user_expand_goal", 2, _user_expand_goal, 0); - Yap_InitCPred("$do_term_expansion", 2, do_term_expansion, 0); - Yap_InitCPred("$get_exception", 1, get_exception, 0); - Yap_InitCPred("$setup_call_catcher_cleanup", 1, setup_call_catcher_cleanup, - 0); - Yap_InitCPred("$cleanup_on_exit", 2, cleanup_on_exit, 0); - Yap_InitCPred("$tag_cleanup", 2, tag_cleanup, 0); -} + Yap_InitCPred("$execute0", 2, execute0, NoTracePredFlag); + Yap_InitCPred("$execute_nonstop", 2, execute_nonstop, NoTracePredFlag); + Yap_InitCPred("$creep_step", 2, creep_step, NoTracePredFlag); + Yap_InitCPred("$execute_clause", 4, execute_clause, NoTracePredFlag); + Yap_InitCPred("$current_choice_point", 1, current_choice_point, 0); + Yap_InitCPred("$ ", 1, + current_choice_point, 0); + CurrentModule = HACKS_MODULE; + Yap_InitCPred("current_choice_point", 1, current_choice_point, 0); + Yap_InitCPred("current_choicepoint", 1, current_choice_point, 0); + Yap_InitCPred("env_choice_point", 1, save_env_b, 0); + Yap_InitCPred("cut_at", 1, clean_ifcp, SafePredFlag); + CurrentModule = cm; + Yap_InitCPred("$restore_regs", 1, restore_regs, + NoTracePredFlag | SafePredFlag); + Yap_InitCPred("$restore_regs", 2, restore_regs2, + NoTracePredFlag | SafePredFlag); + Yap_InitCPred("$clean_ifcp", 1, clean_ifcp, SafePredFlag); + Yap_InitCPred("qpack_clean_up_to_disjunction", 0, cut_up_to_next_disjunction, + SafePredFlag); + Yap_InitCPred("$jump_env_and_store_ball", 1, jump_env, 0); + Yap_InitCPred("$generate_pred_info", 4, generate_pred_info, 0); + Yap_InitCPred("$reset_exception", 1, reset_exception, 0); + Yap_InitCPred("_user_expand_goal", 2, _user_expand_goal, 0); + Yap_InitCPred("$do_term_expansion", 2, do_term_expansion, 0); + Yap_InitCPred("$get_exception", 1, get_exception, 0); + Yap_InitCPred("$setup_call_catcher_cleanup", 1, setup_call_catcher_cleanup, + 0); + Yap_InitCPred("$cleanup_on_exit", 2, cleanup_on_exit, 0); + Yap_InitCPred("$tag_cleanup", 2, tag_cleanup, 0); + } diff --git a/C/text.c b/C/text.c index 618373324..622d7876f 100644 --- a/C/text.c +++ b/C/text.c @@ -51,9 +51,16 @@ typedef struct TextBuffer_manager { int lvl; } text_buffer_t; -int push_text_stack(USES_REGS1) { return LOCAL_TextBuffer->lvl++; } +int AllocLevel(void) { return LOCAL_TextBuffer->lvl; } +int push_text_stack__(USES_REGS1) { + int i = LOCAL_TextBuffer->lvl; + i++; + LOCAL_TextBuffer->lvl = i; -int pop_text_stack(int i) { + return i; +} + +int pop_text_stack__(int i) { int lvl = LOCAL_TextBuffer->lvl; while (lvl >= i) { struct mblock *p = LOCAL_TextBuffer->first[lvl]; @@ -66,7 +73,7 @@ int pop_text_stack(int i) { LOCAL_TextBuffer->last[lvl] = NULL; lvl--; } - LOCAL_TextBuffer->lvl = i; + LOCAL_TextBuffer->lvl = lvl; return lvl; } @@ -116,24 +123,25 @@ void *Malloc(size_t sz USES_REGS) { return o + 1; } -void *Realloc(void *pt, size_t sz USES_REGS) { +void *MallocAtLevel(size_t sz, int atL USES_REGS) { + int lvl = LOCAL_TextBuffer->lvl; + if (atL > 0 && atL <= lvl) { + lvl = atL; + } else if (atL < 0 && lvl - atL >= 0) { + lvl += atL; + } else { + return NULL; + } + if (sz == 0) + sz = 1024; sz = ALIGN_BY_TYPE(sz + sizeof(struct mblock), CELL); - struct mblock *old = pt, *o; - old--; - int lvl = old->lvl; - o = realloc(old, sz); - if (o->prev) - o->prev->next = o; - if (o->next) - o->next->prev = o; - if (LOCAL_TextBuffer->first[lvl] == old) { - LOCAL_TextBuffer->first[lvl] = o; - } - if (LOCAL_TextBuffer->last[lvl] == old) { - LOCAL_TextBuffer->last[lvl] = o; - } + struct mblock *o = malloc(sz); + if (!o) + return NULL; o->sz = sz; - + o->lvl = lvl; + o->prev = o->next = 0; + insert_block(o); return o + 1; } @@ -149,6 +157,17 @@ void *export_block(int i, void *protected USES_REGS) { return o; } } +void *Realloc(void *pt, size_t sz USES_REGS) { + sz += sizeof(struct mblock); + struct mblock *old = pt, *o; + old--; + release_block(old); + o = realloc(old, sz); + o->sz = sz; + insert_block(o); + + return o + 1; +} void Free(void *pt USES_REGS) { struct mblock *o = pt; @@ -165,7 +184,7 @@ void *Yap_InitTextAllocator(void) { static size_t MaxTmp(USES_REGS1) { return ((char *)LOCAL_TextBuffer->buf + LOCAL_TextBuffer->sz) - - (char *)LOCAL_TextBuffer->ptr; + (char *)LOCAL_TextBuffer->ptr; } static Term Globalize(Term v USES_REGS) { @@ -179,529 +198,509 @@ static Term Globalize(Term v USES_REGS) { return v; } -static Int SkipListCodes(unsigned char **bufp, Term *l, Term **tailp, - Int *atoms, bool *wide, seq_tv_t *inp USES_REGS) { - Int length = 0; - Term v; /* temporary */ - *wide = false; - unsigned char *st0 = *bufp, *st; - bool atomst; - size_t max_lim = 1024; +static void *codes2buf(Term t0, void *b0, bool *get_codes USES_REGS) { + unsigned char *st0, *st, ar[16]; + Term t = t0; + size_t length = 0; - if (!st0) { - st0 = Malloc(1024); + if (t == TermNil) { + st0 = Malloc(4); + st0[0] = 0; + export_block(0, st0); + return st0; } - - do_derefa(v, l, derefa_unk, derefa_nonvar); - *tailp = l; - - *bufp = st = st0; - - if (*l == TermNil) { - st[0] = '\0'; - return 0; - } - if (IsPairTerm(*l)) { - Term hd0 = HeadOfTerm(*l); - if (IsVarTerm(hd0)) { - return -INSTANTIATION_ERROR; - } - // are we looking for atoms/codes? - // whatever the case, we should be consistent throughout, - // so we should be consistent with the first arg. - if (st > st0 + max_lim) { - max_lim += 2048; - *bufp = st0 = Realloc(st0, max_lim); - } - if (IsAtomTerm(hd0)) { - atomst = true; - - } else { - atomst = false; - } - - while (IsPairTerm(*l)) { - int ch; - length++; - { - Term hd = Deref(RepPair(*l)[0]); - if (IsVarTerm(hd)) { - return -INSTANTIATION_ERROR; - } else if (IsAtomTerm(hd)) { - if (!atomst) { - return -REPRESENTATION_ERROR_CHARACTER; - } else { - AtomEntry *ae = RepAtom(AtomOfTerm(hd)); - st = (unsigned char *)stpcpy((char *)st, ae->StrOfAE); - } - } else if (IsIntegerTerm(hd)) { - ch = IntegerOfTerm(hd); - if (atomst) - return -REPRESENTATION_ERROR_CHARACTER; - else if (ch < 0) { - *tailp = l; - return -REPRESENTATION_ERROR_CHARACTER_CODE; - } else { - st += put_utf8(st, ch); - } - } else { - return -TYPE_ERROR_INTEGER; - } - if (length < 0) { - *tailp = l; - return length; - } + if (!IsPairTerm(t)) + return NULL; + bool codes = IsIntegerTerm(HeadOfTerm(t)); + if (get_codes) + *get_codes = codes; + if (codes) { + while (IsPairTerm(t)) { + Term hd = HeadOfTerm(t); + if (IsVarTerm(hd)) { + Yap_Error(INSTANTIATION_ERROR, t0, "scanning list of codes"); + return NULL; + } + if (!IsIntegerTerm(hd)) { + Yap_Error(TYPE_ERROR_INTEGER, t0, "scanning list of codes"); + return NULL; + } + Int code = IntegerOfTerm(hd); + if (code < 0) { + Yap_Error(REPRESENTATION_ERROR_CHARACTER_CODE, t0, + "scanning list of codes"); + return NULL; + } + length += put_utf8(ar, code); + t = TailOfTerm(t); + } + } else { + while (IsPairTerm(t)) { + Term hd = HeadOfTerm(t); + if (!IsAtomTerm(hd)) { + Yap_Error(TYPE_ERROR_ATOM, t0, "scanning list of atoms"); + return NULL; + } + const char *code = RepAtom(AtomOfTerm(hd))->StrOfAE; + if (code < 0) { + Yap_Error(REPRESENTATION_ERROR_CHARACTER, t0, "scanning list of atoms"); + return NULL; + } + length += strlen(code); + t = TailOfTerm(t); } - - l = RepPair(*l) + 1; - do_derefa(v, l, derefa2_unk, derefa2_nonvar); } + + if (!IsVarTerm(t)) { + if (t != TermNil) { + Yap_Error(TYPE_ERROR_INTEGER, t0, "scanning list of codes"); + return NULL; + } + } + + st0 = st = Malloc(length + 1); + export_block(0, st0); + t = t0; + if (codes) { + while (IsPairTerm(t)) { + Term hd = HeadOfTerm(t); + + Int code = IntegerOfTerm(hd); + + st = st + put_utf8(st, code); + t = TailOfTerm(t); + } + } else { + while (IsPairTerm(t)) { + Term hd = HeadOfTerm(t); + const char *code = RepAtom(AtomOfTerm(hd))->StrOfAE; + st = (unsigned char *)stpcpy((char *)st, code); + t = TailOfTerm(t); + } + } + st[0] = '\0'; + + return st0; } - if (IsVarTerm(*l)) { - return -INSTANTIATION_ERROR; + + static unsigned char *latin2utf8(seq_tv_t *inp) { + unsigned char *b0 = inp->val.uc; + size_t sz = strlen(inp->val.c); + sz *= 2; + int ch; + unsigned char *buf = Malloc(sz + 1), *pt = buf; + if (!buf) + return NULL; + while ((ch = *b0++)) { + int off = put_utf8(pt, ch); + if (off < 0) { + continue; + } + pt += off; + } + *pt++ = '\0'; + return buf; } - if (*l != TermNil) { - return -TYPE_ERROR_LIST; + + static unsigned char *wchar2utf8(seq_tv_t *inp) { + size_t sz = wcslen(inp->val.w) * 4; + wchar_t *b0 = inp->val.w; + unsigned char *buf = Malloc(sz + 1), *pt = buf; + int ch; + if (!buf) + return NULL; + while ((ch = *b0++)) + pt += put_utf8(pt, ch); + *pt++ = '\0'; + return buf; } - st[0] = '\0'; - *tailp = l; - *atoms = length; - length = (st - st0); - return length; -} + static void *slice(size_t min, size_t max, const unsigned char *buf USES_REGS); -static unsigned char *latin2utf8(seq_tv_t *inp) { - unsigned char *b0 = inp->val.uc; - size_t sz = strlen(inp->val.c); - sz *= 2; - int ch; - unsigned char *buf = Malloc(sz + 1), *pt = buf; - if (!buf) - return NULL; - while ((ch = *b0++)) { - int off = put_utf8(pt, ch); - if (off < 0) - continue; - pt += off; + static unsigned char *Yap_ListOfCodesToBuffer(unsigned char *buf, Term t, + seq_tv_t *inp USES_REGS) { + bool codes; + unsigned char *nbuf = codes2buf(t, buf, &codes PASS_REGS); + if (!codes) + return NULL; + return nbuf; } - *pt++ = '\0'; - return buf; -} -static unsigned char *wchar2utf8(seq_tv_t *inp) { - size_t sz = wcslen(inp->val.w) * 4; - wchar_t *b0 = inp->val.w; - unsigned char *buf = Malloc(sz + 1), *pt = buf; - int ch; - if (!buf) - return NULL; - while ((ch = *b0++)) - pt += put_utf8(pt, ch); - *pt++ = '\0'; - return buf; -} - -static void *slice(size_t min, size_t max, const unsigned char *buf USES_REGS); - -static unsigned char *to_buffer(unsigned char *buf, Term t, seq_tv_t *inp, - bool *widep, Int *atoms USES_REGS) { - CELL *r = NULL; - Int n; - - unsigned char *bufc = buf; - if (bufc == NULL) { - bufc = malloc(1024); - } - n = SkipListCodes(&bufc, &t, &r, atoms, widep, inp PASS_REGS); - if (n < 0) { - LOCAL_Error_TYPE = -n; - return NULL; + static unsigned char *Yap_ListOfAtomsToBuffer(unsigned char *buf, Term t, + seq_tv_t *inp USES_REGS) { + bool codes; + unsigned char *nbuf = codes2buf(t, buf, &codes PASS_REGS); + if (!codes) + return NULL; + return nbuf; } - return bufc; -} -static unsigned char *Yap_ListOfCodesToBuffer(unsigned char *buf, Term t, - seq_tv_t *inp, - bool *widep USES_REGS) { - Int atoms = 1; // we only want lists of atoms - return to_buffer(buf, t, inp, widep, &atoms PASS_REGS); -} - -static unsigned char *Yap_ListOfAtomsToBuffer(unsigned char *buf, Term t, - seq_tv_t *inp, - bool *widep USES_REGS) { - Int atoms = 2; // we only want lists of integer codes - return to_buffer(buf, t, inp, widep, &atoms PASS_REGS); -} - -static unsigned char *Yap_ListToBuffer(unsigned char *buf, Term t, - seq_tv_t *inp, bool *widep USES_REGS) { - Int atoms = 0; // we accept both types of lists. - return to_buffer(buf, t, inp, widep, &atoms PASS_REGS); -} + static unsigned char *Yap_ListToBuffer(unsigned char *buf, Term t, + seq_tv_t *inp USES_REGS) { + unsigned char *nbuf = codes2buf(t, buf, NULL PASS_REGS); + return nbuf; + } #if USE_GEN_TYPE_ERROR -static yap_error_number gen_type_error(int flags) { - if ((flags & (YAP_STRING_STRING | YAP_STRING_ATOM | YAP_STRING_INT | - YAP_STRING_FLOAT | YAP_STRING_ATOMS_CODES | YAP_STRING_BIG)) == - (YAP_STRING_STRING | YAP_STRING_ATOM | YAP_STRING_INT | YAP_STRING_FLOAT | - YAP_STRING_ATOMS_CODES | YAP_STRING_BIG)) - return TYPE_ERROR_TEXT; - if ((flags & (YAP_STRING_STRING | YAP_STRING_ATOM | YAP_STRING_INT | - YAP_STRING_FLOAT | YAP_STRING_BIG)) == - (YAP_STRING_STRING | YAP_STRING_ATOM | YAP_STRING_INT | YAP_STRING_FLOAT | - YAP_STRING_BIG)) - return TYPE_ERROR_ATOMIC; - if ((flags & (YAP_STRING_INT | YAP_STRING_FLOAT | YAP_STRING_BIG)) == - (YAP_STRING_INT | YAP_STRING_FLOAT | YAP_STRING_BIG)) + static yap_error_number gen_type_error(int flags) { + if ((flags & (YAP_STRING_STRING | YAP_STRING_ATOM | YAP_STRING_INT | + YAP_STRING_FLOAT | YAP_STRING_ATOMS_CODES | YAP_STRING_BIG)) == + (YAP_STRING_STRING | YAP_STRING_ATOM | YAP_STRING_INT | YAP_STRING_FLOAT | + YAP_STRING_ATOMS_CODES | YAP_STRING_BIG)) + return TYPE_ERROR_TEXT; + if ((flags & (YAP_STRING_STRING | YAP_STRING_ATOM | YAP_STRING_INT | + YAP_STRING_FLOAT | YAP_STRING_BIG)) == + (YAP_STRING_STRING | YAP_STRING_ATOM | YAP_STRING_INT | YAP_STRING_FLOAT | + YAP_STRING_BIG)) + return TYPE_ERROR_ATOMIC; + if ((flags & (YAP_STRING_INT | YAP_STRING_FLOAT | YAP_STRING_BIG)) == + (YAP_STRING_INT | YAP_STRING_FLOAT | YAP_STRING_BIG)) + return TYPE_ERROR_NUMBER; + if (flags & YAP_STRING_ATOM) + return TYPE_ERROR_ATOM; + if (flags & YAP_STRING_STRING) + return TYPE_ERROR_STRING; + if (flags & (YAP_STRING_CODES | YAP_STRING_ATOMS)) + return TYPE_ERROR_LIST; return TYPE_ERROR_NUMBER; - if (flags & YAP_STRING_ATOM) - return TYPE_ERROR_ATOM; - if (flags & YAP_STRING_STRING) - return TYPE_ERROR_STRING; - if (flags & (YAP_STRING_CODES | YAP_STRING_ATOMS)) - return TYPE_ERROR_LIST; - return TYPE_ERROR_NUMBER; -} + } #endif -// static int cnt; + // static int cnt; -unsigned char *Yap_readText(seq_tv_t *inp USES_REGS) { - unsigned char *s0 = NULL; - bool wide; + unsigned char *Yap_readText(seq_tv_t *inp USES_REGS) { - if (LOCAL_Error_TYPE != YAP_NO_ERROR) { - fprintf(stderr, "Spurious error %u\n", LOCAL_Error_TYPE); - LOCAL_Error_TYPE = YAP_NO_ERROR; - } - /* we know what the term is */ - if (!(inp->type & (YAP_STRING_CHARS | YAP_STRING_WCHARS))) { - if (!(inp->type & YAP_STRING_TERM)) { - if (IsVarTerm(inp->val.t)) { - LOCAL_Error_TYPE = INSTANTIATION_ERROR; - } else if (!IsAtomTerm(inp->val.t) && inp->type == YAP_STRING_ATOM) { - LOCAL_Error_TYPE = TYPE_ERROR_ATOM; - } else if (!IsStringTerm(inp->val.t) && inp->type == YAP_STRING_STRING) { - LOCAL_Error_TYPE = TYPE_ERROR_STRING; - } else if (!IsPairOrNilTerm(inp->val.t) && !IsStringTerm(inp->val.t) && - inp->type == (YAP_STRING_ATOMS_CODES | YAP_STRING_STRING)) { - LOCAL_Error_TYPE = TYPE_ERROR_LIST; - } else if (!IsPairOrNilTerm(inp->val.t) && !IsStringTerm(inp->val.t) && - !IsAtomTerm(inp->val.t) && !(inp->type & YAP_STRING_DATUM)) { - LOCAL_Error_TYPE = TYPE_ERROR_TEXT; + /* we know what the term is */ + if (!(inp->type & (YAP_STRING_CHARS | YAP_STRING_WCHARS))) { + if (!(inp->type & YAP_STRING_TERM)) { + if (IsVarTerm(inp->val.t)) { + LOCAL_Error_TYPE = INSTANTIATION_ERROR; + } else if (!IsAtomTerm(inp->val.t) && inp->type == YAP_STRING_ATOM) { + LOCAL_Error_TYPE = TYPE_ERROR_ATOM; + } else if (!IsStringTerm(inp->val.t) && inp->type == YAP_STRING_STRING) { + LOCAL_Error_TYPE = TYPE_ERROR_STRING; + } else if (!IsPairOrNilTerm(inp->val.t) && !IsStringTerm(inp->val.t) && + inp->type == (YAP_STRING_ATOMS_CODES | YAP_STRING_STRING)) { + LOCAL_Error_TYPE = TYPE_ERROR_LIST; + } else if (!IsPairOrNilTerm(inp->val.t) && !IsStringTerm(inp->val.t) && + !IsAtomTerm(inp->val.t) && !(inp->type & YAP_STRING_DATUM)) { + LOCAL_Error_TYPE = TYPE_ERROR_TEXT; + } } } - } - if (LOCAL_Error_TYPE != YAP_NO_ERROR) - return NULL; - - if (IsAtomTerm(inp->val.t) && inp->type & YAP_STRING_ATOM) { - // this is a term, extract to a buffer, and representation is wide - // Yap_DebugPlWriteln(inp->val.t); - Atom at = AtomOfTerm(inp->val.t); - if (inp->type & YAP_STRING_WITH_BUFFER) - return at->UStrOfAE; - size_t sz = strlen(at->StrOfAE); - inp->type |= YAP_STRING_IN_TMP; - char *o = Malloc(sz + 1); - strcpy(o, at->StrOfAE); - o = export_block(0, o); - return (unsigned char *)o; - } - if (IsStringTerm(inp->val.t) && inp->type & YAP_STRING_STRING) { - // this is a term, extract to a buffer, and representation is wide - // Yap_DebugPlWriteln(inp->val.t); - const char *s = StringOfTerm(inp->val.t); - if (inp->type & YAP_STRING_WITH_BUFFER) - return (unsigned char *)UStringOfTerm(inp->val.t); - inp->type |= YAP_STRING_IN_TMP; - size_t sz = strlen(s); - char *o = Malloc(sz + 1); - o = export_block(0, o); - strcpy(o, s); - return (unsigned char *)o; - } - if (((inp->type & (YAP_STRING_CODES | YAP_STRING_ATOMS)) == - (YAP_STRING_CODES | YAP_STRING_ATOMS)) && - IsPairOrNilTerm(inp->val.t)) { - // Yap_DebugPlWriteln(inp->val.t); - return Yap_ListToBuffer(s0, inp->val.t, inp, &wide PASS_REGS); - // this is a term, extract to a sfer, and representation is wide - } - if (inp->type & YAP_STRING_CODES && IsPairOrNilTerm(inp->val.t)) { - // Yap_DebugPlWriteln(inp->val.t); - return Yap_ListOfCodesToBuffer(s0, inp->val.t, inp, &wide PASS_REGS); - // this is a term, extract to a sfer, and representation is wide - } - if (inp->type & YAP_STRING_ATOMS && IsPairOrNilTerm(inp->val.t)) { - // Yap_DebugPlWriteln(inp->val.t); - return Yap_ListOfAtomsToBuffer(s0, inp->val.t, inp, &wide PASS_REGS); - // this is a term, extract to a buffer, and representation is wide - } - if (inp->type & YAP_STRING_INT && IsIntegerTerm(inp->val.t)) { - // ASCII, so both LATIN1 and UTF-8 - // Yap_DebugPlWriteln(inp->val.t); - char *s; - s = Malloc(2 * MaxTmp(PASS_REGS1)); - if (snprintf(s, MaxTmp(PASS_REGS1) - 1, Int_FORMAT, - IntegerOfTerm(inp->val.t)) < 0) { - AUX_ERROR(inp->val.t, 2 * MaxTmp(PASS_REGS1), s, char); - } - return (unsigned char *)s; - } - if (inp->type & YAP_STRING_FLOAT && IsFloatTerm(inp->val.t)) { - char *s; - // Yap_DebugPlWriteln(inp->val.t); - if (!Yap_FormatFloat(FloatOfTerm(inp->val.t), &s, 1024)) { + if (LOCAL_Error_TYPE != YAP_NO_ERROR) return NULL; + + if (IsAtomTerm(inp->val.t) && inp->type & YAP_STRING_ATOM) { + // this is a term, extract to a buffer, and representation is wide + // Yap_DebugPlWriteln(inp->val.t); + Atom at = AtomOfTerm(inp->val.t); + if (RepAtom(at)->UStrOfAE[0] == 0) { + unsigned char *o = Malloc(4); + memset(o, 0, 4); + return o; + } + if (inp->type & YAP_STRING_WITH_BUFFER) + return at->UStrOfAE; + size_t sz = strlen(at->StrOfAE); + inp->type |= YAP_STRING_IN_TMP; + char *o = BaseMalloc(sz + 1); + strcpy(o, at->StrOfAE); + return (unsigned char *)o; + } + if (IsStringTerm(inp->val.t) && inp->type & YAP_STRING_STRING) { + // this is a term, extract to a buffer, and representation is wide + // Yap_DebugPlWriteln(inp->val.t); + const char *s = StringOfTerm(inp->val.t); + if (s[0] == 0) { + char *o = BaseMalloc(4); + memset(o, 0, 4); + } + if (inp->type & YAP_STRING_WITH_BUFFER) + return (unsigned char *)UStringOfTerm(inp->val.t); + inp->type |= YAP_STRING_IN_TMP; + size_t sz = strlen(s); + char *o = BaseMalloc(sz + 1); + strcpy(o, s); + return (unsigned char *)o; + } + if (((inp->type & (YAP_STRING_CODES | YAP_STRING_ATOMS)) == + (YAP_STRING_CODES | YAP_STRING_ATOMS)) && + IsPairOrNilTerm(inp->val.t)) { + // Yap_DebugPlWriteln(inp->val.t); + return Yap_ListToBuffer(NULL, inp->val.t, inp PASS_REGS); + // this is a term, extract to a sfer, and representation is wide + } + if (inp->type & YAP_STRING_CODES && IsPairOrNilTerm(inp->val.t)) { + // Yap_DebugPlWriteln(inp->val.t); + return Yap_ListOfCodesToBuffer(NULL, inp->val.t, inp PASS_REGS); + // this is a term, extract to a sfer, and representation is wide + } + if (inp->type & YAP_STRING_ATOMS && IsPairOrNilTerm(inp->val.t)) { + // Yap_DebugPlWriteln(inp->val.t); + return Yap_ListOfAtomsToBuffer(NULL, inp->val.t, inp PASS_REGS); + // this is a term, extract to a buffer, and representation is wide + } + if (inp->type & YAP_STRING_INT && IsIntegerTerm(inp->val.t)) { + // ASCII, so both LATIN1 and UTF-8 + // Yap_DebugPlWriteln(inp->val.t); + char *s; + s = BaseMalloc(2 * MaxTmp(PASS_REGS1)); + if (snprintf(s, MaxTmp(PASS_REGS1) - 1, Int_FORMAT, + IntegerOfTerm(inp->val.t)) < 0) { + AUX_ERROR(inp->val.t, 2 * MaxTmp(PASS_REGS1), s, char); + } + return (unsigned char *)s; + } + if (inp->type & YAP_STRING_FLOAT && IsFloatTerm(inp->val.t)) { + char *s; + // Yap_DebugPlWriteln(inp->val.t); + if (!Yap_FormatFloat(FloatOfTerm(inp->val.t), &s, 1024)) { + return NULL; + } + return (unsigned char *)s; } - return (unsigned char *)s; - } #if USE_GMP - if (inp->type & YAP_STRING_BIG && IsBigIntTerm(inp->val.t)) { - // Yap_DebugPlWriteln(inp->val.t); - char *s; - s = Malloc(MaxTmp()); - if (!Yap_mpz_to_string(Yap_BigIntOfTerm(inp->val.t), s, MaxTmp() - 1, 10)) { - AUX_ERROR(inp->val.t, MaxTmp(PASS_REGS1), s, char); + if (inp->type & YAP_STRING_BIG && IsBigIntTerm(inp->val.t)) { + // Yap_DebugPlWriteln(inp->val.t); + char *s; + s = BaseMalloc(MaxTmp()); + if (!Yap_mpz_to_string(Yap_BigIntOfTerm(inp->val.t), s, MaxTmp() - 1, 10)) { + AUX_ERROR(inp->val.t, MaxTmp(PASS_REGS1), s, char); + } + return inp->val.uc = (unsigned char *)s; } - return inp->val.uc = (unsigned char *)s; - } #endif - if (inp->type & YAP_STRING_TERM) { - // Yap_DebugPlWriteln(inp->val.t); - char *s = (char *)Yap_TermToString(inp->val.t, ENC_ISO_UTF8, 0); - return inp->val.uc = (unsigned char *)s; - } - if (inp->type & YAP_STRING_CHARS) { - if (inp->enc == ENC_ISO_LATIN1) { - return latin2utf8(inp); - } else if (inp->enc == ENC_ISO_ASCII) { - return inp->val.uc; - } else { // if (inp->enc == ENC_ISO_UTF8) { - return inp->val.uc; + if (inp->type & YAP_STRING_TERM) { + // Yap_DebugPlWriteln(inp->val.t); + char *s = (char *)Yap_TermToString(inp->val.t, ENC_ISO_UTF8, 0); + return inp->val.uc = (unsigned char *)s; } - } - if (inp->type & YAP_STRING_WCHARS) { - // printf("%S\n",inp->val.w); - return wchar2utf8(inp); - } - return NULL; -} - -static Term write_strings(unsigned char *s0, seq_tv_t *out USES_REGS) { - size_t min = 0, max = strlen((char *)s0); - - if (out->type & (YAP_STRING_NCHARS | YAP_STRING_TRUNC)) { - if (out->type & YAP_STRING_NCHARS) - min = out->max; - if (out->type & YAP_STRING_TRUNC && out->max < max) { - max = out->max; - s0[max] = '\0'; + if (inp->type & YAP_STRING_CHARS) { + if (inp->enc == ENC_ISO_LATIN1) { + return latin2utf8(inp); + } else if (inp->enc == ENC_ISO_ASCII) { + return inp->val.uc; + } else { // if (inp->enc == ENC_ISO_UTF8) { + return inp->val.uc; + } } - } - - char *s = (char *)s0; - Term t = init_tstring(PASS_REGS1); - LOCAL_TERM_ERROR(t, 2 * max); - unsigned char *buf = buf_from_tstring(HR); - strcpy((char *)buf, s); - if (max + 1 < min) { - LOCAL_TERM_ERROR(t, 2 * min); - memset(buf + min, '\0', max); - buf += min; - } else { - buf += max + 1; - } - close_tstring(buf PASS_REGS); - out->val.t = t; - - return out->val.t; -} - -static Term write_atoms(void *s0, seq_tv_t *out USES_REGS) { - Term t = AbsPair(HR); - char *s1 = (char *)s0; - size_t sz = 0; - size_t max = strlen(s1); - if (s1[0] == '\0') { - out->val.t = TermNil; - return TermNil; - } - if (out->type & (YAP_STRING_NCHARS | YAP_STRING_TRUNC)) { - if (out->type & YAP_STRING_TRUNC && out->max < max) - max = out->max; - } - - unsigned char *s = s0, *lim = s + strnlen((char *)s, max); - unsigned char *cp = s; - unsigned char w[10]; - int wp = 0; - LOCAL_TERM_ERROR(t, 2 * (lim - s)); - while (cp < lim && *cp) { - utf8proc_int32_t chr; - CELL *cl; - s += get_utf8(s, -1, &chr); - if (chr == '\0') { - w[0] = '\0'; - break; + if (inp->type & YAP_STRING_WCHARS) { + // printf("%S\n",inp->val.w); + return wchar2utf8(inp); } - wp = put_utf8(w, chr); - w[wp] = '\0'; - cl = HR; - HR += 2; - cl[0] = MkAtomTerm(Yap_ULookupAtom(w)); - cl[1] = AbsPair(HR); - sz++; - if (sz == max) - break; + return NULL; } - if (out->type & YAP_STRING_DIFF) { - if (sz == 0) - t = out->dif; - else - HR[-1] = Globalize(out->dif PASS_REGS); - } else { - if (sz == 0) - t = TermNil; - else - HR[-1] = TermNil; - } - out->val.t = t; - return (t); -} -static Term write_codes(void *s0, seq_tv_t *out USES_REGS) { - Term t; - size_t sz = strlen(s0); - if (sz == 0) { - if (out->type & YAP_STRING_DIFF) { - out->val.t = Globalize(out->dif PASS_REGS); + static Term write_strings(unsigned char *s0, seq_tv_t *out USES_REGS) { + size_t min = 0, max = strlen((char *)s0); + + if (out->type & (YAP_STRING_NCHARS | YAP_STRING_TRUNC)) { + if (out->type & YAP_STRING_NCHARS) + min = out->max; + if (out->type & YAP_STRING_TRUNC && out->max < max) { + max = out->max; + s0[max] = '\0'; + } + } + + char *s = (char *)s0; + Term t = init_tstring(PASS_REGS1); + LOCAL_TERM_ERROR(t, 2 * max); + unsigned char *buf = buf_from_tstring(HR); + strcpy((char *)buf, s); + if (max + 1 < min) { + LOCAL_TERM_ERROR(t, 2 * min); + memset(buf + min, '\0', max); + buf += min; } else { - out->val.t = TermNil; + buf += max + 1; } + close_tstring(buf PASS_REGS); + out->val.t = t; + return out->val.t; } - unsigned char *s = s0, *lim = s + sz; - unsigned char *cp = s; - t = AbsPair(HR); - LOCAL_TERM_ERROR(t, 2 * (lim - s)); - t = AbsPair(HR); - while (*cp) { - utf8proc_int32_t chr; - CELL *cl; - cp += get_utf8(cp, -1, &chr); - if (chr == '\0') - break; - cl = HR; - HR += 2; - cl[0] = MkIntegerTerm(chr); - cl[1] = AbsPair(HR); - } - if (sz == 0) { - HR[-1] = Globalize(out->dif PASS_REGS); - } else { - HR[-1] = TermNil; - } - out->val.t = t; - return (t); -} - -static Atom write_atom(void *s0, seq_tv_t *out USES_REGS) { - unsigned char *s = s0; - int32_t ch; - size_t leng = strlen(s0); - if (leng == 0) { - return Yap_LookupAtom(""); - } - if (strlen_utf8(s0) <= leng) { - return Yap_LookupAtom(s0); - } else { - size_t n = get_utf8(s, -1, &ch); - unsigned char *buf = Malloc(n + 1); - memcpy(buf, s0, n + 1); - return Yap_ULookupAtom(buf); - } -} - -size_t write_buffer(unsigned char *s0, seq_tv_t *out USES_REGS) { - size_t leng = strlen((char *)s0); - size_t min = 0, max = leng, room_end; - if (out->enc == ENC_ISO_UTF8) { - room_end = strlen((char *)s0) + 1; - if (out->val.uc == NULL) { // this should always be the case - out->val.uc = malloc(room_end < 16 ? 16 : room_end); + static Term write_atoms(void *s0, seq_tv_t *out USES_REGS) { + Term t = AbsPair(HR); + char *s1 = (char *)s0; + size_t sz = 0; + size_t max = strlen(s1); + if (s1[0] == '\0') { + out->val.t = TermNil; + return TermNil; } - if (out->val.uc != s0) { - strcpy(out->val.c, (char *)s0); + if (out->type & (YAP_STRING_NCHARS | YAP_STRING_TRUNC)) { + if (out->type & YAP_STRING_TRUNC && out->max < max) + max = out->max; } - } else if (out->enc == ENC_ISO_LATIN1) { - room_end = strlen((char *)s0) + 1; - unsigned char *s = s0; + + unsigned char *s = s0, *lim = s + strnlen((char *)s, max); unsigned char *cp = s; - unsigned char *buf = out->val.uc; - if (!buf) - return -1; + unsigned char w[10]; + int wp = 0; + LOCAL_TERM_ERROR(t, 2 * (lim - s)); + while (cp < lim && *cp) { + utf8proc_int32_t chr; + CELL *cl; + s += get_utf8(s, -1, &chr); + if (chr == '\0') { + w[0] = '\0'; + break; + } + wp = put_utf8(w, chr); + w[wp] = '\0'; + cl = HR; + HR += 2; + cl[0] = MkAtomTerm(Yap_ULookupAtom(w)); + cl[1] = AbsPair(HR); + sz++; + if (sz == max) + break; + } + if (out->type & YAP_STRING_DIFF) { + if (sz == 0) + t = out->dif; + else + HR[-1] = Globalize(out->dif PASS_REGS); + } else { + if (sz == 0) + t = TermNil; + else + HR[-1] = TermNil; + } + out->val.t = t; + return (t); + } + + static Term write_codes(void *s0, seq_tv_t *out USES_REGS) { + Term t; + size_t sz = strlen(s0); + if (sz == 0) { + if (out->type & YAP_STRING_DIFF) { + out->val.t = Globalize(out->dif PASS_REGS); + } else { + out->val.t = TermNil; + } + return out->val.t; + } + unsigned char *s = s0, *lim = s + sz; + unsigned char *cp = s; + + t = AbsPair(HR); + LOCAL_TERM_ERROR(t, 2 * (lim - s)); + t = AbsPair(HR); while (*cp) { utf8proc_int32_t chr; - int off = get_utf8(cp, -1, &chr); - if (off <= 0 || chr > 255) - return -1; - if (off == max) - break; - cp += off; - *buf++ = chr; - } - if (max >= min) - *buf++ = '\0'; - else - while (max < min) { - utf8proc_int32_t chr; - max++; - cp += get_utf8(cp, -1, &chr); - *buf++ = chr; - } - room_end = buf - out->val.uc; - } else if (out->enc == ENC_WCHAR) { - unsigned char *s = s0, *lim = s + (max = strnlen((char *)s0, max)); - unsigned char *cp = s; - wchar_t *buf0, *buf; - - buf = buf0 = out->val.w; - if (!buf) - return -1; - while (*cp && cp < lim) { - utf8proc_int32_t chr; + CELL *cl; cp += get_utf8(cp, -1, &chr); - *buf++ = chr; + if (chr == '\0') + break; + cl = HR; + HR += 2; + cl[0] = MkIntegerTerm(chr); + cl[1] = AbsPair(HR); } - if (max >= min) - *buf++ = '\0'; - else - while (max < min) { - utf8proc_int32_t chr; - max++; - cp += get_utf8(cp, -1, &chr); - *buf++ = chr; - } - *buf = '\0'; - room_end = (buf - buf0) + 1; - } else { - // no other encodings are supported. - room_end = -1; + if (sz == 0) { + HR[-1] = Globalize(out->dif PASS_REGS); + } else { + HR[-1] = TermNil; + } + out->val.t = t; + return (t); + } + + static Atom write_atom(void *s0, seq_tv_t *out USES_REGS) { + unsigned char *s = s0; + int32_t ch; + size_t leng = strlen(s0); + if (leng == 0) { + return Yap_LookupAtom(""); + } + if (strlen_utf8(s0) <= leng) { + return Yap_LookupAtom(s0); + } else { + size_t n = get_utf8(s, -1, &ch); + unsigned char *buf = Malloc(n + 1); + memcpy(buf, s0, n + 1); + return Yap_ULookupAtom(buf); + } + } + + void *write_buffer(unsigned char *s0, seq_tv_t *out USES_REGS) { + size_t leng = strlen((char *)s0); + size_t min = 0, max = leng; + if (out->enc == ENC_ISO_UTF8) { + if (true || out->val.uc == NULL) { // this should always be the case + out->val.uc = BaseMalloc(leng + 1); + strcpy(out->val.c, (char *)s0); + } else if (out->val.uc != s0) { + out->val.c = Realloc(out->val.c, leng + 1); + strcpy(out->val.c, (char *)s0); + } + } else if (out->enc == ENC_ISO_LATIN1) { + + unsigned char *s = s0; + unsigned char *cp = s; + unsigned char *buf = out->val.uc; + if (!buf) + return NULL; + while (*cp) { + utf8proc_int32_t chr; + int off = get_utf8(cp, -1, &chr); + if (off <= 0 || chr > 255) + return NULL; + if (off == max) + break; + cp += off; + *buf++ = chr; + } + if (max >= min) + *buf++ = '\0'; + else + while (max < min) { + utf8proc_int32_t chr; + max++; + cp += get_utf8(cp, -1, &chr); + *buf++ = chr; + } + } else if (out->enc == ENC_WCHAR) { + unsigned char *s = s0, *lim = s + (max = strnlen((char *)s0, max)); + unsigned char *cp = s; + wchar_t *buf0, *buf; + + buf = buf0 = out->val.w; + if (!buf) + return NULL; + while (*cp && cp < lim) { + utf8proc_int32_t chr; + cp += get_utf8(cp, -1, &chr); + *buf++ = chr; + } + if (max >= min) + *buf++ = '\0'; + else + while (max < min) { + utf8proc_int32_t chr; + max++; + cp += get_utf8(cp, -1, &chr); + *buf++ = chr; + } + *buf = '\0'; + } else { + // no other encodings are supported. + return NULL; + } + return out->val.c; } - return room_end; -} static size_t write_length(const unsigned char *s0, seq_tv_t *out USES_REGS) { return strlen_utf8(s0); } static Term write_number(unsigned char *s, seq_tv_t *out, - bool error_on USES_REGS) { + bool error_on USES_REGS) { Term t; yap_error_number erro = LOCAL_Error_TYPE; int i = push_text_stack(); @@ -726,433 +725,436 @@ bool write_Text(unsigned char *inp, seq_tv_t *out USES_REGS) { return true; } - if (out->type & YAP_STRING_DATUM) { - if ((out->val.t = string_to_term(inp, out PASS_REGS)) != 0L) - return out->val.t != 0; - } if (out->type & (YAP_STRING_INT | YAP_STRING_FLOAT | YAP_STRING_BIG)) { if ((out->val.t = write_number( - inp, out, !(out->type & YAP_STRING_ATOM) PASS_REGS)) != 0L) { + inp, out, !(out->type & YAP_STRING_ATOM) PASS_REGS)) != 0L) { // Yap_DebugPlWriteln(out->val.t); - return true; + return true; + } + + if (!(out->type & YAP_STRING_ATOM)) + return false; + } + if (out->type & (YAP_STRING_ATOM)) { + if ((out->val.a = write_atom(inp, out PASS_REGS)) != NIL) { + Atom at = out->val.a; + if (at && (out->type & YAP_STRING_OUTPUT_TERM)) + out->val.t = MkAtomTerm(at); + // Yap_DebugPlWriteln(out->val.t); + return at != NIL; + } + } + if (out->type & YAP_STRING_DATUM) { + if ((out->val.t = string_to_term(inp, out PASS_REGS)) != 0L) + return out->val.t != 0; } - if (!(out->type & YAP_STRING_ATOM)) - return false; - } - if (out->type & (YAP_STRING_ATOM)) { - if ((out->val.a = write_atom(inp, out PASS_REGS)) != NIL) { - Atom at = out->val.a; - if (at && (out->type & YAP_STRING_OUTPUT_TERM)) - out->val.t = MkAtomTerm(at); + switch (out->type & YAP_TYPE_MASK) { + case YAP_STRING_CHARS: { + void *room = write_buffer(inp, out PASS_REGS); + // printf("%s\n", out->val.c); + return room != NULL; + } + case YAP_STRING_WCHARS: { + void *room = write_buffer(inp, out PASS_REGS); + // printf("%S\n", out->val.w); + return room != NULL; + } + case YAP_STRING_STRING: + out->val.t = write_strings(inp, out PASS_REGS); // Yap_DebugPlWriteln(out->val.t); - return at != NIL; + return out->val.t != 0; + case YAP_STRING_ATOMS: + out->val.t = write_atoms(inp, out PASS_REGS); + // Yap_DebugPlWriteln(out->val.t); + return out->val.t != 0; + case YAP_STRING_CODES: + out->val.t = write_codes(inp, out PASS_REGS); + // Yap_DebugPlWriteln(out->val.t); + return out->val.t != 0; + case YAP_STRING_LENGTH: + out->val.l = write_length(inp, out PASS_REGS); + // printf("s\n",out->val.l); + return out->val.l != (size_t)(-1); + case YAP_STRING_ATOM: + out->val.a = write_atom(inp, out PASS_REGS); + // Yap_DebugPlWriteln(out->val.t); + return out->val.a != NULL; + case YAP_STRING_INT | YAP_STRING_FLOAT | YAP_STRING_BIG: + out->val.t = write_number(inp, out, true PASS_REGS); + // Yap_DebugPlWriteln(out->val.t); + return out->val.t != 0; + default: { return true; } } + return false; } - switch (out->type & YAP_TYPE_MASK) { - case YAP_STRING_CHARS: { - size_t room = write_buffer(inp, out PASS_REGS); - // printf("%s\n", out->val.c); - return ((Int)room > 0); - } - case YAP_STRING_WCHARS: { - size_t room = write_buffer(inp, out PASS_REGS); - // printf("%S\n", out->val.w); - return ((Int)room > 0); - } - case YAP_STRING_STRING: - out->val.t = write_strings(inp, out PASS_REGS); - // Yap_DebugPlWriteln(out->val.t); - return out->val.t != 0; - case YAP_STRING_ATOMS: - out->val.t = write_atoms(inp, out PASS_REGS); - // Yap_DebugPlWriteln(out->val.t); - return out->val.t != 0; - case YAP_STRING_CODES: - out->val.t = write_codes(inp, out PASS_REGS); - // Yap_DebugPlWriteln(out->val.t); - return out->val.t != 0; - case YAP_STRING_LENGTH: - out->val.l = write_length(inp, out PASS_REGS); - // printf("s\n",out->val.l); - return out->val.l != (size_t)(-1); - case YAP_STRING_ATOM: - out->val.a = write_atom(inp, out PASS_REGS); - // Yap_DebugPlWriteln(out->val.t); - return out->val.a != NULL; - case YAP_STRING_INT | YAP_STRING_FLOAT | YAP_STRING_BIG: - out->val.t = write_number(inp, out, true PASS_REGS); - // Yap_DebugPlWriteln(out->val.t); - return out->val.t != 0; - default: { return true; } - } - return false; -} + static size_t upcase(void *s0, seq_tv_t *out USES_REGS) { -static size_t upcase(void *s0, seq_tv_t *out USES_REGS) { - - unsigned char *s = s0; - while (*s) { - // assumes the two code have always the same size; - utf8proc_int32_t chr; - get_utf8(s, -1, &chr); - chr = utf8proc_toupper(chr); - s += put_utf8(s, chr); + unsigned char *s = s0; + while (*s) { + // assumes the two code have always the same size; + utf8proc_int32_t chr; + get_utf8(s, -1, &chr); + chr = utf8proc_toupper(chr); + s += put_utf8(s, chr); + } + return true; } - return true; -} -static size_t downcase(void *s0, seq_tv_t *out USES_REGS) { + static size_t downcase(void *s0, seq_tv_t *out USES_REGS) { - unsigned char *s = s0; - while (*s) { - // assumes the two code have always the same size; - utf8proc_int32_t chr; - get_utf8(s, -1, &chr); - chr = utf8proc_tolower(chr); - s += put_utf8(s, chr); + unsigned char *s = s0; + while (*s) { + // assumes the two code have always the same size; + utf8proc_int32_t chr; + get_utf8(s, -1, &chr); + chr = utf8proc_tolower(chr); + s += put_utf8(s, chr); + } + return true; } - return true; -} -bool Yap_CVT_Text(seq_tv_t *inp, seq_tv_t *out USES_REGS) { - unsigned char *buf; - bool rc; - /* - f//printfmark(stderr, "[ %d ", n++) ; + bool Yap_CVT_Text(seq_tv_t *inp, seq_tv_t *out USES_REGS) { + unsigned char *buf; + bool rc; + /* + //printf(stderr, "[ %d ", n++) ; if (inp->type & (YAP_STRING_TERM|YAP_STRING_ATOM|YAP_STRING_ATOMS_CODES |YAP_STRING_STRING)) //Yap_DebugPlWriteln(inp->val.t); else if (inp->type & YAP_STRING_WCHARS) fprintf(stderr,"S %S\n", inp->val .w); else fprintf(stderr,"s %s\n", inp->val.c); - */ - // cnt++; - int l = push_text_stack(); - buf = Yap_readText(inp PASS_REGS); - if (!buf) { + */ + // cnt++; + int l = push_text_stack(); + buf = Yap_readText(inp PASS_REGS); + if (!buf) { + pop_text_stack(l); + return 0L; + } + size_t leng = strlen_utf8(buf); + if (out->type & (YAP_STRING_NCHARS | YAP_STRING_TRUNC)) { + if (out->max < leng) { + const unsigned char *ptr = skip_utf8(buf, out->max); + size_t diff = (ptr - buf); + char *nbuf = Malloc(diff + 1); + memcpy(nbuf, buf, diff); + nbuf[diff] = '\0'; + leng = diff; + } + // else if (out->type & YAP_STRING_NCHARS && + // const unsigned char *ptr = skip_utf8(buf) + } + + 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 PASS_REGS); + /* fprintf(stderr, " -> "); + if (!rc) fprintf(stderr, "NULL"); + else if (out->type & + (YAP_STRING_TERM|YAP_STRING_ATOMS_CODES + |YAP_STRING_STRING)) //Yap_DebugPlWrite(out->val.t); + else if (out->type & + YAP_STRING_ATOM) //Yap_DebugPlWriteln(MkAtomTerm(out->val.a)); + else if (out->type & YAP_STRING_WCHARS) fprintf(stderr, "%S", + out->val.w); + else + fprintf(stderr, "%s", out->val.c); + fprintf(stderr, "\n]\n"); */ pop_text_stack(l); - return 0L; + return rc; } - size_t leng = strlen_utf8(buf); - if (out->type & (YAP_STRING_NCHARS | YAP_STRING_TRUNC)) { - if (out->max < leng) { - const unsigned char *ptr = skip_utf8(buf, out->max); - size_t diff = (ptr - buf); - char *nbuf = Malloc(diff + 1); - memcpy(nbuf, buf, diff); - nbuf[diff] = '\0'; - leng = diff; + + static unsigned char *concat(int n, void *sv[] USES_REGS) { + void *buf; + unsigned char *buf0; + size_t room = 0; + int i; + + for (i = 0; i < n; i++) { + char *s = sv[i]; + if (s[0]) + room += strlen(s); } - // else if (out->type & YAP_STRING_NCHARS && - // const unsigned char *ptr = skip_utf8(buf) - } - - 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 PASS_REGS); - /* fprintf(stderr, " -> "); - if (!rc) fprintf(stderr, "NULL"); - else if (out->type & - (YAP_STRING_TERM|YAP_STRING_ATOMS_CODES - |YAP_STRING_STRING)) //Yap_DebugPlWrite(out->val.t); - else if (out->type & - YAP_STRING_ATOM) //Yap_DebugPlWriteln(MkAtomTerm(out->val.a)); - else if (out->type & YAP_STRING_WCHARS) fprintf(stderr, "%S", - out->val.w); - else - fprintf(stderr, "%s", out->val.c); - fprintf(stderr, "\n]\n"); */ - pop_text_stack(l); - return rc; -} - -static unsigned char *concat(int n, void *sv[] USES_REGS) { - void *buf; - unsigned char *buf0; - size_t room = 0; - int i; - - for (i = 0; i < n; i++) { - char *s = sv[i]; - if (s[0]) - room += strlen(s); - } - buf = Malloc(room + 1); - buf0 = buf; - for (i = 0; i < n; i++) { - char *s = sv[i]; - if (!s[0]) - continue; + buf = Malloc(room + 1); + buf0 = buf; + for (i = 0; i < n; i++) { + char *s = sv[i]; + if (!s[0]) + continue; #if _WIN32 || defined(__ANDROID__) - strcpy(buf, s); - buf = (char *)buf + strlen(buf); + strcpy(buf, s); + buf = (char *)buf + strlen(buf); #else - buf = stpcpy(buf, s); + buf = stpcpy(buf, s); #endif + } + return buf0; } - return buf0; -} -static void *slice(size_t min, size_t max, const unsigned char *buf USES_REGS) { - unsigned char *nbuf = Malloc((max - min) * 4 + 1); - const unsigned char *ptr = skip_utf8(buf, min); - unsigned char *nptr = nbuf; - utf8proc_int32_t chr; + static void *slice(size_t min, size_t max, const unsigned char *buf USES_REGS) { + unsigned char *nbuf = Malloc((max - min) * 4 + 1); + const unsigned char *ptr = skip_utf8(buf, min); + unsigned char *nptr = nbuf; + utf8proc_int32_t chr; - while (min++ < max) { - ptr += get_utf8(ptr, -1, &chr); - nptr += put_utf8(nptr, chr); + while (min++ < max) { + ptr += get_utf8(ptr, -1, &chr); + nptr += put_utf8(nptr, chr); + } + nptr[0] = '\0'; + return nbuf; } - nptr[0] = '\0'; - return nbuf; -} -// -// Out must be an atom or a string -bool Yap_Concat_Text(int tot, seq_tv_t inp[], seq_tv_t *out USES_REGS) { - void **bufv; - unsigned char *buf; - int i, j; + // + // Out must be an atom or a string + bool Yap_Concat_Text(int tot, seq_tv_t inp[], seq_tv_t *out USES_REGS) { + void **bufv; + unsigned char *buf; + int i, j; - bufv = Malloc(tot * sizeof(unsigned char *)); - if (!bufv) { - return NULL; - } - for (i = 0, j = 0; i < tot; i++) { - inp[j].type |= YAP_STRING_WITH_BUFFER; - unsigned char *nbuf = Yap_readText(inp + i PASS_REGS); - - if (!nbuf) { + bufv = Malloc(tot * sizeof(unsigned char *)); + if (!bufv) { return NULL; } - if (!nbuf[0]) - continue; - bufv[j++] = nbuf; - } - if (j == 0) { - buf = malloc(8); - memset(buf, 0, 4); - } else if (j == 1) { - buf = bufv[0]; - } else { - buf = concat(tot, bufv PASS_REGS); - } - bool rc = write_Text(buf, out PASS_REGS); + for (i = 0, j = 0; i < tot; i++) { + inp[j].type |= YAP_STRING_WITH_BUFFER; + unsigned char *nbuf = Yap_readText(inp + i PASS_REGS); - return rc; -} - -// -bool Yap_Splice_Text(int n, size_t cuts[], seq_tv_t *inp, - seq_tv_t outv[] USES_REGS) { - const unsigned char *buf; - size_t b_l, u_l; - - inp->type |= YAP_STRING_IN_TMP; - buf = Yap_readText(inp PASS_REGS); - if (!buf) { - return false; - } - b_l = strlen((char *)buf); - u_l = strlen_utf8(buf); - if (!cuts) { - if (n == 2) { - size_t b_l0, b_l1, u_l0, u_l1; - unsigned char *buf0, *buf1; - - if (outv[0].val.t) { - buf0 = Yap_readText(outv PASS_REGS); - if (!buf0) { - return false; - } - b_l0 = strlen((const char *)buf0); - if (bcmp(buf, buf0, b_l0) != 0) { - return false; - } - u_l0 = strlen_utf8(buf0); - u_l1 = u_l - u_l0; - - b_l1 = b_l - b_l0; - buf1 = slice(u_l0, u_l, buf PASS_REGS); - b_l1 = strlen((const char *)buf1); - bool rc = write_Text(buf1, outv + 1 PASS_REGS); - if (!rc) { - return false; - } - return rc; - } else /* if (outv[1].val.t) */ { - buf1 = Yap_readText(outv + 1 PASS_REGS); - if (!buf1) { - return false; - } - b_l1 = strlen((char *)buf1); - u_l1 = strlen_utf8(buf1); - b_l0 = b_l - b_l1; - u_l0 = u_l - u_l1; - if (bcmp(skip_utf8((const unsigned char *)buf, b_l0), buf1, b_l1) != - 0) { - return false; - } - buf0 = slice(0, u_l0, buf PASS_REGS); - bool rc = write_Text(buf0, outv PASS_REGS); - return rc; + if (!nbuf) { + return NULL; } + if (!nbuf[0]) + continue; + bufv[j++] = nbuf; } + if (j == 0) { + buf = malloc(8); + memset(buf, 0, 4); + } else if (j == 1) { + buf = bufv[0]; + } else { + buf = concat(tot, bufv PASS_REGS); + } + bool rc = write_Text(buf, out PASS_REGS); + + return rc; } - int i, next; - for (i = 0; i < n; i++) { - if (i == 0) - next = 0; - else - next = cuts[i - 1]; - if (i > 0 && cuts[i] == 0) - break; - void *bufi = slice(next, cuts[i], buf PASS_REGS); - if (!write_Text(bufi, outv + i PASS_REGS)) { + + // + bool Yap_Splice_Text(int n, size_t cuts[], seq_tv_t *inp, + seq_tv_t outv[] USES_REGS) { + const unsigned char *buf; + size_t b_l, u_l; + + inp->type |= YAP_STRING_IN_TMP; + buf = Yap_readText(inp PASS_REGS); + if (!buf) { return false; } + b_l = strlen((char *)buf); + if (b_l == 0) { + return false; + } + u_l = strlen_utf8(buf); + if (!cuts) { + if (n == 2) { + size_t b_l0, b_l1, u_l0, u_l1; + unsigned char *buf0, *buf1; + + if (outv[0].val.t) { + buf0 = Yap_readText(outv PASS_REGS); + if (!buf0) { + return false; + } + b_l0 = strlen((const char *)buf0); + if (bcmp(buf, buf0, b_l0) != 0) { + return false; + } + u_l0 = strlen_utf8(buf0); + u_l1 = u_l - u_l0; + + b_l1 = b_l - b_l0; + buf1 = slice(u_l0, u_l, buf PASS_REGS); + b_l1 = strlen((const char *)buf1); + bool rc = write_Text(buf1, outv + 1 PASS_REGS); + if (!rc) { + return false; + } + return rc; + } else /* if (outv[1].val.t) */ { + buf1 = Yap_readText(outv + 1 PASS_REGS); + if (!buf1) { + return false; + } + b_l1 = strlen((char *)buf1); + u_l1 = strlen_utf8(buf1); + b_l0 = b_l - b_l1; + u_l0 = u_l - u_l1; + if (bcmp(skip_utf8((const unsigned char *)buf, b_l0), buf1, b_l1) != + 0) { + return false; + } + buf0 = slice(0, u_l0, buf PASS_REGS); + bool rc = write_Text(buf0, outv PASS_REGS); + return rc; + } + } + } + int i, next; + for (i = 0; i < n; i++) { + if (i == 0) + next = 0; + else + next = cuts[i - 1]; + if (i > 0 && cuts[i] == 0) + break; + void *bufi = slice(next, cuts[i], buf PASS_REGS); + if (!write_Text(bufi, outv + i PASS_REGS)) { + return false; + } + } + + return true; } - return true; -} - -/** - * Function to convert a generic text term (string, atom, list of codes, list - of< - atoms) into a buff - er. - * - * @param t the term - * @param buf the buffer, if NULL a buffer is malloced, and the user should - reclai it - * @param len buffer size - * @param enc encoding (UTF-8 is strongly recommended) - * - * @return the buffer, or NULL in case of failure. If so, Yap_Error may be - called. -*/ -const char *Yap_TextTermToText(Term t, char *buf, encoding_t enc USES_REGS) { - seq_tv_t inp, out; - inp.val.t = t; - if (IsAtomTerm(t) && t != TermNil) { - inp.type = YAP_STRING_ATOM; - inp.enc = ENC_ISO_UTF8; - } else if (IsStringTerm(t)) { - inp.type = YAP_STRING_STRING; - inp.enc = ENC_ISO_UTF8; - } else if (IsPairOrNilTerm(t)) { - inp.type = (YAP_STRING_CODES | YAP_STRING_ATOMS); - } else { - Yap_Error(TYPE_ERROR_TEXT, t, NULL); - return false; + /** + * Function to convert a generic text term (string, atom, list of codes, list + of< + atoms) into a buff + er. + * + * @param t the term + * @param buf the buffer, if NULL a buffer is malloced, and the user should + reclai it + * @param len buffer size + * @param enc encoding (UTF-8 is strongly recommended) + * + * @return the buffer, or NULL in case of failure. If so, Yap_Error may be + called. + */ + const char *Yap_TextTermToText(Term t, char *buf, encoding_t enc USES_REGS) { + seq_tv_t inp, out; + inp.val.t = t; + if (IsAtomTerm(t) && t != TermNil) { + inp.type = YAP_STRING_ATOM; + inp.enc = ENC_ISO_UTF8; + } else if (IsStringTerm(t)) { + inp.type = YAP_STRING_STRING; + inp.enc = ENC_ISO_UTF8; + } else if (IsPairOrNilTerm(t)) { + inp.type = (YAP_STRING_CODES | YAP_STRING_ATOMS); + } else { + Yap_Error(TYPE_ERROR_TEXT, t, NULL); + return false; + } + out.enc = enc; + out.type = YAP_STRING_CHARS; + out.val.c = buf; + if (!Yap_CVT_Text(&inp, &out PASS_REGS)) + return NULL; + return out.val.c; } - out.enc = enc; - out.type = YAP_STRING_CHARS; - out.val.c = buf; - if (!Yap_CVT_Text(&inp, &out PASS_REGS)) - return NULL; - return out.val.c; -} -/** - * Convert from a predicate structure to an UTF-8 string of the form - * - * module:name/arity. - * - * The result is in very volatile memory. - * - * @param s the buffer - * - * @return the temporary string - */ -const char *Yap_PredIndicatorToUTF8String(PredEntry *ap) { - CACHE_REGS - Atom at; - arity_t arity = 0; - Functor f; - char *s, *smax, *s0; - s = s0 = malloc(1024); - smax = s + 1024; - Term tmod = ap->ModuleOfPred; - if (tmod) { - Yap_AtomToUTF8Text(AtomOfTerm(tmod), s); + /** + * Convert from a predicate structure to an UTF-8 string of the form + * + * module:name/arity. + * + * The result is in very volatile memory. + * + * @param s the buffer + * + * @return the temporary string + */ + const char *Yap_PredIndicatorToUTF8String(PredEntry *ap) { + CACHE_REGS + Atom at; + arity_t arity = 0; + Functor f; + char *s, *smax, *s0; + s = s0 = malloc(1024); + smax = s + 1024; + Term tmod = ap->ModuleOfPred; + if (tmod) { + char *sn = Yap_AtomToUTF8Text(AtomOfTerm(tmod)); + stpcpy(s, sn); + if (smax - s > 1) { + strcat(s, ":"); + } else { + return NULL; + } + s++; + } else { + if (smax - s > strlen("prolog:")) { + s = strcpy(s, "prolog:"); + } else { + return NULL; + } + } + // follows the actual functor + if (ap->ModuleOfPred == IDB_MODULE) { + if (ap->PredFlags & NumberDBPredFlag) { + Int key = ap->src.IndxId; + snprintf(s, smax - s, "%" PRIdPTR, key); + return LOCAL_FileNameBuf; + } else if (ap->PredFlags & AtomDBPredFlag) { + at = (Atom)(ap->FunctorOfPred); + if (!stpcpy(s, Yap_AtomToUTF8Text(at))) + return NULL; + } else { + f = ap->FunctorOfPred; + at = NameOfFunctor(f); + arity = ArityOfFunctor(f); + } + } else { + arity = ap->ArityOfPE; + if (arity) { + at = NameOfFunctor(ap->FunctorOfPred); + } else { + at = (Atom)(ap->FunctorOfPred); + } + } + if (!stpcpy(s,Yap_AtomToUTF8Text(at))) { + return NULL; + } s += strlen(s); - if (smax - s > 1) { - strcat(s, ":"); - } else { - return NULL; - } - s++; - } else { - if (smax - s > strlen("prolog:")) { - s = strcpy(s, "prolog:"); - } else { - return NULL; - } + snprintf(s, smax - s, "/%" PRIdPTR, arity); + return s0; } - // follows the actual functor - if (ap->ModuleOfPred == IDB_MODULE) { - if (ap->PredFlags & NumberDBPredFlag) { - Int key = ap->src.IndxId; - snprintf(s, smax - s, "%" PRIdPTR, key); - return LOCAL_FileNameBuf; - } else if (ap->PredFlags & AtomDBPredFlag) { - at = (Atom)(ap->FunctorOfPred); - if (!Yap_AtomToUTF8Text(at, s)) - return NULL; - } else { - f = ap->FunctorOfPred; - at = NameOfFunctor(f); - arity = ArityOfFunctor(f); - } - } else { - arity = ap->ArityOfPE; - if (arity) { - at = NameOfFunctor(ap->FunctorOfPred); - } else { - at = (Atom)(ap->FunctorOfPred); - } - } - if (!Yap_AtomToUTF8Text(at, s)) { - return NULL; - } - s += strlen(s); - snprintf(s, smax - s, "/%" PRIdPTR, arity); - return s0; -} -/** - * Convert from a text buffer (8-bit) to a term that has the same type as - * _Tguide_ - * - ≈* @param s the buffer - ≈ * @param tguide the guide - * - ≈ * @return the term -*/ -Term Yap_MkTextTerm(const char *s, encoding_t enc, Term tguide USES_REGS) { - if (IsAtomTerm(tguide)) - return MkAtomTerm(Yap_LookupAtom(s)); - if (IsStringTerm(tguide)) - return MkStringTerm(s); - if (IsPairTerm(tguide) && IsAtomTerm(HeadOfTerm(tguide))) { - return Yap_CharsToListOfAtoms(s, enc PASS_REGS); + /** + * Convert from a text buffer (8-bit) to a term that has the same type as + * _Tguide_ + * + ≈* @param s the buffer + ≈ * @param tguide the guide + * + ≈ * @return the term + */ + Term Yap_MkTextTerm(const char *s, encoding_t enc, Term tguide USES_REGS) { + if (IsAtomTerm(tguide)) + return MkAtomTerm(Yap_LookupAtom(s)); + if (IsStringTerm(tguide)) + return MkStringTerm(s); + if (IsPairTerm(tguide) && IsAtomTerm(HeadOfTerm(tguide))) { + return Yap_CharsToListOfAtoms(s, enc PASS_REGS); + } + return Yap_CharsToListOfCodes(s, enc PASS_REGS); } - return Yap_CharsToListOfCodes(s, enc PASS_REGS); -} diff --git a/C/tracer.c b/C/tracer.c index c53b75de3..ab926acc3 100644 --- a/C/tracer.c +++ b/C/tracer.c @@ -1,19 +1,19 @@ /************************************************************************* - * * - * YAP Prolog @(#)amidefs.h 1.3 3/15/90 - * * - * Yap Prolog was developed at NCCUP - Universidade do Porto * - * * - * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * - * * - ************************************************************************** - * * - * File: tracer.h * - * Last rev: * - * mods: * - * comments: definitions for low level tracer * - * * - *************************************************************************/ + * * + * YAP Prolog @(#)amidefs.h 1.3 3/15/90 + * * + * Yap Prolog was developed at NCCUP - Universidade do Porto * + * * + * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * + * * + ************************************************************************** + * * + * File: tracer.h * + * Last rev: * + * mods: * + * comments: definitions for low level tracer * + * * + *************************************************************************/ #include "Yap.h" @@ -48,7 +48,7 @@ static char *send_tracer_message(char *start, char *name, arity_t arity, s = s1; expand = false; } - min = 1024; + min = 1024; if (name == NULL) { #ifdef YAPOR d = snprintf(s, max, "(%d)%s", worker_id, start); @@ -81,7 +81,7 @@ static char *send_tracer_message(char *start, char *name, arity_t arity, if (max > 16) { *s++ = ','; *s++ = ' '; - max-=2; + max -= 2; } else { expand = true; continue; @@ -95,18 +95,18 @@ static char *send_tracer_message(char *start, char *name, arity_t arity, } sz = strlen(sn); if (max <= sz) { - min = sz + 1024; + min = sz + 1024; expand = true; continue; } strcpy(s, sn); s += sz; - max -= sz; + max -= sz; } if (arity) { *s++ = ' '; *s++ = ')'; - max -= 2; + max -= 2; } } } while (expand); @@ -346,7 +346,7 @@ bool low_level_trace__(yap_low_level_port port, PredEntry *pred, CELL *args) { if (p == pe) { UNLOCK(Yap_heap_regs->low_level_trace_lock); pop_text_stack(l); - ReleaseAndReturn(true); + return (true); } if (env_ptr != NULL) env_ptr = (CELL *)(env_ptr[E_E]); @@ -354,7 +354,8 @@ bool low_level_trace__(yap_low_level_port port, PredEntry *pred, CELL *args) { printf("\n"); } #endif - b += snprintf(b, top - b, "%llud "UInt_FORMAT " ", vsc_count, LCL0 - (CELL *)B); + b += snprintf(b, top - b, "%llud " UInt_FORMAT " ", vsc_count, + LCL0 - (CELL *)B); b += snprintf(b, top - b, Int_FORMAT " ", LCL0 - (CELL *)Yap_REGS.CUT_C_TOP); #if defined(THREADS) || defined(YAPOR) b += snprintf(b, top - b, "(%d)", worker_id); @@ -363,12 +364,13 @@ bool low_level_trace__(yap_low_level_port port, PredEntry *pred, CELL *args) { if (pred == NULL) { UNLOCK(Yap_low_level_trace_lock); pop_text_stack(l); - ReleaseAndReturn(true); + return (true); } if (pred->ModuleOfPred == PROLOG_MODULE) { if (!LOCAL_do_trace_primitives) { UNLOCK(Yap_low_level_trace_lock); - ReleaseAndReturn(true); + pop_text_stack(l); + return (true); } mname = "prolog"; } else { @@ -460,7 +462,7 @@ bool low_level_trace__(yap_low_level_port port, PredEntry *pred, CELL *args) { fputs(buf, stderr); #endif pop_text_stack(l); - ReleaseAndReturn(true); + return (true); } void toggle_low_level_trace(void) { diff --git a/C/write.c b/C/write.c index d331f8108..5465cf1ed 100644 --- a/C/write.c +++ b/C/write.c @@ -390,7 +390,7 @@ int Yap_FormatFloat(Float f, char **s, size_t sz) { wglb.stream = GLOBAL_Stream + sno; wrputf(f, &wglb); so = Yap_MemExportStreamPtr(sno); - *s = Malloc( strlen(so)+1 ); + *s = BaseMalloc( strlen(so)+1 ); strcpy(*s, so ); Yap_CloseStream(sno); return true; diff --git a/CXX/yapi.cpp b/CXX/yapi.cpp index 4d7c41852..2c7a8ae65 100644 --- a/CXX/yapi.cpp +++ b/CXX/yapi.cpp @@ -406,7 +406,7 @@ YAPListTerm::YAPListTerm(YAPTerm ts[], arity_t n) } } -const char *YAPAtom::getName(void) { return Yap_AtomToUTF8Text(a, nullptr); } +const char *YAPAtom::getName(void) { return Yap_AtomToUTF8Text(a); } void YAPQuery::openQuery(Term *ts) { @@ -691,7 +691,7 @@ YAPQuery::YAPQuery(YAPTerm t) : YAPPredicate(t) if (IsApplTerm(tt)) { Functor f = FunctorOfTerm(tt); if (IsExtensionFunctor(f)) - nts = nullptr; + nts = nullptr; nts = RepAppl(goal.term())+1; } else if (IsPairTerm(tt)) { nts = RepPair(tt); diff --git a/H/YapText.h b/H/YapText.h index 065d6bf40..453296897 100644 --- a/H/YapText.h +++ b/H/YapText.h @@ -31,31 +31,14 @@ #include "../utf8proc/utf8proc.h" #include "Yap.h" -#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(); \ - } - /// allocate a temporary text block /// extern void *Malloc(size_t sz USES_REGS); extern void *Realloc(void *buf, size_t sz USES_REGS); extern void Free(void *buf USES_REGS); -extern int push_text_stack(USES_REGS1); -extern int pop_text_stack(int lvl USES_REGS); -extern void *export_block(int lvl, void *exp USES_REGS); +extern void *MallocAtLevel(size_t sz, int atL USES_REGS); +#define BaseMalloc(sz) MallocAtLevel(sz, 1) #ifndef Yap_Min #define Yap_Min(x, y) (x < y ? x : y) @@ -65,6 +48,17 @@ extern void *export_block(int lvl, void *exp USES_REGS); #define MBYTE (1024 * 1024) /* Character types for tokenizer and write.c */ +extern int AllocLevel(void); + +#define push_text_stack() \ + (/* fprintf(stderr, "^ %*c %s:%s:%d\n", AllocLevel(), AllocLevel()+'0', __FILE__, __FUNCTION__, __LINE__), */ \ + push_text_stack__(PASS_REGS1)) +extern int push_text_stack__(USES_REGS1); + +#define pop_text_stack(lvl) \ + (/*fprintf(stderr, "v %*c %s:%s:%d\n", AllocLevel(), ' ', __FILE__, __FUNCTION__, __LINE__),*/ \ + pop_text_stack__(lvl)) +extern int pop_text_stack__(int lvl USES_REGS); /****************** character definition table **************************/ @@ -878,24 +872,8 @@ static inline Term Yap_CharsToString(const char *s, encoding_t enc USES_REGS) { return out.val.t; } -static inline char *Yap_AtomToUTF8Text(Atom at, const char *s USES_REGS) { - seq_tv_t inp, out; - - inp.val.a = at; - inp.type = YAP_STRING_ATOM; - out.type = YAP_STRING_CHARS; - out.val.uc = NULL; - out.enc = ENC_ISO_UTF8; - if (s) { - out.val.c0 = s; - out.type |= YAP_STRING_WITH_BUFFER; - } else { - out.type |= YAP_STRING_MALLOC; - out.val.c = NULL; - } - if (!Yap_CVT_Text(&inp, &out PASS_REGS)) - return 0L; - return out.val.c; +static inline char *Yap_AtomToUTF8Text(Atom at USES_REGS) { + return RepAtom(at)->StrOfAE; } static inline Term Yap_CharsToTDQ(const char *s, Term mod, @@ -1635,6 +1613,5 @@ static inline Term Yap_SubtractTailString(Term t1, Term th USES_REGS) { #endif // ≈YAP_TEXT_H -const char *Yap_TextTermToText(Term t, char *bufwrite_Text, - encoding_t e USES_REGS); +const char *Yap_TextTermToText(Term t, char *s, encoding_t e USES_REGS); Term Yap_MkTextTerm(const char *s, encoding_t e, Term tguide); diff --git a/library/dialect/swi/fli/swi.c b/library/dialect/swi/fli/swi.c index 5f125c9cc..4aea2aed5 100755 --- a/library/dialect/swi/fli/swi.c +++ b/library/dialect/swi/fli/swi.c @@ -223,12 +223,13 @@ X_API int PL_get_nchars(term_t l, size_t *lengthp, char **s, unsigned flags) { out.type |= YAP_STRING_NCHARS; out.max = *lengthp; } + char *sf = malloc(strlen(out.val.c)+1); + strcpy(sf, out.val.c); if (!Yap_CVT_Text(&inp, &out PASS_REGS)) { pop_text_stack(lvl); return false; } - out.val.c = export_block(-1, out.val.c PASS_REGS); - *s = out.val.c; + *s = out.val.c = sf; return true; } diff --git a/os/files.c b/os/files.c index 588186a47..55f35fd59 100644 --- a/os/files.c +++ b/os/files.c @@ -453,23 +453,23 @@ static Int is_absolute_file_name(USES_REGS1) { /* file_base_name(Stream,N) */ Term t = Deref(ARG1); Atom at; bool rc; - if (IsVarTerm(t)) { Yap_Error(INSTANTIATION_ERROR, t, "file_base_name/2"); return false; } + int l = push_text_stack(); const char *buf = Yap_TextTermToText(t, NULL, LOCAL_encoding); if (buf) { rc = Yap_IsAbsolutePath(buf); } else { - at = AtomOfTerm(t); + at = AtomOfTerm(t); #if _WIN32 - rc = PathIsRelative(RepAtom(at)->StrOfAE); + rc = PathIsRelative(RepAtom(at)->StrOfAE); #else - rc = RepAtom(at)->StrOfAE[0] == '/'; + rc = RepAtom(at)->StrOfAE[0] == '/'; #endif - freeBuffer(buf); } + pop_text_stack(l); return rc; } diff --git a/os/format.c b/os/format.c index c31b229a4..18fc9f440 100644 --- a/os/format.c +++ b/os/format.c @@ -335,9 +335,9 @@ format_clean_up(int sno, int sno0, format_info *finf, const unsigned char *fstr, sno = format_synch(sno, sno0, finf); Yap_CloseStream(sno); } - if (fstr) { - free((void *)fstr); - } + + pop_text_stack(finf->lvl); + if (targs) Yap_FreeAtomSpace((void *)targs); } @@ -409,17 +409,21 @@ static Int doformat(volatile Term otail, volatile Term oargs, args = oargs; tail = otail; targ = 0; - if (IsVarTerm(tail)) { + int l = push_text_stack(); + if (IsVarTerm(tail)) { + pop_text_stack(l); Yap_Error(INSTANTIATION_ERROR, tail, "format/2"); return (FALSE); } else if ((fptr = Yap_TextToUTF8Buffer(tail))) { fstr = fptr; alloc_fstr = true; } else { + pop_text_stack(l); Yap_Error(TYPE_ERROR_TEXT, tail, "format/2"); return false; } if (IsVarTerm(args)) { + pop_text_stack(l); Yap_Error(INSTANTIATION_ERROR, args, "format/2"); return FALSE; } @@ -427,14 +431,17 @@ static Int doformat(volatile Term otail, volatile Term oargs, fmod = ArgOfTerm(1, args); args = ArgOfTerm(2, args); if (IsVarTerm(fmod)) { + pop_text_stack(l); Yap_Error(INSTANTIATION_ERROR, fmod, "format/2"); return FALSE; } if (!IsAtomTerm(fmod)) { + pop_text_stack(l); Yap_Error(TYPE_ERROR_ATOM, fmod, "format/2"); return FALSE; } if (IsVarTerm(args)) { + pop_text_stack(l); Yap_Error(INSTANTIATION_ERROR, args, "format/2"); return FALSE; } @@ -446,15 +453,15 @@ static Int doformat(volatile Term otail, volatile Term oargs, do { tnum = format_copy_args(args, targs, tsz); if (tnum == FORMAT_COPY_ARGS_ERROR) - return FALSE; + return FALSE; else if (tnum == FORMAT_COPY_ARGS_OVERFLOW) { - if (mytargs != targs) { - Yap_FreeCodeSpace((char *)targs); - } - tsz += 16; - targs = (Term *)Yap_AllocAtomSpace(tsz * sizeof(Term)); + if (mytargs != targs) { + Yap_FreeCodeSpace((char *)targs); + } + tsz += 16; + targs = (Term *)Yap_AllocAtomSpace(tsz * sizeof(Term)); } else { - break; + break; } } while (true); } else if (args != TermNil) { @@ -470,8 +477,9 @@ static Int doformat(volatile Term otail, volatile Term oargs, finfo.gapi = 0; finfo.phys_start = 0; finfo.lstart = 0; + finfo.lvl = l; if (true || !(GLOBAL_Stream[sno].status & InMemory_Stream_f)) - sno = Yap_OpenBufWriteStream(PASS_REGS1); + sno = Yap_OpenBufWriteStream(PASS_REGS1); if (sno < 0) { if (!alloc_fstr) fstr = NULL; @@ -491,493 +499,493 @@ static Int doformat(volatile Term otail, volatile Term oargs, /* start command */ fptr += get_utf8(fptr, -1, &ch); if (ch == '*') { - fptr += get_utf8(fptr, -1, &ch); - has_repeats = TRUE; - if (targ > tnum - 1) { - goto do_format_control_sequence_error; - } - repeats = fetch_index_from_args(targs[targ++]); - if (repeats == -1) - goto do_format_control_sequence_error; + fptr += get_utf8(fptr, -1, &ch); + has_repeats = TRUE; + if (targ > tnum - 1) { + goto do_format_control_sequence_error; + } + repeats = fetch_index_from_args(targs[targ++]); + if (repeats == -1) + goto do_format_control_sequence_error; } else if (ch == '`') { - /* next character is kept as code */ - has_repeats = TRUE; - fptr += get_utf8(fptr, -1, &repeats); - fptr += get_utf8(fptr, -1, &ch); + /* next character is kept as code */ + has_repeats = TRUE; + fptr += get_utf8(fptr, -1, &repeats); + fptr += get_utf8(fptr, -1, &ch); } else if (ch >= '0' && ch <= '9') { - has_repeats = TRUE; - repeats = 0; - while (ch >= '0' && ch <= '9') { - repeats = repeats * 10 + (ch - '0'); - fptr += get_utf8(fptr, -1, &ch); - } + has_repeats = TRUE; + repeats = 0; + while (ch >= '0' && ch <= '9') { + repeats = repeats * 10 + (ch - '0'); + fptr += get_utf8(fptr, -1, &ch); + } } switch (ch) { case 'a': - /* print an atom */ - if (has_repeats || targ > tnum - 1) - goto do_format_control_sequence_error; - t = targs[targ++]; - if (IsVarTerm(t)) - goto do_instantiation_error; - if (!IsAtomTerm(t)) - goto do_type_atom_error; - yhandle_t sl = Yap_StartSlots(); - // stream is already locked. - Yap_plwrite(t, GLOBAL_Stream + sno, 0, Handle_vars_f | To_heap_f, - GLOBAL_MaxPriority); - Yap_CloseSlots(sl); - break; + /* print an atom */ + if (has_repeats || targ > tnum - 1) + goto do_format_control_sequence_error; + t = targs[targ++]; + if (IsVarTerm(t)) + goto do_instantiation_error; + if (!IsAtomTerm(t)) + goto do_type_atom_error; + yhandle_t sl = Yap_StartSlots(); + // stream is already locked. + Yap_plwrite(t, GLOBAL_Stream + sno, 0, Handle_vars_f | To_heap_f, + GLOBAL_MaxPriority); + Yap_CloseSlots(sl); + break; case 'c': { - Int nch, i; + Int nch, i; - if (targ > tnum - 1) - goto do_format_control_sequence_error; - t = targs[targ++]; - if (IsVarTerm(t)) - goto do_instantiation_error; - if (!IsIntegerTerm(t)) - goto do_type_int_error; - nch = IntegerOfTerm(t); - if (nch < 0) - goto do_domain_not_less_zero_error; - if (!has_repeats) - repeats = 1; - for (i = 0; i < repeats; i++) - f_putc(sno, nch); - break; + if (targ > tnum - 1) + goto do_format_control_sequence_error; + t = targs[targ++]; + if (IsVarTerm(t)) + goto do_instantiation_error; + if (!IsIntegerTerm(t)) + goto do_type_int_error; + nch = IntegerOfTerm(t); + if (nch < 0) + goto do_domain_not_less_zero_error; + if (!has_repeats) + repeats = 1; + for (i = 0; i < repeats; i++) + f_putc(sno, nch); + break; } case 'e': case 'E': case 'f': case 'g': case 'G': { - Float fl; - char *ptr; - char fmt[32]; + Float fl; + char *ptr; + char fmt[32]; - if (targ > tnum - 1) - goto do_format_control_sequence_error; - t = targs[targ++]; - if (IsVarTerm(t)) - goto do_instantiation_error; - if (!IsNumTerm(t)) - goto do_type_number_error; - if (IsIntegerTerm(t)) { - fl = (Float)IntegerOfTerm(t); + if (targ > tnum - 1) + goto do_format_control_sequence_error; + t = targs[targ++]; + if (IsVarTerm(t)) + goto do_instantiation_error; + if (!IsNumTerm(t)) + goto do_type_number_error; + if (IsIntegerTerm(t)) { + fl = (Float)IntegerOfTerm(t); #ifdef HAVE_GMP - } else if (IsBigIntTerm(t)) { - fl = Yap_gmp_to_float(t); + } else if (IsBigIntTerm(t)) { + fl = Yap_gmp_to_float(t); #endif - } else { - fl = FloatOfTerm(t); - } - if (!has_repeats) - repeats = 6; - fmt[0] = '%'; - fmt[1] = '.'; - ptr = fmt + 2; + } else { + fl = FloatOfTerm(t); + } + if (!has_repeats) + repeats = 6; + fmt[0] = '%'; + fmt[1] = '.'; + ptr = fmt + 2; #if HAVE_SNPRINTF - snprintf(ptr, 31 - 5, "%d", repeats); + snprintf(ptr, 31 - 5, "%d", repeats); #else - sprintf(ptr, "%d", repeats); + sprintf(ptr, "%d", repeats); #endif - while (*ptr) - ptr++; - ptr[0] = ch; - ptr[1] = '\0'; - { - unsigned char *uptr = (unsigned char *)tmp1; + while (*ptr) + ptr++; + ptr[0] = ch; + ptr[1] = '\0'; + { + unsigned char *uptr = (unsigned char *)tmp1; #if HAVE_SNPRINTF - snprintf(tmp1, repeats + 10, fmt, fl); + snprintf(tmp1, repeats + 10, fmt, fl); #else - sprintf(tmp1, fmt, fl); + sprintf(tmp1, fmt, fl); #endif - while ((uptr += get_utf8(uptr, -1, &ch)) && ch != 0) - f_putc(sno, ch); - } - break; - case 'd': - case 'D': - /* print a decimal, using weird . stuff */ - if (targ > tnum - 1) - goto do_format_control_sequence_error; - t = targs[targ++]; - if (IsVarTerm(t)) - goto do_instantiation_error; - if (!IsIntegerTerm(t) + while ((uptr += get_utf8(uptr, -1, &ch)) && ch != 0) + f_putc(sno, ch); + } + break; + case 'd': + case 'D': + /* print a decimal, using weird . stuff */ + if (targ > tnum - 1) + goto do_format_control_sequence_error; + t = targs[targ++]; + if (IsVarTerm(t)) + goto do_instantiation_error; + if (!IsIntegerTerm(t) #ifdef HAVE_GMP - && !IsBigIntTerm(t) + && !IsBigIntTerm(t) #endif - ) - goto do_type_int_error; + ) + goto do_type_int_error; - { - Int siz = 0; - char *ptr = tmp1; - tmpbase = tmp1; + { + Int siz = 0; + char *ptr = tmp1; + tmpbase = tmp1; - if (IsIntegerTerm(t)) { - Int il = IntegerOfTerm(t); + if (IsIntegerTerm(t)) { + Int il = IntegerOfTerm(t); #if HAVE_SNPRINTF - snprintf(tmp1, 256, "%ld", (long int)il); + snprintf(tmp1, 256, "%ld", (long int)il); #else - sprintf(tmp1, "%ld", (long int)il); + sprintf(tmp1, "%ld", (long int)il); #endif - siz = strlen(tmp1); - if (il < 0) - siz--; + siz = strlen(tmp1); + if (il < 0) + siz--; #ifdef HAVE_GMP - } else if (IsBigIntTerm(t) && RepAppl(t)[1] == BIG_INT) { - char *res; + } else if (IsBigIntTerm(t) && RepAppl(t)[1] == BIG_INT) { + char *res; - tmpbase = tmp1; + tmpbase = tmp1; - while ( - !(res = Yap_gmp_to_string(t, tmpbase, TMP_STRING_SIZE, 10))) { - if (tmpbase == tmp1) { - tmpbase = NULL; - } else { - tmpbase = res; + while ( + !(res = Yap_gmp_to_string(t, tmpbase, TMP_STRING_SIZE, 10))) { + if (tmpbase == tmp1) { + tmpbase = NULL; + } else { + tmpbase = res; - goto do_type_int_error; - } - } - tmpbase = res; - ptr = tmpbase; + goto do_type_int_error; + } + } + tmpbase = res; + ptr = tmpbase; #endif - siz = strlen(tmpbase); - } else { - goto do_type_int_error; - } + siz = strlen(tmpbase); + } else { + goto do_type_int_error; + } - if (tmpbase[0] == '-') { - f_putc(sno, (int)'-'); - ptr++; - } - if (ch == 'D') { - int first = TRUE; + if (tmpbase[0] == '-') { + f_putc(sno, (int)'-'); + ptr++; + } + if (ch == 'D') { + int first = TRUE; - while (siz > repeats) { - if ((siz - repeats) % 3 == 0 && !first) { - f_putc(sno, (int)','); - } - f_putc(sno, (int)(*ptr++)); - first = FALSE; - siz--; - } - } else { - while (siz > repeats) { - f_putc(sno, (int)(*ptr++)); - siz--; - } - } - if (repeats) { - if (ptr == tmpbase || ptr[-1] == '-') { - f_putc(sno, (int)'0'); - } - f_putc(sno, (int)'.'); - while (repeats > siz) { - f_putc(sno, (int)'0'); - repeats--; - } - while (repeats) { - f_putc(sno, (int)(*ptr++)); - repeats--; - } - } - if (tmpbase != tmp1) - free(tmpbase); - break; - case 'r': - case 'R': { - Int numb, radix; - UInt divfactor = 1, size = 1, i; - wchar_t och; + while (siz > repeats) { + if ((siz - repeats) % 3 == 0 && !first) { + f_putc(sno, (int)','); + } + f_putc(sno, (int)(*ptr++)); + first = FALSE; + siz--; + } + } else { + while (siz > repeats) { + f_putc(sno, (int)(*ptr++)); + siz--; + } + } + if (repeats) { + if (ptr == tmpbase || ptr[-1] == '-') { + f_putc(sno, (int)'0'); + } + f_putc(sno, (int)'.'); + while (repeats > siz) { + f_putc(sno, (int)'0'); + repeats--; + } + while (repeats) { + f_putc(sno, (int)(*ptr++)); + repeats--; + } + } + if (tmpbase != tmp1) + free(tmpbase); + break; + case 'r': + case 'R': { + Int numb, radix; + UInt divfactor = 1, size = 1, i; + wchar_t och; - /* print a decimal, using weird . stuff */ - if (targ > tnum - 1) - goto do_format_control_sequence_error; - t = targs[targ++]; - if (IsVarTerm(t)) - goto do_instantiation_error; - if (!has_repeats) - radix = 8; - else - radix = repeats; - if (radix > 36 || radix < 2) - goto do_domain_error_radix; + /* print a decimal, using weird . stuff */ + if (targ > tnum - 1) + goto do_format_control_sequence_error; + t = targs[targ++]; + if (IsVarTerm(t)) + goto do_instantiation_error; + if (!has_repeats) + radix = 8; + else + radix = repeats; + if (radix > 36 || radix < 2) + goto do_domain_error_radix; #ifdef HAVE_GMP - if (IsBigIntTerm(t) && RepAppl(t)[1] == BIG_INT) { - char *pt, *res; + if (IsBigIntTerm(t) && RepAppl(t)[1] == BIG_INT) { + char *pt, *res; - tmpbase = tmp1; - while (!( - res = Yap_gmp_to_string(t, tmpbase, TMP_STRING_SIZE, radix))) { - if (tmpbase == tmp1) { - tmpbase = NULL; - } else { - tmpbase = res; - goto do_type_int_error; - } - } - tmpbase = res; - pt = tmpbase; - while ((ch = *pt++)) - f_putc(sno, ch); - if (tmpbase != tmp1) - free(tmpbase); - break; - } + tmpbase = tmp1; + while (!( + res = Yap_gmp_to_string(t, tmpbase, TMP_STRING_SIZE, radix))) { + if (tmpbase == tmp1) { + tmpbase = NULL; + } else { + tmpbase = res; + goto do_type_int_error; + } + } + tmpbase = res; + pt = tmpbase; + while ((ch = *pt++)) + f_putc(sno, ch); + if (tmpbase != tmp1) + free(tmpbase); + break; + } #endif - if (!IsIntegerTerm(t)) - goto do_type_int_error; - numb = IntegerOfTerm(t); - if (numb < 0) { - numb = -numb; - f_putc(sno, (int)'-'); - } - while (numb / divfactor >= radix) { - divfactor *= radix; - size++; - } - for (i = 1; i < size; i++) { - Int dig = numb / divfactor; - och = base_dig(dig, ch); - f_putc(sno, och); - numb %= divfactor; - divfactor /= radix; - } - och = base_dig(numb, ch); - f_putc(sno, och); - break; - } - case 's': - if (targ > tnum - 1) - goto do_format_control_sequence_error; - t = targs[targ++]; - if (IsVarTerm(t)) - goto do_instantiation_error; - if (!format_print_str(sno, repeats, has_repeats, t, f_putc)) { - goto do_default_error; - } - break; - case 'i': - if (targ > tnum - 1 || has_repeats) - goto do_format_control_sequence_error; - targ++; - break; - case 'k': - if (targ > tnum - 1 || has_repeats) - goto do_format_control_sequence_error; - t = targs[targ++]; - yhandle_t sl = Yap_StartSlots(); - Yap_plwrite(t, GLOBAL_Stream + sno, 0, - Quote_illegal_f | Ignore_ops_f | To_heap_f, - GLOBAL_MaxPriority); - Yap_CloseSlots(sl); - break; - case '@': - t = targs[targ++]; - { - yhandle_t sl0 = Yap_StartSlots(), s1 = Yap_PushHandle(ARG1), - sl = Yap_InitSlots(tnum - targ, targs + targ); + if (!IsIntegerTerm(t)) + goto do_type_int_error; + numb = IntegerOfTerm(t); + if (numb < 0) { + numb = -numb; + f_putc(sno, (int)'-'); + } + while (numb / divfactor >= radix) { + divfactor *= radix; + size++; + } + for (i = 1; i < size; i++) { + Int dig = numb / divfactor; + och = base_dig(dig, ch); + f_putc(sno, och); + numb %= divfactor; + divfactor /= radix; + } + och = base_dig(numb, ch); + f_putc(sno, och); + break; + } + case 's': + if (targ > tnum - 1) + goto do_format_control_sequence_error; + t = targs[targ++]; + if (IsVarTerm(t)) + goto do_instantiation_error; + if (!format_print_str(sno, repeats, has_repeats, t, f_putc)) { + goto do_default_error; + } + break; + case 'i': + if (targ > tnum - 1 || has_repeats) + goto do_format_control_sequence_error; + targ++; + break; + case 'k': + if (targ > tnum - 1 || has_repeats) + goto do_format_control_sequence_error; + t = targs[targ++]; + yhandle_t sl = Yap_StartSlots(); + Yap_plwrite(t, GLOBAL_Stream + sno, 0, + Quote_illegal_f | Ignore_ops_f | To_heap_f, + GLOBAL_MaxPriority); + Yap_CloseSlots(sl); + break; + case '@': + t = targs[targ++]; + { + yhandle_t sl0 = Yap_StartSlots(), s1 = Yap_PushHandle(ARG1), + sl = Yap_InitSlots(tnum - targ, targs + targ); - Int res; - int os = LOCAL_c_output_stream; - LOCAL_c_output_stream = sno; - res = Yap_execute_goal(t, 0, fmod, true); - LOCAL_c_output_stream = os; - if (Yap_HasException()) - goto ex_handler; - if (!res) { - if (!alloc_fstr) - fstr = NULL; - if (mytargs == targs) { - targs = NULL; - } - format_clean_up(sno, sno0, &finfo, fstr, targs); - return false; - } - ARG1 = Yap_GetFromHandle(s1); - Yap_RecoverHandles(tnum - targ, sl); - Yap_CloseSlots(sl0); - } - break; - case 'p': - if (targ > tnum - 1 || has_repeats) - goto do_format_control_sequence_error; - t = targs[targ++]; - { - Int sl = Yap_InitSlot(args); - Yap_plwrite(t, GLOBAL_Stream + sno, 0, - Handle_vars_f | Use_portray_f | To_heap_f, - GLOBAL_MaxPriority); - args = Yap_GetFromSlot(sl); - Yap_CloseSlots(sl); - } - if (Yap_HasException()) { + Int res; + int os = LOCAL_c_output_stream; + LOCAL_c_output_stream = sno; + res = Yap_execute_goal(t, 0, fmod, true); + LOCAL_c_output_stream = os; + if (Yap_HasException()) + goto ex_handler; + if (!res) { + if (!alloc_fstr) + fstr = NULL; + if (mytargs == targs) { + targs = NULL; + } + format_clean_up(sno, sno0, &finfo, fstr, targs); + return false; + } + ARG1 = Yap_GetFromHandle(s1); + Yap_RecoverHandles(tnum - targ, sl); + Yap_CloseSlots(sl0); + } + break; + case 'p': + if (targ > tnum - 1 || has_repeats) + goto do_format_control_sequence_error; + t = targs[targ++]; + { + Int sl = Yap_InitSlot(args); + Yap_plwrite(t, GLOBAL_Stream + sno, 0, + Handle_vars_f | Use_portray_f | To_heap_f, + GLOBAL_MaxPriority); + args = Yap_GetFromSlot(sl); + Yap_CloseSlots(sl); + } + if (Yap_HasException()) { - ex_handler: - if (tnum <= 8) - targs = NULL; - if (IsAtomTerm(tail)) { - fstr = NULL; - } - if (GLOBAL_Stream[sno].status & InMemory_Stream_f) { - GLOBAL_Stream[sno].u.mem_string.error_handler = old_handler; - } - if (!alloc_fstr) - fstr = NULL; - if (mytargs == targs) { - targs = NULL; - } - format_clean_up(sno, sno0, &finfo, fstr, targs); - Yap_RaiseException(); - return false; - } - break; - case 'q': - if (targ > tnum - 1 || has_repeats) - goto do_format_control_sequence_error; - t = targs[targ++]; - { - yhandle_t sl0 = Yap_StartSlots(); - Yap_plwrite(t, GLOBAL_Stream + sno, 0, - Handle_vars_f | Quote_illegal_f | To_heap_f, - GLOBAL_MaxPriority); - Yap_CloseSlots(sl0); - } - break; - case 'w': - if (targ > tnum - 1 || has_repeats) - goto do_format_control_sequence_error; - t = targs[targ++]; - { - yhandle_t slf = Yap_StartSlots(); - Yap_plwrite(t, GLOBAL_Stream + sno, 0, Handle_vars_f | To_heap_f, - GLOBAL_MaxPriority); - Yap_CloseSlots(slf); - } - break; - case 'W': - if (targ > tnum - 2 || has_repeats) - goto do_format_control_sequence_error; - targ -= 2; - { - yhandle_t slf = Yap_StartSlots(); - if (!Yap_WriteTerm(sno, targs[1], targs[0] PASS_REGS)) { - Yap_CloseSlots(slf); - goto do_default_error; - }; - Yap_CloseSlots(slf); - } - break; - case '~': - if (has_repeats) - goto do_format_control_sequence_error; - f_putc(sno, (int)'~'); - break; - case 'n': - if (!has_repeats) - repeats = 1; - while (repeats--) { - f_putc(sno, (int)'\n'); - } - sno = format_synch(sno, sno0, &finfo); - break; - case 'N': - if (!has_repeats) - has_repeats = 1; - if (GLOBAL_Stream[sno].linepos != 0) { - f_putc(sno, '\n'); - sno = format_synch(sno, sno0, &finfo); - } - if (repeats > 1) { - Int i; - for (i = 1; i < repeats; i++) - f_putc(sno, '\n'); - } - sno = format_synch(sno, sno0, &finfo); - break; - /* padding */ - case '|': - fill_pads(sno, sno0, repeats, &finfo PASS_REGS); - break; - case '+': - fill_pads(sno, sno0, finfo.lstart + repeats, &finfo PASS_REGS); - break; - case 't': { + ex_handler: + if (tnum <= 8) + targs = NULL; + if (IsAtomTerm(tail)) { + fstr = NULL; + } + if (GLOBAL_Stream[sno].status & InMemory_Stream_f) { + GLOBAL_Stream[sno].u.mem_string.error_handler = old_handler; + } + if (!alloc_fstr) + fstr = NULL; + if (mytargs == targs) { + targs = NULL; + } + format_clean_up(sno, sno0, &finfo, fstr, targs); + Yap_RaiseException(); + return false; + } + break; + case 'q': + if (targ > tnum - 1 || has_repeats) + goto do_format_control_sequence_error; + t = targs[targ++]; + { + yhandle_t sl0 = Yap_StartSlots(); + Yap_plwrite(t, GLOBAL_Stream + sno, 0, + Handle_vars_f | Quote_illegal_f | To_heap_f, + GLOBAL_MaxPriority); + Yap_CloseSlots(sl0); + } + break; + case 'w': + if (targ > tnum - 1 || has_repeats) + goto do_format_control_sequence_error; + t = targs[targ++]; + { + yhandle_t slf = Yap_StartSlots(); + Yap_plwrite(t, GLOBAL_Stream + sno, 0, Handle_vars_f | To_heap_f, + GLOBAL_MaxPriority); + Yap_CloseSlots(slf); + } + break; + case 'W': + if (targ > tnum - 2 || has_repeats) + goto do_format_control_sequence_error; + targ -= 2; + { + yhandle_t slf = Yap_StartSlots(); + if (!Yap_WriteTerm(sno, targs[1], targs[0] PASS_REGS)) { + Yap_CloseSlots(slf); + goto do_default_error; + }; + Yap_CloseSlots(slf); + } + break; + case '~': + if (has_repeats) + goto do_format_control_sequence_error; + f_putc(sno, (int)'~'); + break; + case 'n': + if (!has_repeats) + repeats = 1; + while (repeats--) { + f_putc(sno, (int)'\n'); + } + sno = format_synch(sno, sno0, &finfo); + break; + case 'N': + if (!has_repeats) + has_repeats = 1; + if (GLOBAL_Stream[sno].linepos != 0) { + f_putc(sno, '\n'); + sno = format_synch(sno, sno0, &finfo); + } + if (repeats > 1) { + Int i; + for (i = 1; i < repeats; i++) + f_putc(sno, '\n'); + } + sno = format_synch(sno, sno0, &finfo); + break; + /* padding */ + case '|': + fill_pads(sno, sno0, repeats, &finfo PASS_REGS); + break; + case '+': + fill_pads(sno, sno0, finfo.lstart + repeats, &finfo PASS_REGS); + break; + case 't': { #if MAY_WRITR - if (fflush(GLOBAL_Stream[sno].file) == 0) { - finfo.gap[finfo.gapi].phys = ftell(GLOBAL_Stream[sno].file); - } + if (fflush(GLOBAL_Stream[sno].file) == 0) { + finfo.gap[finfo.gapi].phys = ftell(GLOBAL_Stream[sno].file); + } #else - finfo.gap[finfo.gapi].phys = GLOBAL_Stream[sno].u.mem_string.pos; + finfo.gap[finfo.gapi].phys = GLOBAL_Stream[sno].u.mem_string.pos; #endif - finfo.gap[finfo.gapi].log = GLOBAL_Stream[sno].linepos; - if (has_repeats) - finfo.gap[finfo.gapi].filler = fptr[-2]; - else - finfo.gap[finfo.gapi].filler = ' '; - finfo.gapi++; - } break; + finfo.gap[finfo.gapi].log = GLOBAL_Stream[sno].linepos; + if (has_repeats) + finfo.gap[finfo.gapi].filler = fptr[-2]; + else + finfo.gap[finfo.gapi].filler = ' '; + finfo.gapi++; + } break; - do_instantiation_error: - LOCAL_Error_TYPE = INSTANTIATION_ERROR; - goto do_default_error; - do_type_int_error: - LOCAL_Error_TYPE = TYPE_ERROR_INTEGER; - goto do_default_error; - do_type_number_error: - LOCAL_Error_TYPE = TYPE_ERROR_NUMBER; - goto do_default_error; - do_type_atom_error: - LOCAL_Error_TYPE = TYPE_ERROR_ATOM; - goto do_default_error; - do_domain_not_less_zero_error: - LOCAL_Error_TYPE = DOMAIN_ERROR_NOT_LESS_THAN_ZERO; - goto do_default_error; - do_domain_error_radix: - LOCAL_Error_TYPE = DOMAIN_ERROR_RADIX; - goto do_default_error; - do_format_control_sequence_error: - LOCAL_Error_TYPE = DOMAIN_ERROR_FORMAT_CONTROL_SEQUENCE; - default: - LOCAL_Error_TYPE = YAP_NO_ERROR; - do_default_error: - if (tnum <= 8) - targs = NULL; - if (IsAtomTerm(tail)) { - fstr = NULL; - } - { - Term ta[2]; - ta[0] = otail; - ta[1] = oargs; - Yap_Error(LOCAL_Error_TYPE, - Yap_MkApplTerm(Yap_MkFunctor(AtomFormat, 2), 2, ta), - "arguments to format"); - } - if (GLOBAL_Stream[sno].status & InMemory_Stream_f) { - GLOBAL_Stream[sno].u.mem_string.error_handler = old_handler; - } - if (!alloc_fstr) - fstr = NULL; - if (mytargs == targs) { - targs = NULL; - } - format_clean_up(sno, sno0, &finfo, fstr, targs); - LOCAL_Error_TYPE = YAP_NO_ERROR; - return FALSE; - } + do_instantiation_error: + LOCAL_Error_TYPE = INSTANTIATION_ERROR; + goto do_default_error; + do_type_int_error: + LOCAL_Error_TYPE = TYPE_ERROR_INTEGER; + goto do_default_error; + do_type_number_error: + LOCAL_Error_TYPE = TYPE_ERROR_NUMBER; + goto do_default_error; + do_type_atom_error: + LOCAL_Error_TYPE = TYPE_ERROR_ATOM; + goto do_default_error; + do_domain_not_less_zero_error: + LOCAL_Error_TYPE = DOMAIN_ERROR_NOT_LESS_THAN_ZERO; + goto do_default_error; + do_domain_error_radix: + LOCAL_Error_TYPE = DOMAIN_ERROR_RADIX; + goto do_default_error; + do_format_control_sequence_error: + LOCAL_Error_TYPE = DOMAIN_ERROR_FORMAT_CONTROL_SEQUENCE; + default: + LOCAL_Error_TYPE = YAP_NO_ERROR; + do_default_error: + if (tnum <= 8) + targs = NULL; + if (IsAtomTerm(tail)) { + fstr = NULL; + } + { + Term ta[2]; + ta[0] = otail; + ta[1] = oargs; + Yap_Error(LOCAL_Error_TYPE, + Yap_MkApplTerm(Yap_MkFunctor(AtomFormat, 2), 2, ta), + "arguments to format"); + } + if (GLOBAL_Stream[sno].status & InMemory_Stream_f) { + GLOBAL_Stream[sno].u.mem_string.error_handler = old_handler; + } + if (!alloc_fstr) + fstr = NULL; + if (mytargs == targs) { + targs = NULL; + } + format_clean_up(sno, sno0, &finfo, fstr, targs); + LOCAL_Error_TYPE = YAP_NO_ERROR; + return FALSE; + } } - /* ok, now we should have a command */ + /* ok, now we should have a command */ } } else { if (ch == '\n') { - sno = format_synch(sno, sno0, &finfo); + sno = format_synch(sno, sno0, &finfo); } f_putc(sno, ch); } diff --git a/os/format.h b/os/format.h index 4ee03aeca..74d7d09e0 100644 --- a/os/format.h +++ b/os/format.h @@ -18,6 +18,7 @@ typedef struct format_status { // number of characters int lstart; int gapi; + int lvl; } format_info; #define FORMAT_COPY_ARGS_ERROR -1 diff --git a/os/sysbits.c b/os/sysbits.c index 0007c07fa..17569c9e7 100644 --- a/os/sysbits.c +++ b/os/sysbits.c @@ -171,7 +171,7 @@ static const char *PlExpandVars(const char *source, const char *root, CACHE_REGS const char *src = source; if (!result) - result = malloc(YAP_FILENAME_MAX + 1); + result = BaseMalloc(YAP_FILENAME_MAX + 1); if (strlen(source) >= YAP_FILENAME_MAX) { Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil, @@ -844,20 +844,23 @@ static Int expand_file_name3(USES_REGS1) { static Int absolute_file_system_path(USES_REGS1) { Term t = Deref(ARG1); - const char *fp; - bool rc; - char s[MAXPATHLEN + 1]; - const char *text = Yap_TextTermToText(t, s, LOCAL_encoding); + int l = push_text_stack(); + const char *text = Yap_TextTermToText(t, NULL, LOCAL_encoding); + const char *fp; + bool rc; if (text == NULL) { + pop_text_stack(l); return false; } - if (!(fp = Yap_AbsoluteFile(RepAtom(AtomOfTerm(t))->StrOfAE, NULL, true))) + if (!(fp = Yap_AbsoluteFile(RepAtom(AtomOfTerm(t))->StrOfAE, NULL, true))) { + pop_text_stack(l); return false; + } + pop_text_stack(l); + rc = Yap_unify(Yap_MkTextTerm(fp, LOCAL_encoding, t), ARG2); - if (fp != s) - freeBuffer((void *)fp); - return rc; + return rc; } static Int prolog_to_os_filename(USES_REGS1) { @@ -1359,14 +1362,18 @@ static Int p_expand_file_name(USES_REGS1) { Yap_Error(INSTANTIATION_ERROR, t, "argument to true_file_name unbound"); return FALSE; } + int l = push_text_stack(); text = Yap_TextTermToText(t, NULL, LOCAL_encoding); - if (!text) + if (!text) { + pop_text_stack(l); return false; - if (!(text2 = PlExpandVars(text, NULL, NULL))) + } + if (!(text2 = PlExpandVars(text, NULL, NULL))) { + pop_text_stack(l); return false; - freeBuffer(text); + } bool rc = Yap_unify(ARG2, Yap_MkTextTerm(text2, LOCAL_encoding, t)); - freeBuffer(text2); + pop_text_stack(l); return rc; } diff --git a/pl/protect.yap b/pl/protect.yap index eeed971a8..ef06f4efd 100755 --- a/pl/protect.yap +++ b/pl/protect.yap @@ -38,7 +38,7 @@ new_system_module( M ), fail. '$protect' :- - '$current_predicate'(Name,M,P,_), + '$current_predicate'(Name,M,P,_), '$is_system_module'(M), functor(P,Name,Arity), '$new_system_predicate'(Name,Arity,M),