From 2192f73b119248ba13f4b8623df27606af4c2b90 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Sun, 28 Feb 2016 19:32:55 +0000 Subject: [PATCH] make it compile under MSN vc. Unfortunately it has a weird crash at boot :( - Lots of indenting changes - VC++ is strict with variadic macros - VC++ does not accept unistd.h - new interface for walltime - VC++ does not seem to have support for integer overflow. - VC++ defines YENV_REG? - no access flags, x permissions ignored. - new FindGMP supporting MPIR - make horus optional (c++ is hard). --- .gitignore | 5 +- C/absmi.c | 24 +- C/adtdefs.c | 66 +- C/atomic.c | 1792 ++++++++++--------- C/c_interface.c | 4 +- C/flags.c | 14 +- C/heapgc.c | 2 +- C/init.c | 54 +- C/modules.c | 2 +- C/parser.c | 113 +- C/save.c | 6 +- C/stdpreds.c | 23 +- C/text.c | 4 +- C/threads.c | 2 + C/write.c | 6 +- CMakeLists.txt | 36 +- H/ *Minibuf-5* | 1 - H/ *Minibuf-6* | 1 - H/Regs.h | 12 +- H/YapTerm.h | 4 + H/Yapproto.h | 19 +- H/Yatom.h | 25 +- H/amidefs.h | 31 +- H/arith2.h | 12 +- H/generated/h0globals.h | 2 +- H/generated/hglobals.h | 2 +- H/inline-only.h | 2 +- H/sshift.h | 2 +- OPTYap/opt.init.c | 2 + OPTYap/or.cow_engine.c | 2 + OPTYap/or.memory.c | 2 + OPTYap/tab.tries.c | 6 +- cmake/FindGMP.cmake | 57 +- console/yap.c | 24 +- include/SWI-Prolog.h | 6 +- include/pl-types.h | 2 - library/CMakeLists.txt | 2 - library/bootlists.yap | 139 -- library/dialect/swi/fli/swi.c | 2 +- library/lists.yap | 5 - library/matrix.yap | 16 +- library/prandom.yap | 2 +- library/ytest.yap | 4 - library/ytest/preds.yap | 4 +- misc/GLOBALS | 2 +- misc/buildlocalglobal | 10 +- os/alias.c | 1 - os/chartypes.yap | 9 +- os/console.c | 5 +- os/files.c | 36 +- os/getw.h | 2 +- os/iopreds.c | 2056 +++++++++++----------- os/iopreds.c:1351 in C-function do_open | 0 os/iopreds.c:1352 in C-function do_open | 0 os/iopreds.c:1374 in C-function do_open | 0 os/iopreds.c:1376 in C-function do_open | 0 os/iopreds.c:1379 in C-function do_open | 0 os/iopreds.c:1382 in C-function do_open | 0 os/iopreds.c:1413 in C-function do_open | 0 os/iopreds.h | 6 +- os/mem.c | 50 +- os/readterm.c | 35 +- os/readutil.c | 228 +-- os/sig.c | 2 +- os/streams.c | 10 +- os/sysbits.c | 75 +- os/sysbits.h | 2 +- os/time.c | 179 +- os/yapio.h | 2 +- packages/CLPBN/CMakeLists.txt | 2 + packages/jpl/CMakeLists.txt | 12 +- packages/jpl/src/c/CMakeLists.txt | 1 + packages/jpl/src/c/jpl.c | 2 + packages/myddas/myddas_statistics.c | 2 + packages/swi-minisat2/C/Solver.h | 2 +- pl/CMakeLists.txt | 3 +- pl/absf.yap | 7 - pl/boot.yap | 8 +- pl/consult.yap | 2 +- pl/corout.yap | 2 +- pl/init.yap | 2 +- pl/messages.yap | 2 +- pl/utils.yap | 151 +- utf8proc/utf8proc.h | 5 +- 84 files changed, 2717 insertions(+), 2737 deletions(-) delete mode 100644 H/ *Minibuf-5* delete mode 100644 H/ *Minibuf-6* delete mode 100644 library/bootlists.yap delete mode 100644 os/iopreds.c:1351 in C-function do_open delete mode 100644 os/iopreds.c:1352 in C-function do_open delete mode 100644 os/iopreds.c:1374 in C-function do_open delete mode 100644 os/iopreds.c:1376 in C-function do_open delete mode 100644 os/iopreds.c:1379 in C-function do_open delete mode 100644 os/iopreds.c:1382 in C-function do_open delete mode 100644 os/iopreds.c:1413 in C-function do_open diff --git a/.gitignore b/.gitignore index 5047415e5..b7e07780e 100644 --- a/.gitignore +++ b/.gitignore @@ -79,7 +79,7 @@ GitSHA1.c CMakeLists.txt.* FindPackageLog.txt GitSHA1.c -out + GitSHA1.c os/YapIOConfig.h @@ -148,6 +148,5 @@ cmake/cmake-android yap-6.3.workspace YAP.project -sublime + *.tmp -CBlocks \ No newline at end of file diff --git a/C/absmi.c b/C/absmi.c index 3f8957519..6a8ab3727 100755 --- a/C/absmi.c +++ b/C/absmi.c @@ -644,7 +644,7 @@ push_live_regs(yamop *pco) } #endif -#if defined(ANALYST) || defined(DEBUG) +#if USE_THREADED_CODE && (defined(ANALYST) || defined(DEBUG)) char *Yap_op_names[] = { @@ -1066,27 +1066,27 @@ static void execute_dealloc( USES_REGS1 ) { /* other instructions do depend on S being set by deallocate - :-( */ - CELL *ENV_YREG = YENV; - S = ENV_YREG; - CP = (yamop *) ENV_YREG[E_CP]; - ENV = ENV_YREG = (CELL *) ENV_YREG[E_E]; + */ + CELL *ENVYREG = YENV; + S = ENVYREG; + CP = (yamop *) ENVYREG[E_CP]; + ENV = ENVYREG = (CELL *) ENVYREG[E_E]; #ifdef DEPTH_LIMIT - DEPTH = ENV_YREG[E_DEPTH]; + DEPTH = ENVYREG[E_DEPTH]; #endif /* DEPTH_LIMIT */ #ifdef FROZEN_STACKS { choiceptr top_b = PROTECT_FROZEN_B(B); #ifdef YAPOR_SBA - if (ENV_YREG > (CELL *) top_b || ENV_YREG < HR) ENV_YREG = (CELL *) top_b; + if (ENVYREG > (CELL *) top_b || ENVYREG < HR) ENVYREG = (CELL *) top_b; #else - if (ENV_YREG > (CELL *) top_b) ENV_YREG = (CELL *) top_b; + if (ENVYREG > (CELL *) top_b) ENVYREG = (CELL *) top_b; #endif /* YAPOR_SBA */ - else ENV_YREG = (CELL *)((CELL) ENV_YREG + ENV_Size(CP)); + else ENVYREG = (CELL *)((CELL) ENVYREG + ENV_Size(CP)); } #else - if (ENV_YREG > (CELL *) B) - ENV_YREG = (CELL *) B; + if (ENVYREG > (CELL *) B) + ENVYREG = (CELL *) B; else ENV_YREG = (CELL *) ((CELL) ENV_YREG + ENV_Size(CP)); #endif /* FROZEN_STACKS */ diff --git a/C/adtdefs.c b/C/adtdefs.c index 8fb4ad869..c38d1cd15 100755 --- a/C/adtdefs.c +++ b/C/adtdefs.c @@ -562,62 +562,62 @@ Yap_OpPropForModule(Atom a, return info; } -static OpEntry * -fetchOpWithModule( PropEntry *pp, Term tmod, op_type type ) -{ +OpEntry * +Yap_GetOpProp(Atom a, + op_type type + USES_REGS) { /* look property list of atom a for kind */ + AtomEntry *ae = RepAtom(a); + PropEntry *pp; + OpEntry *oinfo = NULL; + + READ_LOCK(ae->ARWLock); + pp = RepProp(ae->PropsOfAE); while (!EndOfPAEntr(pp)) { OpEntry *info = NULL; - if (pp->KindOfPE != OpProperty) { pp = RepProp(pp->NextOfPE); continue; } info = (OpEntry *)pp; - if (info->OpModule != tmod) { + if (info->OpModule != CurrentModule && info->OpModule != PROLOG_MODULE) { pp = RepProp(pp->NextOfPE); continue; } if (type == INFIX_OP) { if (!info->Infix) { - return NULL; + pp = RepProp(pp->NextOfPE); + continue; } } else if (type == POSFIX_OP) { if (!info->Posfix) { - return NULL; + pp = RepProp(pp->NextOfPE); + continue; } } else { if (!info->Prefix) { - return NULL; + pp = RepProp(pp->NextOfPE); + continue; } } - return info; + /* if it is not the latest module */ + if (info->OpModule == PROLOG_MODULE) { + /* cannot commit now */ + oinfo = info; + pp = RepProp(pp->NextOfPE); + } else { + READ_LOCK(info->OpRWLock); + READ_UNLOCK(ae->ARWLock); + return info; + } } + if (oinfo) { + READ_LOCK(oinfo->OpRWLock); + READ_UNLOCK(ae->ARWLock); + return oinfo; + } + READ_UNLOCK(ae->ARWLock); return NULL; } - -OpEntry * -Yap_GetOpProp(Atom a, - op_type type, - Term tmod - USES_REGS) { /* look property list of atom a for kind */ - AtomEntry *ae = RepAtom(a); - PropEntry *pp; - OpEntry *info; - - READ_LOCK(ae->ARWLock); - pp = RepProp(ae->PropsOfAE); - if (( (info = fetchOpWithModule( pp, tmod, type )) != NULL) || - ( (info = fetchOpWithModule( pp, USER_MODULE, type )) != NULL) || - ( (info = fetchOpWithModule( pp, PROLOG_MODULE, type )) != NULL) - ) { - LOCK(info->OpRWLock); - return info; - READ_UNLOCK(ae->ARWLock); - } - READ_UNLOCK(ae->ARWLock); - - return NULL; -} inline static Prop GetPredPropByAtomHavingLock(AtomEntry *ae, Term cur_mod) /* get predicate entry for ap/arity; create it if neccessary. */ diff --git a/C/atomic.c b/C/atomic.c index 342ca8d47..8a325dbcf 100644 --- a/C/atomic.c +++ b/C/atomic.c @@ -15,7 +15,7 @@ * * *************************************************************************/ #ifdef SCCS -static char SccsId[] = "%W% %G%"; +static char SccsId[] = "%W% %G%"; #endif /** @addgroup Predicates_on_Atoms Predicates on Atoms and Strings @@ -25,9 +25,10 @@ static char SccsId[] = "%W% %G%"; The following predicates are used to manipulate atoms: \toc - + */ + #define HAS_CACHE_REGS 1 /* * This file includes the definition of a miscellania of standard operations @@ -53,29 +54,32 @@ The following predicates are used to manipulate atoms: #endif #include -static Int name(USES_REGS1); -static Int atom_chars(USES_REGS1); -static Int atom_codes(USES_REGS1); -static Int atom_length(USES_REGS1); -static Int string_length(USES_REGS1); -static Int atom_split(USES_REGS1); -static Int number_chars(USES_REGS1); -static Int number_codes(USES_REGS1); -static Int current_atom(USES_REGS1); -static Int cont_current_atom(USES_REGS1); +static Int name( USES_REGS1 ); +static Int atom_chars( USES_REGS1 ); +static Int atom_codes( USES_REGS1 ); +static Int atom_length( USES_REGS1 ); +static Int string_length( USES_REGS1 ); +static Int atom_split( USES_REGS1 ); +static Int number_chars( USES_REGS1 ); +static Int number_codes( USES_REGS1 ); +static Int current_atom( USES_REGS1 ); +static Int cont_current_atom( USES_REGS1 ); static int AlreadyHidden(unsigned char *); -static Int hide_atom(USES_REGS1); -static Int hidden_atom(USES_REGS1); -static Int unhide_atom(USES_REGS1); +static Int hide_atom( USES_REGS1 ); +static Int hidden_atom( USES_REGS1 ); +static Int unhide_atom( USES_REGS1 ); -static int AlreadyHidden(unsigned char *name) { - AtomEntry *chain; + + +static int +AlreadyHidden(unsigned char *name) +{ + AtomEntry *chain; READ_LOCK(INVISIBLECHAIN.AERWLock); chain = RepAtom(INVISIBLECHAIN.Entry); READ_UNLOCK(INVISIBLECHAIN.AERWLock); - while (!EndOfPAEntr(chain) && - strcmp((char *)chain->StrOfAE, (char *)name) != 0) + while (!EndOfPAEntr(chain) && strcmp((char *)chain->StrOfAE, (char *)name) != 0) chain = RepAtom(chain->NextOfAE); if (EndOfPAEntr(chain)) return (FALSE); @@ -89,41 +93,44 @@ static int AlreadyHidden(unsigned char *name) { result in a different atom.xs **/ -static Int hide_atom(USES_REGS1) { /* hide(+Atom) */ - Atom atomToInclude; +static Int +hide_atom( USES_REGS1 ) +{ /* hide(+Atom) */ + Atom atomToInclude; Term t1 = Deref(ARG1); if (IsVarTerm(t1)) { - Yap_Error(INSTANTIATION_ERROR, t1, "hide_atom/1"); - return (FALSE); + Yap_Error(INSTANTIATION_ERROR,t1,"hide_atom/1"); + return(FALSE); } if (!IsAtomTerm(t1)) { - Yap_Error(TYPE_ERROR_ATOM, t1, "hide_atom/1"); - return (FALSE); + Yap_Error(TYPE_ERROR_ATOM,t1,"hide_atom/1"); + return(FALSE); } atomToInclude = AtomOfTerm(t1); if (AlreadyHidden(RepAtom(atomToInclude)->UStrOfAE)) { - Yap_Error(SYSTEM_ERROR_INTERNAL, t1, - "an atom of name %s was already hidden", - RepAtom(atomToInclude)->StrOfAE); - return (FALSE); + Yap_Error(SYSTEM_ERROR_INTERNAL,t1,"an atom of name %s was already hidden", + RepAtom(atomToInclude)->StrOfAE); + return(FALSE); } AtomEntry *ae = RepAtom(atomToInclude); Prop p = ae->PropsOfAE; while (p) { - if (IsPredProperty(p->KindOfPE) || IsDBProperty(p->KindOfPE)) { + if (IsPredProperty(p->KindOfPE) || + IsDBProperty(p->KindOfPE ) ) { RepPredProp(p)->PredFlags |= HiddenPredFlag; - + } else if (p->KindOfPE == FunctorProperty) { Prop q = RepFunctorProp(p)->PropsOfFE; while (q) { - if (IsPredProperty(q->KindOfPE) || IsDBProperty(q->KindOfPE)) { + if (IsPredProperty(q->KindOfPE) || + IsDBProperty(q->KindOfPE) ) { RepPredProp(q)->PredFlags |= HiddenPredFlag; } q = q->NextOfPE; } } - p = p->NextOfPE; + p =p->NextOfPE; } Yap_ReleaseAtom(atomToInclude); WRITE_LOCK(INVISIBLECHAIN.AERWLock); @@ -135,13 +142,15 @@ static Int hide_atom(USES_REGS1) { /* hide(+Atom) */ return (TRUE); } -/** @pred hidden_atom( +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; +static Int +hidden_atom( USES_REGS1 ) +{ /* '$hidden_atom'(+F) */ + Atom at; + AtomEntry *chain; Term t1 = Deref(ARG1); if (IsVarTerm(t1)) @@ -162,36 +171,37 @@ static Int hidden_atom(USES_REGS1) { /* '$hidden_atom'(+F) */ return (TRUE); } -/** @pred unhide_atom(+ _Atom_) - Make hidden atom _Atom_ visible - Note that the operation fails if another atom with name _Atom_ was defined - since. +/** @pred unhide_atom(+ _Atom_) + Make hidden atom _Atom_ visible + + Note that the operation fails if another atom with name _Atom_ was defined since. **/ -static Int unhide_atom(USES_REGS1) { /* unhide_atom(+Atom) */ - AtomEntry *atom, *old, *chain; +static Int +unhide_atom( USES_REGS1 ) +{ /* unhide_atom(+Atom) */ + AtomEntry *atom, *old, *chain; Term t1 = Deref(ARG1); if (IsVarTerm(t1)) { - Yap_Error(INSTANTIATION_ERROR, t1, "unhide_atom/1"); - return (FALSE); + Yap_Error(INSTANTIATION_ERROR,t1,"unhide_atom/1"); + return(FALSE); } if (!IsAtomTerm(t1)) { - Yap_Error(TYPE_ERROR_ATOM, t1, "unhide_atom/1"); - return (FALSE); + Yap_Error(TYPE_ERROR_ATOM,t1,"unhide_atom/1"); + return(FALSE); } atom = RepAtom(AtomOfTerm(t1)); WRITE_LOCK(atom->ARWLock); if (atom->PropsOfAE != NIL) { - Yap_Error(SYSTEM_ERROR_INTERNAL, t1, "cannot unhide_atom an atom in use"); - return (FALSE); + Yap_Error(SYSTEM_ERROR_INTERNAL,t1,"cannot unhide_atom an atom in use"); + return(FALSE); } WRITE_LOCK(INVISIBLECHAIN.AERWLock); chain = RepAtom(INVISIBLECHAIN.Entry); old = NIL; - while (!EndOfPAEntr(chain) && - strcmp((char *)chain->StrOfAE, (char *)atom->StrOfAE) != 0) { + while (!EndOfPAEntr(chain) && strcmp((char *)chain->StrOfAE, (char *)atom->StrOfAE) != 0) { old = chain; chain = RepAtom(chain->NextOfAE); } @@ -207,99 +217,104 @@ static Int unhide_atom(USES_REGS1) { /* unhide_atom(+Atom) */ return (TRUE); } -static Int char_code(USES_REGS1) { +static Int +char_code( USES_REGS1 ) +{ Int t0 = Deref(ARG1); if (IsVarTerm(t0)) { Term t1 = Deref(ARG2); if (IsVarTerm(t1)) { - Yap_Error(INSTANTIATION_ERROR, t0, "char_code/2"); - return (FALSE); + Yap_Error(INSTANTIATION_ERROR,t0,"char_code/2"); + return(FALSE); } else if (!IsIntegerTerm(t1)) { if (!IsBigIntTerm(t1)) { - Yap_Error(REPRESENTATION_ERROR_INT, t1, "char_code/2"); - return (FALSE); + Yap_Error(REPRESENTATION_ERROR_INT,t1,"char_code/2"); + return(FALSE); } - Yap_Error(TYPE_ERROR_INTEGER, t1, "char_code/2"); - return (FALSE); + Yap_Error(TYPE_ERROR_INTEGER,t1,"char_code/2"); + return(FALSE); } else { Int code = IntegerOfTerm(t1); Term tout; if (code < 0) { - Yap_Error(REPRESENTATION_ERROR_CHARACTER_CODE, t1, "char_code/2"); - return (FALSE); + Yap_Error(REPRESENTATION_ERROR_CHARACTER_CODE,t1,"char_code/2"); + return(FALSE); } if (code > MAX_ISO_LATIN1) { - wchar_t wcodes[2]; + wchar_t wcodes[2]; - if (code > CHARCODE_MAX) { - Yap_Error(REPRESENTATION_ERROR_INT, t1, "char_code/2"); - return (FALSE); - } - wcodes[0] = code; - wcodes[1] = '\0'; - tout = MkAtomTerm(Yap_LookupWideAtom(wcodes)); + if (code > CHARCODE_MAX) { + Yap_Error(REPRESENTATION_ERROR_INT,t1,"char_code/2"); + return(FALSE); + } + wcodes[0] = code; + wcodes[1] = '\0'; + tout = MkAtomTerm(Yap_LookupWideAtom(wcodes)); } else { - char codes[2]; + char codes[2]; - codes[0] = code; - codes[1] = '\0'; - tout = MkAtomTerm(Yap_LookupAtom(codes)); + codes[0] = code; + codes[1] = '\0'; + tout = MkAtomTerm(Yap_LookupAtom(codes)); } - return Yap_unify(ARG1, tout); + return Yap_unify(ARG1,tout); } } else if (!IsAtomTerm(t0)) { - Yap_Error(TYPE_ERROR_CHARACTER, t0, "char_code/2"); - return (FALSE); + Yap_Error(TYPE_ERROR_CHARACTER,t0,"char_code/2"); + return(FALSE); } else { Atom at = AtomOfTerm(t0); Term tf; if (IsWideAtom(at)) { wchar_t *c = RepAtom(at)->WStrOfAE; - + if (c[1] != '\0') { - Yap_Error(TYPE_ERROR_CHARACTER, t0, "char_code/2"); - return FALSE; + Yap_Error(TYPE_ERROR_CHARACTER,t0,"char_code/2"); + return FALSE; } tf = MkIntegerTerm(c[0]); } else { unsigned char *c = RepAtom(at)->UStrOfAE; - + if (c[1] != '\0') { - Yap_Error(TYPE_ERROR_CHARACTER, t0, "char_code/2"); - return FALSE; + Yap_Error(TYPE_ERROR_CHARACTER,t0,"char_code/2"); + return FALSE; } tf = MkIntTerm((unsigned char)(c[0])); } - return Yap_unify(ARG2, tf); + return Yap_unify(ARG2,tf); } } -static Int name(USES_REGS1) { /* name(?Atomic,?String) */ - Term t = Deref(ARG2), NewT, AtomNameT = Deref(ARG1); +static Int +name( USES_REGS1 ) +{ /* name(?Atomic,?String) */ + Term t = Deref(ARG2), NewT, AtomNameT = Deref(ARG1); LOCAL_MAX_SIZE = 1024; -restart_aux: + restart_aux: if (Yap_IsGroundTerm(AtomNameT)) { if (!IsVarTerm(t) && !IsPairTerm(t) && t != TermNil) { - Yap_Error(TYPE_ERROR_LIST, ARG2, "name/2"); + Yap_Error(TYPE_ERROR_LIST,ARG2, + "name/2"); return FALSE; } // verify if an atom, int, float or bi§gnnum - NewT = Yap_AtomicToListOfCodes(AtomNameT PASS_REGS); + NewT = Yap_AtomicToListOfCodes( AtomNameT PASS_REGS ); if (NewT) return Yap_unify(NewT, ARG2); // else - } else if (IsVarTerm(t)) { - Yap_Error(INSTANTIATION_ERROR, t, "name/2"); + } else if (IsVarTerm(t)){ + Yap_Error(INSTANTIATION_ERROR,t, + "name/2"); return FALSE; } else { - Term at = Yap_ListToAtomic(t PASS_REGS); - if (at) - return Yap_unify(at, ARG1); + Term at = Yap_ListToAtomic( t PASS_REGS ); + if (at) return Yap_unify(at, ARG1); } - if (LOCAL_Error_TYPE && Yap_HandleError("atom/2")) { + if (LOCAL_Error_TYPE && Yap_HandleError( "atom/2" )) { AtomNameT = Deref(ARG1); t = Deref(ARG2); goto restart_aux; @@ -307,27 +322,27 @@ restart_aux: return FALSE; } -static Int string_to_atomic( - USES_REGS1) { /* string_to_atom(?String,?Atom) */ - Term t2 = Deref(ARG2), t1 = Deref(ARG1); +static Int +string_to_atomic( USES_REGS1 ) +{ /* string_to_atom(?String,?Atom) */ + Term t2 = Deref(ARG2), t1 = Deref(ARG1); LOCAL_MAX_SIZE = 1024; -restart_aux: + restart_aux: if (IsStringTerm(t1)) { Term t; // verify if an atom, int, float or bignnum - t = Yap_StringToAtomic(t1 PASS_REGS); + t = Yap_StringToAtomic( t1 PASS_REGS ); if (t != 0L) return Yap_unify(t, t2); // else } else if (IsVarTerm(t1)) { - Term t0 = Yap_AtomicToString(t2 PASS_REGS); - if (t0) - return Yap_unify(t0, t1); + Term t0 = Yap_AtomicToString( t2 PASS_REGS ); + if (t0) return Yap_unify(t0, t1); } else { LOCAL_Error_TYPE = TYPE_ERROR_STRING; } - if (LOCAL_Error_TYPE && Yap_HandleError("string_to_atomic/2")) { + if (LOCAL_Error_TYPE && Yap_HandleError( "string_to_atomic/2" )) { t1 = Deref(ARG1); t2 = Deref(ARG2); goto restart_aux; @@ -335,27 +350,27 @@ restart_aux: return FALSE; } -static Int string_to_atom( - USES_REGS1) { /* string_to_atom(?String,?Atom) */ - Term t2 = Deref(ARG2), t1 = Deref(ARG1); +static Int +string_to_atom( USES_REGS1 ) +{ /* string_to_atom(?String,?Atom) */ + Term t2 = Deref(ARG2), t1 = Deref(ARG1); LOCAL_MAX_SIZE = 1024; -restart_aux: + restart_aux: if (IsStringTerm(t1)) { Atom at; // verify if an atom, int, float or bignnum - at = Yap_StringSWIToAtom(t1 PASS_REGS); + at = Yap_StringSWIToAtom( t1 PASS_REGS ); if (at) return Yap_unify(MkAtomTerm(at), t2); // else - } else if (IsVarTerm(t1)) { - Term t0 = Yap_AtomSWIToString(t2 PASS_REGS); - if (t0) - return Yap_unify(t0, t1); + } else if (IsVarTerm(t1)) { + Term t0 = Yap_AtomSWIToString( t2 PASS_REGS ); + if (t0) return Yap_unify(t0, t1); } else { LOCAL_Error_TYPE = TYPE_ERROR_ATOM; } - if (LOCAL_Error_TYPE && Yap_HandleError("string_to_atom/2")) { + if (LOCAL_Error_TYPE && Yap_HandleError( "string_to_atom/2" )) { t1 = Deref(ARG1); t2 = Deref(ARG2); goto restart_aux; @@ -363,22 +378,24 @@ restart_aux: return FALSE; } -static Int string_to_list(USES_REGS1) { - Term list = Deref(ARG2), string = Deref(ARG1); +static Int +string_to_list( USES_REGS1 ) +{ + Term list = Deref(ARG2), string = Deref(ARG1); LOCAL_MAX_SIZE = 1024; -restart_aux: + restart_aux: if (IsVarTerm(string)) { - Term t1 = Yap_ListToString(list PASS_REGS); + Term t1 = Yap_ListToString( list PASS_REGS); if (t1) - return Yap_unify(ARG1, t1); + return Yap_unify( ARG1, t1 ); } else if (IsStringTerm(string)) { Term tf = Yap_StringToListOfCodes(string PASS_REGS); - return Yap_unify(ARG2, tf); + return Yap_unify( ARG2, tf ); } else { LOCAL_Error_TYPE = TYPE_ERROR_STRING; } - if (LOCAL_Error_TYPE && Yap_HandleError("string_to_list/2")) { + if (LOCAL_Error_TYPE && Yap_HandleError( "string_to_list/2" )) { string = Deref(ARG1); list = Deref(ARG2); goto restart_aux; @@ -386,26 +403,27 @@ restart_aux: return FALSE; } -static Int atom_string(USES_REGS1) { - Term t1 = Deref(ARG1), t2 = Deref(ARG2); +static Int +atom_string( USES_REGS1 ) +{ + Term t1 = Deref(ARG1), t2 = Deref(ARG2); LOCAL_MAX_SIZE = 1024; -restart_aux: + restart_aux: if (IsVarTerm(t1)) { Atom at; // verify if an atom, int, float or bignnum - at = Yap_StringSWIToAtom(t2 PASS_REGS); + at = Yap_StringSWIToAtom( t2 PASS_REGS ); if (at) return Yap_unify(MkAtomTerm(at), t1); // else } else if (IsAtomTerm(t1)) { - Term t0 = Yap_AtomSWIToString(t1 PASS_REGS); - if (t0) - return Yap_unify(t0, t2); + Term t0 = Yap_AtomSWIToString( t1 PASS_REGS ); + if (t0) return Yap_unify(t0, t2); } else { LOCAL_Error_TYPE = TYPE_ERROR_ATOM; } - if (LOCAL_Error_TYPE && Yap_HandleError("atom_string/2")) { + if (LOCAL_Error_TYPE && Yap_HandleError( "atom_string/2" )) { t1 = Deref(ARG1); t2 = Deref(ARG2); goto restart_aux; @@ -413,241 +431,257 @@ restart_aux: return FALSE; } -static Int atom_chars(USES_REGS1) { +static Int +atom_chars( USES_REGS1 ) +{ Term t1; LOCAL_MAX_SIZE = 1024; -restart_aux: - t1 = Deref(ARG1); + restart_aux: + t1 = Deref(ARG1); if (IsAtomTerm(t1)) { Term tf = Yap_AtomSWIToListOfAtoms(t1 PASS_REGS); if (tf) - return Yap_unify(ARG2, tf); - } else if (IsVarTerm(t1)) { + return Yap_unify( ARG2, tf ); + } else if (IsVarTerm(t1)) { /* ARG1 unbound */ - Term t = Deref(ARG2); + Term t = Deref(ARG2); Atom af = Yap_ListOfAtomsToAtom(t PASS_REGS); if (af) - return Yap_unify(ARG1, MkAtomTerm(af)); - /* error handling */ + return Yap_unify( ARG1, MkAtomTerm(af) ); + /* error handling */ } else { LOCAL_Error_TYPE = TYPE_ERROR_ATOM; } - if (LOCAL_Error_TYPE && Yap_HandleError("atom_chars/2")) { + if (LOCAL_Error_TYPE && Yap_HandleError( "atom_chars/2" )) { goto restart_aux; } return false; } -static Int atom_codes(USES_REGS1) { +static Int +atom_codes( USES_REGS1 ) +{ Term t1; - t1 = Deref(ARG1); + t1 = Deref(ARG1); restart_aux: if (IsAtomTerm(t1)) { Term tf = Yap_AtomToListOfCodes(t1 PASS_REGS); if (tf) - return Yap_unify(ARG2, tf); + return Yap_unify( ARG2, tf ); } else if (IsVarTerm(t1)) { /* ARG1 unbound */ - Term t = Deref(ARG2); + Term t = Deref(ARG2); Atom af = Yap_ListToAtom(t PASS_REGS); if (af) - return Yap_unify(ARG1, MkAtomTerm(af)); - } else if (IsVarTerm(t1)) { + return Yap_unify( ARG1, MkAtomTerm(af) ); + } else if (IsVarTerm(t1)) { LOCAL_Error_TYPE = TYPE_ERROR_ATOM; } /* error handling */ - if (LOCAL_Error_TYPE && Yap_HandleError("atom_codes/2")) { + if (LOCAL_Error_TYPE && Yap_HandleError( "atom_codes/2" )) { t1 = Deref(ARG1); goto restart_aux; } return FALSE; } -static Int string_codes(USES_REGS1) { +static Int +string_codes( USES_REGS1 ) +{ Term t1; - t1 = Deref(ARG1); + t1 = Deref(ARG1); restart_aux: if (IsStringTerm(t1)) { Term tf = Yap_StringSWIToListOfCodes(t1 PASS_REGS); if (tf) - return Yap_unify(ARG2, tf); - } else if (IsVarTerm(t1)) { + return Yap_unify( ARG2, tf ); + } else if (IsVarTerm(t1)) { /* ARG1 unbound */ - Term t = Deref(ARG2); + Term t = Deref(ARG2); Term tf = Yap_ListSWIToString(t PASS_REGS); if (tf) - return Yap_unify(ARG1, tf); + return Yap_unify( ARG1, tf ); } else { LOCAL_Error_TYPE = TYPE_ERROR_STRING; } /* error handling */ - if (LOCAL_Error_TYPE && Yap_HandleError("atom_codes/2")) { + if (LOCAL_Error_TYPE && Yap_HandleError( "atom_codes/2" )) { t1 = Deref(ARG1); goto restart_aux; } return FALSE; } -static Int string_chars(USES_REGS1) { +static Int +string_chars( USES_REGS1 ) +{ Term t1; - t1 = Deref(ARG1); + t1 = Deref(ARG1); restart_aux: if (IsStringTerm(t1)) { Term tf = Yap_StringSWIToListOfAtoms(t1 PASS_REGS); if (tf) - return Yap_unify(ARG2, tf); - } else if (IsVarTerm(t1)) { + return Yap_unify( ARG2, tf ); + } else if (IsVarTerm(t1)) { /* ARG1 unbound */ - Term t = Deref(ARG2); + Term t = Deref(ARG2); Term tf = Yap_ListSWIToString(t PASS_REGS); if (tf) - return Yap_unify(ARG1, tf); + return Yap_unify( ARG1, tf ); } else { LOCAL_Error_TYPE = TYPE_ERROR_STRING; } /* error handling */ - if (LOCAL_Error_TYPE && Yap_HandleError("string_chars/2")) { + if (LOCAL_Error_TYPE && Yap_HandleError( "string_chars/2" )) { t1 = Deref(ARG1); goto restart_aux; } return FALSE; } -/** @pred number_chars(? _I_,? _L_) is iso +/** @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_. - + */ -static Int number_chars(USES_REGS1) { +static Int +number_chars( USES_REGS1 ) +{ Term t1; -restart_aux: - t1 = Deref(ARG1); + restart_aux: + t1 = Deref(ARG1); if (IsNumTerm(t1)) { Term tf; tf = Yap_NumberToListOfAtoms(t1 PASS_REGS); if (tf) { LOCAL_Error_TYPE = YAP_NO_ERROR; - return Yap_unify(ARG2, tf); + return Yap_unify( ARG2, tf ); } } else if (IsVarTerm(t1)) { /* ARG1 unbound */ - Term t = Deref(ARG2); + Term t = Deref(ARG2); Term tf = Yap_ListToNumber(t PASS_REGS); if (tf) { LOCAL_Error_TYPE = YAP_NO_ERROR; - return Yap_unify(ARG1, tf); + return Yap_unify( ARG1, tf ); } - } else if (IsVarTerm(t1)) { + } else if (IsVarTerm(t1)) { LOCAL_Error_TYPE = TYPE_ERROR_NUMBER; } /* error handling */ - if (LOCAL_Error_TYPE && Yap_HandleError("number_chars/2")) { + if (LOCAL_Error_TYPE && Yap_HandleError( "number_chars/2" )) { goto restart_aux; } return false; } -static Int number_atom(USES_REGS1) { +static Int +number_atom( USES_REGS1 ) +{ Term t1; -restart_aux: - t1 = Deref(ARG1); + restart_aux: + t1 = Deref(ARG1); if (IsNumTerm(t1)) { Atom af; af = Yap_NumberToAtom(t1 PASS_REGS); if (af) - return Yap_unify(ARG2, MkAtomTerm(af)); + return Yap_unify( ARG2, MkAtomTerm(af) ); } else if (IsVarTerm(t1)) { /* ARG1 unbound */ - Term t = Deref(ARG2); + Term t = Deref(ARG2); Term tf = Yap_AtomToNumber(t PASS_REGS); if (tf) - return Yap_unify(ARG1, tf); - } else if (IsVarTerm(t1)) { + 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")) { + } /* error handling */ + if (LOCAL_Error_TYPE && Yap_HandleError( "number_atom/2")) { goto restart_aux; } return false; } -static Int number_string(USES_REGS1) { +static Int +number_string( USES_REGS1 ) +{ Term t1; -restart_aux: - t1 = Deref(ARG1); + restart_aux: + t1 = Deref(ARG1); if (IsNumTerm(t1)) { Term tf; tf = Yap_NumberToString(t1 PASS_REGS); if (tf) - return Yap_unify(ARG2, tf); + return Yap_unify( ARG2, tf ); } else if (IsVarTerm(t1)) { /* ARG1 unbound */ - Term t = Deref(ARG2); + Term t = Deref(ARG2); Term tf = Yap_StringToNumber(t PASS_REGS); if (tf) - return Yap_unify(ARG1, tf); + return Yap_unify( ARG1, tf ); } else { LOCAL_Error_TYPE = TYPE_ERROR_NUMBER; } - /* error handling */ - if (LOCAL_Error_TYPE && Yap_HandleError("number_string/2")) { + /* error handling */ + if (LOCAL_Error_TYPE && Yap_HandleError( "number_string/2")) { goto restart_aux; } return FALSE; } -static Int number_codes(USES_REGS1) { +static Int +number_codes( USES_REGS1 ) +{ Term t1; -restart_aux: - t1 = Deref(ARG1); + restart_aux: + t1 = Deref(ARG1); if (IsNumTerm(t1)) { Term tf; tf = Yap_NumberToListOfCodes(t1 PASS_REGS); if (tf) - return Yap_unify(ARG2, tf); + return Yap_unify( ARG2, tf ); } else if (IsVarTerm(t1)) { /* ARG1 unbound */ - Term t = Deref(ARG2); + Term t = Deref(ARG2); Term tf = Yap_ListToNumber(t PASS_REGS); if (tf) - return Yap_unify(ARG1, tf); + return Yap_unify( ARG1, tf ); } else { LOCAL_Error_TYPE = TYPE_ERROR_NUMBER; } /* error handling */ - if (LOCAL_Error_TYPE && Yap_HandleError("number_codes/2")) { + if (LOCAL_Error_TYPE && Yap_HandleError( "number_codes/2" )) { goto restart_aux; } return FALSE; } -static Int cont_atom_concat3(USES_REGS1) { +static Int +cont_atom_concat3( USES_REGS1 ) +{ Term t3; Atom ats[2]; Int i, max; -restart_aux: + restart_aux: t3 = Deref(ARG3); - i = IntOfTerm(EXTRA_CBACK_ARG(3, 1)); - max = IntOfTerm(EXTRA_CBACK_ARG(3, 2)); - EXTRA_CBACK_ARG(3, 1) = MkIntTerm(i + 1); - if (!Yap_SpliceAtom(t3, ats, i, max PASS_REGS)) { + i = IntOfTerm(EXTRA_CBACK_ARG(3,1)); + max = IntOfTerm(EXTRA_CBACK_ARG(3,2)); + EXTRA_CBACK_ARG(3,1) = MkIntTerm(i+1); + if ( ! Yap_SpliceAtom( t3, ats, i, max PASS_REGS ) ) { cut_fail(); } else { - if (i < max) - 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]))) - cut_succeed(); + if (i < max) 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]))) cut_succeed(); cut_fail(); } /* Error handling */ if (LOCAL_Error_TYPE) { - if (Yap_HandleError("atom_concat/3")) { + if (Yap_HandleError( "atom_concat/3" )) { goto restart_aux; } else { return FALSE; @@ -656,43 +690,43 @@ restart_aux: cut_fail(); } -static Int atom_concat3(USES_REGS1) { + +static Int +atom_concat3( USES_REGS1 ) +{ Term t1; Term t2, t3, ot; Atom at; -restart_aux: + restart_aux: t1 = Deref(ARG1); t2 = Deref(ARG2); t3 = Deref(ARG3); if (Yap_IsGroundTerm(t1) && Yap_IsGroundTerm(t2)) { - at = Yap_ConcatAtoms(t1, t2 PASS_REGS); + at = Yap_ConcatAtoms( t1, t2 PASS_REGS ); ot = ARG3; - } else if (Yap_IsGroundTerm(t1) && Yap_IsGroundTerm(t3)) { - at = Yap_SubtractHeadAtom(Deref(ARG3), t1 PASS_REGS); + } else if (Yap_IsGroundTerm(t1) && Yap_IsGroundTerm(t3) ) { + at = Yap_SubtractHeadAtom( Deref(ARG3), t1 PASS_REGS ); ot = ARG2; } else if (Yap_IsGroundTerm(t2) && Yap_IsGroundTerm(t3)) { - at = Yap_SubtractTailAtom(Deref(ARG3), t2 PASS_REGS); + at = Yap_SubtractTailAtom( Deref(ARG3), t2 PASS_REGS ); ot = ARG1; } else if (Yap_IsGroundTerm(t3)) { - EXTRA_CBACK_ARG(3, 1) = MkIntTerm(0); - EXTRA_CBACK_ARG(3, 2) = MkIntTerm(Yap_AtomToLength(t3 PASS_REGS)); - return cont_atom_concat3(PASS_REGS1); + EXTRA_CBACK_ARG(3,1) = MkIntTerm(0); + EXTRA_CBACK_ARG(3,2) = MkIntTerm(Yap_AtomToLength(t3 PASS_REGS)); + return cont_atom_concat3( PASS_REGS1 ); } else { LOCAL_Error_TYPE = INSTANTIATION_ERROR; LOCAL_Error_Term = t1; - Yap_Error(INSTANTIATION_ERROR, IsVarTerm(t1) ? t1 : t2, - "got atom_concat(X,atom,Z) or atom_concat(,atom,Y,Z)"); + Yap_Error( INSTANTIATION_ERROR, IsVarTerm(t1) ? t1 : t2, "got atom_concat(X,atom,Z) or atom_concat(,atom,Y,Z)" ); return false; } if (at) { - if (Yap_unify(ot, MkAtomTerm(at))) - cut_succeed(); - else - cut_fail(); + if (Yap_unify(ot, MkAtomTerm(at))) cut_succeed(); + else cut_fail(); } /* Error handling */ if (LOCAL_Error_TYPE) { - if (Yap_HandleError("atom_concat/3")) { + if (Yap_HandleError( "atom_concat/3" )) { goto restart_aux; } else { return FALSE; @@ -703,44 +737,51 @@ restart_aux: #define CastToAtom(x) CastToAtom__(x PASS_REGS) -static Term CastToAtom__(Term t USES_REGS) { +static Term +CastToAtom__(Term t USES_REGS) +{ if (IsAtomTerm(t)) return t; - return MkAtomTerm(Yap_AtomicToAtom(t PASS_REGS)); + return MkAtomTerm(Yap_AtomicToAtom( t PASS_REGS)); } #define CastToNumeric(x) CastToNumeric__(x PASS_REGS) -static Term CastToNumeric__(Atom at USES_REGS) { - Term t; - if ((t = Yap_AtomToNumber(MkAtomTerm(at) PASS_REGS))) +static Term +CastToNumeric__(Atom at USES_REGS) +{ + Term t; + if ((t = Yap_AtomToNumber( MkAtomTerm( at ) PASS_REGS) ) ) return t; return MkAtomTerm(at); } -static Int cont_atomic_concat3(USES_REGS1) { + +static Int +cont_atomic_concat3( USES_REGS1 ) +{ Term t3; Atom ats[2]; size_t i, max; -restart_aux: + restart_aux: t3 = Deref(ARG3); - i = IntOfTerm(EXTRA_CBACK_ARG(3, 1)); - max = IntOfTerm(EXTRA_CBACK_ARG(3, 2)); - EXTRA_CBACK_ARG(3, 1) = MkIntTerm(i + 1); - if (!Yap_SpliceAtom(t3, ats, i, max PASS_REGS)) { + i = IntOfTerm(EXTRA_CBACK_ARG(3,1)); + max = IntOfTerm(EXTRA_CBACK_ARG(3,2)); + EXTRA_CBACK_ARG(3,1) = MkIntTerm(i+1); + if ( ! Yap_SpliceAtom( t3, ats, i, max PASS_REGS ) ) { cut_fail(); } else { - Term t1 = CastToNumeric(ats[0]); - Term t2 = CastToNumeric(ats[1]); - if (i < max) - return Yap_unify(ARG1, t1) && Yap_unify(ARG2, t2); - if (Yap_unify(ARG1, t1) && Yap_unify(ARG2, t2)) - cut_succeed(); + Term t1 = CastToNumeric(ats[0]); + Term t2 = CastToNumeric(ats[1]); + if (i < max) return Yap_unify( ARG1, t1) && + Yap_unify( ARG2, t2) ; + if (Yap_unify( ARG1, t1) && + Yap_unify( ARG2, t2)) cut_succeed(); cut_fail(); } /* Error handling */ if (LOCAL_Error_TYPE) { - if (Yap_HandleError("string_concat/3")) { + if (Yap_HandleError( "string_concat/3" )) { goto restart_aux; } else { return FALSE; @@ -749,40 +790,40 @@ restart_aux: cut_fail(); } -static Int atomic_concat3(USES_REGS1) { +static Int +atomic_concat3( USES_REGS1 ) +{ Term t1; Term t2, t3, ot; Atom at = NULL; -restart_aux: + restart_aux: t1 = Deref(ARG1); t2 = Deref(ARG2); t3 = Deref(ARG3); if (Yap_IsGroundTerm(t1) && Yap_IsGroundTerm(t2)) { - at = Yap_ConcatAtoms(CastToAtom(t1), CastToAtom(t2) PASS_REGS); + at = Yap_ConcatAtoms( CastToAtom(t1), CastToAtom(t2) PASS_REGS ); ot = ARG3; - } else if (Yap_IsGroundTerm(t1) && Yap_IsGroundTerm(t3)) { - at = Yap_SubtractHeadAtom(t3, CastToAtom(t1) PASS_REGS); + } else if (Yap_IsGroundTerm(t1) && Yap_IsGroundTerm(t3) ) { + at = Yap_SubtractHeadAtom( t3, CastToAtom(t1) PASS_REGS ); ot = ARG2; } else if (Yap_IsGroundTerm(t2) && Yap_IsGroundTerm(t3)) { - at = Yap_SubtractTailAtom(t3, CastToAtom(t2) PASS_REGS); + at = Yap_SubtractTailAtom( t3, CastToAtom(t2) PASS_REGS ); ot = ARG1; } else if (Yap_IsGroundTerm(t3)) { - EXTRA_CBACK_ARG(3, 1) = MkIntTerm(0); - EXTRA_CBACK_ARG(3, 2) = MkIntTerm(Yap_AtomicToLength(t3 PASS_REGS)); - return cont_atomic_concat3(PASS_REGS1); + EXTRA_CBACK_ARG(3,1) = MkIntTerm(0); + EXTRA_CBACK_ARG(3,2) = MkIntTerm(Yap_AtomicToLength(t3 PASS_REGS)); + return cont_atomic_concat3( PASS_REGS1 ); } else { LOCAL_Error_TYPE = INSTANTIATION_ERROR; LOCAL_Error_Term = t1; } if (at) { - if (Yap_unify(ot, CastToNumeric(at))) - cut_succeed(); - else - cut_fail(); + if (Yap_unify(ot, CastToNumeric(at))) cut_succeed(); + else cut_fail(); } /* Error handling */ if (LOCAL_Error_TYPE) { - if (Yap_HandleError("atomic_concat/3")) { + if (Yap_HandleError( "atomic_concat/3" )) { goto restart_aux; } else { return FALSE; @@ -791,27 +832,30 @@ restart_aux: cut_fail(); } -static Int cont_string_concat3(USES_REGS1) { + +static Int +cont_string_concat3( USES_REGS1 ) +{ Term t3; Term ts[2]; size_t i, max; -restart_aux: + restart_aux: t3 = Deref(ARG3); - i = IntOfTerm(EXTRA_CBACK_ARG(3, 1)); - max = IntOfTerm(EXTRA_CBACK_ARG(3, 2)); - EXTRA_CBACK_ARG(3, 1) = MkIntTerm(i + 1); - if (!Yap_SpliceString(t3, ts, i, max PASS_REGS)) { + i = IntOfTerm(EXTRA_CBACK_ARG(3,1)); + max = IntOfTerm(EXTRA_CBACK_ARG(3,2)); + EXTRA_CBACK_ARG(3,1) = MkIntTerm(i+1); + if ( ! Yap_SpliceString( t3, ts, i, max PASS_REGS ) ) { cut_fail(); } else { - if (i < max) - return Yap_unify(ARG1, ts[0]) && Yap_unify(ARG2, ts[1]); - if (Yap_unify(ARG1, ts[0]) && Yap_unify(ARG2, ts[1])) - cut_succeed(); + if (i < max) return Yap_unify( ARG1, ts[0]) && + Yap_unify( ARG2, ts[1]) ; + if (Yap_unify( ARG1, ts[0]) && + Yap_unify( ARG2, ts[1])) cut_succeed(); cut_fail(); } /* Error handling */ if (LOCAL_Error_TYPE) { - if (Yap_HandleError("string_concat/3")) { + if (Yap_HandleError( "string_concat/3" )) { goto restart_aux; } else { return FALSE; @@ -820,41 +864,41 @@ restart_aux: cut_fail(); } -static Int string_concat3(USES_REGS1) { + +static Int +string_concat3( USES_REGS1 ) +{ Term t1; Term t2, t3, ot; Term tf = 0; -restart_aux: + restart_aux: t1 = Deref(ARG1); t2 = Deref(ARG2); t3 = Deref(ARG3); if (Yap_IsGroundTerm(t1) && Yap_IsGroundTerm(t2)) { - tf = Yap_ConcatStrings(t1, t2 PASS_REGS); + tf = Yap_ConcatStrings( t1, t2 PASS_REGS ); ot = ARG3; - } else if (Yap_IsGroundTerm(t1) && Yap_IsGroundTerm(t3)) { - tf = Yap_SubtractHeadString(t3, t1 PASS_REGS); + } else if (Yap_IsGroundTerm(t1) && Yap_IsGroundTerm(t3) ) { + tf = Yap_SubtractHeadString(t3, t1 PASS_REGS ); ot = ARG2; } else if (Yap_IsGroundTerm(t2) && Yap_IsGroundTerm(t3)) { - tf = Yap_SubtractTailString(t3, t2 PASS_REGS); + tf = Yap_SubtractTailString( t3, t2 PASS_REGS ); ot = ARG1; } else if (Yap_IsGroundTerm(t3)) { - EXTRA_CBACK_ARG(3, 1) = MkIntTerm(0); - EXTRA_CBACK_ARG(3, 2) = MkIntTerm(Yap_StringToLength(t3 PASS_REGS)); - return cont_string_concat3(PASS_REGS1); + EXTRA_CBACK_ARG(3,1) = MkIntTerm(0); + EXTRA_CBACK_ARG(3,2) = MkIntTerm(Yap_StringToLength(t3 PASS_REGS)); + return cont_string_concat3( PASS_REGS1 ); } else { LOCAL_Error_TYPE = INSTANTIATION_ERROR; LOCAL_Error_Term = t1; } if (tf) { - if (Yap_unify(ot, tf)) { - cut_succeed(); - } else { - cut_fail(); - } + if (Yap_unify(ot, tf)) { cut_succeed(); } + else { cut_fail(); } } /* Error handling */ if (LOCAL_Error_TYPE) { - if (Yap_HandleError("string_concat/3")) { + if (Yap_HandleError( "string_concat/3" )) { goto restart_aux; } else { return FALSE; @@ -863,33 +907,33 @@ restart_aux: cut_fail(); } -static Int cont_string_code3(USES_REGS1) { + +static Int +cont_string_code3( USES_REGS1 ) +{ Term t2; Int i, j; utf8proc_int32_t chr; const unsigned char *s; const unsigned char *s0; -restart_aux: + 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 - s = (s0 + i) + get_utf8((unsigned char *)s0 + i, -1, &chr); + 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 + 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); - return Yap_unify(MkIntegerTerm(chr), ARG3) && - Yap_unify(MkIntegerTerm(j + 1), ARG1); + EXTRA_CBACK_ARG(3,1) = MkIntTerm(s-s0); + EXTRA_CBACK_ARG(3,2) = MkIntTerm(j+1); + return Yap_unify(MkIntegerTerm( chr ), ARG3) && Yap_unify(MkIntegerTerm( j+1 ), ARG1); } - if (Yap_unify(MkIntegerTerm(chr), ARG3) && Yap_unify(MkIntegerTerm(j), ARG1)) + if (Yap_unify(MkIntegerTerm( chr ), ARG3) && Yap_unify(MkIntegerTerm( j ), ARG1)) cut_succeed(); else cut_fail(); /* Error handling */ if (LOCAL_Error_TYPE) { - if (Yap_HandleError("string_code/3")) { + if (Yap_HandleError( "string_code/3" )) { goto restart_aux; } else { return FALSE; @@ -898,11 +942,14 @@ restart_aux: cut_fail(); } -static Int string_code3(USES_REGS1) { + +static Int +string_code3( USES_REGS1 ) +{ Term t1; Term t2; const unsigned char *s; -restart_aux: + restart_aux: t1 = Deref(ARG1); t2 = Deref(ARG2); if (IsVarTerm(t2)) { @@ -912,41 +959,39 @@ restart_aux: LOCAL_Error_TYPE = TYPE_ERROR_STRING; LOCAL_Error_Term = t2; } else { - s = UStringOfTerm(t2); + s = UStringOfTerm( t2 ); t1 = Deref(ARG1); if (IsVarTerm(t1)) { - EXTRA_CBACK_ARG(3, 1) = MkIntTerm(0); - EXTRA_CBACK_ARG(3, 2) = MkIntTerm(0); - return cont_string_code3(PASS_REGS1); - } else if (!IsIntegerTerm(t1)) { + EXTRA_CBACK_ARG(3,1) = MkIntTerm(0); + EXTRA_CBACK_ARG(3,2) = MkIntTerm(0); + return cont_string_code3( PASS_REGS1 ); + } else if (!IsIntegerTerm( t1 )) { LOCAL_Error_TYPE = TYPE_ERROR_INTEGER; LOCAL_Error_Term = t1; } else { const unsigned char *ns = s; utf8proc_int32_t chr; - Int indx = IntegerOfTerm(t1); + Int indx = IntegerOfTerm( t1 ); if (indx <= 0) { - if (indx < 0) { - LOCAL_Error_TYPE = DOMAIN_ERROR_NOT_LESS_THAN_ZERO; - LOCAL_Error_Term = t1; - } - cut_fail(); + if (indx < 0) { + LOCAL_Error_TYPE = DOMAIN_ERROR_NOT_LESS_THAN_ZERO; + LOCAL_Error_Term = t1; + } + cut_fail(); } ns = skip_utf8((unsigned char *)s, indx); if (ns == NULL) { - cut_fail(); // silently fail? + cut_fail(); // silently fail? } - get_utf8((unsigned char *)ns, -1, &chr); - if (chr == '\0') - cut_fail(); - if (Yap_unify(ARG3, MkIntegerTerm(chr))) - cut_succeed(); + get_utf8( (unsigned char *)ns, -1, &chr); + if ( chr == '\0') cut_fail(); + if (Yap_unify(ARG3, MkIntegerTerm(chr))) cut_succeed(); cut_fail(); } } /* Error handling */ if (LOCAL_Error_TYPE) { - if (Yap_HandleError("string_code/3")) { + if (Yap_HandleError( "string_code/3" )) { goto restart_aux; } else { return FALSE; @@ -955,11 +1000,14 @@ restart_aux: cut_fail(); } -static Int get_string_code3(USES_REGS1) { + +static Int +get_string_code3( USES_REGS1 ) +{ Term t1; Term t2; const unsigned char *s; -restart_aux: + restart_aux: t1 = Deref(ARG1); t2 = Deref(ARG2); if (IsVarTerm(t2)) { @@ -969,42 +1017,41 @@ restart_aux: LOCAL_Error_TYPE = TYPE_ERROR_STRING; LOCAL_Error_Term = t2; } else { - s = UStringOfTerm(t2); + s = UStringOfTerm( t2 ); t1 = Deref(ARG1); if (IsVarTerm(t1)) { LOCAL_Error_TYPE = INSTANTIATION_ERROR; LOCAL_Error_Term = t1; - } else if (!IsIntegerTerm(t1)) { + } else if (!IsIntegerTerm( t1 )) { LOCAL_Error_TYPE = TYPE_ERROR_INTEGER; LOCAL_Error_Term = t1; } else { - unsigned char *ns = (unsigned char *)s; + unsigned char *ns = (unsigned char *)s; utf8proc_int32_t chr; - Int indx = IntegerOfTerm(t1); + Int indx = IntegerOfTerm( t1 ); if (indx <= 0) { - if (indx < 0) { - LOCAL_Error_TYPE = DOMAIN_ERROR_NOT_LESS_THAN_ZERO; - LOCAL_Error_Term = t1; - } else { - return FALSE; - } + if (indx < 0) { + LOCAL_Error_TYPE = DOMAIN_ERROR_NOT_LESS_THAN_ZERO; + LOCAL_Error_Term = t1; + } else { + return FALSE; + } } else { - indx -= 1; - ns = skip_utf8((unsigned char *)s, indx); - if (ns == NULL) { - return FALSE; - } else { - get_utf8(ns, -1, &chr); - if (chr != '\0') - return Yap_unify(ARG3, MkIntegerTerm(chr)); - } + indx -= 1; + ns = skip_utf8((unsigned char *)s,indx); + if (ns == NULL) { + return FALSE; + } else { + get_utf8( ns, -1, &chr); + if ( chr != '\0') return Yap_unify(ARG3, MkIntegerTerm(chr)); + } } return FALSE; // replace by error code } } /* Error handling */ if (LOCAL_Error_TYPE) { - if (Yap_HandleError("string_code/3")) { + if (Yap_HandleError( "string_code/3" )) { goto restart_aux; } else { return FALSE; @@ -1013,20 +1060,22 @@ restart_aux: cut_fail(); } -static Int atom_concat2(USES_REGS1) { +static Int +atom_concat2( USES_REGS1 ) +{ Term t1; Term *tailp; Int n; -restart_aux: + restart_aux: t1 = Deref(ARG1); n = Yap_SkipList(&t1, &tailp); 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); @@ -1045,14 +1094,13 @@ restart_aux: goto error; } free(inpv); - at = out.val.a; - if (at) - return Yap_unify(ARG2, MkAtomTerm(at)); + at = out.val.a; + if (at) return Yap_unify(ARG2, MkAtomTerm(at)); } -error: + error: /* Error handling */ if (LOCAL_Error_TYPE) { - if (Yap_HandleError("atom_concat/2")) { + if (Yap_HandleError( "atom_concat/2" )) { goto restart_aux; } else { return FALSE; @@ -1061,19 +1109,21 @@ error: cut_fail(); } -static Int string_concat2(USES_REGS1) { +static Int +string_concat2( USES_REGS1 ) +{ Term t1; Term *tailp; Int n; -restart_aux: + restart_aux: t1 = Deref(ARG1); n = Yap_SkipList(&t1, &tailp); 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; - + if (!inpv) { LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP; free(inpv); @@ -1092,13 +1142,12 @@ restart_aux: goto error; } free(inpv); - if (out.val.t) - return Yap_unify(ARG2, out.val.t); + if (out.val.t) return Yap_unify(ARG2, out.val.t); } -error: + error: /* Error handling */ if (LOCAL_Error_TYPE) { - if (Yap_HandleError("string_code/3")) { + if (Yap_HandleError( "string_code/3" )) { goto restart_aux; } else { return FALSE; @@ -1107,22 +1156,24 @@ error: cut_fail(); } -static Int atomic_concat2(USES_REGS1) { + +static Int +atomic_concat2( USES_REGS1 ) +{ Term t1; Term *tailp; Int n; -restart_aux: + restart_aux: t1 = Deref(ARG1); n = Yap_SkipList(&t1, &tailp); 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 (n == 1) - return Yap_unify(ARG2, HeadOfTerm(t1)); + if (n == 1) return Yap_unify(ARG2, HeadOfTerm(t1)); if (!inpv) { LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP; free(inpv); @@ -1130,9 +1181,7 @@ restart_aux: } while (t1 != TermNil) { - inpv[i].type = YAP_STRING_STRING | YAP_STRING_ATOM | YAP_STRING_INT | - YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_CHARS | - YAP_STRING_CODES; + inpv[i].type = YAP_STRING_STRING|YAP_STRING_ATOM|YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_BIG|YAP_STRING_CHARS|YAP_STRING_CODES; inpv[i].val.t = HeadOfTerm(t1); i++; t1 = TailOfTerm(t1); @@ -1143,32 +1192,33 @@ restart_aux: goto error; } free(inpv); - at = out.val.a; - if (at) - return Yap_unify(ARG2, MkAtomTerm(at)); + at = out.val.a; + if (at) return Yap_unify(ARG2, MkAtomTerm(at)); } -error: + error: /* Error handling */ - if (LOCAL_Error_TYPE && Yap_HandleError("atom_concat/3")) { + if (LOCAL_Error_TYPE && Yap_HandleError( "atom_concat/3" )) { goto restart_aux; } return FALSE; } -static Int atomics_to_string2(USES_REGS1) { +static Int +atomics_to_string2( USES_REGS1 ) +{ Term t1; Term *tailp; Int n; -restart_aux: + restart_aux: t1 = Deref(ARG1); n = Yap_SkipList(&t1, &tailp); 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); @@ -1176,8 +1226,7 @@ restart_aux: } while (t1 != TermNil) { - inpv[i].type = YAP_STRING_STRING | YAP_STRING_ATOM | YAP_STRING_INT | - YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM; + inpv[i].type = YAP_STRING_STRING|YAP_STRING_ATOM|YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_BIG|YAP_STRING_TERM; inpv[i].val.t = HeadOfTerm(t1); i++; t1 = TailOfTerm(t1); @@ -1188,33 +1237,34 @@ restart_aux: goto error; } free(inpv); - at = out.val.a; - if (at) - return Yap_unify(ARG2, MkAtomTerm(at)); + at = out.val.a; + if (at) return Yap_unify(ARG2, MkAtomTerm(at)); } -error: + error: /* Error handling */ - if (LOCAL_Error_TYPE && Yap_HandleError("atomics_to_string/2")) { + if (LOCAL_Error_TYPE && Yap_HandleError( "atomics_to_string/2" )) { goto restart_aux; } return FALSE; } -static Int atomics_to_string3(USES_REGS1) { +static Int +atomics_to_string3( USES_REGS1 ) +{ Term t1, t2; Term *tailp; Int n; -restart_aux: + restart_aux: t1 = Deref(ARG1); t2 = Deref(ARG2); n = Yap_SkipList(&t1, &tailp); if (*tailp != TermNil) { LOCAL_Error_TYPE = TYPE_ERROR_LIST; } else { - seq_tv_t *inpv = (seq_tv_t *)malloc((n * 2 - 1) * sizeof(seq_tv_t)), out; + seq_tv_t *inpv = (seq_tv_t *)malloc((n*2-1)*sizeof(seq_tv_t)), out; int i = 0; Atom at; - + if (!inpv) { LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP; free(inpv); @@ -1222,133 +1272,138 @@ restart_aux: } while (t1 != TermNil) { - inpv[i].type = YAP_STRING_STRING | YAP_STRING_ATOM | YAP_STRING_INT | - YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM; + inpv[i].type = YAP_STRING_STRING|YAP_STRING_ATOM|YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_BIG|YAP_STRING_TERM; inpv[i].val.t = HeadOfTerm(t1); i++; - inpv[i].type = YAP_STRING_STRING | YAP_STRING_ATOM | YAP_STRING_INT | - YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM; + inpv[i].type = YAP_STRING_STRING|YAP_STRING_ATOM|YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_BIG|YAP_STRING_TERM; inpv[i].val.t = t2; i++; t1 = TailOfTerm(t1); } out.type = YAP_STRING_STRING; - if (!Yap_Concat_Text(2 * n - 1, inpv, &out PASS_REGS)) { + if (!Yap_Concat_Text(2*n-1, inpv, &out PASS_REGS)) { free(inpv); goto error; } free(inpv); - at = out.val.a; - if (at) - return Yap_unify(ARG3, MkAtomTerm(at)); + at = out.val.a; + if (at) return Yap_unify(ARG3, MkAtomTerm(at)); } -error: + error: /* Error handling */ - if (LOCAL_Error_TYPE && Yap_HandleError("atomics_to_string/3")) { + if (LOCAL_Error_TYPE && Yap_HandleError( "atomics_to_string/3" )) { goto restart_aux; } return FALSE; } -static Int atom_length(USES_REGS1) { - Term t1 = Deref(ARG1); - ; +static Int +atom_length( USES_REGS1 ) +{ + Term t1 = Deref(ARG1);; Term t2 = Deref(ARG2); - ssize_t len; + size_t len; if (!Yap_IsGroundTerm(t1)) { - Yap_Error(INSTANTIATION_ERROR, t1, "atom_length/2"); - return (FALSE); + Yap_Error(INSTANTIATION_ERROR, t1, "atom_length/2"); + return(FALSE); } else if (!IsAtomTerm(t1)) { - Yap_Error(TYPE_ERROR_ATOM, t1, "atom_length/2"); - return (FALSE); + Yap_Error(TYPE_ERROR_ATOM, t1, "atom_length/2"); + return(FALSE); } if (Yap_IsGroundTerm(t2)) { if (!IsIntegerTerm(t2)) { Yap_Error(TYPE_ERROR_INTEGER, t2, "atom_length/2"); - return (FALSE); + return(FALSE); } else if ((len = IntegerOfTerm(t2)) < 0) { Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t2, "atom_length/2"); - return (FALSE); + return(FALSE); } } restart_aux: len = Yap_AtomicToLength(t1 PASS_REGS); if (len != (size_t)-1) - return Yap_unify(ARG2, MkIntegerTerm(len)); + return Yap_unify( ARG2, MkIntegerTerm(len) ); /* error handling */ - if (LOCAL_Error_TYPE && Yap_HandleError("atom_length/2")) { + if (LOCAL_Error_TYPE && Yap_HandleError( "atom_length/2" )) { goto restart_aux; } return FALSE; } -static Int atomic_length(USES_REGS1) { +static Int +atomic_length( USES_REGS1 ) +{ Term t1 = Deref(ARG1); Term t2 = Deref(ARG2); - ssize_t len; + size_t len; if (!Yap_IsGroundTerm(t1)) { - Yap_Error(INSTANTIATION_ERROR, t1, "atomic_length/2"); - return (FALSE); + Yap_Error(INSTANTIATION_ERROR, t1, "atomic_length/2"); + return(FALSE); } else if (!IsAtomicTerm(t1)) { - Yap_Error(TYPE_ERROR_ATOM, t1, "atomic_length/2"); - return (FALSE); + Yap_Error(TYPE_ERROR_ATOM, t1, "atomic_length/2"); + return(FALSE); } if (Yap_IsGroundTerm(t2)) { if (!IsIntegerTerm(t2)) { Yap_Error(TYPE_ERROR_INTEGER, t2, "atomic_length/2"); - return (FALSE); + return(FALSE); } if ((len = IntegerOfTerm(t2)) < 0) { Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t2, "atomic_length/2"); - return (FALSE); + return(FALSE); } } restart_aux: len = Yap_AtomicToLength(t1 PASS_REGS); if (len != (size_t)-1) - return Yap_unify(ARG2, MkIntegerTerm(len)); + return Yap_unify( ARG2, MkIntegerTerm(len) ); /* error handling */ - if (LOCAL_Error_TYPE && Yap_HandleError("atomic_length/2")) { + if (LOCAL_Error_TYPE && Yap_HandleError( "atomic_length/2" )) { goto restart_aux; } return FALSE; } -static Int string_length(USES_REGS1) { +static Int +string_length( USES_REGS1 ) +{ Term t1; Term t2 = Deref(ARG2); - ssize_t len; + size_t len; if (Yap_IsGroundTerm(t2)) { if (!IsIntegerTerm(t2)) { Yap_Error(TYPE_ERROR_INTEGER, t2, "string_length/2"); - return (FALSE); + return(FALSE); } if (FALSE && (len = IntegerOfTerm(t2)) < 0) { Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t2, "string_length/2"); - return (FALSE); + return(FALSE); } } restart_aux: - t1 = Deref(ARG1); + t1 = Deref(ARG1); len = Yap_AtomicToLength(t1 PASS_REGS); if (len != (size_t)-1) - return Yap_unify(ARG2, MkIntegerTerm(len)); + return Yap_unify( ARG2, MkIntegerTerm(len) ); /* error handling */ - if (LOCAL_Error_TYPE && Yap_HandleError("string_length/2")) { + if (LOCAL_Error_TYPE && Yap_HandleError( "string_length/2" )) { goto restart_aux; } return FALSE; } -static int is_wide(wchar_t *s) { + +static int +is_wide(wchar_t *s) +{ wchar_t ch; while ((ch = *s++)) { @@ -1359,7 +1414,9 @@ static int is_wide(wchar_t *s) { } /* split an atom into two sub-atoms */ -static Int atom_split(USES_REGS1) { +static Int +atom_split( USES_REGS1 ) +{ Term t1 = Deref(ARG1); Term t2 = Deref(ARG2); size_t len; @@ -1369,25 +1426,25 @@ static Int atom_split(USES_REGS1) { if (IsVarTerm(t1)) { Yap_Error(INSTANTIATION_ERROR, t1, "$atom_split/4"); - return (FALSE); + return(FALSE); } if (!IsAtomTerm(t1)) { Yap_Error(TYPE_ERROR_ATOM, t1, "$atom_split/4"); - return (FALSE); + return(FALSE); } if (IsVarTerm(t2)) { Yap_Error(INSTANTIATION_ERROR, t2, "$atom_split/4"); - return (FALSE); + return(FALSE); } if (!IsIntTerm(t2)) { Yap_Error(TYPE_ERROR_INTEGER, t2, "$atom_split/4"); - return (FALSE); + return(FALSE); } if ((Int)(len = IntOfTerm(t2)) < 0) { Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t2, "$atom_split/4"); - return (FALSE); + return(FALSE); } - at = AtomOfTerm(t1); + at = AtomOfTerm(t1); if (IsWideAtom(at)) { wchar_t *ws, *ws1 = (wchar_t *)HR; unsigned char *s1 = (unsigned char *)HR; @@ -1395,146 +1452,149 @@ static Int atom_split(USES_REGS1) { ws = (wchar_t *)RepAtom(at)->StrOfAE; wlen = wcslen(ws); - if (len > wlen) - return FALSE; - if (s1 + len > (unsigned char *)LCL0 - 1024) - Yap_Error(RESOURCE_ERROR_STACK, t1, "$atom_split/4"); - for (i = 0; i < len; i++) { + if (len > wlen) return FALSE; + if (s1+len > (unsigned char *)LCL0-1024) + Yap_Error(RESOURCE_ERROR_STACK,t1,"$atom_split/4"); + for (i = 0; i< len; i++) { if (ws[i] > MAX_ISO_LATIN1) { - break; + break; } s1[i] = ws[i]; } if (ws1[i] > MAX_ISO_LATIN1) { /* first sequence is wide */ - if (ws1 + len > (wchar_t *)ASP - 1024) - Yap_Error(RESOURCE_ERROR_STACK, t1, "$atom_split/4"); + if (ws1+len > (wchar_t *)ASP-1024) + Yap_Error(RESOURCE_ERROR_STACK,t1,"$atom_split/4"); ws = (wchar_t *)RepAtom(at)->StrOfAE; - for (i = 0; i < len; i++) { - ws1[i] = ws[i]; + for (i = 0; i< len; i++) { + ws1[i] = ws[i]; } ws1[len] = '\0'; to1 = MkAtomTerm(Yap_LookupWideAtom(ws1)); /* we don't know if the rest of the string is wide or not */ - if (is_wide(ws + len)) { - to2 = MkAtomTerm(Yap_LookupWideAtom(ws + len)); + if (is_wide(ws+len)) { + to2 = MkAtomTerm(Yap_LookupWideAtom(ws+len)); } else { - char *s2 = (char *)HR; - if (s2 + (wlen - len) > (char *)ASP - 1024) - Yap_Error(RESOURCE_ERROR_STACK, t1, "$atom_split/4"); - ws += len; - while ((*s2++ = *ws++)) - ; - to2 = MkAtomTerm(Yap_LookupAtom((char *)HR)); + char *s2 = (char *)HR; + if (s2+(wlen-len) > (char *)ASP-1024) + Yap_Error(RESOURCE_ERROR_STACK,t1,"$atom_split/4"); + ws += len; + while ((*s2++ = *ws++)); + to2 = MkAtomTerm(Yap_LookupAtom(( char *)HR)); } } else { s1[len] = '\0'; to1 = MkAtomTerm(Yap_ULookupAtom(s1)); /* second atom must be wide, if first wasn't */ - to2 = MkAtomTerm(Yap_LookupWideAtom(ws + len)); + to2 = MkAtomTerm(Yap_LookupWideAtom(ws+len)); } } else { unsigned char *s, *s1 = (unsigned char *)HR; s = RepAtom(at)->UStrOfAE; - if (len > (Int)strlen((char *)s)) - return (FALSE); - if (s1 + len > (unsigned char *)ASP - 1024) - Yap_Error(RESOURCE_ERROR_STACK, t1, "$atom_split/4"); - for (i = 0; i < len; i++) { + if (len > (Int)strlen((char *)s)) return(FALSE); + if (s1+len > (unsigned char *)ASP-1024) + Yap_Error(RESOURCE_ERROR_STACK,t1,"$atom_split/4"); + for (i = 0; i< len; i++) { s1[i] = s[i]; } s1[len] = '\0'; to1 = MkAtomTerm(Yap_ULookupAtom(s1)); - to2 = MkAtomTerm(Yap_ULookupAtom(s + len)); + to2 = MkAtomTerm(Yap_ULookupAtom(s+len)); } - return (Yap_unify_constant(ARG3, to1) && Yap_unify_constant(ARG4, to2)); + return(Yap_unify_constant(ARG3,to1) && Yap_unify_constant(ARG4,to2)); } -static Int atom_number(USES_REGS1) { +static Int +atom_number( USES_REGS1 ) +{ Term t1; -restart_aux: - t1 = Deref(ARG1); + restart_aux: + t1 = Deref(ARG1); if (Yap_IsGroundTerm(t1)) { Term tf = Yap_AtomToNumber(t1 PASS_REGS); if (tf) - return Yap_unify(ARG2, tf); + return Yap_unify( ARG2, tf ); } else { /* ARG1 unbound */ - Term t = Deref(ARG2); + Term t = Deref(ARG2); Atom af = Yap_NumberToAtom(t PASS_REGS); if (af) - return Yap_unify(ARG1, MkAtomTerm(af)); + return Yap_unify( ARG1, MkAtomTerm(af) ); } /* error handling */ - if (LOCAL_Error_TYPE && Yap_HandleError("atom_number/2")) { + if (LOCAL_Error_TYPE && Yap_HandleError( "atom_number/2" )) { t1 = Deref(ARG1); goto restart_aux; } return FALSE; } -static Int string_number(USES_REGS1) { + +static Int +string_number( USES_REGS1 ) +{ Term t1; -restart_aux: - t1 = Deref(ARG1); + restart_aux: + t1 = Deref(ARG1); if (Yap_IsGroundTerm(t1)) { Term tf = Yap_StringToNumber(t1 PASS_REGS); if (tf) - return Yap_unify(ARG2, tf); + return Yap_unify( ARG2, tf ); } else { /* ARG1 unbound */ - Term t = Deref(ARG2); + Term t = Deref(ARG2); Term tf = Yap_NumberToString(t PASS_REGS); if (tf) - return Yap_unify(ARG1, tf); + return Yap_unify( ARG1, tf ); } /* error handling */ - if (LOCAL_Error_TYPE && Yap_HandleError("string_number/2")) { + if (LOCAL_Error_TYPE && Yap_HandleError( "string_number/2" )) { t1 = Deref(ARG1); goto restart_aux; } return FALSE; } -#define SUB_ATOM_HAS_MIN 1 -#define SUB_ATOM_HAS_SIZE 2 -#define SUB_ATOM_HAS_AFTER 4 -#define SUB_ATOM_HAS_VAL 8 -#define SUB_ATOM_HAS_WIDE 16 -#define SUB_ATOM_HAS_UTF8 32 -static void *alloc_tmp_stack(size_t sz USES_REGS) { +#define SUB_ATOM_HAS_MIN 1 +#define SUB_ATOM_HAS_SIZE 2 +#define SUB_ATOM_HAS_AFTER 4 +#define SUB_ATOM_HAS_VAL 8 +#define SUB_ATOM_HAS_WIDE 16 +#define SUB_ATOM_HAS_UTF8 32 + +static void * +alloc_tmp_stack(size_t sz USES_REGS) { void *pt = (void *)HR; - while (HR > ASP - (1044 + sz / sizeof(CELL))) { - if (!Yap_gc(5, ENV, gc_P(P, CP))) { + while (HR > ASP-(1044+sz/sizeof(CELL))) { + if (!Yap_gc(5, ENV, gc_P(P,CP))) { Yap_Error(RESOURCE_ERROR_STACK, TermNil, "sub_atom/5"); - return (NULL); + return(NULL); } } return pt; } -static Term build_new_atomic(int mask, wchar_t *wp, const unsigned char *p, - size_t min, size_t len USES_REGS) { +static Term +build_new_atomic(int mask, wchar_t *wp, const unsigned char *p, size_t min, size_t len USES_REGS) +{ Atom nat; if (mask & SUB_ATOM_HAS_WIDE) { - wchar_t *src = wp + min; - wchar_t *d = alloc_tmp_stack((len + 1) * sizeof(wchar_t) PASS_REGS); - if (!d) - return NIL; - + wchar_t *src = wp+min; + wchar_t *d = alloc_tmp_stack((len+1)*sizeof(wchar_t) PASS_REGS); + if (!d) return NIL; + wcsncpy(d, src, len); d[len] = '\0'; nat = Yap_LookupMaybeWideAtom(d); if (nat) return MkAtomTerm(nat); } else if (!(mask & SUB_ATOM_HAS_UTF8)) { - const unsigned char *src = p + min; - unsigned char *d = alloc_tmp_stack((len + 1) * sizeof(char) PASS_REGS); - if (!d) - return NIL; - + const unsigned char *src = p+min; + unsigned char *d = alloc_tmp_stack((len+1)*sizeof(char) PASS_REGS); + if (!d) return NIL; + strncpy((char *)d, (char *)src, len); d[len] = '\0'; nat = Yap_ULookupAtom(d); @@ -1543,134 +1603,131 @@ static Term build_new_atomic(int mask, wchar_t *wp, const unsigned char *p, } else { const unsigned char *src = p; unsigned char *buf; - Term t = init_tstring(PASS_REGS1); + Term t = init_tstring( PASS_REGS1 ); src = skip_utf8((unsigned char *)src, min); const unsigned char *cp = src; - LOCAL_TERM_ERROR(t, 4 * (len + 1)); + LOCAL_TERM_ERROR( t, 4*(len+1) ); buf = buf_from_tstring(HR); while (len) { - utf8proc_int32_t chr; - cp += get_utf8((unsigned char *)cp, -1, &chr); + utf8proc_int32_t chr; + cp += get_utf8((unsigned char *)cp, -1, &chr); buf += put_utf8((unsigned char *)buf, chr); len--; } *buf++ = '\0'; - - close_tstring(buf PASS_REGS); + + close_tstring( buf PASS_REGS ); return t; } return 0L; } -static Int wcsstrcmp(wchar_t *p, char *p2, size_t len) { +static Int wcsstrcmp(wchar_t *p, char *p2, size_t len) +{ while (len--) { - Int d = *p++ - *p2++; - if (d) - return d; + Int d = *p++-*p2++; + if (d) return d; } return 0; } -static int check_sub_atom_at(int min, Atom at, Atom nat) { +static int +check_sub_atom_at(int min, Atom at, Atom nat) +{ if (IsWideAtom(nat)) { wchar_t *p1, *p2; wchar_t c1; - if (!IsWideAtom(at)) - return FALSE; - p1 = RepAtom(at)->WStrOfAE + min; + if (!IsWideAtom(at)) return FALSE; + p1 = RepAtom(at)->WStrOfAE+min; p2 = RepAtom(nat)->WStrOfAE; - while ((c1 = *p1++) == *p2++ && c1) - ; + while ( (c1 = *p1++) == *p2++ && c1); return c1 == 0; } else { if (IsWideAtom(at)) { wchar_t *p1; unsigned char *p2; wchar_t c1; - p1 = RepAtom(at)->WStrOfAE + min; + p1 = RepAtom(at)->WStrOfAE+min; p2 = RepAtom(nat)->UStrOfAE; - while ((c1 = *p1++) == *p2++ && c1) - ; + while ( (c1 = *p1++) == *p2++ && c1); return c1 == 0; } else { unsigned char *p1, *p2; char c1; - p1 = RepAtom(at)->UStrOfAE + min; + p1 = RepAtom(at)->UStrOfAE+min; p2 = RepAtom(nat)->UStrOfAE; - while ((c1 = *p1++) == *p2++ && c1) - ; + while ( (c1 = *p1++) == *p2++ && c1); return c1 == 0; } } } -static int check_sub_string_at(int min, const unsigned char *p1, - const unsigned char *p2, size_t len) { +static int +check_sub_string_at(int min, const unsigned char *p1, const unsigned char *p2, size_t len) +{ p1 = skip_utf8((unsigned char *)p1, min); - return cmpn_utf8(p1, p2, len) == 0; + return cmpn_utf8( p1, p2, len ) == 0; } -static int check_sub_atom_bef(int max, Atom at, Atom nat) { +static int +check_sub_atom_bef(int max, Atom at, Atom nat) +{ if (IsWideAtom(nat)) { wchar_t *p1, *p2; wchar_t c1; size_t len = wcslen(RepAtom(nat)->WStrOfAE); - int min = max - len; - if (min < 0) - return FALSE; - if (!IsWideAtom(at)) - return FALSE; - p1 = RepAtom(at)->WStrOfAE + min; + int min = max- len; + if (min < 0) return FALSE; + if (!IsWideAtom(at)) return FALSE; + p1 = RepAtom(at)->WStrOfAE+min; p2 = RepAtom(nat)->WStrOfAE; - while ((c1 = *p1++) == *p2++ && c1) - ; + while ( (c1 = *p1++) == *p2++ && c1); return c1 == 0; } else { size_t len = strlen((char *)RepAtom(nat)->StrOfAE); - int min = max - len; - if ((Int)(min - len) < 0) - return FALSE; + int min = max- len; + if ((Int)(min - len) < 0) return FALSE; if (IsWideAtom(at)) { wchar_t *p1; unsigned char *p2; wchar_t c1; - p1 = RepAtom(at)->WStrOfAE + min; + p1 = RepAtom(at)->WStrOfAE+min; p2 = RepAtom(nat)->UStrOfAE; - while ((c1 = *p1++) == *p2++ && c1) - ; + while ( (c1 = *p1++) == *p2++ && c1); return c1 == 0; } else { unsigned char *p1, *p2; char c1; - p1 = RepAtom(at)->UStrOfAE + min; + p1 = RepAtom(at)->UStrOfAE+min; p2 = RepAtom(nat)->UStrOfAE; - while ((c1 = *p1++) == *p2++ && c1) - ; + while ( (c1 = *p1++) == *p2++ && c1); return c1 == 0; } } } -static int check_sub_string_bef(int max, Term at, Term nat) { +static int +check_sub_string_bef(int max, Term at, Term nat) +{ size_t len = strlen_utf8(UStringOfTerm(nat)); - int min = max - len; + int min = max- len; const unsigned char *p1, *p2; int c1; - if ((Int)(min - len) < 0) - return FALSE; + if ((Int)(min - len) < 0) return FALSE; - p1 = skip_utf8((unsigned char *)UStringOfTerm(at), min); + p1 = skip_utf8((unsigned char *)UStringOfTerm(at),min); p2 = UStringOfTerm(nat); - while ((c1 = *p1++) == *p2++ && c1) - ; + while ( (c1 = *p1++) == *p2++ && c1); return c1 == 0; } -static Int cont_sub_atomic(USES_REGS1) { - Term tat1 = Deref(ARG1); +static Int +cont_sub_atomic( USES_REGS1 ) +{ + Term tat1= Deref(ARG1); Atom at = NULL; int mask; size_t min, len, after, sz; @@ -1679,11 +1736,11 @@ static Int cont_sub_atomic(USES_REGS1) { Term nat; int sub_atom = TRUE; - mask = IntegerOfTerm(EXTRA_CBACK_ARG(5, 1)); - min = IntegerOfTerm(EXTRA_CBACK_ARG(5, 2)); - len = IntegerOfTerm(EXTRA_CBACK_ARG(5, 3)); - after = IntegerOfTerm(EXTRA_CBACK_ARG(5, 4)); - sz = IntegerOfTerm(EXTRA_CBACK_ARG(5, 5)); + mask = IntegerOfTerm(EXTRA_CBACK_ARG(5,1)); + min = IntegerOfTerm(EXTRA_CBACK_ARG(5,2)); + len = IntegerOfTerm(EXTRA_CBACK_ARG(5,3)); + after = IntegerOfTerm(EXTRA_CBACK_ARG(5,4)); + sz = IntegerOfTerm(EXTRA_CBACK_ARG(5,5)); if (mask & SUB_ATOM_HAS_UTF8) { sub_atom = FALSE; @@ -1702,104 +1759,96 @@ static Int cont_sub_atomic(USES_REGS1) { if (mask & SUB_ATOM_HAS_WIDE) { wp = RepAtom(at)->WStrOfAE; if (IsWideAtom(AtomOfTerm(nat))) { - while (!found) { - if (wcsncmp(wp + min, AtomOfTerm(nat)->WStrOfAE, len) == 0) { - Yap_unify(ARG2, MkIntegerTerm(min)); - Yap_unify(ARG3, MkIntegerTerm(len)); - Yap_unify(ARG4, MkIntegerTerm(after)); - found = TRUE; - /* found one, check if there is any left */ - while (min <= sz - len) { - after--; - min++; - if (wcsncmp(wp + min, AtomOfTerm(nat)->WStrOfAE, len) == 0) - break; - } - } else { - if (min == sz - len) - break; - after--; - min++; - } - } + while (!found) { + if (wcsncmp(wp+min, AtomOfTerm(nat)->WStrOfAE, len) == 0) { + Yap_unify(ARG2, MkIntegerTerm(min)); + Yap_unify(ARG3, MkIntegerTerm(len)); + Yap_unify(ARG4, MkIntegerTerm(after)); + found = TRUE; + /* found one, check if there is any left */ + while (min <= sz-len) { + after--; + min++; + if (wcsncmp(wp+min, AtomOfTerm(nat)->WStrOfAE, len) == 0) + break; + } + } else { + if (min == sz-len) break; + after--; + min++; + } + } } else { - while (!found) { - if (wcsstrcmp(wp + min, (char *)AtomOfTerm(nat)->StrOfAE, len) == 0) { - Yap_unify(ARG2, MkIntegerTerm(min)); - Yap_unify(ARG3, MkIntegerTerm(len)); - Yap_unify(ARG4, MkIntegerTerm(after)); - found = TRUE; - /* found one, check if there is any left */ - while (min <= sz - len) { - after--; - min++; - if (wcsstrcmp(wp + min, (char *)AtomOfTerm(nat)->StrOfAE, len) == - 0) - break; - } - } else { - if (min == sz - len) - break; - after--; - min++; - } - } - } + while (!found) { + if (wcsstrcmp(wp+min, (char *)AtomOfTerm(nat)->StrOfAE, len) == 0) { + Yap_unify(ARG2, MkIntegerTerm(min)); + Yap_unify(ARG3, MkIntegerTerm(len)); + Yap_unify(ARG4, MkIntegerTerm(after)); + found = TRUE; + /* found one, check if there is any left */ + while (min <= sz-len) { + after--; + min++; + if (wcsstrcmp(wp+min, (char *)AtomOfTerm(nat)->StrOfAE, len) == 0) + break; + } + } else { + if (min == sz-len) break; + after--; + min++; + } + } + } } else if (sub_atom) { p = RepAtom(at)->UStrOfAE; while (!found) { - if (strncmp((char *)p + min, (char *)AtomOfTerm(nat)->StrOfAE, len) == - 0) { - Yap_unify(ARG2, MkIntegerTerm(min)); - Yap_unify(ARG3, MkIntegerTerm(len)); - Yap_unify(ARG4, MkIntegerTerm(after)); - found = TRUE; - /* found one, check if there is any left */ - while (min <= sz - len) { - after--; - min++; - if (strncmp((char *)p + min, (char *)AtomOfTerm(nat)->StrOfAE, - len) == 0) - break; - } - } else { - if (min == sz - len) - break; - after--; - min++; - } + if (strncmp((char *)p+min, (char *)AtomOfTerm(nat)->StrOfAE, len) == 0) { + Yap_unify(ARG2, MkIntegerTerm(min)); + Yap_unify(ARG3, MkIntegerTerm(len)); + Yap_unify(ARG4, MkIntegerTerm(after)); + found = TRUE; + /* found one, check if there is any left */ + while (min <= sz-len) { + after--; + min++; + if (strncmp((char *)p+min, (char *)AtomOfTerm(nat)->StrOfAE, len) == 0) + break; + } + } else { + if (min == sz-len) break; + after--; + min++; + } } } else { - const unsigned char *p = UStringOfTerm(Deref(ARG1)), *p1 = p; - const unsigned char *p5 = UStringOfTerm(Deref(ARG5)); + const unsigned char *p = UStringOfTerm( Deref(ARG1) ), *p1 = p; + const unsigned char *p5 = UStringOfTerm( Deref(ARG5) ); while (!found) { - p = skip_utf8((unsigned char *)p1, min); + p = skip_utf8((unsigned char *)p1, min); if (cmpn_utf8(p, p5, len) == 0) { Yap_unify(ARG2, MkIntegerTerm(min)); Yap_unify(ARG3, MkIntegerTerm(len)); Yap_unify(ARG4, MkIntegerTerm(after)); found = TRUE; /* found one, check if there is any left */ - while (min <= sz - len) { - int chr; - p += get_utf8((unsigned char *)p, -1, &chr); + while (min <= sz-len) { + int chr; + p += get_utf8((unsigned char *)p, -1, &chr); after--; min++; if (cmpn_utf8(p, UStringOfTerm(nat), len) == 0) break; } } else { - if (min == sz - len) - break; + if (min == sz-len) break; after--; min++; } } } if (found) { - if (min > sz - len) - cut_succeed(); + if (min > sz-len) cut_succeed(); } else { cut_fail(); } @@ -1809,26 +1858,23 @@ static Int cont_sub_atomic(USES_REGS1) { Yap_unify(ARG4, MkIntegerTerm(after)); Yap_unify(ARG5, nat); min++; - if (after-- == 0) - cut_succeed(); + if (after-- == 0) cut_succeed(); } else if (mask & SUB_ATOM_HAS_MIN) { - after = sz - (min + len); + after = sz-(min+len); nat = build_new_atomic(mask, wp, p, min, len PASS_REGS); Yap_unify(ARG3, MkIntegerTerm(len)); Yap_unify(ARG4, MkIntegerTerm(after)); Yap_unify(ARG5, nat); len++; - if (after-- == 0) - cut_succeed(); + if (after-- == 0) cut_succeed(); } else if (mask & SUB_ATOM_HAS_AFTER) { - len = sz - (min + after); + len = sz-(min+after); nat = build_new_atomic(mask, wp, p, min, len PASS_REGS); Yap_unify(ARG2, MkIntegerTerm(min)); Yap_unify(ARG3, MkIntegerTerm(len)); Yap_unify(ARG5, nat); min++; - if (len-- == 0) - cut_succeed(); + if (len-- == 0) cut_succeed(); } else { nat = build_new_atomic(mask, wp, p, min, len PASS_REGS); Yap_unify(ARG2, MkIntegerTerm(min)); @@ -1837,22 +1883,23 @@ static Int cont_sub_atomic(USES_REGS1) { Yap_unify(ARG5, nat); len++; if (after-- == 0) { - if (min == sz) - cut_succeed(); + if (min == sz) cut_succeed(); min++; len = 0; - after = sz - min; + after = sz-min; } } - EXTRA_CBACK_ARG(5, 1) = MkIntegerTerm(mask); - EXTRA_CBACK_ARG(5, 2) = MkIntegerTerm(min); - EXTRA_CBACK_ARG(5, 3) = MkIntegerTerm(len); - EXTRA_CBACK_ARG(5, 4) = MkIntegerTerm(after); - EXTRA_CBACK_ARG(5, 5) = MkIntegerTerm(sz); + EXTRA_CBACK_ARG(5,1) = MkIntegerTerm(mask); + EXTRA_CBACK_ARG(5,2) = MkIntegerTerm(min); + EXTRA_CBACK_ARG(5,3) = MkIntegerTerm(len); + EXTRA_CBACK_ARG(5,4) = MkIntegerTerm(after); + EXTRA_CBACK_ARG(5,5) = MkIntegerTerm(sz); return TRUE; } -static Int sub_atomic(int sub_atom USES_REGS) { +static Int +sub_atomic( int sub_atom USES_REGS ) +{ Term tat1, tbef, tsize, tafter, tout; int mask = 0; size_t min, len, after, sz; @@ -1862,8 +1909,8 @@ static Int sub_atomic(int sub_atom USES_REGS) { Term nat = 0L; Atom at = NULL; - tat1 = Deref(ARG1); - EXTRA_CBACK_ARG(5, 3) = MkIntegerTerm(0); + tat1 = Deref(ARG1); + EXTRA_CBACK_ARG(5,3) = MkIntegerTerm(0); if (IsVarTerm(tat1)) { Yap_Error(INSTANTIATION_ERROR, tat1, "sub_atom/5: first argument"); return FALSE; @@ -1874,7 +1921,7 @@ static Int sub_atomic(int sub_atom USES_REGS) { Yap_Error(TYPE_ERROR_STRING, tat1, "sub_string/5"); return FALSE; } - tbef = Deref(ARG2); + tbef = Deref(ARG2); if (IsVarTerm(tbef)) { min = 0; } else if (!IsIntegerTerm(tbef)) { @@ -1882,10 +1929,10 @@ static Int sub_atomic(int sub_atom USES_REGS) { return FALSE; } else { min = IntegerOfTerm(tbef); - if ((Int)min < 0) { - Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, tbef, "sub_string/5"); - return FALSE; - }; + if ((Int)min < 0) { + Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, tbef, "sub_string/5"); + return FALSE; + }; mask |= SUB_ATOM_HAS_MIN; bnds++; } @@ -1896,10 +1943,10 @@ static Int sub_atomic(int sub_atom USES_REGS) { return FALSE; } else { len = IntegerOfTerm(tsize); - if ((Int)len < 0) { - Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, tsize, "sub_string/5"); - return FALSE; - }; + if ((Int)len < 0) { + Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, tsize, "sub_string/5"); + return FALSE; + }; mask |= SUB_ATOM_HAS_SIZE; bnds++; } @@ -1910,39 +1957,39 @@ static Int sub_atomic(int sub_atom USES_REGS) { return FALSE; } else { after = IntegerOfTerm(tafter); - if ((Int)after < 0) { - Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, tafter, "sub_string/5"); - return FALSE; - }; + if ((Int)after < 0) { + Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, tafter, "sub_string/5"); + return FALSE; + }; mask |= SUB_ATOM_HAS_AFTER; bnds++; } if (!IsVarTerm(tout = Deref(ARG5))) { if (sub_atom) { if (!IsAtomTerm(tout)) { - Yap_Error(TYPE_ERROR_ATOM, tout, "sub_atom/5"); - return FALSE; + Yap_Error(TYPE_ERROR_ATOM, tout, "sub_atom/5"); + return FALSE; } else { - Atom oat; - mask |= SUB_ATOM_HAS_VAL | SUB_ATOM_HAS_SIZE; - oat = AtomOfTerm(tout); - if (IsWideAtom(oat)) - len = wcslen(RepAtom(oat)->WStrOfAE); - else - len = strlen((const char *)RepAtom(oat)->StrOfAE); + Atom oat; + mask |= SUB_ATOM_HAS_VAL|SUB_ATOM_HAS_SIZE; + oat = AtomOfTerm(tout); + if (IsWideAtom(oat)) + len = wcslen(RepAtom(oat)->WStrOfAE); + else + len = strlen((const char *)RepAtom(oat)->StrOfAE); } } else { if (!IsStringTerm(tout)) { - Yap_Error(TYPE_ERROR_STRING, tout, "sub_string/5"); - return FALSE; + Yap_Error(TYPE_ERROR_STRING, tout, "sub_string/5"); + return FALSE; } else { - mask |= SUB_ATOM_HAS_VAL | SUB_ATOM_HAS_SIZE; - len = strlen_utf8(UStringOfTerm(tout)); + mask |= SUB_ATOM_HAS_VAL|SUB_ATOM_HAS_SIZE; + len = strlen_utf8( UStringOfTerm(tout) ); } } if (!Yap_unify(ARG3, MkIntegerTerm(len))) cut_fail(); - bnds += 2; + bnds+=2; } if (sub_atom) { at = AtomOfTerm(tat1); @@ -1955,105 +2002,96 @@ static Int sub_atomic(int sub_atom USES_REGS) { sz = strlen((const char *)p); } } else { - mask |= SUB_ATOM_HAS_UTF8; - p = (unsigned char *)StringOfTerm(tat1); - sz = strlen_utf8(p); + mask |= SUB_ATOM_HAS_UTF8; + p = (unsigned char *)StringOfTerm(tat1); + sz = strlen_utf8(p); } /* 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 (min + len > sz) - cut_fail(); - if ((Int)(after = (sz - (min + len))) < 0) - cut_fail(); + if ((mask & (SUB_ATOM_HAS_MIN|SUB_ATOM_HAS_SIZE)) == + (SUB_ATOM_HAS_MIN|SUB_ATOM_HAS_SIZE)) { + if (min+len > sz) cut_fail(); + if ((Int)(after = (sz-(min+len))) < 0) cut_fail(); nat = build_new_atomic(mask, wp, p, min, len PASS_REGS); - if (!nat) - 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 < min + after) - cut_fail(); - len = sz - (min + after); + if (!nat) 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 < min+after) cut_fail(); + len = sz-(min+after); nat = build_new_atomic(mask, wp, p, min, len PASS_REGS); - if (!nat) - cut_fail(); - out = Yap_unify(ARG3, MkIntegerTerm(len)) && Yap_unify(ARG5, nat); - } else if ((mask & (SUB_ATOM_HAS_SIZE | SUB_ATOM_HAS_AFTER)) == - (SUB_ATOM_HAS_SIZE | SUB_ATOM_HAS_AFTER)) { - if (len + after > sz) - cut_fail(); - min = sz - (len + after); + if (!nat) cut_fail(); + out = Yap_unify(ARG3,MkIntegerTerm(len)) && + Yap_unify(ARG5, nat); + } else if ((mask & (SUB_ATOM_HAS_SIZE|SUB_ATOM_HAS_AFTER)) == + (SUB_ATOM_HAS_SIZE|SUB_ATOM_HAS_AFTER) ) { + if (len+after > sz) cut_fail(); + min = sz-(len+after); nat = build_new_atomic(mask, wp, p, min, len PASS_REGS); - if (!nat) - cut_fail(); - out = Yap_unify(ARG2, MkIntegerTerm(min)) && Yap_unify(ARG5, nat); - } else if ((mask & (SUB_ATOM_HAS_MIN | SUB_ATOM_HAS_VAL)) == - (SUB_ATOM_HAS_MIN | SUB_ATOM_HAS_VAL)) { + if (!nat) cut_fail(); + out = Yap_unify(ARG2,MkIntegerTerm(min)) && + Yap_unify(ARG5, nat); + } else 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(min, at, AtomOfTerm(nat)); + out = check_sub_atom_at(min, at, AtomOfTerm(nat)); else - out = check_sub_string_at(min, p, UStringOfTerm(nat), len); - } else if ((mask & (SUB_ATOM_HAS_AFTER | SUB_ATOM_HAS_VAL)) == - (SUB_ATOM_HAS_AFTER | SUB_ATOM_HAS_VAL)) { + out = check_sub_string_at(min, p, UStringOfTerm( nat ), 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)); + out = check_sub_atom_bef(sz - after, at, AtomOfTerm(nat)); else - out = check_sub_string_bef(sz - after, tat1, tout); - } else if ((mask & (SUB_ATOM_HAS_SIZE | SUB_ATOM_HAS_VAL)) == - (SUB_ATOM_HAS_SIZE | SUB_ATOM_HAS_VAL)) { + out = check_sub_string_bef(sz - after, tat1, tout); + } 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) - cut_fail(); + out = (strlen_utf8(UStringOfTerm(tout)) == len); + if (!out) cut_fail(); } else if (IsWideAtom(AtomOfTerm(tout))) { - if (!(mask & SUB_ATOM_HAS_VAL)) { - cut_fail(); - } - /* just check length, they may still be several occurrences :( */ - out = (wcslen(RepAtom(AtomOfTerm(tout))->WStrOfAE) == len); + if (!(mask & SUB_ATOM_HAS_VAL)) { + cut_fail(); + } + /* just check length, they may still be several occurrences :( */ + out = (wcslen(RepAtom(AtomOfTerm(tout))->WStrOfAE) == len); } else { - out = (strlen((const char *)RepAtom(AtomOfTerm(tout))->StrOfAE) == len); - if (!out) - cut_fail(); + out = (strlen((const char *)RepAtom(AtomOfTerm(tout))->StrOfAE) == len); + if (!out) cut_fail(); } if (len == sz) { - out = out && Yap_unify(ARG1, ARG5) && - Yap_unify(ARG2, MkIntegerTerm(0)) && - Yap_unify(ARG4, MkIntegerTerm(0)); + out = out && + Yap_unify(ARG1, ARG5) && + Yap_unify(ARG2, MkIntegerTerm(0)) && + Yap_unify(ARG4, MkIntegerTerm(0)); } else if (len > sz) { - cut_fail(); + cut_fail(); } else { - mask |= SUB_ATOM_HAS_SIZE; - min = 0; - after = sz - len; - goto backtrackable; + mask |= SUB_ATOM_HAS_SIZE; + min = 0; + after = sz-len; + goto backtrackable; } } - if (out) - cut_succeed(); + if (out) cut_succeed(); cut_fail(); } else { - if (!(mask & SUB_ATOM_HAS_MIN)) - min = 0; - if (!(mask & SUB_ATOM_HAS_SIZE)) - len = 0; - if (!(mask & SUB_ATOM_HAS_AFTER)) - after = sz - (len + min); + if (!(mask & SUB_ATOM_HAS_MIN)) min = 0; + if (!(mask & SUB_ATOM_HAS_SIZE)) len = 0; + if (!(mask & SUB_ATOM_HAS_AFTER)) after = sz-(len+min); } -backtrackable: - EXTRA_CBACK_ARG(5, 1) = MkIntegerTerm(mask); - EXTRA_CBACK_ARG(5, 2) = MkIntegerTerm(min); - EXTRA_CBACK_ARG(5, 3) = MkIntegerTerm(len); - EXTRA_CBACK_ARG(5, 4) = MkIntegerTerm(after); - EXTRA_CBACK_ARG(5, 5) = MkIntegerTerm(sz); - return cont_sub_atomic(PASS_REGS1); + backtrackable: + EXTRA_CBACK_ARG(5,1) = MkIntegerTerm(mask); + EXTRA_CBACK_ARG(5,2) = MkIntegerTerm(min); + EXTRA_CBACK_ARG(5,3) = MkIntegerTerm(len); + EXTRA_CBACK_ARG(5,4) = MkIntegerTerm(after); + EXTRA_CBACK_ARG(5,5) = MkIntegerTerm(sz); + return cont_sub_atomic( PASS_REGS1 ); } -/** @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 @@ -2065,14 +2103,18 @@ 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 PASS_REGS); } +static Int +sub_atom( USES_REGS1 ) +{ + return sub_atomic( TRUE 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 +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. @@ -2081,21 +2123,27 @@ 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 PASS_REGS); } +static Int +sub_string( USES_REGS1 ) +{ + return sub_atomic( FALSE PASS_REGS ); +} -static Int cont_current_atom(USES_REGS1) { - Atom catom; - Int i = IntOfTerm(EXTRA_CBACK_ARG(1, 2)); - AtomEntry *ap; /* nasty hack for gcc on hpux */ +static Int +cont_current_atom( USES_REGS1 ) +{ + Atom catom; + Int i = IntOfTerm(EXTRA_CBACK_ARG(1,2)); + AtomEntry *ap; /* nasty hack for gcc on hpux */ /* protect current hash table line */ - if (IsAtomTerm(EXTRA_CBACK_ARG(1, 1))) - catom = AtomOfTerm(EXTRA_CBACK_ARG(1, 1)); + if (IsAtomTerm(EXTRA_CBACK_ARG(1,1))) + catom = AtomOfTerm(EXTRA_CBACK_ARG(1,1)); else catom = NIL; - if (catom == NIL) { + if (catom == NIL){ i++; /* move away from current hash table line */ while (i < AtomHashTableSize) { @@ -2103,7 +2151,7 @@ static Int cont_current_atom(USES_REGS1) { catom = HashChain[i].Entry; READ_UNLOCK(HashChain[i].AERWLock); if (catom != NIL) { - break; + break; } i++; } @@ -2118,31 +2166,33 @@ static Int cont_current_atom(USES_REGS1) { READ_UNLOCK(ap->ARWLock); i++; while (i < AtomHashTableSize) { - READ_LOCK(HashChain[i].AERWLock); - catom = HashChain[i].Entry; - READ_UNLOCK(HashChain[i].AERWLock); - if (catom != NIL) { - break; - } - i++; + READ_LOCK(HashChain[i].AERWLock); + catom = HashChain[i].Entry; + READ_UNLOCK(HashChain[i].AERWLock); + if (catom != NIL) { + break; + } + i++; } if (i == AtomHashTableSize) { - cut_fail(); + cut_fail(); } else { - EXTRA_CBACK_ARG(1, 1) = MkAtomTerm(catom); + EXTRA_CBACK_ARG(1,1) = MkAtomTerm(catom); } } else { - EXTRA_CBACK_ARG(1, 1) = MkAtomTerm(ap->NextOfAE); + EXTRA_CBACK_ARG(1,1) = MkAtomTerm(ap->NextOfAE); READ_UNLOCK(ap->ARWLock); } - EXTRA_CBACK_ARG(1, 2) = MkIntTerm(i); + EXTRA_CBACK_ARG(1,2) = MkIntTerm(i); return TRUE; } else { return FALSE; } } -static Int current_atom(USES_REGS1) { /* current_atom(?Atom) */ +static Int +current_atom( USES_REGS1 ) +{ /* current_atom(?Atom) */ Term t1 = Deref(ARG1); if (!IsVarTerm(t1)) { if (IsAtomTerm(t1)) @@ -2152,26 +2202,29 @@ static Int current_atom(USES_REGS1) { /* current_atom(?Atom) */ } READ_LOCK(HashChain[0].AERWLock); if (HashChain[0].Entry != NIL) { - EXTRA_CBACK_ARG(1, 1) = MkAtomTerm(HashChain[0].Entry); + EXTRA_CBACK_ARG(1,1) = MkAtomTerm(HashChain[0].Entry); } else { - EXTRA_CBACK_ARG(1, 1) = MkIntTerm(0); + EXTRA_CBACK_ARG(1,1) = MkIntTerm(0); } READ_UNLOCK(HashChain[0].AERWLock); - EXTRA_CBACK_ARG(1, 2) = MkIntTerm(0); - return (cont_current_atom(PASS_REGS1)); + EXTRA_CBACK_ARG(1,2) = MkIntTerm(0); + return (cont_current_atom( PASS_REGS1 )); } -static Int cont_current_wide_atom(USES_REGS1) { - Atom catom; - Int i = IntOfTerm(EXTRA_CBACK_ARG(1, 2)); - AtomEntry *ap; /* nasty hack for gcc on hpux */ + +static Int +cont_current_wide_atom( USES_REGS1 ) +{ + Atom catom; + Int i = IntOfTerm(EXTRA_CBACK_ARG(1,2)); + AtomEntry *ap; /* nasty hack for gcc on hpux */ /* protect current hash table line */ - if (IsAtomTerm(EXTRA_CBACK_ARG(1, 1))) - catom = AtomOfTerm(EXTRA_CBACK_ARG(1, 1)); + if (IsAtomTerm(EXTRA_CBACK_ARG(1,1))) + catom = AtomOfTerm(EXTRA_CBACK_ARG(1,1)); else catom = NIL; - if (catom == NIL) { + if (catom == NIL){ i++; /* move away from current hash table line */ while (i < WideAtomHashTableSize) { @@ -2179,7 +2232,7 @@ static Int cont_current_wide_atom(USES_REGS1) { catom = WideHashChain[i].Entry; READ_UNLOCK(WideHashChain[i].AERWLock); if (catom != NIL) { - break; + break; } i++; } @@ -2194,32 +2247,33 @@ static Int cont_current_wide_atom(USES_REGS1) { READ_UNLOCK(ap->ARWLock); i++; while (i < WideAtomHashTableSize) { - READ_LOCK(WideHashChain[i].AERWLock); - catom = WideHashChain[i].Entry; - READ_UNLOCK(WideHashChain[i].AERWLock); - if (catom != NIL) { - break; - } - i++; + READ_LOCK(WideHashChain[i].AERWLock); + catom = WideHashChain[i].Entry; + READ_UNLOCK(WideHashChain[i].AERWLock); + if (catom != NIL) { + break; + } + i++; } if (i == WideAtomHashTableSize) { - cut_fail(); + cut_fail(); } else { - EXTRA_CBACK_ARG(1, 1) = MkAtomTerm(catom); + EXTRA_CBACK_ARG(1,1) = MkAtomTerm(catom); } } else { - EXTRA_CBACK_ARG(1, 1) = MkAtomTerm(ap->NextOfAE); + EXTRA_CBACK_ARG(1,1) = MkAtomTerm(ap->NextOfAE); READ_UNLOCK(ap->ARWLock); } - EXTRA_CBACK_ARG(1, 2) = MkIntTerm(i); + EXTRA_CBACK_ARG(1,2) = MkIntTerm(i); return TRUE; } else { return FALSE; } } -static Int current_wide_atom(USES_REGS1) { /* current_atom(?Atom) - */ +static Int +current_wide_atom( USES_REGS1 ) +{ /* current_atom(?Atom) */ Term t1 = Deref(ARG1); if (!IsVarTerm(t1)) { if (IsAtomTerm(t1)) @@ -2229,151 +2283,151 @@ static Int current_wide_atom(USES_REGS1) { /* current_atom(?Atom) } READ_LOCK(WideHashChain[0].AERWLock); if (WideHashChain[0].Entry != NIL) { - EXTRA_CBACK_ARG(1, 1) = MkAtomTerm(WideHashChain[0].Entry); + EXTRA_CBACK_ARG(1,1) = MkAtomTerm(WideHashChain[0].Entry); } else { - EXTRA_CBACK_ARG(1, 1) = MkIntTerm(0); + EXTRA_CBACK_ARG(1,1) = MkIntTerm(0); } READ_UNLOCK(WideHashChain[0].AERWLock); - EXTRA_CBACK_ARG(1, 2) = MkIntTerm(0); - return (cont_current_wide_atom(PASS_REGS1)); + EXTRA_CBACK_ARG(1,2) = MkIntTerm(0); + return (cont_current_wide_atom( PASS_REGS1 )); } -void Yap_InitBackAtoms(void) { - Yap_InitCPredBack("$current_atom", 1, 2, current_atom, cont_current_atom, - SafePredFlag | SyncPredFlag); - Yap_InitCPredBack("$current_wide_atom", 1, 2, current_wide_atom, - cont_current_wide_atom, SafePredFlag | SyncPredFlag); +void +Yap_InitBackAtoms(void) +{ + Yap_InitCPredBack("$current_atom", 1, 2, current_atom, cont_current_atom,SafePredFlag|SyncPredFlag); + Yap_InitCPredBack("$current_wide_atom", 1, 2, current_wide_atom,cont_current_wide_atom,SafePredFlag|SyncPredFlag); Yap_InitCPredBack("atom_concat", 3, 2, atom_concat3, cont_atom_concat3, 0); - Yap_InitCPredBack("atomic_concat", 3, 2, atomic_concat3, cont_atomic_concat3, - 0); - Yap_InitCPredBack("string_concat", 3, 2, string_concat3, cont_string_concat3, - 0); + Yap_InitCPredBack("atomic_concat", 3, 2, atomic_concat3, cont_atomic_concat3, 0); + Yap_InitCPredBack("string_concat", 3, 2, string_concat3, cont_string_concat3, 0); Yap_InitCPredBack("sub_atom", 5, 5, sub_atom, cont_sub_atomic, 0); Yap_InitCPredBack("sub_string", 5, 5, sub_string, cont_sub_atomic, 0); Yap_InitCPredBack("string_code", 3, 1, string_code3, cont_string_code3, 0); + } -void Yap_InitAtomPreds(void) { +void +Yap_InitAtomPreds(void) +{ Yap_InitCPred("name", 2, name, 0); - /** @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]. +~~~~~ - - */ + +*/ Yap_InitCPred("string_to_atom", 2, string_to_atom, 0); Yap_InitCPred("atom_string", 2, atom_string, 0); Yap_InitCPred("string_to_atomic", 2, string_to_atomic, 0); Yap_InitCPred("string_to_list", 2, string_to_list, 0); Yap_InitCPred("char_code", 2, char_code, SafePredFlag); - /** @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. - - */ + +*/ Yap_InitCPred("atom_chars", 2, atom_chars, 0); - /** @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_. - - */ + +*/ Yap_InitCPred("atom_codes", 2, atom_codes, 0); Yap_InitCPred("string_codes", 2, string_codes, 0); Yap_InitCPred("string_chars", 2, string_chars, 0); Yap_InitCPred("atom_length", 2, atom_length, SafePredFlag); - /** @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. +The predicate holds when the first argument is an atom, and the second +unifies with the number of characters forming that atom. - - */ + +*/ Yap_InitCPred("atomic_length", 2, atomic_length, SafePredFlag); Yap_InitCPred("string_length", 2, string_length, SafePredFlag); Yap_InitCPred("$atom_split", 4, atom_split, SafePredFlag); Yap_InitCPred("number_chars", 2, number_chars, 0); Yap_InitCPred("number_atom", 2, number_atom, 0); - /** @pred number_atom(? _I_,? _L_) +/** @pred number_atom(? _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 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 _L_ must be unifiable +with an atom representing the number. - - */ + +*/ Yap_InitCPred("number_string", 2, number_string, 0); Yap_InitCPred("number_codes", 2, number_codes, 0); Yap_InitCPred("atom_number", 2, atom_number, 0); - /** @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_. - - */ + +*/ Yap_InitCPred("string_number", 2, string_number, 0); Yap_InitCPred("$atom_concat", 2, atom_concat2, 0); Yap_InitCPred("$string_concat", 2, string_concat2, 0); Yap_InitCPred("atomic_concat", 2, atomic_concat2, 0); - /** @pred atomic_concat(+ _As_,? _A_) +/** @pred atomic_concat(+ _As_,? _A_) - The predicate holds when the first argument is a list of atomic terms, and - the second unifies with the atom obtained by concatenating all the - atomic terms in the first list. The first argument thus may contain - atoms or numbers. +The predicate holds when the first argument is a list of atomic terms, and +the second unifies with the atom obtained by concatenating all the +atomic terms in the first list. The first argument thus may contain +atoms or numbers. - - */ + +*/ Yap_InitCPred("atomics_to_string", 2, atomics_to_string2, 0); Yap_InitCPred("atomics_to_string", 3, atomics_to_string3, 0); Yap_InitCPred("get_string_code", 3, get_string_code3, 0); /* hiding and unhiding some predicates */ - Yap_InitCPred("hide_atom", 1, hide_atom, SafePredFlag | SyncPredFlag); - Yap_InitCPred("unhide_atom", 1, unhide_atom, SafePredFlag | SyncPredFlag); - Yap_InitCPred("$hidden_atom", 1, hidden_atom, - HiddenPredFlag | SafePredFlag | SyncPredFlag); + Yap_InitCPred("hide_atom", 1, hide_atom, SafePredFlag|SyncPredFlag); + Yap_InitCPred("unhide_atom", 1, unhide_atom, SafePredFlag|SyncPredFlag); + Yap_InitCPred("$hidden_atom", 1, hidden_atom, HiddenPredFlag|SafePredFlag|SyncPredFlag); } /** diff --git a/C/c_interface.c b/C/c_interface.c index ab03a88d2..0fa349b93 100755 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -83,7 +83,7 @@ X_API int YAP_Reset(yap_reset_t mode); #define strncat(X, Y, Z) strcat(X, Y) #endif -#if defined(_WIN32) +#if defined(_WIN32) && !defined(X_API) #define X_API __declspec(dllexport) #endif @@ -2345,7 +2345,7 @@ static void construct_init_file(char *boot_file, char *BootFile) { #define BOOT_FROM_SAVED_STATE TRUE -X_API Int YAP_Init(YAP_init_args *yap_init) { +Int YAP_Init(YAP_init_args *yap_init) { int restore_result; int do_bootstrap = (yap_init->YapPrologBootFile != NULL); CELL Trail = 0, Stack = 0, Heap = 0, Atts = 0; diff --git a/C/flags.c b/C/flags.c index f44dc2541..4c32ea845 100644 --- a/C/flags.c +++ b/C/flags.c @@ -1018,13 +1018,13 @@ Term Yap_UnknownFlag(Term mod) { mod = TermProlog; ModEntry *fv = Yap_GetModuleEntry(mod); - if (fv == NULL) - fv = Yap_GetModuleEntry(TermUser); - if (fv->flags & UNKNOWN_ERROR) - return TermError; - if (fv->flags & UNKNOWN_WARNING) - return TermWarning; - return TermFail; + if (fv == NULL) + fv = Yap_GetModuleEntry(AtomUser); + if (fv->flags & UNKNOWN_ERROR) + return TermError; + if (fv->flags & UNKNOWN_WARNING) + return TermWarning; + return TermFail; } Term getYapFlag(Term tflag) { diff --git a/C/heapgc.c b/C/heapgc.c index 622a6e0d1..b628c828c 100644 --- a/C/heapgc.c +++ b/C/heapgc.c @@ -2035,7 +2035,7 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, bool very_verbose #endif /* TABLING */ if (very_verbose) { PredEntry *pe = Yap_PredForChoicePt(gc_B, NULL); -#if defined(ANALYST) || DEBUG +#if defined(ANALYST) || 0 if (pe == NULL) { fprintf(stderr,"%% marked " UInt_FORMAT " (%s)\n", LOCAL_total_marked, Yap_op_names[opnum]); } else if (pe->ArityOfPE) { diff --git a/C/init.c b/C/init.c index 2b7fb45b2..c83dd84ca 100755 --- a/C/init.c +++ b/C/init.c @@ -196,52 +196,6 @@ int Yap_IsOpType(char *type) { return (i <= 7); } -static OpEntry * -fetchOpForModule(AtomEntry *ae, Term tmod ) -{ - OpEntry *oinfo = NULL; - PropEntry **prev = &ae->PropsOfAE; - PropEntry *pp = ae->PropsOfAE; - - while (!EndOfPAEntr(pp)) { - OpEntry *info = RepOpProp(pp); - if (!info) - return NULL; - if (pp->KindOfPE == OpProperty) { - if (tmod == PROLOG_MODULE) { - if (info->OpModule != PROLOG_MODULE) { - info->Infix = info->Prefix = info->Posfix = 0; - info->OpModule = tmod; - if (oinfo == NULL) - oinfo = info; - else { - pp = RepProp(pp->NextOfPE); - *prev = pp; - //Yap_FreeCodeSpace( oinfo ); - continue; - } - } else{ - if (oinfo) { - // should never happen? - oinfo->Infix = info->Infix; - oinfo->Prefix = info->Prefix; - oinfo->Posfix = info->Posfix; - pp = RepProp(pp->NextOfPE); - *prev = pp; - // Yap_FreeCodeSpace( oinfo ); - continue; - } - return info; - } - } else if (info->OpModule == tmod) - return info; - } - prev = & pp->NextOfPE; - pp = RepProp(pp->NextOfPE); - } - return oinfo; -} - static int OpDec(int p, const char *type, Atom a, Term m) { int i; AtomEntry *ae = RepAtom(a); @@ -249,6 +203,8 @@ static int OpDec(int p, const char *type, Atom a, Term m) { if (m == TermProlog) m = PROLOG_MODULE; + else if (m == USER_MODULE) + m = PROLOG_MODULE; for (i = 1; i <= 7; ++i) if (strcmp(type, optypes[i]) == 0) break; @@ -264,7 +220,7 @@ static int OpDec(int p, const char *type, Atom a, Term m) { p |= DcrrpFlag; } WRITE_LOCK(ae->ARWLock); - info = fetchOpForModule(ae, m); + info = Yap_GetOpPropForAModuleHavingALock(ae, m); if (EndOfPAEntr(info)) { info = (OpEntry *)Yap_AllocAtomSpace(sizeof(OpEntry)); info->KindOfPE = Ord(OpProperty); @@ -283,7 +239,6 @@ static int OpDec(int p, const char *type, Atom a, Term m) { WRITE_LOCK(info->OpRWLock); WRITE_UNLOCK(ae->ARWLock); } - if (i <= 3) { if (trueGlobalPrologFlag(ISO_FLAG) && info->Posfix != 0) /* there is a posfix operator */ { @@ -294,6 +249,7 @@ static int OpDec(int p, const char *type, Atom a, Term m) { } info->Infix = p; } else if (i <= 5) { + if (trueGlobalPrologFlag(ISO_FLAG) && info->Infix != 0) /* there is an infix operator */ { /* ISO dictates */ @@ -441,7 +397,7 @@ static void InitOps(void) { /// @} #if DEBUG -#ifdef HAVE_ISATTY +#ifdef HAVE_UNISTD_H #include #endif #endif diff --git a/C/modules.c b/C/modules.c index ad3b26808..e3575fe25 100644 --- a/C/modules.c +++ b/C/modules.c @@ -52,7 +52,6 @@ initMod( AtomEntry *toname, AtomEntry *ae) { n->KindOfPE = ModProperty; n->PredForME = NULL; n->NextME = CurrentModules; - n->ParentForME = CurrentModule; CurrentModules = n; n->AtomOfME = ae; n->OwnerFile = Yap_ConsultingFile( PASS_REGS1); @@ -260,6 +259,7 @@ static Int change_module(USES_REGS1) { /* $change_module(N) */ Term mod = Deref(ARG1); LookupModule(mod); CurrentModule = mod; + LOCAL_SourceModule = mod; return TRUE; } diff --git a/C/parser.c b/C/parser.c index 77c0e20a1..b4f76eaef 100755 --- a/C/parser.c +++ b/C/parser.c @@ -164,9 +164,9 @@ typedef struct jmp_buff_struct { sigjmp_buf JmpBuff; } JMPBUFF; static void GNextToken(CACHE_TYPE1); static void checkfor(wchar_t, JMPBUFF *CACHE_TYPE); -static Term ParseArgs(Atom, wchar_t, JMPBUFF *, Term, Term CACHE_TYPE); -static Term ParseList(JMPBUFF *, Term CACHE_TYPE); -static Term ParseTerm(int, JMPBUFF *, Term CACHE_TYPE); +static Term ParseArgs(Atom, wchar_t, JMPBUFF *, Term CACHE_TYPE); +static Term ParseList(JMPBUFF *CACHE_TYPE); +static Term ParseTerm(int, JMPBUFF *CACHE_TYPE); const char *Yap_tokRep(TokEntry *tokptr); @@ -367,12 +367,16 @@ Term Yap_Variables(VarEntry *p, Term l) { return Variables(p, l PASS_REGS); } -static int IsPrefixOp(Atom op, int *pptr, int *rpptr, Term tmod USES_REGS) { +static int IsPrefixOp(Atom op, int *pptr, int *rpptr USES_REGS) { int p; - OpEntry *opp = Yap_GetOpProp(op, PREFIX_OP, tmod PASS_REGS); + OpEntry *opp = Yap_GetOpProp(op, PREFIX_OP PASS_REGS); if (!opp) return FALSE; + if (opp->OpModule && opp->OpModule != CurrentModule) { + READ_UNLOCK(opp->OpRWLock); + return FALSE; + } if ((p = opp->Prefix) != 0) { READ_UNLOCK(opp->OpRWLock); *pptr = *rpptr = p &MaskPrio; @@ -385,17 +389,21 @@ static int IsPrefixOp(Atom op, int *pptr, int *rpptr, Term tmod USES_REGS) { } } -int Yap_IsPrefixOp(Atom op, int *pptr, int *rpptr, Term tmod) { +int Yap_IsPrefixOp(Atom op, int *pptr, int *rpptr) { CACHE_REGS - return IsPrefixOp(op, pptr, rpptr, tmod PASS_REGS); + return IsPrefixOp(op, pptr, rpptr PASS_REGS); } -static int IsInfixOp(Atom op, int *pptr, int *lpptr, int *rpptr, Term tmod USES_REGS) { +static int IsInfixOp(Atom op, int *pptr, int *lpptr, int *rpptr USES_REGS) { int p; - OpEntry *opp = Yap_GetOpProp(op, INFIX_OP, tmod PASS_REGS); + OpEntry *opp = Yap_GetOpProp(op, INFIX_OP PASS_REGS); if (!opp) return FALSE; + if (opp->OpModule && opp->OpModule != CurrentModule) { + READ_UNLOCK(opp->OpRWLock); + return FALSE; + } if ((p = opp->Infix) != 0) { READ_UNLOCK(opp->OpRWLock); *pptr = *rpptr = *lpptr = p &MaskPrio; @@ -410,17 +418,21 @@ static int IsInfixOp(Atom op, int *pptr, int *lpptr, int *rpptr, Term tmod USES_ } } -int Yap_IsInfixOp(Atom op, int *pptr, int *lpptr, int *rpptr, Term tmod) { +int Yap_IsInfixOp(Atom op, int *pptr, int *lpptr, int *rpptr) { CACHE_REGS - return IsInfixOp(op, pptr, lpptr, rpptr, tmod PASS_REGS); + return IsInfixOp(op, pptr, lpptr, rpptr PASS_REGS); } -static int IsPosfixOp(Atom op, int *pptr, int *lpptr, Term tmod USES_REGS) { +static int IsPosfixOp(Atom op, int *pptr, int *lpptr USES_REGS) { int p; - OpEntry *opp = Yap_GetOpProp(op, POSFIX_OP, tmod PASS_REGS); + OpEntry *opp = Yap_GetOpProp(op, POSFIX_OP PASS_REGS); if (!opp) return FALSE; + if (opp->OpModule && opp->OpModule != CurrentModule) { + READ_UNLOCK(opp->OpRWLock); + return FALSE; + } if ((p = opp->Posfix) != 0) { READ_UNLOCK(opp->OpRWLock); *pptr = *lpptr = p &MaskPrio; @@ -433,9 +445,9 @@ static int IsPosfixOp(Atom op, int *pptr, int *lpptr, Term tmod USES_REGS) { } } -int Yap_IsPosfixOp(Atom op, int *pptr, int *lpptr, Term tmod) { +int Yap_IsPosfixOp(Atom op, int *pptr, int *lpptr) { CACHE_REGS - return IsPosfixOp(op, pptr, lpptr, tmod PASS_REGS); + return IsPosfixOp(op, pptr, lpptr PASS_REGS); } inline static void GNextToken(USES_REGS1) { @@ -460,9 +472,9 @@ inline static void checkfor(wchar_t c, JMPBUFF *FailBuff USES_REGS) { #ifdef O_QUASIQUOTATIONS -static int is_quasi_quotation_syntax(Term goal, Term m, Atom *pat) { +static int is_quasi_quotation_syntax(Term goal, Atom *pat) { CACHE_REGS - Term t; + Term m = CurrentModule, t; Atom at; UInt arity; Functor f; @@ -512,8 +524,8 @@ static int get_quasi_quotation(term_t t, unsigned char **here, } #endif /*O_QUASIQUOTATIONS*/ -static Term ParseArgs(Atom a, wchar_t close, JMPBUFF *FailBuff, - Term arg1, Term tmod USES_REGS) { +static Term ParseArgs(Atom a, wchar_t close, JMPBUFF *FailBuff, + Term arg1 USES_REGS) { int nargs = 0; Term *p, t; Functor func; @@ -550,7 +562,7 @@ static Term ParseArgs(Atom a, wchar_t close, JMPBUFF *FailBuff, syntax_msg("line %d: Trail Overflow",LOCAL_tokptr->TokPos); FAIL; } - *tp++ = Unsigned(ParseTerm(999, FailBuff, tmod PASS_REGS)); + *tp++ = Unsigned(ParseTerm(999, FailBuff PASS_REGS)); ParserAuxSp = (char *)tp; ++nargs; if (LOCAL_tokptr->Tok != Ord(Ponctuation_tok)) @@ -605,14 +617,14 @@ static Term MakeAccessor(Term t, Functor f USES_REGS) { return Yap_MkApplTerm(f, 2, tf); } -static Term ParseList(JMPBUFF *FailBuff, Term tmod USES_REGS) { +static Term ParseList(JMPBUFF *FailBuff USES_REGS) { Term o; CELL *to_store; o = AbsPair(HR); loop: to_store = HR; HR += 2; - to_store[0] = ParseTerm(999, FailBuff, tmod PASS_REGS); + to_store[0] = ParseTerm(999, FailBuff PASS_REGS); if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok)) { if (((int)LOCAL_tokptr->TokInfo) == ',') { NextToken; @@ -629,7 +641,7 @@ loop: } } else if (((int)LOCAL_tokptr->TokInfo) == '|') { NextToken; - to_store[1] = ParseTerm(999, FailBuff, tmod PASS_REGS); + to_store[1] = ParseTerm(999, FailBuff PASS_REGS); } else { to_store[1] = MkAtomTerm(AtomNil); } @@ -641,7 +653,7 @@ loop: return (o); } -static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) { +static Term ParseTerm(int prio, JMPBUFF *FailBuff USES_REGS) { /* parse term with priority prio */ Volatile Term t; Volatile Functor func; @@ -674,7 +686,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) { } if ((LOCAL_tokptr->Tok != Ord(Ponctuation_tok) || Unsigned(LOCAL_tokptr->TokInfo) != 'l') && - IsPrefixOp((Atom)t, &opprio, &oprprio, tmod PASS_REGS)) { + IsPrefixOp((Atom)t, &opprio, &oprprio PASS_REGS)) { if (LOCAL_tokptr->Tok == Name_tok) { Atom at = (Atom)LOCAL_tokptr->TokInfo; #ifndef _MSC_VER @@ -709,7 +721,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) { syntax_msg("line %d: Heap Overflow",LOCAL_tokptr->TokPos); FAIL; } - t = ParseTerm(oprprio, FailBuff, tmod PASS_REGS); + t = ParseTerm(oprprio, FailBuff PASS_REGS); t = Yap_MkApplTerm(func, 1, &t); /* check for possible overflow against local stack */ if (HR > ASP - 4096) { @@ -721,7 +733,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) { } if (LOCAL_tokptr->Tok == Ord(Ponctuation_tok) && Unsigned(LOCAL_tokptr->TokInfo) == 'l') - t = ParseArgs((Atom)t, ')', FailBuff, 0L, tmod PASS_REGS); + t = ParseArgs((Atom)t, ')', FailBuff, 0L PASS_REGS); else t = MkAtomTerm((Atom)t); break; @@ -737,7 +749,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) { // we may be operating under a syntax error yap_error_number oerr = LOCAL_Error_TYPE; LOCAL_Error_TYPE = YAP_NO_ERROR; - t = Yap_CharsToTDQ(p, tmod, LOCAL_encoding PASS_REGS); + t = Yap_CharsToTDQ(p, CurrentModule, LOCAL_encoding PASS_REGS); if (!t) { syntax_msg("line %d: could not convert \"%s\"",LOCAL_tokptr->TokPos, (char *)LOCAL_tokptr->TokInfo); FAIL; @@ -752,7 +764,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) { // we may be operating under a syntax error yap_error_number oerr = LOCAL_Error_TYPE; LOCAL_Error_TYPE = YAP_NO_ERROR; - t = Yap_WCharsToTDQ(p, tmod PASS_REGS); + t = Yap_WCharsToTDQ(p, CurrentModule PASS_REGS); if (!t) { syntax_msg("line %d: could not convert \'%S\'",LOCAL_tokptr->TokPos, (wchar_t *)LOCAL_tokptr->TokInfo); FAIL; @@ -768,7 +780,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) { yap_error_number oerr = LOCAL_Error_TYPE; LOCAL_Error_TYPE = YAP_NO_ERROR; - t = Yap_CharsToTBQ(p, tmod, LOCAL_encoding PASS_REGS); + t = Yap_CharsToTBQ(p, CurrentModule, LOCAL_encoding PASS_REGS); if (!t) { syntax_msg("line %d: could not convert \'%s\"",LOCAL_tokptr->TokPos, (char *)LOCAL_tokptr->TokInfo); FAIL; @@ -780,7 +792,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) { case WBQString_tok: /* build list on the heap */ { Volatile wchar_t *p = (wchar_t *)LOCAL_tokptr->TokInfo; - t = Yap_WCharsToTBQ(p, tmod PASS_REGS); + t = Yap_WCharsToTBQ(p, CurrentModule PASS_REGS); // we may be operating under a syntax error yap_error_number oerr = LOCAL_Error_TYPE; LOCAL_Error_TYPE = YAP_NO_ERROR; @@ -810,7 +822,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) { case '(': case 'l': /* non solo ( */ NextToken; - t = ParseTerm(GLOBAL_MaxPriority, FailBuff, tmod PASS_REGS); + t = ParseTerm(GLOBAL_MaxPriority, FailBuff PASS_REGS); checkfor(')', FailBuff PASS_REGS); break; case '[': @@ -821,7 +833,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) { NextToken; break; } - t = ParseList(FailBuff, tmod PASS_REGS); + t = ParseList(FailBuff PASS_REGS); checkfor(']', FailBuff PASS_REGS); break; case '{': @@ -832,7 +844,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) { NextToken; break; } - t = ParseTerm(GLOBAL_MaxPriority, FailBuff, tmod PASS_REGS); + t = ParseTerm(GLOBAL_MaxPriority, FailBuff PASS_REGS); t = Yap_MkApplTerm(FunctorBraces, 1, &t); /* check for possible overflow against local stack */ if (HR > ASP - 4096) { @@ -884,7 +896,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) { } NextToken; - t = ParseTerm(GLOBAL_MaxPriority, FailBuff, tmod PASS_REGS); + t = ParseTerm(GLOBAL_MaxPriority, FailBuff PASS_REGS); if (LOCAL_tokptr->Tok != QuasiQuotes_tok) { syntax_msg("expected to find quasi quotes, got \"%s\"", , Yap_tokRep(LOCAL_tokptr)); @@ -942,7 +954,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) { if (LOCAL_tokptr->Tok == Ord(Name_tok) && Yap_HasOp((Atom)(LOCAL_tokptr->TokInfo))) { Atom save_opinfo = opinfo = (Atom)(LOCAL_tokptr->TokInfo); - if (IsInfixOp(save_opinfo, &opprio, &oplprio, &oprprio, tmod PASS_REGS) && + if (IsInfixOp(save_opinfo, &opprio, &oplprio, &oprprio PASS_REGS) && opprio <= prio && oplprio >= curprio) { /* try parsing as infix operator */ Volatile int oldprio = curprio; @@ -955,7 +967,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) { { Term args[2]; args[0] = t; - args[1] = ParseTerm(oprprio, FailBuff, tmod PASS_REGS); + args[1] = ParseTerm(oprprio, FailBuff PASS_REGS); t = Yap_MkApplTerm(func, 2, args); /* check for possible overflow against local stack */ if (HR > ASP - 4096) { @@ -967,7 +979,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) { opinfo = save_opinfo; continue;, opinfo = save_opinfo; curprio = oldprio;) } - if (IsPosfixOp(opinfo, &opprio, &oplprio , tmod PASS_REGS) && opprio <= prio && + if (IsPosfixOp(opinfo, &opprio, &oplprio PASS_REGS) && opprio <= prio && oplprio >= curprio) { /* parse as posfix operator */ Functor func = Yap_MkFunctor((Atom)LOCAL_tokptr->TokInfo, 1); @@ -993,7 +1005,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) { Volatile Term args[2]; NextToken; args[0] = t; - args[1] = ParseTerm(1000, FailBuff, tmod PASS_REGS); + args[1] = ParseTerm(1000, FailBuff PASS_REGS); t = Yap_MkApplTerm(FunctorComma, 2, args); /* check for possible overflow against local stack */ if (HR > ASP - 4096) { @@ -1003,12 +1015,12 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) { curprio = 1000; continue; } else if (Unsigned(LOCAL_tokptr->TokInfo) == '|' && - IsInfixOp(AtomVBar, &opprio, &oplprio, &oprprio, tmod PASS_REGS) && + IsInfixOp(AtomVBar, &opprio, &oplprio, &oprprio PASS_REGS) && opprio <= prio && oplprio >= curprio) { Volatile Term args[2]; NextToken; args[0] = t; - args[1] = ParseTerm(oprprio, FailBuff, tmod PASS_REGS); + args[1] = ParseTerm(oprprio, FailBuff PASS_REGS); t = Yap_MkApplTerm(FunctorVBar, 2, args); /* check for possible overflow against local stack */ if (HR > ASP - 4096) { @@ -1018,24 +1030,24 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) { curprio = opprio; continue; } else if (Unsigned(LOCAL_tokptr->TokInfo) == '(' && - IsPosfixOp(AtomEmptyBrackets, &opprio, &oplprio, tmod PASS_REGS) && + IsPosfixOp(AtomEmptyBrackets, &opprio, &oplprio PASS_REGS) && opprio <= prio && oplprio >= curprio) { - t = ParseArgs(AtomEmptyBrackets, ')', FailBuff, t, tmod PASS_REGS); + t = ParseArgs(AtomEmptyBrackets, ')', FailBuff, t PASS_REGS); curprio = opprio; continue; } else if (Unsigned(LOCAL_tokptr->TokInfo) == '[' && IsPosfixOp(AtomEmptySquareBrackets, &opprio, - &oplprio, tmod PASS_REGS) && + &oplprio PASS_REGS) && opprio <= prio && oplprio >= curprio) { - t = ParseArgs(AtomEmptySquareBrackets, ']', FailBuff, t, tmod PASS_REGS); + t = ParseArgs(AtomEmptySquareBrackets, ']', FailBuff, t PASS_REGS); t = MakeAccessor(t, FunctorEmptySquareBrackets PASS_REGS); curprio = opprio; continue; } else if (Unsigned(LOCAL_tokptr->TokInfo) == '{' && IsPosfixOp(AtomEmptyCurlyBrackets, &opprio, - &oplprio, tmod PASS_REGS) && + &oplprio PASS_REGS) && opprio <= prio && oplprio >= curprio) { - t = ParseArgs(AtomEmptyCurlyBrackets, '}', FailBuff, t, tmod PASS_REGS); + t = ParseArgs(AtomEmptyCurlyBrackets, '}', FailBuff, t PASS_REGS); t = MakeAccessor(t, FunctorEmptyCurlyBrackets PASS_REGS); curprio = opprio; continue; @@ -1050,7 +1062,7 @@ static Term ParseTerm(int prio, JMPBUFF *FailBuff, Term tmod USES_REGS) { return t; } -Term Yap_Parse(UInt prio, Term tmod) { +Term Yap_Parse(UInt prio) { CACHE_REGS Volatile Term t; JMPBUFF FailBuff; @@ -1058,7 +1070,7 @@ Term Yap_Parse(UInt prio, Term tmod) { if (!sigsetjmp(FailBuff.JmpBuff, 0)) { - t = ParseTerm(prio, &FailBuff, tmod PASS_REGS); + t = ParseTerm(prio, &FailBuff PASS_REGS); #if DEBUG if (GLOBAL_Option['p' - 'a' + 1]) { Yap_DebugPutc(stderr, '['); @@ -1071,8 +1083,7 @@ Term Yap_Parse(UInt prio, Term tmod) { } #endif Yap_CloseSlots(sls); - if (LOCAL_Error_TYPE == YAP_NO_ERROR && - LOCAL_tokptr != NULL && LOCAL_tokptr->Tok != Ord(eot_tok)) { + if (LOCAL_tokptr != NULL && LOCAL_tokptr->Tok != Ord(eot_tok)) { LOCAL_Error_TYPE = SYNTAX_ERROR; LOCAL_ErrorMessage = "term does not end on . "; t = 0; diff --git a/C/save.c b/C/save.c index b20e9f3ad..b4dc9ed45 100755 --- a/C/save.c +++ b/C/save.c @@ -186,7 +186,7 @@ do_SYSTEM_ERROR_INTERNAL(yap_error_number etype, const char *msg) inline static int myread(FILE *fd, char *buffer, Int len) { - ssize_t nread; + size_t nread; while (len > 0) { nread = fread(buffer, 1, (int)len, fd); @@ -202,7 +202,7 @@ int myread(FILE *fd, char *buffer, Int len) { inline static Int mywrite(FILE *fd, char *buff, Int len) { - ssize_t nwritten; + size_t nwritten; while (len > 0) { nwritten = fwrite(buff, 1, (size_t)len, fd); @@ -1440,7 +1440,7 @@ OpenRestore(const char *inpf, char *YapLibDir, CELL *Astate, CELL *ATrail, CELL CACHE_REGS int mode; - char fname[PATH_MAX+1]; + char fname[YAP_FILENAME_MAX +1]; if (!Yap_findFile( inpf, YAP_STARTUP, YapLibDir, fname, true, YAP_SAVED_STATE, true, true)) return false; diff --git a/C/stdpreds.c b/C/stdpreds.c index 863a77a68..60d8e42c8 100755 --- a/C/stdpreds.c +++ b/C/stdpreds.c @@ -385,8 +385,7 @@ static Int p_systime(USES_REGS1) { } static Int p_walltime(USES_REGS1) { - Int now, interval; - Yap_walltime_interval(&now, &interval); + uint64_t now, interval; return (Yap_unify_constant(ARG1, MkIntegerTerm(now)) && Yap_unify_constant(ARG2, MkIntegerTerm(interval))); } @@ -984,27 +983,24 @@ int Yap_IsOpMaxPrio(Atom at) { return max; } -static bool unify_op(OpEntry *op, Term emod USES_REGS) { +static Int unify_op(OpEntry *op USES_REGS) { Term tmod = op->OpModule; - if (tmod != PROLOG_MODULE && - tmod != USER_MODULE && - tmod != emod && - (op->Prefix || op->Infix || op->Posfix)) - return false; - return Yap_unify_constant(ARG3, MkIntegerTerm(op->Prefix)) && + if (tmod == PROLOG_MODULE) + tmod = TermProlog; + return Yap_unify_constant(ARG2, tmod) && + Yap_unify_constant(ARG3, MkIntegerTerm(op->Prefix)) && Yap_unify_constant(ARG4, MkIntegerTerm(op->Infix)) && Yap_unify_constant(ARG5, MkIntegerTerm(op->Posfix)); } static Int cont_current_op(USES_REGS1) { OpEntry *op = (OpEntry *)IntegerOfTerm(EXTRA_CBACK_ARG(5, 1)), *next; - Term emod = Deref(ARG2); - + READ_LOCK(op->OpRWLock); next = op->OpNext; if (Yap_unify_constant(ARG1, MkAtomTerm(op->OpName)) && - unify_op(op, emod PASS_REGS)) { + unify_op(op PASS_REGS)) { READ_UNLOCK(op->OpRWLock); if (next) { EXTRA_CBACK_ARG(5, 1) = (CELL)MkIntegerTerm((CELL)next); @@ -1017,6 +1013,7 @@ static Int cont_current_op(USES_REGS1) { READ_UNLOCK(op->OpRWLock); if (next) { EXTRA_CBACK_ARG(5, 1) = (CELL)MkIntegerTerm((CELL)next); + B->cp_h = HR; return FALSE; } else { cut_fail(); @@ -1036,7 +1033,7 @@ static Int cont_current_atom_op(USES_REGS1) { READ_LOCK(op->OpRWLock); next = NextOp(RepOpProp(op->NextOfPE) PASS_REGS); - if (unify_op(op, CurrentModule PASS_REGS)) { + if (unify_op(op PASS_REGS)) { READ_UNLOCK(op->OpRWLock); if (next) { EXTRA_CBACK_ARG(5, 1) = (CELL)MkIntegerTerm((CELL)next); diff --git a/C/text.c b/C/text.c index 6eeeb0abb..ff98cc573 100644 --- a/C/text.c +++ b/C/text.c @@ -931,7 +931,7 @@ write_buffer( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng -static ssize_t +static size_t write_length( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng USES_REGS) { size_t max = -1; @@ -998,7 +998,7 @@ write_Text( void *inp, seq_tv_t *out, encoding_t enc, int minimal, size_t leng U case YAP_STRING_LENGTH: out->val.l = write_length( inp, out, enc, minimal, leng PASS_REGS); - return out->val.l != (ssize_t)(-1); + return out->val.l != (size_t)(-1); case YAP_STRING_ATOM: out->val.a = write_atom( inp, out, enc, minimal, leng PASS_REGS); diff --git a/C/threads.c b/C/threads.c index c1c3dc761..f875530f1 100644 --- a/C/threads.c +++ b/C/threads.c @@ -30,7 +30,9 @@ static char SccsId[] = "%W% %G%"; #include "yapio.h" #include "blobs.h" #include +#if HAVE_UNISTD_H #include +#endif #if HAVE_STRING_H #include #endif diff --git a/C/write.c b/C/write.c index a986600ee..89ba06d03 100644 --- a/C/write.c +++ b/C/write.c @@ -1007,7 +1007,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg, return; } } - if (!wglb->Ignore_ops && Arity == 1 && Yap_IsPrefixOp(atom, &op, &rp, CurrentModule)) { + if (!wglb->Ignore_ops && Arity == 1 && Yap_IsPrefixOp(atom, &op, &rp)) { Term tright = ArgOfTerm(1, t); int bracket_right = !IsVarTerm(tright) && IsAtomTerm(tright) && Yap_IsOp(AtomOfTerm(tright)); @@ -1035,7 +1035,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg, ((atom == AtomEmptyBrackets || atom == AtomEmptyCurlyBrackets || atom == AtomEmptySquareBrackets) && Yap_IsListTerm(ArgOfTerm(1, t)))) && - Yap_IsPosfixOp(atom, &op, &lp, CurrentModule)) { + Yap_IsPosfixOp(atom, &op, &lp)) { Term tleft = ArgOfTerm(1, t); int bracket_left, offset; @@ -1087,7 +1087,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg, wrclose_bracket(wglb, TRUE); } } else if (!wglb->Ignore_ops && Arity == 2 && - Yap_IsInfixOp(atom, &op, &lp, &rp, CurrentModule)) { + Yap_IsInfixOp(atom, &op, &lp, &rp)) { Term tleft = ArgOfTerm(1, t); Term tright = ArgOfTerm(2, t); int bracket_left = diff --git a/CMakeLists.txt b/CMakeLists.txt index a4c24732c..865071086 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -128,8 +128,9 @@ set_property(DIRECTORY PROPERTY CXX_STANDARD 11) # include (Config) +IF (NOT MSVC) target_link_libraries(libYap m) - +ENDIF (NOT MSVC) set_target_properties(libYap PROPERTIES VERSION ${YAP_FULL_VERSION} @@ -286,18 +287,23 @@ include_directories ( utf8proc ) set_property( DIRECTORY APPEND PROPERTY COMPILE_DEFINITIONS UTF8PROC=1) ADD_SUBDIRECTORY ( utf8proc ) -macro_optional_find_package (GMP ON) +find_package (GMP) macro_log_feature (GMP_FOUND - "libgmp" + "GNU libgmp (in some cases MPIR" "GNU big integers and rationals" "http://gmplib.org") set(YAP_SYSTEM_OPTIONS "big_numbers " ${YAP_SYSTEM_OPTIONS}) if (GMP_FOUND) - include_directories (${GMP_INCLUDE_DIR}) +# GMP_FOUND - true if GMP/MPIR was found +# GMP_INCLUDE_DIRS - include search path +# GMP_LIBARIES - libraries to link with +# GMP_LIBARY_DLL - library DLL to install. Only available on WIN32. +# GMP_LIBRARIES_DIR - the directory the library we link with is found in. + include_directories (${GMP_INCLUDE_DIRS}) #add_executable(test ${SOURCES}) target_link_libraries(libYap ${GMP_LIBRARIES}) #config.h needs this (TODO: change in code latter) - set( CMAKE_REQUIRED_INCLUDES ${CMAKE_REQUIRED_INCLUDES} ${GMP_INCLUDE_DIR} ) + set( CMAKE_REQUIRED_INCLUDES ${CMAKE_REQUIRED_INCLUDES} ${GMP_INCLUDE_DIRS} ) #set( CMAKE_REQUIRED_LIBRARIES ${GMP_LIBRARIES} ${CMAKE_REQUIRED_LIBRARIES} ) endif (GMP_FOUND) @@ -409,9 +415,19 @@ add_subDIRECTORY (packages/ProbLog) add_subDIRECTORY (packages/swi-minisat2) -add_subDIRECTORY (packages/CLPBN) +OPTION (WITH_CLPBN " Enable the CLPBN and PFL probabilistic languages" ON) +OPTION (WITH_CPLINT " Enable the cplint probabilistic language" ON) + +OPTION (WITH_HORUS " Enable the CLPBN and PFL probabilistic languages" ON) + +IF (WITH_CLPBN) +add_subDIRECTORY (packages/CLPBN) +ENDIF() + +IF (WITH_CPLINT) add_subDIRECTORY (packages/cplint) +ENDIF() add_subDIRECTORY (packages/raptor) @@ -426,7 +442,7 @@ add_subDIRECTORY (packages/xml) option (WITH_DOCS "generate YAP docs" OFF) - add_subDIRECTORY (docs) + # add_subDIRECTORY (docs) # add_subDIRECTORY (packages/cuda) @@ -506,8 +522,10 @@ target_link_libraries(libYap ) if(WIN32) - target_link_libraries(libYap wsock32 ws2_32 Shlwapi - ) + if(MSVC) + set(MSVC_RUNTIME "dynamic") + ENDIF(MSVC) + target_link_libraries(libYap wsock32 ws2_32 Shlwapi) endif() add_executable (yap-bin ${CONSOLE_SOURCES}) diff --git a/H/ *Minibuf-5* b/H/ *Minibuf-5* deleted file mode 100644 index d8eacd145..000000000 --- a/H/ *Minibuf-5* +++ /dev/null @@ -1 +0,0 @@ -M-x \ No newline at end of file diff --git a/H/ *Minibuf-6* b/H/ *Minibuf-6* deleted file mode 100644 index 09c616005..000000000 --- a/H/ *Minibuf-6* +++ /dev/null @@ -1 +0,0 @@ -File to save in: ~/git/yap-6.3/H/ \ No newline at end of file diff --git a/H/Regs.h b/H/Regs.h index cee5a6c66..999488f13 100755 --- a/H/Regs.h +++ b/H/Regs.h @@ -69,6 +69,11 @@ #endif #endif +#if _MSC_VER +// no support for __builtin_expect +#define __builtin_expect(Exp, Val) (Exp) +#endif + #include "inline-only.h" INLINE_ONLY inline EXTERN void restore_machine_regs(void); @@ -586,10 +591,11 @@ INLINE_ONLY EXTERN inline void restore_TR(void) { } #else - -#define CP Yap_REGS.CP_ /* continuation program counter */ +/** continuation program counter: what to do when we exit the goal. */ +#define CP (Yap_REGS.CP_) #define P Yap_REGS.P_ /* prolog machine program counter */ -#define YENV Yap_REGS.YENV_ /* current environment (may differ from ENV) */ +/** current environment (may be pointing at an enevironment frame before the neck sets ENV) */ +#define YENV (Yap_REGS).YENV_ #define S Yap_REGS.S_ /* structure pointer */ #define HR Yap_REGS.H_ /* top of heap (global) stack */ #define B Yap_REGS.B_ /* latest choice point */ diff --git a/H/YapTerm.h b/H/YapTerm.h index e64a3661f..f6cbea92f 100644 --- a/H/YapTerm.h +++ b/H/YapTerm.h @@ -34,8 +34,12 @@ typedef void *Atom; #ifndef EXTERN +#ifdef _MSC_VER +#define EXTERN +#else #define EXTERN extern #endif +#endif /* defines integer types Int and UInt (unsigned) with the same size as a ptr ** and integer types Short and UShort with half the size of a ptr */ diff --git a/H/Yapproto.h b/H/Yapproto.h index 1e173a197..10c26c7f3 100755 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -13,6 +13,10 @@ * version: $Id: Yapproto.h,v 1.90 2008-08-07 20:51:23 vsc Exp $ * *************************************************************************/ +#if defined(_WIN32) +#define X_API __declspec(dllexport) +#endif + /* prototype file for Yap */ /* absmi.c */ @@ -111,11 +115,11 @@ size_t Yap_OpaqueTermToString(Term t, char *str, size_t max); /* c_interface.c */ #ifndef YAP_CPP_INTERFACE -Int YAP_Execute(struct pred_entry *, CPredicate); -Int YAP_ExecuteFirst(struct pred_entry *, CPredicate); -Int YAP_ExecuteNext(struct pred_entry *, CPredicate); -Int YAP_ExecuteOnCut(struct pred_entry *, CPredicate, struct cut_c_str *); -Int YAP_RunGoalOnce(Term); +X_API Int YAP_Execute(struct pred_entry *, CPredicate); +X_API Int YAP_ExecuteFirst(struct pred_entry *, CPredicate); +X_API Int YAP_ExecuteNext(struct pred_entry *, CPredicate); +X_API Int YAP_ExecuteOnCut(struct pred_entry *, CPredicate, struct cut_c_str *); +X_API Int YAP_RunGoalOnce(Term); #endif /* cdmgr.c */ @@ -388,14 +392,14 @@ int Yap_IsOpMaxPrio(Atom); void Yap_InitPageSize(void); bool Yap_set_fpu_exceptions(Term); UInt Yap_cputime(void); -Int Yap_walltime(void); +uint64_t Yap_walltime(void); int Yap_dir_separator(int); int Yap_volume_header(char *); int Yap_signal_index(const char *); #ifdef MAC void Yap_SetTextFile(char *); #endif -#if __ANDROIDD__ +#if __ANDROID__ extern AAssetManager *Yap_assetManager; extern void *Yap_openAssetFile(const char *path); @@ -404,7 +408,6 @@ extern bool Yap_isAsset(const char *path); const char *Yap_getcwd(const char *, size_t); void Yap_cputime_interval(Int *, Int *); void Yap_systime_interval(Int *, Int *); -void Yap_walltime_interval(Int *, Int *); void Yap_InitSysbits(int wid); void Yap_InitSysPreds(void); void Yap_InitcTime(int); diff --git a/H/Yatom.h b/H/Yatom.h index 5c7a3231c..08d1dfb9b 100755 --- a/H/Yatom.h +++ b/H/Yatom.h @@ -266,17 +266,16 @@ INLINE_ONLY inline EXTERN int IsWideAtom(Atom at) { /* Module property */ typedef struct mod_entry { - Prop NextOfPE; /** used to chain properties */ - PropFlags KindOfPE; /** kind of property */ - struct pred_entry *PredForME; /** list of predicates for that module */ - Atom AtomOfME; /** module's name */ - Atom OwnerFile; /** module's owner file */ + Prop NextOfPE; /* used to chain properties */ + PropFlags KindOfPE; /* kind of property */ + struct pred_entry *PredForME; /* index in module table */ + Atom AtomOfME; /* module's name */ + Atom OwnerFile; /* module's owner file */ #if defined(YAPOR) || defined(THREADS) - rwlock_t ModRWLock; /** a read-write lock to protect the entry */ + rwlock_t ModRWLock; /* a read-write lock to protect the entry */ #endif - Term ParentForME; /** the module we wer created from */ - unsigned int flags; /** Module local flags (from SWI compat): includes ops, strings */ - struct mod_entry *NextME; /** next module */ + unsigned int flags; /* Module local flags (from SWI compat) */ + struct mod_entry *NextME; /* next module */ } ModEntry; #if USE_OFFSETS_IN_PROPS @@ -392,12 +391,12 @@ INLINE_ONLY inline EXTERN PropFlags IsOpProperty(int flags) { typedef enum { INFIX_OP = 0, POSFIX_OP = 1, PREFIX_OP = 2 } op_type; - OpEntry *Yap_GetOpProp(Atom, op_type, Term CACHE_TYPE); +OpEntry *Yap_GetOpProp(Atom, op_type CACHE_TYPE); -int Yap_IsPrefixOp(Atom, int *, int *, Term); +int Yap_IsPrefixOp(Atom, int *, int *); int Yap_IsOp(Atom); -int Yap_IsInfixOp(Atom, int *, int *, int *, Term); -int Yap_IsPosfixOp(Atom, int *, int *, Term); +int Yap_IsInfixOp(Atom, int *, int *, int *); +int Yap_IsPosfixOp(Atom, int *, int *); /* defines related to operator specifications */ #define MaskPrio 0x0fff diff --git a/H/amidefs.h b/H/amidefs.h index d0c6fc569..c7ab91d16 100644 --- a/H/amidefs.h +++ b/H/amidefs.h @@ -938,6 +938,15 @@ typedef struct choicept { CELL *cp_env; /* GNUCC understands empty arrays */ CELL cp_args[MIN_ARRAY]; +#else + /* Otherwise, we need a very dirty trick to access the arguments */ + union { + CELL *cp_uenv; + CELL cp_xargs[1]; + } cp_last; +#define cp_env cp_last.cp_uenv +#define cp_args cp_last.cp_xargs +#endif #define cp_a1 cp_args[0] #define cp_a2 cp_args[1] #define cp_a3 cp_args[2] @@ -949,23 +958,6 @@ typedef struct choicept { #define cp_a9 cp_args[8] #define cp_a10 cp_args[9] #define EXTRA_CBACK_ARG(Arity,Offset) B->cp_args[(Arity)+(Offset)-1] -#else - /* Otherwise, we need a very dirty trick to access the arguments */ - union { - CELL *cp_uenv; - CELL cp_args[1]; - } cp_last; -#define cp_env cp_last.cp_uenv -#define cp_a1 cp_last.cp_args[1] -#define cp_a2 cp_last.cp_args[2] -#define cp_a3 cp_last.cp_args[3] -#define cp_a4 cp_last.cp_args[4] -#define cp_a5 cp_last.cp_args[5] -#define cp_a6 cp_last.cp_args[6] -#define cp_a7 cp_last.cp_args[7] -#define cp_a8 cp_last.cp_args[8] -#define EXTRA_CBACK_ARG(Arity,Offset) B->cp_last.cp_args[(Arity)+(Offset)] -#endif } *choiceptr; /* This has problems with \+ \+ a, !, b. */ @@ -1062,10 +1054,9 @@ OPCODE ENV_ToOp(yamop *cp) } static inline -size_t EnvSize(yamop *cp) +int64_t EnvSize(yamop *cp) { - return ((-ENV_Size(cp - ))/(OPREG)sizeof(CELL)); + return (-ENV_Size(cp)/sizeof(CELL)); } static inline diff --git a/H/arith2.h b/H/arith2.h index c960aa255..7cab75570 100755 --- a/H/arith2.h +++ b/H/arith2.h @@ -74,8 +74,15 @@ mul_overflow(Int z, Int i1, Int i2) return (i2 && z/i2 != i1); } -#ifndef OPTIMIZE_MULTIPLI -#if __clang__ && FALSE /* not in OSX yet */ +#if defined(_MSC_VER) && SIZEOF_DOUBLE == SIZEOF_INT_P +#define DO_MULTI() { \ +uint64_t h1 = (11 > 0 ? i1 : -i1) >> 32;\ +uint64_t h2 = (12 > 0 ? i2 : -12) >> 32;\ +if (h1 != 0 && h2 != 0) goto overflow;\ +if ((uint64_t)(i1 & 0xfffffff)*h2 + ((uint64_t)(i2 & 0xfffffff)*h1) > 0x7fffffff) goto overflow;\ +z = i1 * i2;\ +} +#elif __clang__ && FALSE /* not in OSX yet */ #define DO_MULTI() if (__builtin_smul_overflow( i1, i2, & z ) ) { goto overflow; } #elif SIZEOF_DOUBLE == 2*SIZEOF_INT_P #define DO_MULTI() {\ @@ -98,7 +105,6 @@ mul_overflow(Int z, Int i1, Int i2) z = (Int)w; \ } #endif -#endif inline static Term times_int(Int i1, Int i2 USES_REGS) { diff --git a/H/generated/h0globals.h b/H/generated/h0globals.h index ff3fbf9bd..59c00abb9 100644 --- a/H/generated/h0globals.h +++ b/H/generated/h0globals.h @@ -111,7 +111,7 @@ EXTERNAL char GLOBAL_pwd[YAP_FILENAME_MAX]; #endif //udi.c //struct udi_control_block RtreeCmd void -EXTERNAL const char* GLOBAL_RestoreFile; +EXTERNAL char* GLOBAL_RestoreFile; //gprof.c EXTERNAL Int GLOBAL_ProfCalls; EXTERNAL Int GLOBAL_ProfGCs; diff --git a/H/generated/hglobals.h b/H/generated/hglobals.h index c24c3fd2a..153b37d00 100644 --- a/H/generated/hglobals.h +++ b/H/generated/hglobals.h @@ -111,7 +111,7 @@ typedef struct global_data { #endif //udi.c //struct udi_control_block RtreeCmd void -const char* RestoreFile_; + char* RestoreFile_; //gprof.c Int ProfCalls_; Int ProfGCs_; diff --git a/H/inline-only.h b/H/inline-only.h index 74fea6cb4..be5039198 100644 --- a/H/inline-only.h +++ b/H/inline-only.h @@ -5,7 +5,7 @@ #define INLINE_ONLY __attribute__((gnu_inline,always_inline)) //#define INLINE_ONLY #else -#define INLINE_ONLY inline EXTERN +#define INLINE_ONLY EXTERN #endif #endif diff --git a/H/sshift.h b/H/sshift.h index f95a53ffc..a64b83f6c 100644 --- a/H/sshift.h +++ b/H/sshift.h @@ -738,7 +738,7 @@ CodeVoidPAdjust__ (void * addr USES_REGS) { if (!addr) return NULL; - return addr + LOCAL_HDiff; + return (void *)((char *)addr + LOCAL_HDiff); } INLINE_ONLY inline EXTERN struct halt_hook *HaltHookAdjust__ (struct halt_hook * CACHE_TYPE); diff --git a/OPTYap/opt.init.c b/OPTYap/opt.init.c index f3d2d9842..3af749a07 100644 --- a/OPTYap/opt.init.c +++ b/OPTYap/opt.init.c @@ -20,7 +20,9 @@ #define OPT_MAVAR_STATIC #include "Yatom.h" #include "YapHeap.h" +#if HAVE_UNISTD_H #include +#endif #include #ifdef YAPOR #include "or.macros.h" diff --git a/OPTYap/or.cow_engine.c b/OPTYap/or.cow_engine.c index 9996db457..a90e12a75 100644 --- a/OPTYap/or.cow_engine.c +++ b/OPTYap/or.cow_engine.c @@ -18,7 +18,9 @@ #include "Yap.h" #ifdef YAPOR_COW #include +#if HAVE_UNISTD_H #include +#endif #include #include "Yatom.h" #include "YapHeap.h" diff --git a/OPTYap/or.memory.c b/OPTYap/or.memory.c index 94cb7fade..c07bfd29b 100644 --- a/OPTYap/or.memory.c +++ b/OPTYap/or.memory.c @@ -18,7 +18,9 @@ #include "Yap.h" #if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) #include +#if HAVE_UNISTD_H #include +#endif #include #include #include diff --git a/OPTYap/tab.tries.c b/OPTYap/tab.tries.c index bec10386d..cf05c885c 100644 --- a/OPTYap/tab.tries.c +++ b/OPTYap/tab.tries.c @@ -166,9 +166,9 @@ trie_stats; #define SHOW_TABLE_STR_ARRAY_SIZE 100000 #define SHOW_TABLE_ARITY_ARRAY_SIZE 10000 -#define SHOW_TABLE_STRUCTURE(MESG, ARGS...) \ +#define SHOW_TABLE_STRUCTURE( ...) \ if (TrStat_show == SHOW_MODE_STRUCTURE) \ - fprintf(TrStat_out, MESG, ##ARGS) + fprintf(TrStat_out, __VA_ARGS__ ) #define CHECK_DECREMENT_GLOBAL_TRIE_REFERENCE(REF, MODE) \ if (MODE == TRAVERSE_MODE_NORMAL && IsVarTerm(REF) && \ @@ -1208,7 +1208,9 @@ sg_fr_ptr subgoal_search(yamop *preg, CELL **Yaddr) { #if !defined(THREADS_FULL_SHARING) && !defined(THREADS_CONSUMER_SHARING) new_subgoal_frame(sg_fr, preg, mode_directed); *sg_fr_end = sg_fr; +#ifndef _MSC_VER __sync_synchronize(); +#endif TAG_AS_SUBGOAL_LEAF_NODE(current_sg_node); UNLOCK_SUBGOAL_NODE(current_sg_node); #else /* THREADS_FULL_SHARING || THREADS_CONSUMER_SHARING */ diff --git a/cmake/FindGMP.cmake b/cmake/FindGMP.cmake index 17d175c6a..8dd74738f 100644 --- a/cmake/FindGMP.cmake +++ b/cmake/FindGMP.cmake @@ -1,23 +1,46 @@ -# Try to find the GMP librairies -# GMP_FOUND - system has GMP lib -# GMP_INCLUDE_DIR - the GMP include directory -# GMP_LIBRARIES - Libraries needed to use GMP - -# Copyright (c) 2006, Laurent Montel, +# vim: set ts=2 shiftwidth=2 expandtab: +# - Find GMP/MPIR libraries and headers +# This module defines the following variables: # -# Redistribution and use is allowed according to the terms of the BSD license. -# For details see the accompanying COPYING-CMAKE-SCRIPTS file. +# GMP_FOUND - true if GMP/MPIR was found +# GMP_INCLUDE_DIRS - include search path +# GMP_LIBARIES - libraries to link with +# GMP_LIBARY_DLL - library DLL to install. Only available on WIN32. +# GMP_LIBRARIES_DIR - the directory the library we link with is found in. +find_path(GMP_INCLUDE_DIRS NAMES gmp.h + PATHS "$ENV{PROGRAMFILES}/mpir/include" + DOC "The gmp include directory" +) -if (GMP_INCLUDE_DIR AND GMP_LIBRARIES) - # Already in cache, be silent - set(GMP_FIND_QUIETLY TRUE) -endif (GMP_INCLUDE_DIR AND GMP_LIBRARIES) +if(WIN32) + if(CMAKE_BUILD_TYPE STREQUAL "Debug" AND MSVC) + set(MPIR_LIB "mpird") + else() + set(MPIR_LIB "mpir") + endif() -find_path(GMP_INCLUDE_DIR NAMES gmp.h ) -find_library(GMP_LIBRARIES NAMES gmp libgmp) + find_library(GMP_LIBRARIES NAMES ${MPIR_LIB} + PATHS "$ENV{PROGRAMFILES}/mpir/lib" + DOC "The MPIR library" + ) + find_library(GMP_LIBRARY_DLL NAMES ${MPIR_LIB} + PATHS "$ENV{PROGRAMFILES}/mpir/bin" + DOC "The MPIR library DLL" + ) +else(WIN32) + find_library(GMP_LIBRARIES NAMES gmp + DOC "The GMP library" + ) +endif(WIN32) +get_filename_component(GMP_LIBRARIES_DIR "${GMP_LIBRARIES}" PATH) + +# handle the QUIET and REQUIRED arguments and set GMP_FOUND to TRUE if +# all listed variables are true include(FindPackageHandleStandardArgs) -FIND_PACKAGE_HANDLE_STANDARD_ARGS(GMP DEFAULT_MSG GMP_INCLUDE_DIR GMP_LIBRARIES) - -mark_as_advanced(GMP_INCLUDE_DIR GMP_LIBRARIES) +if(WIN32) + find_package_handle_standard_args(GMP DEFAULT_MSG GMP_LIBRARIES GMP_LIBRARY_DLL GMP_INCLUDE_DIRS) +else() + find_package_handle_standard_args(GMP DEFAULT_MSG GMP_LIBRARIES GMP_INCLUDE_DIRS) +endif() diff --git a/console/yap.c b/console/yap.c index 86bd313c6..154ba90f8 100755 --- a/console/yap.c +++ b/console/yap.c @@ -22,11 +22,12 @@ #include "cut_c.h" #ifdef _MSC_VER /* Microsoft's Visual C++ Compiler */ -#ifdef HAVE_UNISTD_H #undef HAVE_UNISTD_H #endif +#ifdef _WIN32 /* Microsoft's Visual C++ Compiler */ +#include +#include #endif - #include #if HAVE_SYS_TYPES_H #include @@ -57,6 +58,7 @@ #include #endif + static void do_top_goal(YAP_Term Goal); static void exec_top_level(int BootMode, YAP_init_args *iap); @@ -68,13 +70,7 @@ static void exec_top_level(int BootMode, YAP_init_args *iap); long _stksize = 32000; #endif -#ifdef USE_MYPUTC -static void -myputc (int ch) -{ - putc(ch,stderr); -} -#endif + static void do_top_goal (YAP_Term Goal) @@ -87,7 +83,7 @@ init_standard_system(int argc, char *argv[], YAP_init_args *iap) { int BootMode; - BootMode = YAP_parse_yap_arguments(argc,argv,iap); +// BootMode = YAP_parse_yap_arguments(argc,argv,iap); /* init memory */ if (BootMode == YAP_BOOT_FROM_PROLOG || @@ -142,16 +138,8 @@ main (int argc, char **argv) #endif { int BootMode; - YAP_init_args init_args; int i; -#if DEBUG_LOCKS - char buf[1024]; - sprintf(buf, "/tmp/yap%d", getpid()); - debugf= fopen(buf, "w"); - if (!debugf) fprintf(stderr,"ERROR %s\n", strerror(errno)); - setvbuf( debugf,NULL, _IOLBF, 1024); -#endif BootMode = init_standard_system(argc, argv, &init_args); if (BootMode == YAP_BOOT_ERROR) { fprintf(stderr,"[ FATAL ERROR: could not find saved state ]\n"); diff --git a/include/SWI-Prolog.h b/include/SWI-Prolog.h index af648dba7..43c7352c2 100755 --- a/include/SWI-Prolog.h +++ b/include/SWI-Prolog.h @@ -607,7 +607,7 @@ extern X_API void PL_fatal_error(const char *msg); extern X_API int Sprintf(const char * fm,...); extern X_API int Sdprintf(const char *,...); -extern char *PL_prompt_string(int fd); +extern X_API char *PL_prompt_string(int fd); /******************************* * FILENAME SUPPORT * @@ -639,7 +639,7 @@ readline overhead. #define PL_DISPATCH_WAIT 1 /* Dispatch till input available */ #define PL_DISPATCH_INSTALLED 2 /* dispatch function installed? */ -extern X_API int PL_dispatch(int fd, int wait); +PL_EXPORT(int) PL_dispatch(int fd, int wait); PL_EXPORT(PL_dispatch_hook_t) PL_dispatch_hook(PL_dispatch_hook_t); PL_EXPORT(void) PL_add_to_protocol(const char *buf, size_t count); PL_EXPORT(char *) PL_prompt_string(int fd); @@ -667,7 +667,7 @@ PL_EXPORT(pl_wchar_t*) PL_atom_generator_w(const pl_wchar_t *pref, PL_EXPORT(LRESULT) PL_win_message_proc(HWND hwnd, UINT message, - WPARAM wParam, + // WPARAM wParam, LPARAM lParam); #endif /*_WINDOWS_*/ diff --git a/include/pl-types.h b/include/pl-types.h index 3e54c3dc3..63f540f06 100644 --- a/include/pl-types.h +++ b/include/pl-types.h @@ -37,9 +37,7 @@ typedef int (*PL_agc_hook_t)(atom_t); typedef uintptr_t foreign_t; /* return type of foreign functions */ typedef wchar_t pl_wchar_t; /* wide character support */ #include /* more portable than stdint.h */ -#if !defined(_MSC_VER) typedef uintptr_t PL_fid_t; /* opaque foreign context handle */ -#endif typedef int (*PL_dispatch_hook_t)(int fd); typedef void *pl_function_t; diff --git a/library/CMakeLists.txt b/library/CMakeLists.txt index 8a1d84b81..0c6c46956 100644 --- a/library/CMakeLists.txt +++ b/library/CMakeLists.txt @@ -8,14 +8,12 @@ set (LIBRARY_PL autoloader.yap avl.yap bhash.yap - bootlists.yap charsio.yap clauses.yap coinduction.yap dbqueues.yap dbusage.yap dgraphs.yap - error.yap exo_interval.yap expand_macros.yap gensym.yap diff --git a/library/bootlists.yap b/library/bootlists.yap deleted file mode 100644 index 24861bc66..000000000 --- a/library/bootlists.yap +++ /dev/null @@ -1,139 +0,0 @@ -/** - * @file pl/lists.yap - * @author VITOR SANTOS COSTA - * @date Thu Nov 19 09:54:00 2015 - * - * @addtogroup lists - * @{ -*/ - -:- system_module( '$_lists', [], []). - -:- set_prolog_flag(source, true). % source. - -% memberchk(+Element, +Set) -% means the same thing, but may only be used to test whether a known -% Element occurs in a known Set. In return for this limited use, it -% is more efficient when it is applicable. -/** @pred memberchk(+ _Element_, + _Set_) - - -As member/2, but may only be used to test whether a known - _Element_ occurs in a known Set. In return for this limited use, it -is more efficient when it is applicable. - - -*/ -lists:memberchk(X,[X|_]) :- !. -lists:memberchk(X,[_|L]) :- - lists:memberchk(X,L). - -%% member(?Element, ?Set) -% is true when Set is a list, and Element occurs in it. It may be used -% to test for an element or to enumerate all the elements by backtracking. -% Indeed, it may be used to generate the Set! - -/** @pred member(? _Element_, ? _Set_) - - -True when _Set_ is a list, and _Element_ occurs in it. It may be used -to test for an element or to enumerate all the elements by backtracking. - - -*/ -lists:member(X,[X|_]). -lists:member(X,[_|L]) :- - lists:member(X,L). - -%% @pred identical_member(?Element, ?Set) is nondet -% -% identical_member holds true when Set is a list, and Element is -% exactly identical to one of the elements that occurs in it. - -lists:identical_member(X,[Y|M]) :- - ( - X == Y - ; - M \= [], lists:identical_member(X,M) - ). - -/** @pred append(? _List1_,? _List2_,? _List3_) - - -Succeeds when _List3_ unifies with the concatenation of _List1_ -and _List2_. The predicate can be used with any instantiation -pattern (even three variables). - - -*/ -lists:append([], L, L). -lists:append([H|T], L, [H|R]) :- - lists:append(T, L, R). - - -:- set_prolog_flag(source, true). % :- no_source. - -% lists:delete(List, Elem, Residue) -% is true when List is a list, in which Elem may or may not occur, and -% Residue is a copy of List with all elements identical to Elem lists:deleted. - -/** @pred delete(+ _List_, ? _Element_, ? _Residue_) - -eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee -True when _List_ is a list, in which _Element_ may or may not -occur, and _Residue_ is a copy of _List_ with all elements -identical to _Element_ deleted. - -eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee -*/ -lists:delete([], _, []). -lists:delete([Head|List], Elem, Residue) :- - Head = Elem, - lists:delete(List, Elem, Residue). -lists:delete([Head|List], Elem, [Head|Residue]) :- - lists:delete(List, Elem, Residue). - -:- set_prolog_flag(source, false). % disable source. - - - -% length of a list. - -/** @pred length(? _L_,? _S_) - - -Unify the well-defined list _L_ with its length. The procedure can -be used to find the length of a pre-defined list, or to build a list -of length _S_. - -*/ - -prolog:length(L, M) :- - '$skip_list'(L, M, M0, R), - ( var(R) -> '$$_length'(R, M, M0) ; - R == [] - ). - -% -% in case A1 is unbound or a difference list, things get tricky -% -'$$_length'(R, M, M0) :- - ( var(M) -> '$$_length1'(R,M,M0) - ; M >= M0 -> '$$_length2'(R,M,M0) ). - -% -% Size is unbound, generate lists -% -'$$_length1'([], M, M). -'$$_length1'([_|L], O, N) :- - M is N + 1, - '$$_length1'(L, O, M). - -% -% Size is bound, generate single list -% -'$$_length2'(NL, O, N) :- - ( N =:= O -> NL = []; - M is N + 1, NL = [_|L], '$$_length2'(L, O, M) ). - -%% @} diff --git a/library/dialect/swi/fli/swi.c b/library/dialect/swi/fli/swi.c index bbc7563f1..1a44b5274 100755 --- a/library/dialect/swi/fli/swi.c +++ b/library/dialect/swi/fli/swi.c @@ -3343,7 +3343,7 @@ term_t Yap_CvtTerm(term_t ts) return ts; } } else if (f == FunctorDBRef) { - Term ta[0]; + Term ta[1]; ta[0] = MkIntegerTerm((Int)DBRefOfTerm(t)); return Yap_InitSlot(Yap_MkApplTerm(FunctorDBREF, 1, ta)); } diff --git a/library/lists.yap b/library/lists.yap index e84945bfa..5065b90bf 100644 --- a/library/lists.yap +++ b/library/lists.yap @@ -47,11 +47,6 @@ sumlist/2 ]). -:- if( source_module(prolog) ). - -:- reconsult(bootlists). - -:- endif. /** @defgroup lists List Manipulation @ingroup library diff --git a/library/matrix.yap b/library/matrix.yap index d2642e127..6a864a521 100644 --- a/library/matrix.yap +++ b/library/matrix.yap @@ -29,14 +29,8 @@ [(<==)/2, op(800, xfx, '<=='), op(700, xfx, in), op(700, xfx, ins), - op(450, xfx, ..), % should bind more tightly than \/ - op(720, fx, ..), % should bind more tightly than of - op(710, xfx, of), - (of)/2, - op(50, yf, '[]'), - op(50, yf, '()'), - op(100, xfy, '.'), - op(100, fy, '.'), + op(450, xfx, ..), % should bind more tightly than \/ + op(710, xfx, of), of/2, matrix_new/3, matrix_new/4, matrix_new_set/4, @@ -87,7 +81,11 @@ matrix_get/2, matrix_set/2, foreach/2, - foreach/4 + foreach/4, + op(50, yf, []), + op(50, yf, '()'), + op(100, xfy, '.'), + op(100, fy, '.') ]). /** @defgroup matrix Matrix Library diff --git a/library/prandom.yap b/library/prandom.yap index 30c83b9c5..75206746b 100644 --- a/library/prandom.yap +++ b/library/prandom.yap @@ -43,7 +43,7 @@ % efficient. % % ranpkg.pl random number package Allen Van Gelder, Stanford -% +vvvvvv % rannum produces a random non-negative integer whose low bits are not % all that random, so it should be scaled to a smaller range in general. % The integer is in the range 0 .. 2^(w-1) - 1, diff --git a/library/ytest.yap b/library/ytest.yap index 973b63286..0b7a60f72 100644 --- a/library/ytest.yap +++ b/library/ytest.yap @@ -6,15 +6,11 @@ op(995, xfx, given), op(990, xfx, returns)] ). -:- (current_op(X,Y,O), write(M0:O), fail:nl). - :- use_module( library(clauses) ). :- use_module( library(maplist) ). :- use_module( library(gensym) ). :- use_module( library(lists) ). -:- (current_op(X,Y,O), write(M0:O), fail:nl). - :- multifile test/1. :- dynamic error/3, failed/3. diff --git a/library/ytest/preds.yap b/library/ytest/preds.yap index a51c6c739..245a725f4 100644 --- a/library/ytest/preds.yap +++ b/library/ytest/preds.yap @@ -9,7 +9,7 @@ -> Flags1 = 0x200000 ). -'$predicate_flags'(_P, _M, Flags0, Flags1) :- +'$predicate_flags'(P, M, Flags0, Flags1) :- ( Flags1 /\ 0x200000 =\= 0, Flags0 /\ 0x200000 =:= 0 -> @@ -23,7 +23,7 @@ predicate_property(M:G, imported_from(M0)), !. '$get_undefined_pred'(G,M,G,OM) :- functor(G,F,N), - ( system_predicate(F/N), OM = prolog ; current_predicate(M:F/N), OM= user), !. + ( system_predicate(F/N), OM = prolog ; current_predicate(user:F/N), OM= user), !. '$get_undefined_pred'(G,M,G,M0) :- predicate_property(M:G, imported_from(M0)), !. '$get_undefined_pred'(G,M,G,M). diff --git a/misc/GLOBALS b/misc/GLOBALS index 5aae6e7fc..7c2842a13 100755 --- a/misc/GLOBALS +++ b/misc/GLOBALS @@ -131,7 +131,7 @@ char pwd[YAP_FILENAME_MAX] void //udi.c //struct udi_control_block RtreeCmd void -const char* RestoreFile void +char* RestoreFile void //gprof.c Int ProfCalls void diff --git a/misc/buildlocalglobal b/misc/buildlocalglobal index cc7f43a51..529c9d314 100644 --- a/misc/buildlocalglobal +++ b/misc/buildlocalglobal @@ -121,19 +121,19 @@ gen_0struct(Inp,Out) :- Inp = "ATOMS", !, Out = "#include \"tatoms.h\"". gen_0struct(Inp,Out) :- - split(Inp," ",["struct"|_L]), !, + split(Inp," ",["struct",Type, Field|L]), !, extract("struct", Inp, NInp), gen_0struct( NInp, NOut ), extract("EXTERNAL", NOut, IOut), append("EXTERNAL struct ", IOut, Out). gen_0struct(Inp,Out) :- - split(Inp," ",["const"|_L]), !, + split(Inp," ",["const",Type, Field|L]), !, extract("const", Inp, NInp), gen_0struct( NInp, NOut ), extract("EXTERNAL", NOut, IOut), append("EXTERNAL const ", IOut, Out). gen_0struct(Inp,Out) :- - split(Inp," ",["union"|_L]), !, + split(Inp," ",["union",Type, Field|L]), !, extract("union", Inp, NInp), gen_0struct( NInp, NOut ), extract("EXTERNAL", NOut, IOut), @@ -495,3 +495,7 @@ extract([0'\t |H], IF) :- !, extract( H, IF). extract(H,H). + + + + diff --git a/os/alias.c b/os/alias.c index d4b403cb4..41329cc85 100644 --- a/os/alias.c +++ b/os/alias.c @@ -68,7 +68,6 @@ static char SccsId[] = "%W% %G%"; #include #endif #ifdef HAVE_UNISTD_H - #include #endif #if HAVE_CTYPE_H diff --git a/os/chartypes.yap b/os/chartypes.yap index 53c75fea8..a6a79a0ed 100644 --- a/os/chartypes.yap +++ b/os/chartypes.yap @@ -1,4 +1,11 @@ -%:- module('$char_type',[]). +:- module('$char_type',[ + op(1150, fx, block) + %dif/2, + %when/2, + %block/1, + %wait/1, + %frozen/2 + ]). /** @defgroup CharacterCodes Character Encoding and Manipulation. diff --git a/os/console.c b/os/console.c index 681f35c61..646529127 100644 --- a/os/console.c +++ b/os/console.c @@ -14,9 +14,6 @@ * comments: Input/Output C implemented predicates * * * *************************************************************************/ -#ifdef SCCS -static char SccsId[] = "%W% %G%"; -#endif /** * @file console.c @@ -265,7 +262,7 @@ void Yap_InitConsole(void) { Yap_InitCPred ("prompt1", 1, prompt1, SafePredFlag|SyncPredFlag); Yap_InitCPred ("$is_same_tty", 2, is_same_tty2, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("prompt", 2, prompt, SafePredFlag|SyncPredFlag); - Yap_InitCPred ("$ensure_prompting", 0, ensure_prompting, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("$ensure_prompting", 0, ensure_prompting, SafePredFlag|SyncPredFlag); } diff --git a/os/files.c b/os/files.c index c78512642..6ab9343f5 100644 --- a/os/files.c +++ b/os/files.c @@ -222,7 +222,11 @@ exists_file(USES_REGS1) /* ignore errors while checking a file */ return FALSE; } - return (S_ISREG(ss.st_mode)); +#if _MSC_VER + return ss.st_mode & S_IFREG; +#else + return (_stat(ss.st_mode)); +#endif #else return FALSE; #endif @@ -373,6 +377,33 @@ access_file(USES_REGS1) return FALSE; } #if HAVE_ACCESS +#if _WIN32 + { + int mode; + + if (atmode == AtomExist) + mode = 00; + else if (atmode == AtomWrite) + mode = 02; + else if (atmode == AtomRead) + mode = 04; + else if (atmode == AtomAppend) + mode = 03; + else if (atmode == AtomCsult) + mode = 04; + else if (atmode == AtomExecute) + mode = 00; // can always execute? + else { + Yap_Error(DOMAIN_ERROR_IO_MODE, tmode, "access_file/2"); + return FALSE; + } + if (access(ares, mode) < 0) { + /* ignore errors while checking a file */ + return false; + } + return true; +} +#else { int mode; @@ -398,6 +429,7 @@ access_file(USES_REGS1) } return true; } +#endif #elif HAVE_STAT { struct SYSTEM_STAT ss; @@ -511,8 +543,6 @@ file_directory_name ( USES_REGS1 ) return false; } at = AtomOfTerm(t); - if (at == AtomEmptyAtom) - at = AtomDot; if (IsWideAtom(at)) { wchar_t s[YAP_FILENAME_MAX+1]; wchar_t *c = RepAtom(at)->WStrOfAE; diff --git a/os/getw.h b/os/getw.h index f0b2336a5..d06fe0d8f 100644 --- a/os/getw.h +++ b/os/getw.h @@ -24,7 +24,7 @@ static int GETW(int sno) { case ENC_ISO_ANSI: { char buf[8]; int out; - wchar_t wch; + int wch; mbstate_t mbstate; memset((void *)&(mbstate), 0, sizeof(mbstate_t)); diff --git a/os/iopreds.c b/os/iopreds.c index 6b94167af..2635b0a42 100644 --- a/os/iopreds.c +++ b/os/iopreds.c @@ -96,6 +96,7 @@ static char SccsId[] = "%W% %G%"; #endif #include "iopreds.h" + #define GETW get_wchar_from_FILE #define GETC() fgetwc(st->file) #include "getw.h" @@ -189,15 +190,12 @@ static bool is_file_errors(Term t) { } void Yap_DefaultStreamOps(StreamDesc *st) { - CACHE_REGS + CACHE_REGS st->stream_wputc = put_wchar; st->stream_wgetc = get_wchar; if (st->status & (Promptable_Stream_f)) { st->stream_wgetc = get_wchar; Yap_ConsoleOps(st, true); - } else if (st->status & (InMemory_Stream_f)) { - st->stream_wgetc = get_wchar; - Yap_ConsoleOps(st, true); } else if (st->encoding == LOCAL_encoding) { st->stream_wgetc = get_wchar_from_file; } else @@ -224,8 +222,8 @@ static void unix_upd_stream_info(StreamDesc *s) { } #if _MSC_VER /* standard error stream should never be buffered */ - else if (StdErrStream == s - Stream) { - setvbuf(s->u.file.file, NULL, _IONBF, 0); + else if (StdErrStream == s - GLOBAL_Stream) { + setvbuf(s->file, NULL, _IONBF, 0); } #endif s->status |= Seekable_Stream_f; @@ -268,8 +266,9 @@ static void unix_upd_stream_info(StreamDesc *s) { s->status |= Seekable_Stream_f; } + static void InitFileIO(StreamDesc *s) { - CACHE_REGS + CACHE_REGS if (s->status & Socket_Stream_f) { /* Console is a socket and socket will prompt */ Yap_ConsoleSocketOps(s); @@ -588,7 +587,7 @@ int ResetEOF(StreamDesc *s) { } else { s->stream_getc = PlGetc; Yap_DefaultStreamOps(s); - } + } /* next, reset our own error indicator */ s->status &= ~Eof_Stream_f; /* try reading again */ @@ -645,9 +644,9 @@ int console_post_process_eof(StreamDesc *s) { } /* check if we read a newline or an EOF */ -int post_process_read_wchar(int ch, ssize_t n, StreamDesc *s) { +int post_process_read_wchar(int ch, size_t n, StreamDesc *s) { if (ch == EOF) { - return post_process_weof(s); + return post_process_weof(s); } s->charcount += n; s->linepos += n; @@ -661,6 +660,7 @@ int post_process_read_wchar(int ch, ssize_t n, StreamDesc *s) { return ch; } + int post_process_weof(StreamDesc *s) { if (!ResetEOF(s)) { s->status |= Eof_Stream_f; @@ -692,451 +692,458 @@ int PlGetc(int sno) { return fgetc(s->file); } -// layered version -static int get_wchar__(int sno) { return fgetwc(GLOBAL_Stream[sno].file); } -static int get_wchar_from_file(int sno) { - return post_process_read_wchar(get_wchar__(sno), 1, GLOBAL_Stream + sno); -} + // layered version + static int get_wchar__(int sno) { return fgetwc(GLOBAL_Stream[sno].file); } + + static int get_wchar_from_file(int sno) { + return post_process_read_wchar(get_wchar__(sno), 1, GLOBAL_Stream + sno); + } #ifndef MB_LEN_MAX #define MB_LEN_MAX 6 #endif -static int handle_write_encoding_error(int sno, wchar_t ch) { - if (GLOBAL_Stream[sno].status & RepError_Xml_f) { - /* use HTML/XML encoding in ASCII */ - int i = ch, digits = 1; - GLOBAL_Stream[sno].stream_putc(sno, '&'); - GLOBAL_Stream[sno].stream_putc(sno, '#'); - while (digits < i) - digits *= 10; - if (digits > i) - digits /= 10; - while (i) { - GLOBAL_Stream[sno].stream_putc(sno, i / digits); - i %= 10; - digits /= 10; - } - GLOBAL_Stream[sno].stream_putc(sno, ';'); - return ch; - } else if (GLOBAL_Stream[sno].status & RepError_Prolog_f) { - /* write quoted */ - GLOBAL_Stream[sno].stream_putc(sno, '\\'); - GLOBAL_Stream[sno].stream_putc(sno, 'u'); - GLOBAL_Stream[sno].stream_putc(sno, ch >> 24); - GLOBAL_Stream[sno].stream_putc(sno, 256 & (ch >> 16)); - GLOBAL_Stream[sno].stream_putc(sno, 256 & (ch >> 8)); - GLOBAL_Stream[sno].stream_putc(sno, 256 & ch); - return ch; - } else { - CACHE_REGS - Yap_Error(REPRESENTATION_ERROR_CHARACTER, MkIntegerTerm(ch), - "charater %ld cannot be encoded in stream %d", - (unsigned long int)ch, sno); - return -1; - } -} - -int put_wchar(int sno, wchar_t ch) { - /* pass the bucck if we can */ - switch (GLOBAL_Stream[sno].encoding) { - case ENC_OCTET: - return GLOBAL_Stream[sno].stream_putc(sno, ch); - case ENC_ISO_LATIN1: - if (ch >= 0xff) { - return handle_write_encoding_error(sno, ch); - } - return GLOBAL_Stream[sno].stream_putc(sno, ch); - case ENC_ISO_ASCII: - if (ch >= 0x80) { - return handle_write_encoding_error(sno, ch); - } - return GLOBAL_Stream[sno].stream_putc(sno, ch); - case ENC_ISO_ANSI: { - char buf[MB_LEN_MAX]; - mbstate_t mbstate; - int n; - - memset((void *)&mbstate, 0, sizeof(mbstate_t)); - if ((n = wcrtomb(buf, ch, &mbstate)) < 0) { - /* error */ - GLOBAL_Stream[sno].stream_putc(sno, ch); - return -1; - } else { - int i; - - for (i = 0; i < n; i++) { - GLOBAL_Stream[sno].stream_putc(sno, buf[i]); + static int handle_write_encoding_error(int sno, wchar_t ch) { + if (GLOBAL_Stream[sno].status & RepError_Xml_f) { + /* use HTML/XML encoding in ASCII */ + int i = ch, digits = 1; + GLOBAL_Stream[sno].stream_putc(sno, '&'); + GLOBAL_Stream[sno].stream_putc(sno, '#'); + while (digits < i) + digits *= 10; + if (digits > i) + digits /= 10; + while (i) { + GLOBAL_Stream[sno].stream_putc(sno, i / digits); + i %= 10; + digits /= 10; + } + GLOBAL_Stream[sno].stream_putc(sno, ';'); + return ch; + } else if (GLOBAL_Stream[sno].status & RepError_Prolog_f) { + /* write quoted */ + GLOBAL_Stream[sno].stream_putc(sno, '\\'); + GLOBAL_Stream[sno].stream_putc(sno, 'u'); + GLOBAL_Stream[sno].stream_putc(sno, ch >> 24); + GLOBAL_Stream[sno].stream_putc(sno, 256 & (ch >> 16)); + GLOBAL_Stream[sno].stream_putc(sno, 256 & (ch >> 8)); + GLOBAL_Stream[sno].stream_putc(sno, 256 & ch); + return ch; + } else { + CACHE_REGS + Yap_Error(REPRESENTATION_ERROR_CHARACTER, MkIntegerTerm(ch), + "charater %ld cannot be encoded in stream %d", + (unsigned long int)ch, sno); + return -1; } - return ch; } - case ENC_ISO_UTF8: - if (ch < 0x80) { - GLOBAL_Stream[sno].stream_putc(sno, ch); - } else if (ch < 0x800) { - GLOBAL_Stream[sno].stream_putc(sno, 0xC0 | ch >> 6); - GLOBAL_Stream[sno].stream_putc(sno, 0x80 | (ch & 0x3F)); - } else if (ch < 0x10000) { - GLOBAL_Stream[sno].stream_putc(sno, 0xE0 | ch >> 12); - GLOBAL_Stream[sno].stream_putc(sno, 0x80 | (ch >> 6 & 0x3F)); - GLOBAL_Stream[sno].stream_putc(sno, 0x80 | (ch & 0x3F)); - } else if (ch < 0x200000) { - GLOBAL_Stream[sno].stream_putc(sno, 0xF0 | ch >> 18); - GLOBAL_Stream[sno].stream_putc(sno, 0x80 | (ch >> 12 & 0x3F)); - GLOBAL_Stream[sno].stream_putc(sno, 0x80 | (ch >> 6 & 0x3F)); - GLOBAL_Stream[sno].stream_putc(sno, 0x80 | (ch & 0x3F)); - } else { - /* should never happen */ + + int put_wchar(int sno, wchar_t ch) { + /* pass the bucck if we can */ + switch (GLOBAL_Stream[sno].encoding) { + case ENC_OCTET: + return GLOBAL_Stream[sno].stream_putc(sno, ch); + case ENC_ISO_LATIN1: + if (ch >= 0xff) { + return handle_write_encoding_error(sno, ch); + } + return GLOBAL_Stream[sno].stream_putc(sno, ch); + case ENC_ISO_ASCII: + if (ch >= 0x80) { + return handle_write_encoding_error(sno, ch); + } + return GLOBAL_Stream[sno].stream_putc(sno, ch); + case ENC_ISO_ANSI: { + char buf[MB_LEN_MAX]; + mbstate_t mbstate; + int n; + + memset((void *)&mbstate, 0, sizeof(mbstate_t)); + if ((n = wcrtomb(buf, ch, &mbstate)) < 0) { + /* error */ + GLOBAL_Stream[sno].stream_putc(sno, ch); + return -1; + } else { + int i; + + for (i = 0; i < n; i++) { + GLOBAL_Stream[sno].stream_putc(sno, buf[i]); + } + return ch; + } + case ENC_ISO_UTF8: + if (ch < 0x80) { + GLOBAL_Stream[sno].stream_putc(sno, ch); + } else if (ch < 0x800) { + GLOBAL_Stream[sno].stream_putc(sno, 0xC0 | ch >> 6); + GLOBAL_Stream[sno].stream_putc(sno, 0x80 | (ch & 0x3F)); + } else if (ch < 0x10000) { + GLOBAL_Stream[sno].stream_putc(sno, 0xE0 | ch >> 12); + GLOBAL_Stream[sno].stream_putc(sno, 0x80 | (ch >> 6 & 0x3F)); + GLOBAL_Stream[sno].stream_putc(sno, 0x80 | (ch & 0x3F)); + } else if (ch < 0x200000) { + GLOBAL_Stream[sno].stream_putc(sno, 0xF0 | ch >> 18); + GLOBAL_Stream[sno].stream_putc(sno, 0x80 | (ch >> 12 & 0x3F)); + GLOBAL_Stream[sno].stream_putc(sno, 0x80 | (ch >> 6 & 0x3F)); + GLOBAL_Stream[sno].stream_putc(sno, 0x80 | (ch & 0x3F)); + } else { + /* should never happen */ + return -1; + } + return ch; + break; + case ENC_UTF16_LE: + { + if (ch < 0x10000) { + GLOBAL_Stream[sno].stream_putc(sno, (ch & 0xff)); + GLOBAL_Stream[sno].stream_putc(sno, (ch >> 8)); + } else { + // computations + uint16_t ich = ch; + uint16_t lead = LEAD_OFFSET + (ich >> 10); + uint16_t trail = 0xDC00 + (ich & 0x3FF); + + GLOBAL_Stream[sno].stream_putc(sno, (trail & 0xff)); + GLOBAL_Stream[sno].stream_putc(sno, (trail >> 8)); + GLOBAL_Stream[sno].stream_putc(sno, (lead & 0xff)); + GLOBAL_Stream[sno].stream_putc(sno, (lead >> 8)); + } + return ch; + } + case ENC_UTF16_BE: + { + // computations + if (ch < 0x10000) { + GLOBAL_Stream[sno].stream_putc(sno, (ch >> 8)); + GLOBAL_Stream[sno].stream_putc(sno, (ch & 0xff)); + } else { + uint16_t lead = (uint16_t)LEAD_OFFSET + ((uint16_t)ch >> 10); + uint16_t trail = 0xDC00 + ((uint16_t)ch & 0x3FF); + + GLOBAL_Stream[sno].stream_putc(sno, (lead >> 8)); + GLOBAL_Stream[sno].stream_putc(sno, (lead & 0xff)); + GLOBAL_Stream[sno].stream_putc(sno, (trail >> 8)); + GLOBAL_Stream[sno].stream_putc(sno, (trail & 0xff)); + + } + return ch; + } + case ENC_UCS2_LE: + { + if (ch >= 0x10000) { + return 0; + } + GLOBAL_Stream[sno].stream_putc(sno, (ch & 0xff)); + GLOBAL_Stream[sno].stream_putc(sno, (ch >> 8)); + return ch; + } + case ENC_UCS2_BE: + { + // computations + if (ch < 0x10000) { + GLOBAL_Stream[sno].stream_putc(sno, (ch >> 8)); + GLOBAL_Stream[sno].stream_putc(sno, (ch & 0xff)); + return ch; + } else { + return 0; + } + } + + case ENC_ISO_UTF32_BE: + GLOBAL_Stream[sno].stream_putc(sno, (ch >> 24) & 0xff); + GLOBAL_Stream[sno].stream_putc(sno, (ch >> 16) & 0xff); + GLOBAL_Stream[sno].stream_putc(sno, (ch >> 8) & 0xff); + GLOBAL_Stream[sno].stream_putc(sno, ch & 0xff); + return ch; + case ENC_ISO_UTF32_LE: + GLOBAL_Stream[sno].stream_putc(sno, ch & 0xff); + GLOBAL_Stream[sno].stream_putc(sno, (ch >> 8) & 0xff); + GLOBAL_Stream[sno].stream_putc(sno, (ch >> 16) & 0xff); + GLOBAL_Stream[sno].stream_putc(sno, (ch >> 24) & 0xff); + return ch; + } + } return -1; } - return ch; - break; - case ENC_UTF16_LE: { - if (ch < 0x10000) { - GLOBAL_Stream[sno].stream_putc(sno, (ch & 0xff)); - GLOBAL_Stream[sno].stream_putc(sno, (ch >> 8)); - } else { - // computations - uint16_t ich = ch; - uint16_t lead = LEAD_OFFSET + (ich >> 10); - uint16_t trail = 0xDC00 + (ich & 0x3FF); - GLOBAL_Stream[sno].stream_putc(sno, (trail & 0xff)); - GLOBAL_Stream[sno].stream_putc(sno, (trail >> 8)); - GLOBAL_Stream[sno].stream_putc(sno, (lead & 0xff)); - GLOBAL_Stream[sno].stream_putc(sno, (lead >> 8)); + /* used by user-code to read characters from the current input stream */ + int Yap_PlGetchar(void) { + CACHE_REGS + return (GLOBAL_Stream[LOCAL_c_input_stream].stream_getc( + LOCAL_c_input_stream)); } - return ch; - } - case ENC_UTF16_BE: { - // computations - if (ch < 0x10000) { - GLOBAL_Stream[sno].stream_putc(sno, (ch >> 8)); - GLOBAL_Stream[sno].stream_putc(sno, (ch & 0xff)); - } else { - uint16_t lead = (uint16_t)LEAD_OFFSET + ((uint16_t)ch >> 10); - uint16_t trail = 0xDC00 + ((uint16_t)ch & 0x3FF); - GLOBAL_Stream[sno].stream_putc(sno, (lead >> 8)); - GLOBAL_Stream[sno].stream_putc(sno, (lead & 0xff)); - GLOBAL_Stream[sno].stream_putc(sno, (trail >> 8)); - GLOBAL_Stream[sno].stream_putc(sno, (trail & 0xff)); + int Yap_PlGetWchar(void) { + CACHE_REGS + return get_wchar(LOCAL_c_input_stream); } - return ch; - } - case ENC_UCS2_LE: { - if (ch >= 0x10000) { - return 0; + + /* avoid using a variable to call a function */ + int Yap_PlFGetchar(void) { + CACHE_REGS + return (PlGetc(LOCAL_c_input_stream)); } - GLOBAL_Stream[sno].stream_putc(sno, (ch & 0xff)); - GLOBAL_Stream[sno].stream_putc(sno, (ch >> 8)); - return ch; - } - case ENC_UCS2_BE: { - // computations - if (ch < 0x10000) { - GLOBAL_Stream[sno].stream_putc(sno, (ch >> 8)); - GLOBAL_Stream[sno].stream_putc(sno, (ch & 0xff)); - return ch; - } else { - return 0; + + Term Yap_MkStream(int n) { + Term t[1]; + t[0] = MkIntTerm(n); + return (Yap_MkApplTerm(FunctorStream, 1, t)); } - } - case ENC_ISO_UTF32_BE: - GLOBAL_Stream[sno].stream_putc(sno, (ch >> 24) & 0xff); - GLOBAL_Stream[sno].stream_putc(sno, (ch >> 16) & 0xff); - GLOBAL_Stream[sno].stream_putc(sno, (ch >> 8) & 0xff); - GLOBAL_Stream[sno].stream_putc(sno, ch & 0xff); - return ch; - case ENC_ISO_UTF32_LE: - GLOBAL_Stream[sno].stream_putc(sno, ch & 0xff); - GLOBAL_Stream[sno].stream_putc(sno, (ch >> 8) & 0xff); - GLOBAL_Stream[sno].stream_putc(sno, (ch >> 16) & 0xff); - GLOBAL_Stream[sno].stream_putc(sno, (ch >> 24) & 0xff); - return ch; - } - } - return -1; -} - -/* used by user-code to read characters from the current input stream */ -int Yap_PlGetchar(void) { - CACHE_REGS - return ( - GLOBAL_Stream[LOCAL_c_input_stream].stream_getc(LOCAL_c_input_stream)); -} - -int Yap_PlGetWchar(void) { - CACHE_REGS - return get_wchar(LOCAL_c_input_stream); -} - -/* avoid using a variable to call a function */ -int Yap_PlFGetchar(void) { - CACHE_REGS - return (PlGetc(LOCAL_c_input_stream)); -} - -Term Yap_MkStream(int n) { - Term t[1]; - t[0] = MkIntTerm(n); - return (Yap_MkApplTerm(FunctorStream, 1, t)); -} - -/* given a stream index, get the corresponding fd */ -Int GetStreamFd(int sno) { + /* given a stream index, get the corresponding fd */ + Int GetStreamFd(int sno) { #if HAVE_SOCKET - if (GLOBAL_Stream[sno].status & Socket_Stream_f) { - return (GLOBAL_Stream[sno].u.socket.fd); - } else + if (GLOBAL_Stream[sno].status & Socket_Stream_f) { + return (GLOBAL_Stream[sno].u.socket.fd); + } else #endif - if (GLOBAL_Stream[sno].status & Pipe_Stream_f) { - return (GLOBAL_Stream[sno].u.pipe.fd); - } else if (GLOBAL_Stream[sno].status & InMemory_Stream_f) { - return (-1); - } - return (fileno(GLOBAL_Stream[sno].file)); -} + if (GLOBAL_Stream[sno].status & Pipe_Stream_f) { + return (GLOBAL_Stream[sno].u.pipe.fd); + } else if (GLOBAL_Stream[sno].status & InMemory_Stream_f) { + return (-1); + } + return (fileno(GLOBAL_Stream[sno].file)); + } -Int Yap_GetStreamFd(int sno) { return GetStreamFd(sno); } + Int Yap_GetStreamFd(int sno) { return GetStreamFd(sno); } -static int binary_file(const char *file_name) { + static int binary_file(const char *file_name) { #if HAVE_STAT #if _MSC_VER || defined(__MINGW32__) - struct _stat ss; - if (_stat(file_name, &ss) != 0) + struct _stat ss; + if (_stat(file_name, &ss) != 0) #else - struct stat ss; - if (stat(file_name, &ss) != 0) + struct stat ss; + if (stat(file_name, &ss) != 0) #endif - { - /* ignore errors while checking a file */ - return (FALSE); - } - return (S_ISDIR(ss.st_mode)); + { + /* ignore errors while checking a file */ + return (FALSE); + } + return (S_ISDIR(ss.st_mode)); #else - return (FALSE); + return (FALSE); #endif -} + } -static int write_bom(int sno, StreamDesc *st) { - /* dump encoding */ - switch (st->encoding) { - case ENC_ISO_UTF8: - if (st->stream_putc(sno, 0xEF) < 0) - return false; - if (st->stream_putc(sno, 0xBB) < 0) - return false; - if (st->stream_putc(sno, 0xBF) < 0) - return false; - st->status |= HAS_BOM_f; - return true; - case ENC_UTF16_BE: - case ENC_UCS2_BE: - if (st->stream_putc(sno, 0xFE) < 0) - return false; - if (st->stream_putc(sno, 0xFF) < 0) - return false; - st->status |= HAS_BOM_f; - return true; - case ENC_UTF16_LE: - case ENC_UCS2_LE: - if (st->stream_putc(sno, 0xFF) < 0) - return false; - if (st->stream_putc(sno, 0xFE) < 0) - return false; - st->status |= HAS_BOM_f; - return true; - case ENC_ISO_UTF32_BE: - if (st->stream_putc(sno, 0x00) < 0) - return false; - if (st->stream_putc(sno, 0x00) < 0) - return false; - if (st->stream_putc(sno, 0xFE) < 0) - return false; - if (st->stream_putc(sno, 0xFF) < 0) - return false; - st->status |= HAS_BOM_f; - return true; - case ENC_ISO_UTF32_LE: - if (st->stream_putc(sno, 0xFF) < 0) - return false; - if (st->stream_putc(sno, 0xFE) < 0) - return false; - if (st->stream_putc(sno, 0x00) < 0) - return false; - if (st->stream_putc(sno, 0x00) < 0) - return false; - st->status |= HAS_BOM_f; - return true; - default: - return true; - } -} + static int write_bom(int sno, StreamDesc *st) { + /* dump encoding */ + switch (st->encoding) { + case ENC_ISO_UTF8: + if (st->stream_putc(sno, 0xEF) < 0) + return false; + if (st->stream_putc(sno, 0xBB) < 0) + return false; + if (st->stream_putc(sno, 0xBF) < 0) + return false; + st->status |= HAS_BOM_f; + return true; + case ENC_UTF16_BE: + case ENC_UCS2_BE: + if (st->stream_putc(sno, 0xFE) < 0) + return false; + if (st->stream_putc(sno, 0xFF) < 0) + return false; + st->status |= HAS_BOM_f; + return true; + case ENC_UTF16_LE: + case ENC_UCS2_LE: + if (st->stream_putc(sno, 0xFF) < 0) + return false; + if (st->stream_putc(sno, 0xFE) < 0) + return false; + st->status |= HAS_BOM_f; + return true; + case ENC_ISO_UTF32_BE: + if (st->stream_putc(sno, 0x00) < 0) + return false; + if (st->stream_putc(sno, 0x00) < 0) + return false; + if (st->stream_putc(sno, 0xFE) < 0) + return false; + if (st->stream_putc(sno, 0xFF) < 0) + return false; + st->status |= HAS_BOM_f; + return true; + case ENC_ISO_UTF32_LE: + if (st->stream_putc(sno, 0xFF) < 0) + return false; + if (st->stream_putc(sno, 0xFE) < 0) + return false; + if (st->stream_putc(sno, 0x00) < 0) + return false; + if (st->stream_putc(sno, 0x00) < 0) + return false; + st->status |= HAS_BOM_f; + return true; + default: + return true; + } + } -static void check_bom(int sno, StreamDesc *st) { - int ch1, ch2, ch3, ch4; + static void check_bom(int sno, StreamDesc *st) { + int ch1, ch2, ch3, ch4; - ch1 = fgetc(st->file); - switch (ch1) { - case 0x00: { - ch2 = fgetc(st->file); - if (ch2 != 0x00) { - ungetc(ch1, st->file); - ungetc(ch2, st->file); - return; - } else { - ch3 = fgetc(st->file); - if (ch3 == EOFCHAR || ch3 != 0xFE) { - ungetc(ch1, st->file); - ungetc(ch2, st->file); - ungetc(ch3, st->file); - return; - } else { - ch4 = fgetc(st->file); - if (ch4 == EOFCHAR || ch3 != 0xFF) { + ch1 = fgetc(st->file); + switch (ch1) { + case 0x00: { + ch2 = fgetc(st->file); + if (ch2 != 0x00) { + ungetc(ch1, st->file); + ungetc(ch2, st->file); + return; + } else { + ch3 = fgetc(st->file); + if (ch3 == EOFCHAR || ch3 != 0xFE) { + ungetc(ch1, st->file); + ungetc(ch2, st->file); + ungetc(ch3, st->file); + return; + } else { + ch4 = fgetc(st->file); + if (ch4 == EOFCHAR || ch3 != 0xFF) { + ungetc(ch1, st->file); + ungetc(ch2, st->file); + ungetc(ch3, st->file); + ungetc(ch4, st->file); + return; + } else { + st->status |= HAS_BOM_f; + st->encoding = ENC_ISO_UTF32_BE; + return; + } + } + } + } + case 0xFE: { + ch2 = fgetc(st->file); + if (ch2 != 0xFF) { ungetc(ch1, st->file); ungetc(ch2, st->file); - ungetc(ch3, st->file); - ungetc(ch4, st->file); return; } else { st->status |= HAS_BOM_f; - st->encoding = ENC_ISO_UTF32_BE; + st->encoding = ENC_UTF16_BE; return; } } - } - } - case 0xFE: { - ch2 = fgetc(st->file); - if (ch2 != 0xFF) { - ungetc(ch1, st->file); - ungetc(ch2, st->file); - return; - } else { - st->status |= HAS_BOM_f; - st->encoding = ENC_UTF16_BE; - return; - } - } - case 0xFF: { - ch2 = fgetc(st->file); - if (ch2 != 0xFE) { - ungetc(ch1, st->file); - ungetc(ch2, st->file); - return; - } else { - ch3 = fgetc(st->file); - if (ch3 != 0x00) { - ungetc(ch3, st->file); - } else { - ch4 = fgetc(st->file); - if (ch4 == 0x00) { - st->status |= HAS_BOM_f; - st->encoding = ENC_ISO_UTF32_LE; + case 0xFF: { + ch2 = fgetc(st->file); + if (ch2 != 0xFE) { + ungetc(ch1, st->file); + ungetc(ch2, st->file); return; } else { - ungetc(ch4, st->file); - ungetc(0x00, st->file); + ch3 = fgetc(st->file); + if (ch3 != 0x00) { + ungetc(ch3, st->file); + } else { + ch4 = fgetc(st->file); + if (ch4 == 0x00) { + st->status |= HAS_BOM_f; + st->encoding = ENC_ISO_UTF32_LE; + return; + } else { + ungetc(ch4, st->file); + ungetc(0x00, st->file); + } + } } - } - } - st->status |= HAS_BOM_f; - st->encoding = ENC_UTF16_LE; - return; - } - case 0xEF: - ch2 = fgetc(st->file); - if (ch2 != 0xBB) { - ungetc(ch1, st->file); - ungetc(ch2, st->file); - return; - } else { - ch3 = fgetc(st->file); - if (ch3 != 0xBF) { - ungetc(ch1, st->file); - ungetc(ch2, st->file); - ungetc(ch3, st->file); - return; - } else { st->status |= HAS_BOM_f; - st->encoding = ENC_ISO_UTF8; + st->encoding = ENC_UTF16_LE; return; } + case 0xEF: + ch2 = fgetc(st->file); + if (ch2 != 0xBB) { + ungetc(ch1, st->file); + ungetc(ch2, st->file); + return; + } else { + ch3 = fgetc(st->file); + if (ch3 != 0xBF) { + ungetc(ch1, st->file); + ungetc(ch2, st->file); + ungetc(ch3, st->file); + return; + } else { + st->status |= HAS_BOM_f; + st->encoding = ENC_ISO_UTF8; + return; + } + } + default: + ungetc(ch1, st->file); + } } - default: - ungetc(ch1, st->file); - } -} -bool Yap_initStream(int sno, FILE *fd, const char *name, Term file_name, - encoding_t encoding, stream_flags_t flags, Atom open_mode) { - StreamDesc *st = &GLOBAL_Stream[sno]; - st->status = flags; + bool Yap_initStream(int sno, FILE *fd, const char *name, Term file_name, + encoding_t encoding, stream_flags_t flags, + Atom open_mode) { + StreamDesc *st = &GLOBAL_Stream[sno]; + st->status = flags; - st->charcount = 0; - st->linecount = 1; - if (flags & Binary_Stream_f) { - st->encoding = ENC_OCTET; - } else { - st->encoding = encoding; - } + st->charcount = 0; + st->linecount = 1; + if (flags & Binary_Stream_f) { + st->encoding = ENC_OCTET; + } else { + st->encoding = encoding; + } - if (name == NULL) { - char buf[YAP_FILENAME_MAX + 1]; - name = Yap_guessFileName(fileno(fd), sno, buf, YAP_FILENAME_MAX); - if (name) - st->name = Yap_LookupAtom(name); - } - st->user_name = file_name; - st->file = fd; - st->linepos = 0; - if (flags & Pipe_Stream_f) { - Yap_PipeOps(st); - Yap_DefaultStreamOps(st); - } else if (flags & Tty_Stream_f) { - Yap_ConsoleOps(st, false); - Yap_DefaultStreamOps(st); - } else { - st->stream_putc = FilePutc; - st->stream_getc = PlGetc; - unix_upd_stream_info(st); - Yap_DefaultStreamOps(st); - } - return true; -} - -static bool open_header(int sno, Atom open_mode) { - if (open_mode == AtomWrite) { - const char *ptr; - const char s[] = "#!"; - int ch; - - ptr = s; - while ((ch = *ptr++)) - GLOBAL_Stream[sno].stream_wputc(sno, ch); - const char *b = Yap_FindExecutable(); - ptr = b; - while ((ch = *ptr++)) - GLOBAL_Stream[sno].stream_wputc(sno, ch); - const char *l = " -L --\n\n YAP script\n#\n# .\n"; - ptr = l; - while ((ch = *ptr++)) - GLOBAL_Stream[sno].stream_wputc(sno, ch); - - } else if (open_mode == AtomRead) { - // skip header - int ch; - while ((ch = Yap_peek(sno)) == '#') { - while ((ch = GLOBAL_Stream[sno].stream_wgetc(sno)) != 10 && ch != -1) - ; + if (name == NULL) { + char buf[YAP_FILENAME_MAX + 1]; + name = Yap_guessFileName(fileno(fd), sno, buf, YAP_FILENAME_MAX); + if (name) + st->name = Yap_LookupAtom(name); + } + st->user_name = file_name; + st->file = fd; + st->linepos = 0; + if (flags & Pipe_Stream_f) { + Yap_PipeOps(st); + Yap_DefaultStreamOps(st); + } else if (flags & Tty_Stream_f) { + Yap_ConsoleOps(st, false); + Yap_DefaultStreamOps(st); + } else { + st->stream_putc = FilePutc; + st->stream_getc = PlGetc; + unix_upd_stream_info(st); + Yap_DefaultStreamOps(st); + } + return true; + } + + static bool open_header(int sno, Atom open_mode) { + if (open_mode == AtomWrite) { + const char *ptr; + const char s[] = "#!"; + int ch; + + ptr = s; + while ((ch = *ptr++)) + GLOBAL_Stream[sno].stream_wputc(sno, ch); + const char *b = Yap_FindExecutable(); + ptr = b; + while ((ch = *ptr++)) + GLOBAL_Stream[sno].stream_wputc(sno, ch); + const char *l = " -L --\n\n YAP script\n#\n# .\n"; + ptr = l; + while ((ch = *ptr++)) + GLOBAL_Stream[sno].stream_wputc(sno, ch); + + } else if (open_mode == AtomRead) { + // skip header + int ch; + while ((ch = Yap_peek(sno)) == '#') { + while ((ch = GLOBAL_Stream[sno].stream_wgetc(sno)) != 10 && ch != -1) + ; + } + } + return true; } - } - return true; -} #define OPEN_DEFS() \ PAR("alias", isatom, OPEN_ALIAS), PAR("bom", booleanFlag, OPEN_BOM), \ @@ -1155,595 +1162,603 @@ static bool open_header(int sno, Atom open_mode) { PAR("wait", booleanFlag, OPEN_WAIT), PAR(NULL, ok, OPEN_END) #define PAR(x, y, z) z -typedef enum open_enum_choices { OPEN_DEFS() } open_choices_t; + typedef enum open_enum_choices { OPEN_DEFS() } open_choices_t; #undef PAR #define PAR(x, y, z) \ { x, y, z } -static const param_t open_defs[] = {OPEN_DEFS()}; + static const param_t open_defs[] = {OPEN_DEFS()}; #undef PAR -static Int -do_open(Term file_name, Term t2, + static Int do_open( + Term file_name, Term t2, Term tlist USES_REGS) { /* '$open'(+File,+Mode,?Stream,-ReturnCode) */ - Atom open_mode; - int sno; - SMALLUNSGN s; - char io_mode[8]; - StreamDesc *st; - bool avoid_bom = false, needs_bom = false; - const char *fname; - stream_flags_t flags; - FILE *fd; - const char *s_encoding; - encoding_t encoding; - Term tenc; + Atom open_mode; + int sno; + SMALLUNSGN s; + char io_mode[8]; + StreamDesc *st; + bool avoid_bom = false, needs_bom = false; + const char *fname; + stream_flags_t flags; + FILE *fd; + const char *s_encoding; + encoding_t encoding; + Term tenc; - // original file name - if (IsVarTerm(file_name)) { - Yap_Error(INSTANTIATION_ERROR, file_name, "open/3"); - return FALSE; - } - if (!IsAtomTerm(file_name)) { - if (IsStringTerm(file_name)) { - fname = (char *)StringOfTerm(file_name); - } else { - Yap_Error(DOMAIN_ERROR_SOURCE_SINK, file_name, "open/3"); - return FALSE; - } - } else { - fname = RepAtom(AtomOfTerm(file_name))->StrOfAE; - } - // open mode - if (IsVarTerm(t2)) { - Yap_Error(INSTANTIATION_ERROR, t2, "open/3"); - return FALSE; - } - if (!IsAtomTerm(t2)) { - if (IsStringTerm(t2)) { - open_mode = Yap_LookupAtom(StringOfTerm(t2)); - } else { - Yap_Error(TYPE_ERROR_ATOM, t2, "open/3"); - return (FALSE); - } - } else { - open_mode = AtomOfTerm(t2); - } - // read, write, append - if (open_mode == AtomRead) { - strncpy(io_mode, "rb", 8); - s = Input_Stream_f; - } else if (open_mode == AtomWrite) { - strncpy(io_mode, "w", 8); - s = Output_Stream_f; - } else if (open_mode == AtomAppend) { - strncpy(io_mode, "a", 8); - s = Append_Stream_f | Output_Stream_f; - } else { - Yap_Error(DOMAIN_ERROR_IO_MODE, t2, "open/3"); - return (FALSE); - } - /* get options */ - xarg *args = Yap_ArgListToVector(tlist, open_defs, OPEN_END); - if (args == NULL) { - if (LOCAL_Error_TYPE != YAP_NO_ERROR) { - if (LOCAL_Error_TYPE == DOMAIN_ERROR_PROLOG_FLAG) - LOCAL_Error_TYPE = DOMAIN_ERROR_OPEN_OPTION; - Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, - "option handling in open/3"); - } - return false; - } - /* done */ - sno = GetFreeStreamD(); - if (sno < 0) - return PlIOError(RESOURCE_ERROR_MAX_STREAMS, TermNil, "open/3"); - st = &GLOBAL_Stream[sno]; - st->user_name = file_name; - flags = s; - // user requested encoding? - if (args[OPEN_ALIAS].used) { - Atom al = AtomOfTerm(args[OPEN_ALIAS].tvalue); - if (!Yap_AddAlias(al, sno)) - return false; - } - if (args[OPEN_ENCODING].used) { - tenc = args[OPEN_ENCODING].tvalue; - s_encoding = RepAtom(AtomOfTerm(tenc))->StrOfAE; - } else { - s_encoding = "default"; - } - // default encoding, no bom yet - encoding = enc_id(s_encoding, ENC_OCTET); - // only set encoding after getting BOM - bool ok = (args[OPEN_EXPAND_FILENAME].used - ? args[OPEN_EXPAND_FILENAME].tvalue == TermTrue - : false) || - trueGlobalPrologFlag(OPEN_EXPANDS_FILENAME_FLAG); - // expand file name? - fname = Yap_AbsoluteFile(fname, ok); - if (fname) { - st->name = Yap_LookupAtom(fname); - } else { - PlIOError(EXISTENCE_ERROR_SOURCE_SINK, ARG1, NULL); - } + // original file name + if (IsVarTerm(file_name)) { + Yap_Error(INSTANTIATION_ERROR, file_name, "open/3"); + return FALSE; + } + if (!IsAtomTerm(file_name)) { + if (IsStringTerm(file_name)) { + fname = (char *)StringOfTerm(file_name); + } else { + Yap_Error(DOMAIN_ERROR_SOURCE_SINK, file_name, "open/3"); + return FALSE; + } + } else { + fname = RepAtom(AtomOfTerm(file_name))->StrOfAE; + } + // open mode + if (IsVarTerm(t2)) { + Yap_Error(INSTANTIATION_ERROR, t2, "open/3"); + return FALSE; + } + if (!IsAtomTerm(t2)) { + if (IsStringTerm(t2)) { + open_mode = Yap_LookupAtom(StringOfTerm(t2)); + } else { + Yap_Error(TYPE_ERROR_ATOM, t2, "open/3"); + return (FALSE); + } + } else { + open_mode = AtomOfTerm(t2); + } + // read, write, append + if (open_mode == AtomRead) { + strncpy(io_mode, "rb", 8); + s = Input_Stream_f; + } else if (open_mode == AtomWrite) { + strncpy(io_mode, "w", 8); + s = Output_Stream_f; + } else if (open_mode == AtomAppend) { + strncpy(io_mode, "a", 8); + s = Append_Stream_f | Output_Stream_f; + } else { + Yap_Error(DOMAIN_ERROR_IO_MODE, t2, "open/3"); + return (FALSE); + } + /* get options */ + xarg *args = Yap_ArgListToVector(tlist, open_defs, OPEN_END); + if (args == NULL) { + if (LOCAL_Error_TYPE != YAP_NO_ERROR) { + if (LOCAL_Error_TYPE == DOMAIN_ERROR_PROLOG_FLAG) + LOCAL_Error_TYPE = DOMAIN_ERROR_OPEN_OPTION; + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, + "option handling in open/3"); + } + return false; + } + /* done */ + sno = GetFreeStreamD(); + if (sno < 0) + return PlIOError(RESOURCE_ERROR_MAX_STREAMS, TermNil, "open/3"); + st = &GLOBAL_Stream[sno]; + st->user_name = file_name; + flags = s; + // user requested encoding? + if (args[OPEN_ALIAS].used) { + Atom al = AtomOfTerm(args[OPEN_ALIAS].tvalue); + if (!Yap_AddAlias(al, sno)) + return false; + } + if (args[OPEN_ENCODING].used) { + tenc = args[OPEN_ENCODING].tvalue; + s_encoding = RepAtom(AtomOfTerm(tenc))->StrOfAE; + } else { + s_encoding = "default"; + } + // default encoding, no bom yet + encoding = enc_id( s_encoding, ENC_OCTET); + // only set encoding after getting BOM + bool ok = (args[OPEN_EXPAND_FILENAME].used + ? args[OPEN_EXPAND_FILENAME].tvalue == TermTrue + : false) || + trueGlobalPrologFlag(OPEN_EXPANDS_FILENAME_FLAG); + // expand file name? + fname = Yap_AbsoluteFile(fname, ok); + if (fname) { + st->name = Yap_LookupAtom(fname); + } else { + PlIOError(EXISTENCE_ERROR_SOURCE_SINK, ARG1, NULL); + } - // Skip scripts that start with !#/.. or similar - bool script = - (args[OPEN_SCRIPT].used ? args[OPEN_SCRIPT].tvalue == TermTrue : false); - // binary type - if (args[OPEN_TYPE].used) { - Term t = args[OPEN_TYPE].tvalue; - bool bin = (t == TermBinary); - if (bin) { + // Skip scripts that start with !#/.. or similar + bool script = + (args[OPEN_SCRIPT].used ? args[OPEN_SCRIPT].tvalue == TermTrue + : false); + // binary type + if (args[OPEN_TYPE].used) { + Term t = args[OPEN_TYPE].tvalue; + bool bin = (t == TermBinary); + if (bin) { #ifdef _WIN32 - strncat(io_mode, "b", 8); + strncat(io_mode, "b", 8); #endif - flags |= Binary_Stream_f; - encoding = ENC_OCTET; - avoid_bom = true; - needs_bom = false; - } else if (t == TermText) { + flags |= Binary_Stream_f; + encoding = ENC_OCTET; + avoid_bom = true; + needs_bom = false; + } else if (t == TermText) { #ifdef _WIN32 - strncat(io_mode, "t", 8); + strncat(io_mode, "t", 8); #endif - /* note that this matters for UNICODE style conversions */ - } else { - Yap_Error(DOMAIN_ERROR_STREAM, tlist, - "type is ~a, must be one of binary or text", t); - } - } - // BOM mess - if (encoding == ENC_UTF16_BE || encoding == ENC_UTF16_LE || - encoding == ENC_UCS2_BE || encoding == ENC_UCS2_LE || - encoding == ENC_ISO_UTF32_BE || encoding == ENC_ISO_UTF32_LE) { - needs_bom = true; - } - if (args[OPEN_BOM].used) { - if (args[OPEN_BOM].tvalue == TermTrue) { - avoid_bom = false; - needs_bom = true; - } else if (args[OPEN_BOM].tvalue == TermFalse) { - avoid_bom = true; - needs_bom = false; - } - } - if (st - GLOBAL_Stream < 3) { - flags |= RepError_Prolog_f; - } - if ((fd = fopen(fname, io_mode)) == NULL || - (!(flags & Binary_Stream_f) && binary_file(fname))) { - strncpy(LOCAL_FileNameBuf, fname, MAXPATHLEN); - free((void *)fname); - fname = LOCAL_FileNameBuf; - UNLOCK(st->streamlock); - if (errno == ENOENT) - return (PlIOError(EXISTENCE_ERROR_SOURCE_SINK, file_name, "%s: %s", fname, - strerror(errno))); - else { - return (PlIOError(PERMISSION_ERROR_OPEN_SOURCE_SINK, file_name, "%s: %s", - fname, strerror(errno))); - } - } + /* note that this matters for UNICODE style conversions */ + } else { + Yap_Error(DOMAIN_ERROR_STREAM, tlist, + "type is ~a, must be one of binary or text", t); + } + } + // BOM mess + if (encoding == ENC_UTF16_BE || encoding == ENC_UTF16_LE || + encoding == ENC_UCS2_BE || encoding == ENC_UCS2_LE || + encoding == ENC_ISO_UTF32_BE || encoding == ENC_ISO_UTF32_LE) { + needs_bom = true; + } + if (args[OPEN_BOM].used) { + if (args[OPEN_BOM].tvalue == TermTrue) { + avoid_bom = false; + needs_bom = true; + } else if (args[OPEN_BOM].tvalue == TermFalse) { + avoid_bom = true; + needs_bom = false; + } + } + if (st - GLOBAL_Stream < 3) { + flags |= RepError_Prolog_f; + } + if ((fd = fopen(fname, io_mode)) == NULL || + (!(flags & Binary_Stream_f) && binary_file(fname))) { + strncpy(LOCAL_FileNameBuf, fname, MAXPATHLEN); + free((void *)fname); + fname = LOCAL_FileNameBuf; + UNLOCK(st->streamlock); + if (errno == ENOENT) + return (PlIOError(EXISTENCE_ERROR_SOURCE_SINK, file_name, "%s: %s", + fname, strerror(errno))); + else { + return (PlIOError(PERMISSION_ERROR_OPEN_SOURCE_SINK, file_name, + "%s: %s", fname, strerror(errno))); + } + } #if MAC - if (open_mode == AtomWrite) { - Yap_SetTextFile(RepAtom(AtomOfTerm(file_name))->StrOfAE); - } + if (open_mode == AtomWrite) { + Yap_SetTextFile(RepAtom(AtomOfTerm(file_name))->StrOfAE); + } #endif - flags &= ~(Free_Stream_f); - if (!Yap_initStream(sno, fd, fname, file_name, encoding, flags, open_mode)) - return false; - if (!Yap_initStream(sno, fd, fname, file_name, encoding, flags, open_mode)) - return false; - if (open_mode == AtomWrite) { - if (needs_bom && !write_bom(sno, st)) - return false; - } else if (open_mode == AtomRead && !avoid_bom) { - check_bom(sno, st); // can change encoding - } - // follow declaration unless there is v - if (st->status & HAS_BOM_f) - st->encoding = enc_id(s_encoding, st->encoding); - else - st->encoding = encoding; - Yap_DefaultStreamOps(st); - if (script) - open_header(sno, open_mode); + flags &= ~(Free_Stream_f); + if (!Yap_initStream(sno, fd, fname, file_name, encoding, flags, + open_mode)) + return false; + if (!Yap_initStream(sno, fd, fname, file_name, encoding, flags, + open_mode)) + return false; + if (open_mode == AtomWrite) { + if (needs_bom && !write_bom(sno, st)) + return false; + } else if (open_mode == AtomRead && !avoid_bom) { + check_bom(sno, st); // can change encoding + } + // follow declaration unless there is v + if (st->status & HAS_BOM_f) + st->encoding = enc_id( s_encoding, st->encoding); + else + st->encoding = encoding; + Yap_DefaultStreamOps( st); + if (script) + open_header(sno, open_mode); - UNLOCK(st->streamlock); - { - Term t = Yap_MkStream(sno); - return (Yap_unify(ARG3, t)); - } -} + UNLOCK(st->streamlock); + { + Term t = Yap_MkStream(sno); + return (Yap_unify(ARG3, t)); + } + } -/** @pred open(+ _F_,+ _M_,- _S_) is iso + /** @pred open(+ _F_,+ _M_,- _S_) is iso -Opens the file with name _F_ in mode _M_ (`read`, `write` or -`append`), returning _S_ unified with the stream name. + Opens the file with name _F_ in mode _M_ (`read`, `write` or + `append`), returning _S_ unified with the stream name. -Yap allows 64 streams opened at the same time. If you need more, - redefine the MaxStreams constant. Each stream is either an input or - an output stream but not both. There are always 3 open streams: - user_input for reading, user_output for writing and user_error for - writing. If there is no ambiguity, the atoms user_input and - user_output may be referred to as `user`. + Yap allows 64 streams opened at the same time. If you need more, + redefine the MaxStreams constant. Each stream is either an input or + an output stream but not both. There are always 3 open streams: + user_input for reading, user_output for writing and user_error for + writing. If there is no ambiguity, the atoms user_input and + user_output may be referred to as `user`. -The `file_errors` flag controls whether errors are reported when in -mode `read` or `append` the file _F_ does not exist or is not -readable, and whether in mode `write` or `append` the file is not -writable. + The `file_errors` flag controls whether errors are reported when in + mode `read` or `append` the file _F_ does not exist or is not + readable, and whether in mode `write` or `append` the file is not + writable. -*/ + */ -static Int open3(USES_REGS1) { /* '$open'(+File,+Mode,?Stream,-ReturnCode) */ - return do_open(Deref(ARG1), Deref(ARG2), TermNil PASS_REGS); -} + static Int open3( + USES_REGS1) { /* '$open'(+File,+Mode,?Stream,-ReturnCode) */ + return do_open(Deref(ARG1), Deref(ARG2), TermNil PASS_REGS); + } -/** @pred open(+ _F_,+ _M_,- _S_,+ _Opts_) is iso + /** @pred open(+ _F_,+ _M_,- _S_,+ _Opts_) is iso -Opens the file with name _F_ in mode _M_ (`read`, `write` or -`append`), returning _S_ unified with the stream name, and following -these options: + Opens the file with name _F_ in mode _M_ (`read`, `write` or + `append`), returning _S_ unified with the stream name, and following + these options: -+ `type(+ _T_)` is iso + + `type(+ _T_)` is iso - Specify whether the stream is a `text` stream (default), or a -`binary` stream. + Specify whether the stream is a `text` stream (default), or a + `binary` stream. -+ `reposition(+ _Bool_)` is iso - Specify whether it is possible to reposition the stream (`true`), or -not (`false`). By default, YAP enables repositioning for all -files, except terminal files and sockets. + + `reposition(+ _Bool_)` is iso + Specify whether it is possible to reposition the stream (`true`), or + not (`false`). By default, YAP enables repositioning for all + files, except terminal files and sockets. -+ `eof(+ _Action_)` is iso + + `eof(+ _Action_)` is iso - Specify the action to take if attempting to input characters from a -stream where we have previously found an `end_of_file`. The possible -actions are `error`, that raises an error, `reset`, that tries to -reset the stream and is used for `tty` type files, and `eof_code`, -which generates a new `end_of_file` (default for non-tty files). + Specify the action to take if attempting to input characters from a + stream where we have previously found an `end_of_file`. The possible + actions are `error`, that raises an error, `reset`, that tries to + reset the stream and is used for `tty` type files, and `eof_code`, + which generates a new `end_of_file` (default for non-tty files). -+ `alias(+ _Name_)` is iso + + `alias(+ _Name_)` is iso - Specify an alias to the stream. The alias Name must be an atom. -The -alias can be used instead of the stream descriptor for every operation -concerning the stream. + Specify an alias to the stream. The alias Name must be an atom. + The + alias can be used instead of the stream descriptor for every operation + concerning the stream. - The operation will fail and give an error if the alias name is already -in use. YAP allows several aliases for the same file, but only -one is returned by stream_property/2 + The operation will fail and give an error if the alias name is already + in use. YAP allows several aliases for the same file, but only + one is returned by stream_property/2 -+ `bom(+ _Bool_)` + + `bom(+ _Bool_)` - If present and `true`, a BOM (Byte Order Mark) was -detected while opening the file for reading or a BOM was written while -opening the stream. See BOM for details. + If present and `true`, a BOM (Byte Order Mark) was + detected while opening the file for reading or a BOM was written while + opening the stream. See BOM for details. -+ `encoding(+ _Encoding_)` + + `encoding(+ _Encoding_)` -Set the encoding used for text. See Encoding for an overview of -wide character and encoding issues. + Set the encoding used for text. See Encoding for an overview of + wide character and encoding issues. -+ `representation_errors(+ _Mode_)` + + `representation_errors(+ _Mode_)` - Change the behaviour when writing characters to the stream that cannot -be represented by the encoding. The behaviour is one of `error` -(throw and Input/Output error exception), `prolog` (write `\u...\` -escape code or `xml` (write `\&#...;` XML character entity). -The initial mode is `prolog` for the user streams and -`error` for all other streams. See also Encoding. + Change the behaviour when writing characters to the stream that cannot + be represented by the encoding. The behaviour is one of `error` + (throw and Input/Output error exception), `prolog` (write `\u...\` + escape code or `xml` (write `\&#...;` XML character entity). + The initial mode is `prolog` for the user streams and + `error` for all other streams. See also Encoding. -+ `expand_filename(+ _Mode_)` + + `expand_filename(+ _Mode_)` - If _Mode_ is `true` then do filename expansion, then ask Prolog -to do file name expansion before actually trying to opening the file: -this includes processing `~` characters and processing `$` -environment variables at the beginning of the file. Otherwise, just try -to open the file using the given name. + If _Mode_ is `true` then do filename expansion, then ask Prolog + to do file name expansion before actually trying to opening the file: + this includes processing `~` characters and processing `$` + environment variables at the beginning of the file. Otherwise, just try + to open the file using the given name. - The default behavior is given by the Prolog flag -open_expands_filename. + The default behavior is given by the Prolog flag + open_expands_filename. -+ `script( + _Boolean_ )` YAP extension. + + `script( + _Boolean_ )` YAP extension. - The file may be a Prolog script. In `read` mode just check for - initial lines if they start with the hash symbol, and skip them. In - `write` mode output an header that can be used to launch the file by - calling `yap -l file -- $*`. Note that YAP will not set file - permissions as executable. In `append` mode ignore the flag. + The file may be a Prolog script. In `read` mode just check for + initial lines if they start with the hash symbol, and skip them. In + `write` mode output an header that can be used to launch the file by + calling `yap -l file -- $*`. Note that YAP will not set file + permissions as executable. In `append` mode ignore the flag. -*/ -static Int open4(USES_REGS1) { /* '$open'(+File,+Mode,?Stream,-ReturnCode) */ - return do_open(Deref(ARG1), Deref(ARG2), Deref(ARG4) PASS_REGS); -} + */ + static Int open4( + USES_REGS1) { /* '$open'(+File,+Mode,?Stream,-ReturnCode) */ + return do_open(Deref(ARG1), Deref(ARG2), Deref(ARG4) PASS_REGS); + } -static Int p_file_expansion(USES_REGS1) { /* '$file_expansion'(+File,-Name) */ - Term file_name = Deref(ARG1); + static Int p_file_expansion( + USES_REGS1) { /* '$file_expansion'(+File,-Name) */ + Term file_name = Deref(ARG1); - /* we know file_name is bound */ - if (IsVarTerm(file_name)) { - PlIOError(INSTANTIATION_ERROR, file_name, "absolute_file_name/3"); - return (FALSE); - } - if (!Yap_locateFile(RepAtom(AtomOfTerm(file_name))->StrOfAE, - LOCAL_FileNameBuf, false)) - return (PlIOError(EXISTENCE_ERROR_SOURCE_SINK, file_name, - "absolute_file_name/3")); - return (Yap_unify(ARG2, MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf)))); -} + /* we know file_name is bound */ + if (IsVarTerm(file_name)) { + PlIOError(INSTANTIATION_ERROR, file_name, "absolute_file_name/3"); + return (FALSE); + } + if (!Yap_locateFile(RepAtom(AtomOfTerm(file_name))->StrOfAE, + LOCAL_FileNameBuf, false)) + return (PlIOError(EXISTENCE_ERROR_SOURCE_SINK, file_name, + "absolute_file_name/3")); + return (Yap_unify(ARG2, MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf)))); + } -static Int p_open_null_stream(USES_REGS1) { - Term t; - StreamDesc *st; - int sno = GetFreeStreamD(); - if (sno < 0) - return (PlIOError(SYSTEM_ERROR_INTERNAL, TermNil, - "new stream not available for open_null_stream/1")); - st = &GLOBAL_Stream[sno]; - st->status = Append_Stream_f | Output_Stream_f | Null_Stream_f; + static Int p_open_null_stream(USES_REGS1) { + Term t; + StreamDesc *st; + int sno = GetFreeStreamD(); + if (sno < 0) + return (PlIOError(SYSTEM_ERROR_INTERNAL, TermNil, + "new stream not available for open_null_stream/1")); + st = &GLOBAL_Stream[sno]; + st->status = Append_Stream_f | Output_Stream_f | Null_Stream_f; #if _WIN32 - st->file = fopen("NUL", "w"); + st->file = fopen("NUL", "w"); #else - st->file = fopen("/dev/null", "w"); + st->file = fopen("/dev/null", "w"); #endif - if (st->file == NULL) { - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "Could not open NULL stream (/dev/null,NUL)"); - return false; - } - st->linepos = 0; - st->charcount = 0; - st->linecount = 1; - st->stream_putc = NullPutc; - st->stream_wputc = put_wchar; - st->stream_getc = PlGetc; - st->stream_wgetc = get_wchar; - st->stream_wgetc_for_read = get_wchar; - st->user_name = MkAtomTerm(st->name = AtomDevNull); - UNLOCK(st->streamlock); - t = Yap_MkStream(sno); - return (Yap_unify(ARG1, t)); -} + if (st->file == NULL) { + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, + "Could not open NULL stream (/dev/null,NUL)"); + return false; + } + st->linepos = 0; + st->charcount = 0; + st->linecount = 1; + st->stream_putc = NullPutc; + st->stream_wputc = put_wchar; + st->stream_getc = PlGetc; + st->stream_wgetc = get_wchar; + st->stream_wgetc_for_read = get_wchar; + st->user_name = MkAtomTerm(st->name = AtomDevNull); + UNLOCK(st->streamlock); + t = Yap_MkStream(sno); + return (Yap_unify(ARG1, t)); + } -int Yap_OpenStream(FILE *fd, char *name, Term file_name, int flags) { - CACHE_REGS - int sno; - Atom at; + int Yap_OpenStream(FILE * fd, char *name, Term file_name, int flags) { + CACHE_REGS + int sno; + Atom at; - sno = GetFreeStreamD(); - if (sno < 0) - return (PlIOError(RESOURCE_ERROR_MAX_STREAMS, file_name, - "new stream not available for opening")); - if (flags & Output_Stream_f) { - if (flags & Append_Stream_f) - at = AtomAppend; - else - at = AtomWrite; - } else - at = AtomRead; - Yap_initStream(sno, fd, name, file_name, LOCAL_encoding, flags, at); - return sno; -} + sno = GetFreeStreamD(); + if (sno < 0) + return (PlIOError(RESOURCE_ERROR_MAX_STREAMS, file_name, + "new stream not available for opening")); + if (flags & Output_Stream_f) { + if (flags & Append_Stream_f) + at = AtomAppend; + else + at = AtomWrite; + } else + at = AtomRead; + Yap_initStream(sno, fd, name, file_name, LOCAL_encoding, flags, at); + return sno; + } #define CheckStream(arg, kind, msg) \ CheckStream__(__FILE__, __FUNCTION__, __LINE__, arg, kind, msg) -static int CheckStream__(const char *file, const char *f, int line, Term arg, - int kind, const char *msg) { - int sno = -1; - arg = Deref(arg); - if (IsVarTerm(arg)) { - Yap_Error(INSTANTIATION_ERROR, arg, msg); - return -1; - } else if (IsAtomTerm(arg)) { - Atom sname = AtomOfTerm(arg); + static int CheckStream__(const char *file, const char *f, int line, + Term arg, int kind, const char *msg) { + int sno = -1; + arg = Deref(arg); + if (IsVarTerm(arg)) { + Yap_Error(INSTANTIATION_ERROR, arg, msg); + return -1; + } else if (IsAtomTerm(arg)) { + Atom sname = AtomOfTerm(arg); - if (sname == AtomUser) { - if (kind & Input_Stream_f) { - if (kind & (Output_Stream_f | Append_Stream_f)) { - PlIOError__(file, f, line, PERMISSION_ERROR_OUTPUT_STREAM, arg, - "ambiguous use of 'user' as a stream"); - return (-1); + if (sname == AtomUser) { + if (kind & Input_Stream_f) { + if (kind & (Output_Stream_f | Append_Stream_f)) { + PlIOError__(file, f, line, PERMISSION_ERROR_OUTPUT_STREAM, arg, + "ambiguous use of 'user' as a stream"); + return (-1); + } + sname = AtomUserIn; + } else { + sname = AtomUserOut; + } + } + if ((sno = Yap_CheckAlias(sname)) < 0) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + PlIOError__(file, f, line, EXISTENCE_ERROR_STREAM, arg, msg); + return -1; + } else { + LOCK(GLOBAL_Stream[sno].streamlock); + return sno; + } + } else if (IsApplTerm(arg) && FunctorOfTerm(arg) == FunctorStream) { + arg = ArgOfTerm(1, arg); + if (!IsVarTerm(arg) && IsIntegerTerm(arg)) { + sno = IntegerOfTerm(arg); } - sname = AtomUserIn; - } else { - sname = AtomUserOut; } - } - if ((sno = Yap_CheckAlias(sname)) < 0) { - UNLOCK(GLOBAL_Stream[sno].streamlock); - PlIOError__(file, f, line, EXISTENCE_ERROR_STREAM, arg, msg); - return -1; - } else { + if (sno < 0) { + Yap_Error(DOMAIN_ERROR_STREAM_OR_ALIAS, arg, msg); + return (-1); + } + if (GLOBAL_Stream[sno].status & Free_Stream_f) { + PlIOError__(file, f, line, EXISTENCE_ERROR_STREAM, arg, msg); + return (-1); + } LOCK(GLOBAL_Stream[sno].streamlock); + if ((GLOBAL_Stream[sno].status & Input_Stream_f) && + !(kind & Input_Stream_f)) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + PlIOError__(file, f, line, PERMISSION_ERROR_OUTPUT_STREAM, arg, msg); + } + if ((GLOBAL_Stream[sno].status & (Append_Stream_f | Output_Stream_f)) && + !(kind & Output_Stream_f)) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + PlIOError__(file, f, line, PERMISSION_ERROR_INPUT_STREAM, arg, msg); + } + return (sno); + } + + int Yap_CheckStream__(const char *file, const char *f, int line, Term arg, + int kind, const char *msg) { + return CheckStream__(file, f, line, arg, kind, msg); + } + + int Yap_CheckTextStream__(const char *file, const char *f, int line, + Term arg, int kind, const char *msg) { + int sno; + if ((sno = CheckStream__(file, f, line, arg, kind, msg)) < 0) + return -1; + if ((GLOBAL_Stream[sno].status & Binary_Stream_f)) { + if (kind == Input_Stream_f) + PlIOError__(file, f, line, PERMISSION_ERROR_INPUT_BINARY_STREAM, arg, + msg); + else + PlIOError__(file, f, line, PERMISSION_ERROR_OUTPUT_BINARY_STREAM, arg, + msg); + UNLOCK(GLOBAL_Stream[sno].streamlock); + return -1; + } return sno; } - } else if (IsApplTerm(arg) && FunctorOfTerm(arg) == FunctorStream) { - arg = ArgOfTerm(1, arg); - if (!IsVarTerm(arg) && IsIntegerTerm(arg)) { - sno = IntegerOfTerm(arg); + + /* used from C-interface */ + int Yap_GetFreeStreamDForReading(void) { + int sno = GetFreeStreamD(); + StreamDesc *s; + + if (sno < 0) + return sno; + s = GLOBAL_Stream + sno; + s->status |= User_Stream_f | Input_Stream_f; + s->charcount = 0; + s->linecount = 1; + s->linepos = 0; + Yap_DefaultStreamOps(s); + UNLOCK(s->streamlock); + return sno; } - } - if (sno < 0) { - Yap_Error(DOMAIN_ERROR_STREAM_OR_ALIAS, arg, msg); - return (-1); - } - if (GLOBAL_Stream[sno].status & Free_Stream_f) { - PlIOError__(file, f, line, EXISTENCE_ERROR_STREAM, arg, msg); - return (-1); - } - LOCK(GLOBAL_Stream[sno].streamlock); - if ((GLOBAL_Stream[sno].status & Input_Stream_f) && - !(kind & Input_Stream_f)) { - UNLOCK(GLOBAL_Stream[sno].streamlock); - PlIOError__(file, f, line, PERMISSION_ERROR_OUTPUT_STREAM, arg, msg); - } - if ((GLOBAL_Stream[sno].status & (Append_Stream_f | Output_Stream_f)) && - !(kind & Output_Stream_f)) { - UNLOCK(GLOBAL_Stream[sno].streamlock); - PlIOError__(file, f, line, PERMISSION_ERROR_INPUT_STREAM, arg, msg); - } - return (sno); -} -int Yap_CheckStream__(const char *file, const char *f, int line, Term arg, - int kind, const char *msg) { - return CheckStream__(file, f, line, arg, kind, msg); -} + /** + * @pred always_prompt_user + * + * Ensure that the stream always prompts before asking the standard input + stream for data. -int Yap_CheckTextStream__(const char *file, const char *f, int line, Term arg, - int kind, const char *msg) { - int sno; - if ((sno = CheckStream__(file, f, line, arg, kind, msg)) < 0) - return -1; - if ((GLOBAL_Stream[sno].status & Binary_Stream_f)) { - if (kind == Input_Stream_f) - PlIOError__(file, f, line, PERMISSION_ERROR_INPUT_BINARY_STREAM, arg, - msg); - else - PlIOError__(file, f, line, PERMISSION_ERROR_OUTPUT_BINARY_STREAM, arg, - msg); - UNLOCK(GLOBAL_Stream[sno].streamlock); - return -1; - } - return sno; -} + */ + static Int always_prompt_user(USES_REGS1) { + StreamDesc *s = GLOBAL_Stream + StdInStream; -/* used from C-interface */ -int Yap_GetFreeStreamDForReading(void) { - int sno = GetFreeStreamD(); - StreamDesc *s; - - if (sno < 0) - return sno; - s = GLOBAL_Stream + sno; - s->status |= User_Stream_f | Input_Stream_f; - s->charcount = 0; - s->linecount = 1; - s->linepos = 0; - Yap_DefaultStreamOps(s); - UNLOCK(s->streamlock); - return sno; -} - -/** - * @pred always_prompt_user - * - * Ensure that the stream always prompts before asking the standard input - stream for data. - - */ -static Int always_prompt_user(USES_REGS1) { - StreamDesc *s = GLOBAL_Stream + StdInStream; - - s->status |= Promptable_Stream_f; + s->status |= Promptable_Stream_f; #if USE_SOCKET - if (s->status & Socket_Stream_f) { - Yap_ConsoleSocketOps(s); - } else + if (s->status & Socket_Stream_f) { + Yap_ConsoleSocketOps(s); + } else #endif - if (s->status & Pipe_Stream_f) { - Yap_ConsolePipeOps(s); - } else - Yap_ConsoleOps(s, false); - return (TRUE); -} + if (s->status & Pipe_Stream_f) { + Yap_ConsolePipeOps(s); + } else + Yap_ConsoleOps(s, false); + return (TRUE); + } -static Int close1 /** @pred close(+ _S_) is iso + static Int close1 /** @pred close(+ _S_) is iso - Closes the stream _S_. If _S_ does not stand for a stream - currently opened an error is reported. The streams user_input, - user_output, and user_error can never be closed. + Closes the stream _S_. If _S_ does not stand for a stream + currently opened an error is reported. The streams user_input, + user_output, and user_error can never be closed. - */ + */ - (USES_REGS1) { /* '$close'(+GLOBAL_Stream) */ - Int sno = CheckStream( - ARG1, (Input_Stream_f | Output_Stream_f | Socket_Stream_f), "close/2"); - if (sno < 0) - return (FALSE); - if (sno <= StdErrStream) { - UNLOCK(GLOBAL_Stream[sno].streamlock); - return TRUE; - } - Yap_CloseStream(sno); - UNLOCK(GLOBAL_Stream[sno].streamlock); - return (TRUE); -} + (USES_REGS1) { /* '$close'(+GLOBAL_Stream) */ + Int sno = CheckStream( + ARG1, (Input_Stream_f | Output_Stream_f | Socket_Stream_f), + "close/2"); + if (sno < 0) + return (FALSE); + if (sno <= StdErrStream) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + return TRUE; + } + Yap_CloseStream(sno); + UNLOCK(GLOBAL_Stream[sno].streamlock); + return (TRUE); + } #define CLOSE_DEFS() \ PAR("force", booleanFlag, CLOSE_FORCE), PAR(NULL, ok, CLOSE_END) #define PAR(x, y, z) z -typedef enum close_enum_choices { CLOSE_DEFS() } close_choices_t; + typedef enum close_enum_choices { CLOSE_DEFS() } close_choices_t; #undef PAR #define PAR(x, y, z) \ { x, y, z } -static const param_t close_defs[] = {CLOSE_DEFS()}; + static const param_t close_defs[] = {CLOSE_DEFS()}; #undef PAR -/** @pred close(+ _S_,+ _O_) is iso + /** @pred close(+ _S_,+ _O_) is iso -Closes the stream _S_, following options _O_. + Closes the stream _S_, following options _O_. -The only valid options are `force(true)` and `force(false)`. -YAP currently ignores these options. + The only valid options are `force(true)` and `force(false)`. + YAP currently ignores these options. -*/ -static Int close2(USES_REGS1) { /* '$close'(+GLOBAL_Stream) */ - Int sno = CheckStream( - ARG1, (Input_Stream_f | Output_Stream_f | Socket_Stream_f), "close/2"); - Term tlist; - if (sno < 0) - return (FALSE); - if (sno <= StdErrStream) { - UNLOCK(GLOBAL_Stream[sno].streamlock); - return TRUE; - } - xarg *args = - Yap_ArgListToVector((tlist = Deref(ARG2)), close_defs, CLOSE_END); - if (args == NULL) { - if (LOCAL_Error_TYPE != YAP_NO_ERROR) { - if (LOCAL_Error_TYPE == DOMAIN_ERROR_PROLOG_FLAG) - LOCAL_Error_TYPE = DOMAIN_ERROR_CLOSE_OPTION; - Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL); + */ + static Int close2(USES_REGS1) { /* '$close'(+GLOBAL_Stream) */ + Int sno = CheckStream( + ARG1, (Input_Stream_f | Output_Stream_f | Socket_Stream_f), + "close/2"); + Term tlist; + if (sno < 0) + return (FALSE); + if (sno <= StdErrStream) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + return TRUE; + } + xarg *args = + Yap_ArgListToVector((tlist = Deref(ARG2)), close_defs, CLOSE_END); + if (args == NULL) { + if (LOCAL_Error_TYPE != YAP_NO_ERROR) { + if (LOCAL_Error_TYPE == DOMAIN_ERROR_PROLOG_FLAG) + LOCAL_Error_TYPE = DOMAIN_ERROR_CLOSE_OPTION; + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL); + } + return false; + return FALSE; + } + // if (args[CLOSE_FORCE].used) { + // } + Yap_CloseStream(sno); + UNLOCK(GLOBAL_Stream[sno].streamlock); + return (TRUE); } - return false; - return FALSE; - } - // if (args[CLOSE_FORCE].used) { - // } - Yap_CloseStream(sno); - UNLOCK(GLOBAL_Stream[sno].streamlock); - return (TRUE); -} -Term read_line(int sno) { - CACHE_REGS - Term tail; - Int ch; + Term read_line(int sno) { + CACHE_REGS + Term tail; + Int ch; - if ((ch = GLOBAL_Stream[sno].stream_wgetc(sno)) == 10) { - return (TermNil); - } - tail = read_line(sno); - return (MkPairTerm(MkIntTerm(ch), tail)); -} + if ((ch = GLOBAL_Stream[sno].stream_wgetc(sno)) == 10) { + return (TermNil); + } + tail = read_line(sno); + return (MkPairTerm(MkIntTerm(ch), tail)); + } #define ABSOLUTE_FILE_NAME_DEFS() \ PAR("access", isatom, ABSOLUTE_FILE_NAME_ACCESS), \ @@ -1760,143 +1775,146 @@ Term read_line(int sno) { #define PAR(x, y, z) z -typedef enum ABSOLUTE_FILE_NAME_enum_ { - ABSOLUTE_FILE_NAME_DEFS() -} absolute_file_name_choices_t; + typedef enum ABSOLUTE_FILE_NAME_enum_ { + ABSOLUTE_FILE_NAME_DEFS() + } absolute_file_name_choices_t; #undef PAR #define PAR(x, y, z) \ { x, y, z } -static const param_t absolute_file_name_search_defs[] = { - ABSOLUTE_FILE_NAME_DEFS()}; + static const param_t absolute_file_name_search_defs[] = { + ABSOLUTE_FILE_NAME_DEFS()}; #undef PAR -static Int abs_file_parameters(USES_REGS1) { - Term t[ABSOLUTE_FILE_NAME_END]; - Term tlist = Deref(ARG1), tf; - /* get options */ - xarg *args = Yap_ArgListToVector(tlist, absolute_file_name_search_defs, - ABSOLUTE_FILE_NAME_END); - if (args == NULL) { - if (LOCAL_Error_TYPE != YAP_NO_ERROR) { - if (LOCAL_Error_TYPE == DOMAIN_ERROR_PROLOG_FLAG) - LOCAL_Error_TYPE = DOMAIN_ERROR_ABSOLUTE_FILE_NAME_OPTION; - Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL); + static Int abs_file_parameters(USES_REGS1) { + Term t[ABSOLUTE_FILE_NAME_END]; + Term tlist = Deref(ARG1), tf; + /* get options */ + xarg *args = Yap_ArgListToVector(tlist, absolute_file_name_search_defs, + ABSOLUTE_FILE_NAME_END); + if (args == NULL) { + if (LOCAL_Error_TYPE != YAP_NO_ERROR) { + if (LOCAL_Error_TYPE == DOMAIN_ERROR_PROLOG_FLAG) + LOCAL_Error_TYPE = DOMAIN_ERROR_ABSOLUTE_FILE_NAME_OPTION; + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL); + } + return false; + } + /* done */ + if (args[ABSOLUTE_FILE_NAME_EXTENSIONS].used) { + t[ABSOLUTE_FILE_NAME_EXTENSIONS] = + args[ABSOLUTE_FILE_NAME_EXTENSIONS].tvalue; + } else { + t[ABSOLUTE_FILE_NAME_EXTENSIONS] = TermNil; + } + if (args[ABSOLUTE_FILE_NAME_RELATIVE_TO].used) { + t[ABSOLUTE_FILE_NAME_RELATIVE_TO] = + gethdir(args[ABSOLUTE_FILE_NAME_RELATIVE_TO].tvalue); + } else { + t[ABSOLUTE_FILE_NAME_RELATIVE_TO] = gethdir(TermDot); + } + if (args[ABSOLUTE_FILE_NAME_FILE_TYPE].used) + t[ABSOLUTE_FILE_NAME_FILE_TYPE] = + args[ABSOLUTE_FILE_NAME_FILE_TYPE].tvalue; + else + t[ABSOLUTE_FILE_NAME_FILE_TYPE] = TermTxt; + if (args[ABSOLUTE_FILE_NAME_ACCESS].used) + t[ABSOLUTE_FILE_NAME_ACCESS] = args[ABSOLUTE_FILE_NAME_ACCESS].tvalue; + else + t[ABSOLUTE_FILE_NAME_ACCESS] = TermNone; + if (args[ABSOLUTE_FILE_NAME_FILE_ERRORS].used) + t[ABSOLUTE_FILE_NAME_FILE_ERRORS] = + args[ABSOLUTE_FILE_NAME_FILE_ERRORS].tvalue; + else + t[ABSOLUTE_FILE_NAME_FILE_ERRORS] = TermError; + if (args[ABSOLUTE_FILE_NAME_SOLUTIONS].used) + t[ABSOLUTE_FILE_NAME_SOLUTIONS] = + args[ABSOLUTE_FILE_NAME_SOLUTIONS].tvalue; + else + t[ABSOLUTE_FILE_NAME_SOLUTIONS] = TermFirst; + if (args[ABSOLUTE_FILE_NAME_EXPAND].used) + t[ABSOLUTE_FILE_NAME_EXPAND] = args[ABSOLUTE_FILE_NAME_EXPAND].tvalue; + else + t[ABSOLUTE_FILE_NAME_EXPAND] = TermFalse; + if (args[ABSOLUTE_FILE_NAME_GLOB].used) { + t[ABSOLUTE_FILE_NAME_GLOB] = args[ABSOLUTE_FILE_NAME_GLOB].tvalue; + t[ABSOLUTE_FILE_NAME_EXPAND] = TermTrue; + } else + t[ABSOLUTE_FILE_NAME_GLOB] = TermEmptyAtom; + if (args[ABSOLUTE_FILE_NAME_VERBOSE_FILE_SEARCH].used) + t[ABSOLUTE_FILE_NAME_VERBOSE_FILE_SEARCH] = + args[ABSOLUTE_FILE_NAME_VERBOSE_FILE_SEARCH].tvalue; + else + t[ABSOLUTE_FILE_NAME_VERBOSE_FILE_SEARCH] = + (trueGlobalPrologFlag(VERBOSE_FILE_SEARCH_FLAG) ? TermTrue + : TermFalse); + tf = Yap_MkApplTerm(Yap_MkFunctor(AtomOpt, ABSOLUTE_FILE_NAME_END), + ABSOLUTE_FILE_NAME_END, t); + return (Yap_unify(ARG2, tf)); } - return false; - } - /* done */ - if (args[ABSOLUTE_FILE_NAME_EXTENSIONS].used) { - t[ABSOLUTE_FILE_NAME_EXTENSIONS] = - args[ABSOLUTE_FILE_NAME_EXTENSIONS].tvalue; - } else { - t[ABSOLUTE_FILE_NAME_EXTENSIONS] = TermNil; - } - if (args[ABSOLUTE_FILE_NAME_RELATIVE_TO].used) { - t[ABSOLUTE_FILE_NAME_RELATIVE_TO] = - gethdir(args[ABSOLUTE_FILE_NAME_RELATIVE_TO].tvalue); - } else { - t[ABSOLUTE_FILE_NAME_RELATIVE_TO] = gethdir(TermDot); - } - if (args[ABSOLUTE_FILE_NAME_FILE_TYPE].used) - t[ABSOLUTE_FILE_NAME_FILE_TYPE] = args[ABSOLUTE_FILE_NAME_FILE_TYPE].tvalue; - else - t[ABSOLUTE_FILE_NAME_FILE_TYPE] = TermTxt; - if (args[ABSOLUTE_FILE_NAME_ACCESS].used) - t[ABSOLUTE_FILE_NAME_ACCESS] = args[ABSOLUTE_FILE_NAME_ACCESS].tvalue; - else - t[ABSOLUTE_FILE_NAME_ACCESS] = TermNone; - if (args[ABSOLUTE_FILE_NAME_FILE_ERRORS].used) - t[ABSOLUTE_FILE_NAME_FILE_ERRORS] = - args[ABSOLUTE_FILE_NAME_FILE_ERRORS].tvalue; - else - t[ABSOLUTE_FILE_NAME_FILE_ERRORS] = TermError; - if (args[ABSOLUTE_FILE_NAME_SOLUTIONS].used) - t[ABSOLUTE_FILE_NAME_SOLUTIONS] = args[ABSOLUTE_FILE_NAME_SOLUTIONS].tvalue; - else - t[ABSOLUTE_FILE_NAME_SOLUTIONS] = TermFirst; - if (args[ABSOLUTE_FILE_NAME_EXPAND].used) - t[ABSOLUTE_FILE_NAME_EXPAND] = args[ABSOLUTE_FILE_NAME_EXPAND].tvalue; - else - t[ABSOLUTE_FILE_NAME_EXPAND] = TermFalse; - if (args[ABSOLUTE_FILE_NAME_GLOB].used) { - t[ABSOLUTE_FILE_NAME_GLOB] = args[ABSOLUTE_FILE_NAME_GLOB].tvalue; - t[ABSOLUTE_FILE_NAME_EXPAND] = TermTrue; - } else - t[ABSOLUTE_FILE_NAME_GLOB] = TermEmptyAtom; - if (args[ABSOLUTE_FILE_NAME_VERBOSE_FILE_SEARCH].used) - t[ABSOLUTE_FILE_NAME_VERBOSE_FILE_SEARCH] = - args[ABSOLUTE_FILE_NAME_VERBOSE_FILE_SEARCH].tvalue; - else - t[ABSOLUTE_FILE_NAME_VERBOSE_FILE_SEARCH] = - (trueGlobalPrologFlag(VERBOSE_FILE_SEARCH_FLAG) ? TermTrue : TermFalse); - tf = Yap_MkApplTerm(Yap_MkFunctor(AtomOpt, ABSOLUTE_FILE_NAME_END), - ABSOLUTE_FILE_NAME_END, t); - return (Yap_unify(ARG2, tf)); -} -static Int get_abs_file_parameter(USES_REGS1) { - Term t = Deref(ARG1), topts = ARG2; - /* get options */ - /* done */ - int i = Yap_ArgKey(AtomOfTerm(t), absolute_file_name_search_defs, - ABSOLUTE_FILE_NAME_END); - if (i >= 0) - return Yap_unify(ARG3, ArgOfTerm(i + 1, topts)); - Yap_Error(DOMAIN_ERROR_ABSOLUTE_FILE_NAME_OPTION, ARG1, NULL); - return false; -} + static Int get_abs_file_parameter(USES_REGS1) { + Term t = Deref(ARG1), topts = ARG2; + /* get options */ + /* done */ + int i = Yap_ArgKey(AtomOfTerm(t), absolute_file_name_search_defs, + ABSOLUTE_FILE_NAME_END); + if (i >= 0) + return Yap_unify(ARG3, ArgOfTerm(i + 1, topts)); + Yap_Error(DOMAIN_ERROR_ABSOLUTE_FILE_NAME_OPTION, ARG1, NULL); + return false; + } -void Yap_InitPlIO(void) { - Int i; + void Yap_InitPlIO(void) { + Int i; - Yap_stdin = stdin; - Yap_stdout = stdout; - Yap_stderr = stderr; - GLOBAL_Stream = - (StreamDesc *)Yap_AllocCodeSpace(sizeof(StreamDesc) * MaxStreams); - for (i = 0; i < MaxStreams; ++i) { - INIT_LOCK(GLOBAL_Stream[i].streamlock); - GLOBAL_Stream[i].status = Free_Stream_f; - } - InitStdStreams(); -} + Yap_stdin = stdin; + Yap_stdout = stdout; + Yap_stderr = stderr; + GLOBAL_Stream = + (StreamDesc *)Yap_AllocCodeSpace(sizeof(StreamDesc) * MaxStreams); + for (i = 0; i < MaxStreams; ++i) { + INIT_LOCK(GLOBAL_Stream[i].streamlock); + GLOBAL_Stream[i].status = Free_Stream_f; + } + InitStdStreams(); + } -void Yap_InitIOPreds(void) { - /* here the Input/Output predicates */ - Yap_InitCPred("always_prompt_user", 0, always_prompt_user, - SafePredFlag | SyncPredFlag); - Yap_InitCPred("close", 1, close1, SafePredFlag | SyncPredFlag); - Yap_InitCPred("close", 2, close2, SafePredFlag | SyncPredFlag); - Yap_InitCPred("open", 4, open4, SyncPredFlag); - Yap_InitCPred("open", 3, open3, SyncPredFlag); - Yap_InitCPred("abs_file_parameters", 2, abs_file_parameters, - SyncPredFlag | HiddenPredFlag); - Yap_InitCPred("get_abs_file_parameter", 3, get_abs_file_parameter, - SafePredFlag | SyncPredFlag | HiddenPredFlag); - Yap_InitCPred("$file_expansion", 2, p_file_expansion, - SafePredFlag | SyncPredFlag | HiddenPredFlag); - Yap_InitCPred("$open_null_stream", 1, p_open_null_stream, - SafePredFlag | SyncPredFlag | HiddenPredFlag); - Yap_InitIOStreams(); - Yap_InitCharsio(); - Yap_InitChtypes(); - Yap_InitConsole(); - Yap_InitReadUtil(); - Yap_InitMems(); - Yap_InitPipes(); - Yap_InitFiles(); - Yap_InitWriteTPreds(); - Yap_InitReadTPreds(); - Yap_InitFormat(); - Yap_InitRandomPreds(); + void Yap_InitIOPreds(void) { + /* here the Input/Output predicates */ + Yap_InitCPred("always_prompt_user", 0, always_prompt_user, + SafePredFlag | SyncPredFlag); + Yap_InitCPred("close", 1, close1, SafePredFlag | SyncPredFlag); + Yap_InitCPred("close", 2, close2, SafePredFlag | SyncPredFlag); + Yap_InitCPred("open", 4, open4, SyncPredFlag); + Yap_InitCPred("open", 3, open3, SyncPredFlag); + Yap_InitCPred("abs_file_parameters", 2, abs_file_parameters, + SyncPredFlag | HiddenPredFlag); + Yap_InitCPred("get_abs_file_parameter", 3, get_abs_file_parameter, + SafePredFlag | SyncPredFlag | HiddenPredFlag); + Yap_InitCPred("$file_expansion", 2, p_file_expansion, + SafePredFlag | SyncPredFlag | HiddenPredFlag); + Yap_InitCPred("$open_null_stream", 1, p_open_null_stream, + SafePredFlag | SyncPredFlag | HiddenPredFlag); + Yap_InitIOStreams(); + Yap_InitCharsio(); + Yap_InitChtypes(); + Yap_InitConsole(); + Yap_InitReadUtil(); + Yap_InitMems(); + Yap_InitPipes(); + Yap_InitFiles(); + Yap_InitWriteTPreds(); + Yap_InitReadTPreds(); + Yap_InitFormat(); + Yap_InitRandomPreds(); #if USE_READLINE - Yap_InitReadlinePreds(); + Yap_InitReadlinePreds(); #endif - Yap_InitSockets(); - Yap_InitSignalPreds(); - Yap_InitSysPreds(); - Yap_InitTimePreds(); -} + Yap_InitSockets(); + Yap_InitSignalPreds(); + Yap_InitSysPreds(); + Yap_InitTimePreds(); + } diff --git a/os/iopreds.c:1351 in C-function do_open b/os/iopreds.c:1351 in C-function do_open deleted file mode 100644 index e69de29bb..000000000 diff --git a/os/iopreds.c:1352 in C-function do_open b/os/iopreds.c:1352 in C-function do_open deleted file mode 100644 index e69de29bb..000000000 diff --git a/os/iopreds.c:1374 in C-function do_open b/os/iopreds.c:1374 in C-function do_open deleted file mode 100644 index e69de29bb..000000000 diff --git a/os/iopreds.c:1376 in C-function do_open b/os/iopreds.c:1376 in C-function do_open deleted file mode 100644 index e69de29bb..000000000 diff --git a/os/iopreds.c:1379 in C-function do_open b/os/iopreds.c:1379 in C-function do_open deleted file mode 100644 index e69de29bb..000000000 diff --git a/os/iopreds.c:1382 in C-function do_open b/os/iopreds.c:1382 in C-function do_open deleted file mode 100644 index e69de29bb..000000000 diff --git a/os/iopreds.c:1413 in C-function do_open b/os/iopreds.c:1413 in C-function do_open deleted file mode 100644 index e69de29bb..000000000 diff --git a/os/iopreds.h b/os/iopreds.h index 5e5c3c99a..f2c04bd4e 100644 --- a/os/iopreds.h +++ b/os/iopreds.h @@ -152,7 +152,7 @@ typedef struct read_data_t { } read_data, *ReadData; Term Yap_read_term(int inp_stream, Term opts, int nargs); -Term Yap_Parse(UInt prio, Term tmod); +Term Yap_Parse(UInt prio); void init_read_data(ReadData _PL_rd, struct stream_desc *s); @@ -207,7 +207,7 @@ typedef struct stream_desc { lockvar streamlock; /* protect stream access */ #endif int (*stream_putc)(int, int); /** function the stream uses for writing a single octet */ - int (*stream_wputc)(int, wchar_t); /** function the stream uses for writing a character */ + int (*stream_wputc)(int, int); /** function the stream uses for writing a character */ int (*stream_getc)(int); /** function the stream uses for reading an octet. */ int (*stream_wgetc)(int); /** function the stream uses for reading a character. */ @@ -305,7 +305,7 @@ Term Yap_syntax_error(TokEntry *tokptr, int sno); int console_post_process_read_char(int, StreamDesc *); int console_post_process_eof(StreamDesc *); -int post_process_read_wchar(int, ssize_t, StreamDesc *); +int post_process_read_wchar(int, size_t, StreamDesc *); int post_process_weof(StreamDesc *); bool is_same_tty(FILE *f1, FILE *f2); diff --git a/os/mem.c b/os/mem.c index e13c00c1d..fe3325743 100644 --- a/os/mem.c +++ b/os/mem.c @@ -1,4 +1,4 @@ -/*************************************************************************post/////85 +/************************************************************************* * * * YAP Prolog * * * @@ -38,7 +38,7 @@ static char SccsId[] = "%W% %G%"; #if HAVE_IO_H /* Windows */ #include -#endif +#endif #if HAVE_SOCKET #include #endif @@ -55,11 +55,11 @@ static char SccsId[] = "%W% %G%"; FILE * open_memstream (char **buf, size_t *len); #endif -#if HAVE_FMEMOPEN +#if HAVE_FMEMOPEN #define MAY_READ 1 #endif -#if HAVE_OPEN_MEMSTREAM +#if HAVE_OPEN_MEMSTREAM #define MAY_READ 1 #define MAY_WRITE 1 #endif @@ -74,20 +74,21 @@ static int MemGetc( int); /* read from memory */ static int -MemGetc (int sno) +MemGetc(int sno) { - register StreamDesc *s = &GLOBAL_Stream[sno]; - Int ch; - int spos; + register StreamDesc *s = &GLOBAL_Stream[sno]; + Int ch; + int spos; - spos = s->u.mem_string.pos; - if (spos == s->u.mem_string.max_size) { - return EOF; - } else { - ch = s->u.mem_string.buf[spos]; - s->u.mem_string.pos = ++spos; - } - return ch; + spos = s->u.mem_string.pos; + if (spos == s->u.mem_string.max_size) { + return -1; + } + else { + ch = s->u.mem_string.buf[spos]; + s->u.mem_string.pos = ++spos; + } + return ch; } #endif @@ -166,7 +167,7 @@ MemPutc(int sno, int ch) FILE *f; encoding_t encoding; stream_flags_t flags; - + sno = GetFreeStreamD(); if (sno < 0) return (PlIOError (RESOURCE_ERROR_MAX_STREAMS,TermNil, "new stream not available for open_mem_read_stream/1")); @@ -254,7 +255,7 @@ Yap_open_buf_write_stream(char *buf, size_t nchars, encoding_t *encp, memBufSou int sno; StreamDesc *st; - + sno = GetFreeStreamD(); if (sno < 0) return -1; @@ -322,11 +323,11 @@ open_mem_write_stream (USES_REGS1) /* $open_mem_write_stream(-Stream) */ return (Yap_unify (ARG1, t)); } -/** +/** * Yap_PeekMemwriteStream() shows the current buffer for a memory stream. - * + * * @param sno, the in-memory stream - * + * * @return temporary buffer, discarded by close and may be moved away * by other writes.. */ @@ -413,13 +414,13 @@ bool Yap_CloseMemoryStream( int sno ) fclose(GLOBAL_Stream[sno].file); if (GLOBAL_Stream[sno].status & FreeOnClose_Stream_f) free( GLOBAL_Stream[sno].nbuf ); -#else +#else if (GLOBAL_Stream[sno].u.mem_string.src == MEM_BUF_CODE) Yap_FreeAtomSpace(GLOBAL_Stream[sno].u.mem_string.buf); else if (GLOBAL_Stream[sno].u.mem_string.src == MEM_BUF_MALLOC) { free(GLOBAL_Stream[sno].u.mem_string.buf); } -#endif +#endif } else { #if MAY_READ fclose(GLOBAL_Stream[sno].file); @@ -430,7 +431,7 @@ bool Yap_CloseMemoryStream( int sno ) else if (GLOBAL_Stream[sno].u.mem_string.src == MEM_BUF_MALLOC) { free(GLOBAL_Stream[sno].u.mem_string.buf); } -#endif +#endif } return true; } @@ -446,3 +447,4 @@ Yap_InitMems( void ) Yap_InitCPred ("peek_mem_write_stream", 3, peek_mem_write_stream, SyncPredFlag); CurrentModule = cm; } + diff --git a/os/readterm.c b/os/readterm.c index 32c403f51..dd4d49a5b 100644 --- a/os/readterm.c +++ b/os/readterm.c @@ -407,9 +407,7 @@ static xarg *setReadEnv(Term opts, FEnv *fe, struct renv *re, int inp_stream) { re->bq = getBackQuotesFlag(); if (args[READ_MODULE].used) { - fe->cmod = args[READ_MODULE].tvalue; - if (fe->cmod == TermProlog) - fe->cmod = PROLOG_MODULE; + CurrentModule = args[READ_MODULE].tvalue; } if (args[READ_BACKQUOTED_STRING].used) { if (!setBackQuotesFlag(args[READ_BACKQUOTED_STRING].tvalue)) @@ -422,6 +420,8 @@ static xarg *setReadEnv(Term opts, FEnv *fe, struct renv *re, int inp_stream) { } if (args[READ_COMMENTS].used) { fe->tcomms = args[READ_COMMENTS].tvalue; + if (fe->tcomms == TermProlog) + fe->tcomms = PROLOG_MODULE; } else { fe->tcomms = 0; } @@ -451,7 +451,7 @@ static xarg *setReadEnv(Term opts, FEnv *fe, struct renv *re, int inp_stream) { fe->np = 0; } if (args[READ_CHARACTER_ESCAPES].used || - Yap_CharacterEscapes(fe->cmod)) { + Yap_CharacterEscapes(CurrentModule)) { fe->ce = true; } else { fe->ce = false; @@ -625,6 +625,9 @@ static bool complete_processing(FEnv *fe, TokEntry *tokstart) { CACHE_REGS Term v1, v2, v3, vc, tp; + CurrentModule = fe->cmod; + if (CurrentModule == TermProlog) + CurrentModule = PROLOG_MODULE; if (fe->t && fe->vp) v1 = get_variables(fe, tokstart); else @@ -660,6 +663,9 @@ static bool complete_clause_processing(FEnv *fe, TokEntry *tokstart) { CACHE_REGS Term v_vp, v_vnames, v_comments, v_pos; + CurrentModule = fe->cmod; + if (CurrentModule == TermProlog) + CurrentModule = PROLOG_MODULE; if (fe->t && fe->vp) v_vp = get_variables(fe, tokstart); else @@ -880,7 +886,7 @@ static parser_state_t parse(REnv *re, FEnv *fe, int inp_stream) { TokEntry *tokstart = LOCAL_tokptr; encoding_t e = LOCAL_encoding; LOCAL_encoding = fe->enc; - fe->t = Yap_Parse(re->prio, fe->cmod); + fe->t = Yap_Parse(re->prio); LOCAL_encoding = e; fe->toklast = LOCAL_tokptr; LOCAL_tokptr = tokstart; @@ -1018,7 +1024,15 @@ static xarg *setClauseReadEnv(Term opts, FEnv *fe, struct renv *re, } re->bq = getBackQuotesFlag(); fe->enc = GLOBAL_Stream[inp_stream].encoding; - fe->cmod = LOCAL_SourceModule; + fe->cmod = CurrentModule; + CurrentModule = LOCAL_SourceModule; + if (CurrentModule == TermProlog) + CurrentModule = PROLOG_MODULE; + if (args[READ_CLAUSE_MODULE].used) { + fe->tcomms = args[READ_CLAUSE_MODULE].tvalue; + } else { + fe->tcomms = 0L; + } fe->sp = 0; fe->qq = 0; if (args[READ_CLAUSE_TERM_POSITION].used) { @@ -1026,14 +1040,11 @@ static xarg *setClauseReadEnv(Term opts, FEnv *fe, struct renv *re, } else { fe->tp = 0; } - if (args[READ_CLAUSE_MODULE].used) { - fe->cmod = args[READ_CLAUSE_MODULE].tvalue; - if (fe->cmod == TermProlog) - fe->cmod = PROLOG_MODULE; - } fe->sp = 0; if (args[READ_CLAUSE_COMMENTS].used) { fe->tcomms = args[READ_CLAUSE_COMMENTS].tvalue; + if (fe->tcomms == TermProlog) + fe->tcomms = PROLOG_MODULE; } else { fe->tcomms = 0L; } @@ -1053,7 +1064,7 @@ static xarg *setClauseReadEnv(Term opts, FEnv *fe, struct renv *re, } else { fe->vp = 0; } - fe->ce = Yap_CharacterEscapes(fe->cmod); + fe->ce = Yap_CharacterEscapes(CurrentModule); re->seekable = (GLOBAL_Stream[inp_stream].status & Seekable_Stream_f) != 0; if (re->seekable) { #if HAVE_FGETPOS diff --git a/os/readutil.c b/os/readutil.c index 0511100bf..e09a6a835 100644 --- a/os/readutil.c +++ b/os/readutil.c @@ -28,13 +28,16 @@ static char SccsId[] = "%W% %G%"; /// @addtogroup readutil -static Int rl_to_codes(Term TEnd, int do_as_binary, int arity USES_REGS) { - int sno = Yap_CheckStream(ARG1, Input_Stream_f, "read_line_to_codes/2"); - StreamDesc *st = GLOBAL_Stream + sno; + +static Int +rl_to_codes(Term TEnd, int do_as_binary, int arity USES_REGS) +{ + int sno = Yap_CheckStream (ARG1, Input_Stream_f, "read_line_to_codes/2"); + StreamDesc *st = GLOBAL_Stream+sno; Int status; UInt max_inp, buf_sz, sz; int *buf; - bool binary_stream; + bool binary_stream; if (sno < 0) return FALSE; @@ -42,167 +45,168 @@ static Int rl_to_codes(Term TEnd, int do_as_binary, int arity USES_REGS) { binary_stream = GLOBAL_Stream[sno].status & Binary_Stream_f; if (status & Eof_Stream_f) { UNLOCK(GLOBAL_Stream[sno].streamlock); - return Yap_unify_constant(ARG2, MkAtomTerm(AtomEof)); + return Yap_unify_constant(ARG2, MkAtomTerm (AtomEof)); } - max_inp = (ASP - HR) / 2 - 1024; + max_inp = (ASP-HR)/2-1024; buf = (int *)TR; - buf_sz = (int *)LOCAL_TrailTop - buf; + buf_sz = (int *)LOCAL_TrailTop-buf; while (TRUE) { - if (buf_sz > max_inp) { + if ( buf_sz > max_inp ) { buf_sz = max_inp; } if (do_as_binary && !binary_stream) { GLOBAL_Stream[sno].status |= Binary_Stream_f; } if (st->status & Binary_Stream_f) { - char *b = (char *)TR; - sz = fread(b, 1, buf_sz, GLOBAL_Stream[sno].file); + char *b = (char *)TR; + sz = fread( b,1 , buf_sz, GLOBAL_Stream[sno].file); } else { - int ch; - int *pt = buf; - do { + int ch; + int *pt = buf; + do { *pt++ = ch = st->stream_wgetc_for_read(sno); - if (pt + 1 == buf + buf_sz) - break; - } while (ch != '\n' && ch != EOF); - sz = pt - buf; - } + if (pt+1 == buf+buf_sz) + break; + } while (ch != '\n'); + sz = pt-buf; + } if (do_as_binary && !binary_stream) GLOBAL_Stream[sno].status &= ~Binary_Stream_f; if (sz == -1 || sz == 0) { if (GLOBAL_Stream[sno].status & Eof_Stream_f) { - UNLOCK(GLOBAL_Stream[sno].streamlock); - return Yap_unify_constant(ARG2, MkAtomTerm(AtomEof)); + UNLOCK(GLOBAL_Stream[sno].streamlock); + return Yap_unify_constant(ARG2, MkAtomTerm (AtomEof)); } UNLOCK(GLOBAL_Stream[sno].streamlock); return FALSE; } - if (GLOBAL_Stream[sno].status & Eof_Stream_f || buf[sz - 1] == 10) { + if (GLOBAL_Stream[sno].status & Eof_Stream_f || buf[sz-1] == 10) { /* we're done */ Term end; if (!(do_as_binary || GLOBAL_Stream[sno].status & Eof_Stream_f)) { - UNLOCK(GLOBAL_Stream[sno].streamlock); - /* handle CR before NL */ - if ((Int)sz - 2 >= 0 && buf[sz - 2] == 13) - buf[sz - 2] = '\0'; - else - buf[sz - 1] = '\0'; + UNLOCK(GLOBAL_Stream[sno].streamlock); + /* handle CR before NL */ + if ((Int)sz-2 >= 0 && buf[sz-2] == 13) + buf[sz-2] = '\0'; + else + buf[sz-1] = '\0'; } else { - UNLOCK(GLOBAL_Stream[sno].streamlock); + UNLOCK(GLOBAL_Stream[sno].streamlock); } if (arity == 2) - end = TermNil; + end = TermNil; else - end = Deref(XREGS[arity]); - return Yap_unify(ARG2, Yap_WCharsToDiffListOfCodes((const wchar_t *)TR, - end PASS_REGS)); - return Yap_unify(ARG2, - Yap_CharsToDiffListOfCodes((const char *)TR, end, - ENC_ISO_LATIN1 PASS_REGS)); + end = Deref(XREGS[arity]); + if (GLOBAL_Stream[sno].encoding == ENC_ISO_UTF8) + return Yap_unify(ARG2, Yap_UTF8ToDiffListOfCodes((const char *)TR, end PASS_REGS)) ; + else if (GLOBAL_Stream[sno].encoding == ENC_WCHAR) + return Yap_unify(ARG2, Yap_WCharsToDiffListOfCodes((const wchar_t *)TR, end PASS_REGS)) ; + return Yap_unify(ARG2, Yap_CharsToDiffListOfCodes((const char *)TR, end, ENC_ISO_LATIN1 PASS_REGS)) ; } - buf += (buf_sz - 1); - max_inp -= (buf_sz - 1); + buf += (buf_sz-1); + max_inp -= (buf_sz-1); if (max_inp <= 0) { UNLOCK(GLOBAL_Stream[sno].streamlock); Yap_Error(RESOURCE_ERROR_STACK, ARG1, "read_line_to_codes/%d", arity); - return FALSE; + return FALSE; } } } -static Int read_line_to_codes(USES_REGS1) { +static Int +read_line_to_codes(USES_REGS1) +{ return rl_to_codes(TermNil, FALSE, 2 PASS_REGS); } -static Int read_line_to_codes2(USES_REGS1) { +static Int +read_line_to_codes2(USES_REGS1) +{ return rl_to_codes(TermNil, TRUE, 3 PASS_REGS); } -static Int read_line_to_string(USES_REGS1) { - int sno = Yap_CheckStream(ARG1, Input_Stream_f, "read_line_to_codes/2"); +static Int +read_line_to_string( USES_REGS1 ) +{ + int sno = Yap_CheckStream (ARG1, Input_Stream_f, "read_line_to_codes/2"); Int status; - size_t max_inp, buf_sz; - unsigned char *buf; - StreamDesc *st = GLOBAL_Stream + sno; + UInt max_inp, buf_sz; + int *buf; + StreamDesc *st = GLOBAL_Stream+sno; if (sno < 0) return FALSE; status = GLOBAL_Stream[sno].status; if (status & Eof_Stream_f) { UNLOCK(GLOBAL_Stream[sno].streamlock); - return Yap_unify_constant(ARG2, MkAtomTerm(AtomEof)); + return Yap_unify_constant(ARG2, MkAtomTerm (AtomEof)); } - max_inp = (ASP - HR) / 2 - 1024; - buf = (unsigned char *)TR; - buf_sz = (unsigned char *)LOCAL_TrailTop - buf; + max_inp = (ASP-HR)/2-1024; + buf = (int *)TR; + buf_sz = (int *)LOCAL_TrailTop-buf; while (true) { size_t sz; - - if (buf_sz > max_inp) { + + if ( buf_sz > max_inp ) { buf_sz = max_inp; } - if (st->status & Binary_Stream_f) { - char *b = (char *)TR; - sz = fread(b, 1, buf_sz, GLOBAL_Stream[sno].file); + if (st->status & Binary_Stream_f) { + char *b = (char *)TR; + sz = fread( b,1 , buf_sz, GLOBAL_Stream[sno].file); } else { - uint32_t ch; - unsigned char *pt = buf; - do { - ch = st->stream_wgetc_for_read(sno); - if (ch == EOF) { - sz = -1; - break; - } - pt += put_utf8(pt, ch); - if (pt + 4 == buf + buf_sz) - break; - } while (ch != '\n'); - sz = pt - buf; - } + int ch; + int *pt = buf; + do { + *pt++ = ch = st->stream_wgetc_for_read(sno); + if (pt+1 == buf+buf_sz) + break; + } while (ch != '\n'); + sz = pt-buf; + } if (sz == -1 || sz == 0) { if (GLOBAL_Stream[sno].status & Eof_Stream_f) { UNLOCK(GLOBAL_Stream[sno].streamlock); - return Yap_unify_constant(ARG2, MkAtomTerm(AtomEof)); + return Yap_unify_constant(ARG2, MkAtomTerm (AtomEof)); } UNLOCK(GLOBAL_Stream[sno].streamlock); return false; } - if (GLOBAL_Stream[sno].status & Eof_Stream_f || buf[sz - 1] == 10) { + if (GLOBAL_Stream[sno].status & Eof_Stream_f || buf[sz-1] == 10) { /* we're done */ if (!(GLOBAL_Stream[sno].status & Eof_Stream_f)) { UNLOCK(GLOBAL_Stream[sno].streamlock); /* handle CR before NL */ - if ((Int)sz - 2 >= 0 && buf[sz - 2] == 13) - buf[sz - 2] = '\0'; + if ((Int)sz-2 >= 0 && buf[sz-2] == 13) + buf[sz-2] = '\0'; else { - buf[sz - 1] = '\0'; + buf[sz-1] = '\0'; } } else { UNLOCK(GLOBAL_Stream[sno].streamlock); } } if (GLOBAL_Stream[sno].encoding == ENC_ISO_UTF8) { - return Yap_unify(ARG2, Yap_UTF8ToString((const char *)TR PASS_REGS)); + return Yap_unify(ARG2, Yap_UTF8ToString((const char *)TR PASS_REGS)) ; } else if (GLOBAL_Stream[sno].encoding == ENC_WCHAR) { - return Yap_unify(ARG2, Yap_WCharsToString((const wchar_t *)TR PASS_REGS)); - } else { - return Yap_unify( - ARG2, Yap_CharsToString((const char *)TR, ENC_ISO_LATIN1 PASS_REGS)); + return Yap_unify(ARG2, Yap_WCharsToString((const wchar_t *)TR PASS_REGS)) ; + }else { + return Yap_unify(ARG2, Yap_CharsToString((const char *)TR, ENC_ISO_LATIN1 PASS_REGS) ); } - buf += (buf_sz - 1); - max_inp -= (buf_sz - 1); + buf += (buf_sz-1); + max_inp -= (buf_sz-1); if (max_inp <= 0) { UNLOCK(GLOBAL_Stream[sno].streamlock); Yap_Error(RESOURCE_ERROR_STACK, ARG1, NULL); - return FALSE; + return FALSE; } } } -static Int read_stream_to_codes(USES_REGS1) { - int sno = Yap_CheckStream(ARG1, Input_Stream_f, - "reaMkAtomTerm (AtomEofd_line_to_codes/2"); +static Int +read_stream_to_codes(USES_REGS1) +{ + int sno = Yap_CheckStream (ARG1, Input_Stream_f, "reaMkAtomTerm (AtomEofd_line_to_codes/2"); CELL *HBASE = HR; CELL *h0 = &ARG4; @@ -217,33 +221,36 @@ static Int read_stream_to_codes(USES_REGS1) { t = MkIntegerTerm(ch); h0[0] = AbsPair(HR); *HR = t; - HR += 2; - h0 = HR - 1; + HR+=2; + h0 = HR-1; yhandle_t news, news1, st = Yap_StartSlots(); - if (HR >= ASP - 1024) { + if (HR >= ASP-1024) { RESET_VARIABLE(h0); news = Yap_InitSlot(AbsPair(HBASE)); - news1 = Yap_InitSlot((CELL)(h0)); - if (!Yap_gcl((ASP - HBASE) * sizeof(CELL), 3, ENV, Yap_gcP())) { + news1 = Yap_InitSlot( (CELL)(h0)); + if (!Yap_gcl((ASP-HBASE)*sizeof(CELL), 3, ENV, Yap_gcP())) { Yap_Error(RESOURCE_ERROR_STACK, ARG1, "read_stream_to_codes/3"); return false; } /* build a legal term again */ - h0 = (CELL *)(Yap_GetFromSlot(news1)); + h0 = (CELL*)(Yap_GetFromSlot(news1)); HBASE = RepPair(Yap_GetFromSlot(news)); } Yap_CloseSlots(st); } UNLOCK(GLOBAL_Stream[sno].streamlock); if (HR == HBASE) - return Yap_unify(ARG2, ARG3); - RESET_VARIABLE(HR - 1); - Yap_unify(HR[-1], ARG3); - return Yap_unify(AbsPair(HBASE), ARG2); + return Yap_unify(ARG2,ARG3); + RESET_VARIABLE(HR-1); + Yap_unify(HR[-1],ARG3); + return Yap_unify(AbsPair(HBASE),ARG2); + } -static Int read_stream_to_terms(USES_REGS1) { - int sno = Yap_CheckStream(ARG1, Input_Stream_f, "read_line_to_codes/2"); +static Int +read_stream_to_terms(USES_REGS1) +{ + int sno = Yap_CheckStream (ARG1, Input_Stream_f, "read_line_to_codes/2"); Term t, hd; yhandle_t tails, news; @@ -252,18 +259,18 @@ static Int read_stream_to_terms(USES_REGS1) { t = AbsPair(HR); RESET_VARIABLE(HR); - Yap_InitSlot((CELL)(HR)); - tails = Yap_InitSlot((CELL)(HR)); - news = Yap_InitSlot((CELL)(HR)); + Yap_InitSlot( (CELL)(HR) ); + tails = Yap_InitSlot( (CELL)(HR) ); + news = Yap_InitSlot( (CELL)(HR) ); HR++; - + while (!(GLOBAL_Stream[sno].status & Eof_Stream_f)) { RESET_VARIABLE(HR); - RESET_VARIABLE(HR + 1); + RESET_VARIABLE(HR+1); hd = (CELL)HR; - Yap_PutInSlot(news, (CELL)(HR + 1)); + Yap_PutInSlot(news, (CELL)(HR+1)); HR += 2; - while ((hd = Yap_read_term(sno, TermNil, 2)) == 0L) + while ((hd=Yap_read_term(sno, TermNil, 2)) == 0L) ; // just ignore failure CELL *pt = VarOfTerm(Yap_GetFromSlot(tails)); @@ -271,17 +278,19 @@ static Int read_stream_to_terms(USES_REGS1) { *pt = Deref(ARG3); break; } else { - CELL *newpt = (CELL *)Yap_GetFromSlot(news); - *pt = AbsPair(newpt - 1); - Yap_PutInSlot(tails, (CELL)newpt); + CELL *newpt = (CELL*)Yap_GetFromSlot(news); + *pt =AbsPair(newpt-1); + Yap_PutInSlot(tails, (CELL)newpt); } } UNLOCK(GLOBAL_Stream[sno].streamlock); - return Yap_unify(t, ARG2); + return Yap_unify(t,ARG2); } -void Yap_InitReadUtil(void) { - CACHE_REGS +void +Yap_InitReadUtil(void) +{ + CACHE_REGS Term cm = CurrentModule; CurrentModule = READUTIL_MODULE; @@ -292,3 +301,4 @@ void Yap_InitReadUtil(void) { Yap_InitCPred("read_stream_to_terms", 3, read_stream_to_terms, SyncPredFlag); CurrentModule = cm; } + diff --git a/os/sig.c b/os/sig.c index 2cc4c5052..0dfa7e304 100644 --- a/os/sig.c +++ b/os/sig.c @@ -363,7 +363,7 @@ Yap_MathException__( USES_REGS1 ) return EVALUATION_ERROR_UNDEFINED; } } -#elif _WIN32 && FALSE +#elif _WIN32 unsigned int raised; int err; diff --git a/os/streams.c b/os/streams.c index 7ad2480f0..5a9ef6d59 100644 --- a/os/streams.c +++ b/os/streams.c @@ -881,8 +881,14 @@ void Yap_CloseStreams(int loud) { for (sno = 3; sno < MaxStreams; ++sno) { if (GLOBAL_Stream[sno].status & Free_Stream_f) continue; - if ((GLOBAL_Stream[sno].status & Popen_Stream_f)) - pclose(GLOBAL_Stream[sno].file); + if ((GLOBAL_Stream[sno].status & Popen_Stream_f)) { +#if _MSC_VER + + _pclose(GLOBAL_Stream[sno].file); +#else + pclose(GLOBAL_Stream[sno].file); +#endif + } if (GLOBAL_Stream[sno].status & (Pipe_Stream_f | Socket_Stream_f)) close(GLOBAL_Stream[sno].u.pipe.fd); #if USE_SOCKET diff --git a/os/sysbits.c b/os/sysbits.c index cd14fb38a..c74f5949b 100644 --- a/os/sysbits.c +++ b/os/sysbits.c @@ -23,7 +23,7 @@ static char SccsId[] = "%W% %G%"; /// File Error Handler static void -Yap_FileError(yap_error_number type, Term where, const char *format,...) +FileError(yap_error_number type, Term where, const char *format,...) { if ( trueLocalPrologFlag(FILEERRORS_FLAG) ) { @@ -53,7 +53,7 @@ static int chdir(char *); /* #define signal skel_signal */ #endif /* MACYAP */ static const char * -expandVars(const char *spec); +expandVars(const char *spec, char *u); void exit(int); @@ -245,7 +245,11 @@ has_access(const char *FileName, int mode) static bool exists( const char *f) { +#if _MSC_VER + return has_access(f, 00); +#else return has_access( f, F_OK ); +#endif } static int @@ -279,7 +283,7 @@ bool Yap_IsAbsolutePath(const char *p0) { // verify first if expansion is needed: ~/ or $HOME/ - const char *p = expandVars( p0 ); + const char *p = expandVars( p0, LOCAL_FileNameBuf ); bool nrc; #if _WIN32 || __MINGW32__ nrc = !PathIsRelative(p); @@ -334,13 +338,13 @@ PlExpandVars (const char *source, const char *root, char *result) res++, src++; res[0] = '\0'; if ((user_passwd = getpwnam (result)) == NULL) { - Yap_FileError(SYSTEM_ERROR_OPERATING_SYSTEM, MkAtomTerm(Yap_LookupAtom(source)),"User %s does not exist in %s", result, source); + FileError(SYSTEM_ERROR_OPERATING_SYSTEM, MkAtomTerm(Yap_LookupAtom(source)),"User %s does not exist in %s", result, source); return NULL; } strncpy (result, user_passwd->pw_dir, YAP_FILENAME_MAX); strcat(result, src); #else - Yap_FileError(SYSTEM_ERROR_OPERATING_SYSTEM, MkAtomTerm(Yap_LookupAtom(source)),"User %s cannot be found in %s, missing getpwnam", result, source); + FileError(SYSTEM_ERROR_OPERATING_SYSTEM, MkAtomTerm(Yap_LookupAtom(source)),"User %s cannot be found in %s, missing getpwnam", result, source); return NULL; #endif } @@ -531,7 +535,7 @@ DirName(const char *X) { if (!o) return NULL; if (( err = _splitpath_s(o, drive, YAP_FILENAME_MAX-1, dir, YAP_FILENAME_MAX-1,NULL, 0, NULL, 0) ) != 0) { - Yap_FileError(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil, "could not perform _splitpath %s: %s", X, strerror(errno)); + FileError(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil, "could not perform _splitpath %s: %s", X, strerror(errno)); return NULL; } @@ -541,14 +545,15 @@ DirName(const char *X) { } #endif -static const char *myrealpath( const char *path, char *out) +static const char *myrealpath( const char *path) { #if _WIN32 || defined(__MINGW32__) DWORD retval=0; + char *out = LOCAL_FileNameBuf; // notice that the file does not need to exist retval = GetFullPathName(path, - MAX_PATH-1, + YAP_FILENAME_MAX, out, NULL); @@ -589,23 +594,22 @@ static const char *myrealpath( const char *path, char *out) } #endif strcat(rc, b); - return rc; + return rc; } } } +#else + char *out = malloc(strlen(path)+1); + strcpy( out, path); + return out; #endif - char *rc = malloc(strlen(path)+1); - strcpy( rc, path); - const char * f = rc; - return f; } static const char * -expandVars(const char *spec) +expandVars(const char *spec, char *u) { CACHE_REGS #if _WIN32 || defined(__MINGW32__) - char u[YAP_FILENAME_MAX+1]; char *out; // first pass, remove Unix style stuff @@ -621,7 +625,7 @@ expandVars(const char *spec) if (IsPairTerm(t)) return RepAtom(AtomOfTerm(HeadOfTerm(t)))->StrOfAE; return NULL; - } + } return spec; } @@ -641,7 +645,7 @@ Yap_AbsoluteFile(const char *spec, bool ok) rc = PlExpandVars(spec, NULL, NULL); if (!rc) rc = spec; - if ((p = myrealpath(rc, NULL )) ) { + if ((p = myrealpath(rc) ) ) { return p; } else { return NULL; @@ -650,7 +654,7 @@ Yap_AbsoluteFile(const char *spec, bool ok) } /** - * generate absolute path and stores path in an user given buffer. If + * generate absolute path and stores path in an user given buffer. If * NULL, uses a temporary buffer that must be quickly released. * * if ok first expand variable names and do globbing @@ -667,14 +671,12 @@ Yap_AbsoluteFileInBuffer(const char *spec, char *out, size_t sz, bool ok) const char*p; const char*rc; if (ok) { - rc = expandVars(spec); + rc = expandVars(spec, LOCAL_FileNameBuf); if (!rc) return spec; - } else { - rc = spec; - } - - if ((p = myrealpath(rc, out) ) ) { + } + + if ((p = myrealpath(rc) ) ) { if (!out) { out = LOCAL_FileNameBuf; sz = YAP_FILENAME_MAX-1; @@ -703,12 +705,12 @@ do_glob(const char *spec, bool glob_vs_wordexp) { WIN32_FIND_DATA find; HANDLE hFind; + const char *espec; CELL *dest; - char *espec; - Term tf; + Term tf; // first pass, remove Unix style stuff - if ((espec =unix2win(spec, u, YAP_FILENAME_MAX)) == NULL) + if (unix2win(espec, u, YAP_FILENAME_MAX) == NULL) return TermNil; espec = (const char *)u; @@ -861,7 +863,6 @@ prolog_realpath( USES_REGS1 ) { Term t1 = Deref(ARG1); const char *cmd; - char out[YAP_FILENAME_MAX]; if (IsAtomTerm(t1)) { cmd = RepAtom(AtomOfTerm(t1))->StrOfAE; @@ -870,7 +871,7 @@ prolog_realpath( USES_REGS1 ) } else { return false; } - const char *rc = myrealpath( cmd , out); + const char *rc = myrealpath( cmd ); if (!rc) { PlIOError( SYSTEM_ERROR_OPERATING_SYSTEM, ARG1, strerror(errno)); return false; @@ -903,7 +904,7 @@ static const param_t expand_filename_defs[] = {EXPAND_FILENAME_DEFS()}; static Term do_expand_file_name(Term t1, Term opts USES_REGS) -{ +{ xarg *args; expand_filename_enum_choices_t i; bool use_system_expansion = true; @@ -925,6 +926,7 @@ do_expand_file_name(Term t1, Term opts USES_REGS) args = Yap_ArgListToVector(opts, expand_filename_defs, EXPAND_FILENAME_END); if (args == NULL) { return TermNil; + } tmpe = malloc(YAP_FILENAME_MAX+1); @@ -934,7 +936,7 @@ do_expand_file_name(Term t1, Term opts USES_REGS) switch (i) { case EXPAND_FILENAME_PARAMETER_EXPANSION: if (t == TermProlog) { - const char *s = expandVars( spec); + const char *s = expandVars( spec, LOCAL_FileNameBuf); if (s == NULL) { return TermNil; } @@ -962,7 +964,7 @@ do_expand_file_name(Term t1, Term opts USES_REGS) if (!use_system_expansion) { - return MkPairTerm(MkAtomTerm(Yap_LookupAtom(expandVars(spec))), TermNil); + return MkPairTerm(MkAtomTerm(Yap_LookupAtom(expandVars(spec, NULL))), TermNil); } tf = do_glob(spec, true); return tf; @@ -971,7 +973,7 @@ do_expand_file_name(Term t1, Term opts USES_REGS) /* @pred expand_file_name( +Pattern, -ListOfPaths) is det This builtin receives a pattern and expands it into a list of files. - In Unix-like systems, YAP applies glob to expand patterns such as '*', '.', and '?'. Further variable expansion + In Unix-like systems, YAP applies glob to expand patterns such as '*', '.', and '?'. Further variable expansion may also happen. glob is shell-dependent: som Yap_InitCPred ("absolute_file_system_path", 2, absolute_file_system_path, 0); Yap_InitCPred ("real_path", 2, prolog_realpath, 0); Yap_InitCPred ("true_file_name", 2, @@ -1203,7 +1205,7 @@ initSysPath(Term tlib, Term tcommons, bool dir_done, bool commons_done) { while (*--pt != '\\') { /* skip executable */ if (pt == LOCAL_FileNameBuf) { - Yap_FileError(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil, "could not find executable name"); + FileError(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil, "could not find executable name"); /* do nothing */ return FALSE; } @@ -1211,7 +1213,7 @@ initSysPath(Term tlib, Term tcommons, bool dir_done, bool commons_done) { while (*--pt != '\\') { /* skip parent directory "bin\\" */ if (pt == LOCAL_FileNameBuf) { - Yap_FileError(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil, "could not find executable name"); + FileError(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil, "could not find executable name"); /* do nothing */ return FALSE; } @@ -1788,7 +1790,7 @@ p_mv ( USES_REGS1 ) Yap_Error(TYPE_ERROR_ATOM, t2, "second argument to rename/2 not atom"); } else { oldname = (RepAtom(AtomOfTerm(t1)))->StrOfAE; - newname = (RepAtom(AtomOfTerm(t2)))->StrOfAE; + newname = (RepAtom(AtomOfTerm(t2)))->StrOfAE; if ((r = link (oldname, newname)) == 0 && (r = unlink (oldname)) != 0) unlink (newname); if (r != 0) { @@ -2299,3 +2301,4 @@ Yap_InitSysPreds(void) Yap_InitCPred ("rmdir", 2, p_rmdir, SyncPredFlag); Yap_InitCPred ("make_directory", 1, make_directory, SyncPredFlag); } + diff --git a/os/sysbits.h b/os/sysbits.h index 36d0103f7..fef730622 100644 --- a/os/sysbits.h +++ b/os/sysbits.h @@ -153,6 +153,6 @@ void Yap_InitRandom (void); void Yap_InitTime (int wid); void Yap_InitOSSignals (int wid); void Yap_InitWTime(void); -void Yap_InitLastWTime ( void ); + diff --git a/os/time.c b/os/time.c index 617d0fca9..a46d5124c 100644 --- a/os/time.c +++ b/os/time.c @@ -152,7 +152,7 @@ void Yap_systime_interval(Int *now,Int *interval) #include - static FILETIME StartOfTimes, last_time; +static FILETIME StartOfTimes, last_time; static FILETIME StartOfTimes_sys, last_time_sys; @@ -530,6 +530,8 @@ real_cputime () #endif /* HAVE_GETRUSAGE */ +uint64_t Yap_StartOfWTimes; + #if HAVE_GETHRTIME #if HAVE_TIME_H @@ -537,92 +539,48 @@ real_cputime () #endif /* since the point YAP was started */ -static hrtime_t StartOfWTimes; -/* since last call to walltime */ -#define LastWTime (*(hrtime_t *)ALIGN_BY_TYPE(GLOBAL_LastWTimePtr,hrtime_t)) - -static void + void Yap_InitWTime (void) { - StartOfWTimes = gethrtime(); + Yap_StartOfWTimes = (uint64_t)gethrtime(); } -static void -Yap_InitLastWTime(void) { - /* ask for twice the space in order to guarantee alignment */ - GLOBAL_LastWTimePtr = (void *)Yap_AllocCodeSpace(2*sizeof(hrtime_t)); - LastWTime = StartOfWTimes; -} - -Int -Yap_walltime (void) +/// returns time since Jan 1 1980 in nano-seconds +uint64_t Yap_walltime(uint64_t old) { - hrtime_t tp = gethrtime(); - /* return time in milliseconds */ - return((Int)((tp-StartOfWTimes)/((hrtime_t)1000000))); - + hrtime_t tp = gethrtime(); + /* return time in milliseconds */ + return = (uint64_t)tp; } -void Yap_walltime_interval(Int *now,Int *interval) -{ - hrtime_t tp = gethrtime(); - /* return time in milliseconds */ - *now = (Int)((tp-StartOfWTimes)/((hrtime_t)1000000)); - *interval = (Int)((tp-LastWTime)/((hrtime_t)1000000)); - LastWTime = tp; -} #elif HAVE_GETTIMEOFDAY /* since the point YAP was started */ -static struct timeval StartOfWTimes; - -/* since last call to walltime */ -#define LastWTime (*(struct timeval *)GLOBAL_LastWTimePtr) - /* store user time in this variable */ void Yap_InitWTime (void) { - gettimeofday(&StartOfWTimes,NULL); + struct timeval tp; + + gettimeofday(&tp, NULL); + Yap_StartOfWTimes = (uint64_t)tp.tv_sec * 1000000000 + (uint64_t)tp.tv_usec * 1000; } - void -Yap_InitLastWTime(void) { - GLOBAL_LastWTimePtr = (void *)Yap_AllocCodeSpace(sizeof(struct timeval)); - LastWTime.tv_usec = StartOfWTimes.tv_usec; - LastWTime.tv_sec = StartOfWTimes.tv_sec; -} - - -Int -Yap_walltime (void) + + /// returns time in nano-secs since the epoch +uint64_t +Yap_walltime(void) { - struct timeval tp; + struct timeval tp; - gettimeofday(&tp,NULL); - if (StartOfWTimes.tv_usec > tp.tv_usec) - return((tp.tv_sec - StartOfWTimes.tv_sec - 1) * 1000 + - (StartOfWTimes.tv_usec - tp.tv_usec) /1000); - else - return((tp.tv_sec - StartOfWTimes.tv_sec)) * 1000 + - ((tp.tv_usec - LastWTime.tv_usec) / 1000); + gettimeofday(&tp, NULL); + return (uint64_t)tp.tv_sec * 1000000000 + (uint64_t)tp.tv_usec * 1000; } -void Yap_walltime_interval(Int *now,Int *interval) -{ - struct timeval tp; - gettimeofday(&tp,NULL); - *now = (tp.tv_sec - StartOfWTimes.tv_sec) * 1000 + - (tp.tv_usec - StartOfWTimes.tv_usec) / 1000; - *interval = (tp.tv_sec - LastWTime.tv_sec) * 1000 + - (tp.tv_usec - LastWTime.tv_usec) / 1000; - LastWTime.tv_usec = tp.tv_usec; - LastWTime.tv_sec = tp.tv_sec; -} #elif defined(_WIN32) @@ -630,103 +588,68 @@ void Yap_walltime_interval(Int *now,Int *interval) #include /* since the point YAP was started */ -static struct _timeb StartOfWTimes; - -/* since last call to walltime */ -#define LastWTime (*(struct timeb *)GLOBAL_LastWTimePtr) +static LARGE_INTEGER Frequency; /* store user time in this variable */ -static void -InitWTime (void) + void +Yap_InitWTime (void) { - _ftime(&StartOfWTimes); -} - -static void -InitLastWTime(void) { - GLOBAL_LastWTimePtr = (void *)Yap_AllocCodeSpace(sizeof(struct timeb)); - LastWTime.time = StartOfWTimes.time; - LastWTime.millitm = StartOfWTimes.millitm; + LARGE_INTEGER ElapsedNanoseconds; + QueryPerformanceFrequency(&Frequency); + QueryPerformanceCounter(&ElapsedNanoseconds); + ElapsedNanoseconds.QuadPart *= 1000000; + ElapsedNanoseconds.QuadPart /= Frequency.QuadPart; + Yap_StartOfWTimes = (uint64_t)ElapsedNanoseconds.QuadPart; } -Int + +uint64_t Yap_walltime (void) { - struct _timeb tp; + LARGE_INTEGER ElapsedNanoseconds; + QueryPerformanceCounter(&ElapsedNanoseconds); + // + // We now have the elapsed number of ticks, along with the + // number of ticks-per-second. We use these values + // to convert to the number of elapsed microseconds. + // To guard against loss-of-precision, we convert + // to microseconds *before* dividing by ticks-per-second. + // - _ftime(&tp); - if (StartOfWTimes.millitm > tp.millitm) - return((tp.time - StartOfWTimes.time - 1) * 1000 + - (StartOfWTimes.millitm - tp.millitm)); - else - return((tp.time - StartOfWTimes.time)) * 1000 + - ((tp.millitm - LastWTime.millitm) / 1000); -} - -void Yap_walltime_interval(Int *now,Int *interval) -{ - struct _timeb tp; - - _ftime(&tp); - *now = (tp.time - StartOfWTimes.time) * 1000 + - (tp.millitm - StartOfWTimes.millitm); - *interval = (tp.time - LastWTime.time) * 1000 + - (tp.millitm - LastWTime.millitm) ; - LastWTime.millitm = tp.millitm; - LastWTime.time = tp.time; + ElapsedNanoseconds.QuadPart *= 1000000; + ElapsedNanoseconds.QuadPart /= Frequency.QuadPart; + return ElapsedNanoseconds.QuadPart; } #elif HAVE_TIMES -static clock_t StartOfWTimes; - -#define LastWTime (*(clock_t *)GLOBAL_LastWTimePtr) - /* store user time in this variable */ -static void -InitWTime (void) + void +Yap_InitWTime (void) { - StartOfWTimes = times(NULL); + Yap_StartOfWTimes = ((uint64_t)times(NULL))*10000000/TicksPerSec; } -static void -InitLastWTime(void) { - GLOBAL_LastWTimePtr = (void *)Yap_AllocCodeSpace(sizeof(clock_t)); - LastWTime = StartOfWTimes; -} - -Int +uint64_t Yap_walltime (void) { clock_t t; t = times(NULL); - return ((t - StartOfWTimes)*1000 / TicksPerSec)); + return = ((uint64_t)times(NULL)) * 10000000 / TicksPerSec; } -void Yap_walltime_interval(Int *now,Int *interval) -{ - clock_t t; - t = times(NULL); - *now = ((t - StartOfWTimes)*1000) / TicksPerSec; - *interval = (t - GLOBAL_LastWTime) * 1000 / TicksPerSec; -} - - #endif /* HAVE_TIMES */ void Yap_ReInitWTime (void) { Yap_InitWTime(); - if (GLOBAL_LastWTimePtr != NULL) - Yap_FreeCodeSpace(GLOBAL_LastWTimePtr); - Yap_InitLastWTime(); - } + } void Yap_InitTimePreds(void) { /* can only do after heap is initialized */ - Yap_InitLastWTime(); + Yap_InitWTime(); } diff --git a/os/yapio.h b/os/yapio.h index c48af2472..ee42682c6 100644 --- a/os/yapio.h +++ b/os/yapio.h @@ -161,7 +161,7 @@ INLINE_ONLY inline EXTERN Term MkCharTerm(Int c); * @return the term. */ INLINE_ONLY inline EXTERN Term MkCharTerm(Int c) { - wchar_t cs[2]; + int cs[2]; if (c < 0) return MkAtomTerm(AtomEof); cs[0] = c; diff --git a/packages/CLPBN/CMakeLists.txt b/packages/CLPBN/CMakeLists.txt index afac66d1a..df9f8f03d 100644 --- a/packages/CLPBN/CMakeLists.txt +++ b/packages/CLPBN/CMakeLists.txt @@ -89,7 +89,9 @@ set( ex/learning/train.yap ) +IF (WITH_HORUS) add_subDIRECTORY (horus) +ENDIF() install(FILES ${CLPBN_TOP} diff --git a/packages/jpl/CMakeLists.txt b/packages/jpl/CMakeLists.txt index bf5542d06..0e8f95591 100644 --- a/packages/jpl/CMakeLists.txt +++ b/packages/jpl/CMakeLists.txt @@ -1,21 +1,19 @@ #CHECK: JavaLibs +set (JPL_SOURCES + src/c/jpl.c) find_package(Java COMPONENTS Runtime Development) # find_package(Java COMPONENTS Development) # find_package(Java COMPONENTS Runtime) #find_package(JavaLibs) - -set (JPL_SOURCES - src/c/jpl.c) - macro_log_feature (Java_Development_FOUND "Java" "Use Java System" "http://www.java.org" FALSE) - find_package(JNI) -if (Java_Development_FOUND AND JNI_FOUND) +if (Java_Development_FOUND) + find_package(JNI) include(UseJava) # @@ -56,4 +54,4 @@ if (Java_Development_FOUND AND JNI_FOUND) DESTINATION ${libpl} ) -endif (Java_Development_FOUND AND JNI_FOUND) +endif (Java_Development_FOUND) diff --git a/packages/jpl/src/c/CMakeLists.txt b/packages/jpl/src/c/CMakeLists.txt index b8d5f8849..3cdaa7e35 100644 --- a/packages/jpl/src/c/CMakeLists.txt +++ b/packages/jpl/src/c/CMakeLists.txt @@ -12,6 +12,7 @@ include_directories (${JAVA_INCLUDE_DIRS} ${JNI_INCLUDE_DIRS} ) # set(YAP_SYSTEM_OPTIONS "jpl " ${YAP_SYSTEM_OPTIONS} PARENT_SCOPE) install(TARGETS jplYap LIBRARY DESTINATION ${dlls} + ARCHIVE DESTINATION ${dlls} ) diff --git a/packages/jpl/src/c/jpl.c b/packages/jpl/src/c/jpl.c index 03a7c3fb7..6d3840564 100755 --- a/packages/jpl/src/c/jpl.c +++ b/packages/jpl/src/c/jpl.c @@ -48,9 +48,11 @@ refactoring (trivial): #define JPL_C_LIB_VERSION_PATCH 4 #define JPL_C_LIB_VERSION_STATUS "alpha" +#if JPL_DEBUG /*#define DEBUG(n, g) ((void)0) */ #define DEBUG_LEVEL 4 #define JPL_DEBUG(n, g) ( n >= DEBUG_LEVEL ? g : (void)0 ) +#endif /* disable type-of-ref caching (at least until GC issues are resolved) */ #define JPL_CACHE_TYPE_OF_REF FALSE diff --git a/packages/myddas/myddas_statistics.c b/packages/myddas/myddas_statistics.c index 435c4da6c..64455bdf9 100644 --- a/packages/myddas/myddas_statistics.c +++ b/packages/myddas/myddas_statistics.c @@ -1,5 +1,7 @@ #include +#if HAVE_SYS_TIME_H #include +#endif #if defined MYDDAS_STATS diff --git a/packages/swi-minisat2/C/Solver.h b/packages/swi-minisat2/C/Solver.h index 7f6086844..fc41a7e0b 100644 --- a/packages/swi-minisat2/C/Solver.h +++ b/packages/swi-minisat2/C/Solver.h @@ -264,7 +264,7 @@ inline bool Solver::okay () const { return ok; } // Debug + etc: -#define reportf(format, args...) ( fflush(stdout), fprintf(stderr, format, ## args), fflush(stderr) ) +#define reportf(...) ( fflush(stdout), fprintf(stderr, __VA_ARGS__), fflush(stderr) ) static inline void logLit(FILE* f, Lit l) { diff --git a/pl/CMakeLists.txt b/pl/CMakeLists.txt index d3eb9f92e..523775d73 100644 --- a/pl/CMakeLists.txt +++ b/pl/CMakeLists.txt @@ -18,7 +18,6 @@ set(PL_SOURCES directives.yap eam.yap eval.yap - error.yap errors.yap flags.yap grammar.yap @@ -26,6 +25,7 @@ set(PL_SOURCES hacks.yap init.yap listing.yap + lists.yap load_foreign.yap messages.yap meta.yap @@ -48,6 +48,7 @@ set(PL_SOURCES udi.yap undefined.yap utils.yap + history.pl swi.yap yapor.yap yio.yap diff --git a/pl/absf.yap b/pl/absf.yap index 56d04557d..fbf181066 100755 --- a/pl/absf.yap +++ b/pl/absf.yap @@ -654,13 +654,6 @@ user:prolog_file_type(A, prolog) :- A \== pl, A \== yap. user:prolog_file_type(qly, qly). -user:prolog_file_type(c, c). -user:prolog_file_type(h, c). -user:prolog_file_type(py, python). -user:prolog_file_type(r, 'R'). -user:prolog_file_type(cc, 'c++'). -user:prolog_file_type(hh, 'c++'). -user:prolog_file_type(java, 'c++'). user:prolog_file_type(A, executable) :- current_prolog_flag(shared_object_extension, A). diff --git a/pl/boot.yap b/pl/boot.yap index a11d920b8..6f8cbb383 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -171,11 +171,7 @@ list, since backtracking could not "pass through" the cut. */ -system_module(_Mod, _SysExps, _Decls) :- ! , - source_module( prolog ), !. -system_module(_Mod, _SysExps, _Decls) :- - nb_setval('$if_skip_mode',skip). - +system_module(_Mod, _SysExps, _Decls) :- ! . % new_system_module(Mod). use_system_module(_init, _SysExps) :- !. @@ -1421,8 +1417,8 @@ bootstrap(F) :- !. '$loop'(Stream,Status) :- % start_low_level_trace, + '$current_module'( OldModule ), repeat, - source_module( OldModule ), '$system_catch'( '$enter_command'(Stream,OldModule,Status), OldModule, Error, user:'$LoopError'(Error, Status) diff --git a/pl/consult.yap b/pl/consult.yap index d1031f602..1332668fd 100644 --- a/pl/consult.yap +++ b/pl/consult.yap @@ -708,7 +708,7 @@ db_files(Fs) :- ), '$loop'(Stream,Reconsult), '$lf_opt'(imports, TOpts, Imports), - '$import_to_current_module'(File, SourceModule, Imports, _, TOpts), + '$import_to_current_module'(File, ContextModule, Imports, _, TOpts), '$current_module'(Mod, SourceModule), H is heapused-H0, '$cputime'(TF,_), T is TF-T0, '$early_print'(Verbosity, loaded(EndMsg, File, Mod, T, H)), diff --git a/pl/corout.yap b/pl/corout.yap index 1edb31160..c6cf548b4 100644 --- a/pl/corout.yap +++ b/pl/corout.yap @@ -26,9 +26,9 @@ * */ -:- op(1150, fx, prolog:block). :- module('$coroutining',[ + op(1150, fx, block) %dif/2, %when/2, %block/1, diff --git a/pl/init.yap b/pl/init.yap index bc29c64b1..12f8750a0 100644 --- a/pl/init.yap +++ b/pl/init.yap @@ -115,7 +115,7 @@ otherwise. :- compile_expressions. -:- bootstrap('../library/bootlists.yap'). +:- bootstrap('lists.yap'). :- bootstrap('consult.yap'). :- bootstrap('preddecls.yap'). :- bootstrap('preddyns.yap'). diff --git a/pl/messages.yap b/pl/messages.yap index 959bb5c09..d955518fe 100644 --- a/pl/messages.yap +++ b/pl/messages.yap @@ -213,7 +213,7 @@ compose_message(Term, Level) --> main_message( Term, Level, LC ), [nl,nl]. -location(error(syntax_error(syntax_error(_,between(_,LN,_),FileName,_)), _), _ ) --> +location(error(syntax_error(syntax_error(_,between(_,LN,_),FileName,_))), _ ) --> !, [ '~a:~d:0: ' - [FileName,LN] ] . location(error(style_check(style_check(_,LN,FileName,_ ) ),_), _ ) --> diff --git a/pl/utils.yap b/pl/utils.yap index e1a2c2eb3..800d63438 100644 --- a/pl/utils.yap +++ b/pl/utils.yap @@ -48,45 +48,37 @@ a postfix operator. */ op(P,T,V) :- - '$yap_strip_module'(V, M, N), - '$check_top_op'(P,T,N,M,op(P,T,V)). + '$check_op'(P,T,V,op(P,T,V)), + '$op'(P, T, V). % just check the operator declarations for correctness. -'$check_top_op'(P,T,Op,_M,G) :- +'$check_op'(P,T,Op,G) :- ( var(P) ; var(T); var(Op)), !, '$do_error'(instantiation_error,G). -'$check_top_op'(P,_,_,_,G) :- +'$check_op'(P,_,_,G) :- \+ integer(P), !, '$do_error'(type_error(integer,P),G). -'$check_top_op'(P,_,_,_,G) :- +'$check_op'(P,_,_,G) :- P < 0, !, '$do_error'(domain_error(operator_priority,P),G). -'$check_top_op'(_,T,_,_,G) :- +'$check_op'(_,T,_,G) :- \+ atom(T), !, '$do_error'(type_error(atom,T),G). -'$check_top_op'(_,T,_,_,G) :- +'$check_op'(_,T,_,G) :- \+ '$associativity'(T), !, '$do_error'(domain_error(operator_specifier,T),G). -'$check_top_op'(P, T, M:Op, _M, G) :- !, - '$vsc_strip_module'(M:Op, M1, Op1), - ( - atom(M1) - -> - '$check_top_op'(P, T, Op1, M1, G) - ; - '$do_error'(type_error(atom,Op),G) - ). -'$check_top_op'(P, T, [Op|NV], M, G) :- !, - '$check_top_op'(P, T, Op, M, G), - (NV = [] - -> - true - ; - '$check_top_op'(P, T, NV, M, G) - ). -'$check_top_op'(P, T, V, M, G) :- - '$check_op_name'(P, T, V, M, G), - '$opdec'(P, T, V, M). +'$check_op'(P,T,V,G) :- + '$check_module_for_op'(V, G, NV), + '$check_top_op'(P, T, NV, G). + +'$check_top_op'(_, _, [], _) :- !. +'$check_top_op'(P, T, [Op|NV], G) :- !, + '$check_ops'(P, T, Op.NV, G). +'$check_top_op'(P, T, V, G) :- + atom(V), !, + '$check_op_name'(P, T, V, G). +'$check_top_op'(_P, _T, V, G) :- + '$do_error'(type_error(atom,V),G). '$associativity'(xfx). '$associativity'(xfy). @@ -97,16 +89,43 @@ a postfix operator. '$associativity'(fx). '$associativity'(fy). -'$check_op_name'(_,_,V,_,G) :- +'$check_module_for_op'(MOp, G, _) :- + var(MOp), !, + '$do_error'(instantiation_error,G). +'$check_module_for_op'(M:_V, G, _) :- + var(M), !, + '$do_error'(instantiation_error,G). +'$check_module_for_op'(M:V, G, NV) :- + atom(M), !, + '$check_module_for_op'(V, G, NV). +'$check_module_for_op'(M:_V, G, _) :- !, + '$do_error'(type_error(atom,M),G). +'$check_module_for_op'(V, _G, V). + +'$check_ops'(_P, _T, [], _G) :- !. +'$check_ops'(P, T, [Op|NV], G) :- !, + ( + var(NV) + -> + '$do_error'(instantiation_error,G) + ; + '$check_module_for_op'(Op, G, NOp), + '$check_op_name'(P, T, NOp, G), + '$check_ops'(P, T, NV, G) + ). +'$check_ops'(_P, _T, Ops, G) :- + '$do_error'(type_error(list,Ops),G). + +'$check_op_name'(_,_,V,G) :- var(V), !, '$do_error'(instantiation_error,G). - '$check_op_name'(_,_,',',_,G) :- !, + '$check_op_name'(_,_,',',G) :- !, '$do_error'(permission_error(modify,operator,','),G). -'$check_op_name'(_,_,'[]',_,G) :- T \= yf, T\= xf, !, +'$check_op_name'(_,_,'[]',G) :- T \= yf, T\= xf, !, '$do_error'(permission_error(create,operator,'[]'),G). -'$check_op_name'(_,_,'{}',_,G) :- T \= yf, T\= xf, !, +'$check_op_name'(_,_,'{}',G) :- T \= yf, T\= xf, !, '$do_error'(permission_error(create,operator,'{}'),G). -'$check_op_name'(P,T,'|',_,G) :- +'$check_op_name'(P,T,'|',G) :- ( integer(P), P < 1001, P > 0 @@ -114,31 +133,77 @@ a postfix operator. atom_codes(T,[_,_]) ), !, '$do_error'(permission_error(create,operator,'|'),G). -'$check_op_name'(P,T,A,M,_G) :- - atom(A), !, - '$opdec'( P, T, A, M). -'$check_op_name'(_,_,A,_,G) :- +'$check_op_name'(_,_,V,_) :- + atom(V), !. +'$check_op_name'(_,_,A,G) :- '$do_error'(type_error(atom,A),G). - + +'$op'(P, T, ML) :- + strip_module(ML, M, [A|As]), !, + '$opl'(P, T, M, [A|As]). +'$op'(P, T, A) :- + '$op2'(P,T,A). + +'$opl'(_P, _T, _, []). +'$opl'(P, T, M, [A|As]) :- + '$op2'(P, T, M:A), + '$opl'(P, T, M, As). + +'$op2'(P,T,A) :- + atom(A), !, + '$opdec'(P,T,A,prolog). +'$op2'(P,T,A) :- + strip_module(A,M,N), + '$opdec'(P,T,N,M). /** @pred current_op( _P_, _T_, _F_) is iso Defines the relation: _P_ is a currently defined operator of type -b*c _T_ and precedence _P_. Returns only operators defined in current module. + _T_ and precedence _P_. */ -current_op(X,Y,V) :- - '$yap_strip_module'(V,M,O), - '$do_current_op'(X, Y, O, M). +current_op(X,Y,V) :- var(V), !, + '$current_module'(M), + '$do_current_op'(X,Y,V,M). +current_op(X,Y,M:Z) :- !, + '$current_opm'(X,Y,Z,M). +current_op(X,Y,Z) :- + '$current_module'(M), + '$do_current_op'(X,Y,Z,M). -'$do_current_op'(X,Y,Z, M) :- + +'$current_opm'(X,Y,Z,M) :- + nonvar(Y), + \+ '$associativity'(Y), + '$do_error'(domain_error(operator_specifier,Y),current_op(X,Y,M:Z)). +'$current_opm'(X,Y,Z,M) :- + var(Z), !, + '$do_current_op'(X,Y,Z,M). +'$current_opm'(X,Y,M:Z,_) :- !, + '$current_opm'(X,Y,Z,M). +'$current_opm'(X,Y,Z,M) :- + '$do_current_op'(X,Y,Z,M). + +'$do_current_op'(X,Y,Z,M) :- nonvar(Y), \+ '$associativity'(Y), '$do_error'(domain_error(operator_specifier,Y),current_op(X,Y,M:Z)). '$do_current_op'(X,Y,Z,M) :- - '$current_op'(Z, M, Prefix, Infix, Posfix), + atom(Z), !, + '$current_atom_op'(Z, M1, Prefix, Infix, Posfix), + ( M1 = prolog -> true ; M1 = M ), + ( + '$get_prefix'(Prefix, X, Y) + ; + '$get_infix'(Infix, X, Y) + ; + '$get_posfix'(Posfix, X, Y) + ). +'$do_current_op'(X,Y,Z,M) :- + '$current_op'(Z, M1, Prefix, Infix, Posfix), + ( M1 = prolog -> true ; M1 = M ), ( '$get_prefix'(Prefix, X, Y) ; diff --git a/utf8proc/utf8proc.h b/utf8proc/utf8proc.h index 00f10c804..1343a3541 100644 --- a/utf8proc/utf8proc.h +++ b/utf8proc/utf8proc.h @@ -83,7 +83,7 @@ typedef short utf8proc_int16_t; typedef unsigned short utf8proc_uint16_t; typedef int utf8proc_int32_t; typedef unsigned int utf8proc_uint32_t; -# ifdef _WIN64 +# ifdef _WIN64 typedef __int64 utf8proc_ssize_t; typedef unsigned __int64 utf8proc_size_t; # else @@ -92,7 +92,8 @@ typedef unsigned int utf8proc_size_t; # endif # ifndef __cplusplus typedef unsigned char utf8proc_bool; -enum {false, true}; +#define false 0 +#define true 1 # else typedef bool utf8proc_bool; # endif