From 9f1ef65ff5955d246ce6c8ce00fc0606a542b6df Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Mon, 2 Oct 2017 08:58:51 +0100 Subject: [PATCH] generic tmp alloc fixes. --- C/atomic.c | 143 +++++++++++++------------------- C/errors.c | 16 ++-- C/text.c | 46 ++++------- CXX/yapt.hh | 5 +- H/YapText.h | 40 +++++++-- os/files.c | 220 +++++++++++++++++++++++++++---------------------- os/fmem.c | 6 +- os/iopreds.c | 22 ++--- os/iopreds.h | 2 +- os/sysbits.c | 23 +++--- pl/absf.yap | 83 ++++++++++--------- pl/boot.yap | 17 ++-- pl/consult.yap | 14 ++-- pl/debug.yap | 6 +- pl/init.yap | 5 +- 15 files changed, 341 insertions(+), 307 deletions(-) diff --git a/C/atomic.c b/C/atomic.c index d143de186..df9df12af 100755 --- a/C/atomic.c +++ b/C/atomic.c @@ -882,26 +882,26 @@ static Int cont_atom_concat3(USES_REGS1) { Term t3; Atom ats[2]; Int i, max; - int l = push_text_stack(); restart_aux: t3 = Deref(ARG3); i = IntOfTerm(EXTRA_CBACK_ARG(3, 1)); max = IntOfTerm(EXTRA_CBACK_ARG(3, 2)); EXTRA_CBACK_ARG(3, 1) = MkIntTerm(i + 1); - if (!Yap_SpliceAtom(t3, ats, i, max PASS_REGS) && - LOCAL_Error_TYPE == YAP_NO_ERROR) { - pop_text_stack(l); - cut_fail(); - } else { - pop_text_stack(l); - if (i < max) { - return (Yap_unify(ARG1, MkAtomTerm(ats[0])) && - Yap_unify(ARG2, MkAtomTerm(ats[1]))); + + int l = push_text_stack(); + bool rc = Yap_SpliceAtom(t3, ats, i, max PASS_REGS); + pop_text_stack(l); + if (LOCAL_Error_TYPE == YAP_NO_ERROR) { + if (rc) { + if (i < max) { + return (Yap_unify(ARG1, MkAtomTerm(ats[0])) && + Yap_unify(ARG2, MkAtomTerm(ats[1]))); + } + return do_cut(Yap_unify(ARG1, MkAtomTerm(ats[0])) && + Yap_unify(ARG2, MkAtomTerm(ats[1]))); + } else { + cut_fail(); } - if (Yap_unify(ARG1, MkAtomTerm(ats[0])) && - Yap_unify(ARG2, MkAtomTerm(ats[1]))) - cut_succeed(); - cut_fail(); } /* Error handling */ if (LOCAL_Error_TYPE) { @@ -918,7 +918,6 @@ static Int atom_concat3(USES_REGS1) { Term t2, t3, ot; Atom at; bool g1, g2, g3; - int l = push_text_stack(); restart_aux: t1 = Deref(ARG1); t2 = Deref(ARG2); @@ -927,50 +926,43 @@ restart_aux: g2 = Yap_IsGroundTerm(t2); g3 = Yap_IsGroundTerm(t3); if (g1 && g2) { + int l = push_text_stack(); at = Yap_ConcatAtoms(t1, t2 PASS_REGS); + pop_text_stack(l); ot = ARG3; } else if (g1 && g3) { + int l = push_text_stack(); at = Yap_SubtractHeadAtom(t3, t1 PASS_REGS); + pop_text_stack(l); ot = ARG2; } else if (g2 && g3) { + int l = push_text_stack(); at = Yap_SubtractTailAtom(t3, t2 PASS_REGS); + pop_text_stack(l); ot = ARG1; } else if (g3) { Int len = Yap_AtomToUnicodeLength(t3 PASS_REGS); if (len <= 0) { - pop_text_stack(l); cut_fail(); } EXTRA_CBACK_ARG(3, 1) = MkIntTerm(0); EXTRA_CBACK_ARG(3, 2) = MkIntTerm(len); - { - pop_text_stack(l); - return cont_atom_concat3(PASS_REGS1); - } + { return cont_atom_concat3(PASS_REGS1); } } else { LOCAL_Error_TYPE = INSTANTIATION_ERROR; at = NULL; } if (at) { - pop_text_stack(l); - if (Yap_unify(ot, MkAtomTerm(at))) { - cut_succeed(); - } else { - cut_fail(); - } + return do_cut(Yap_unify(ot, MkAtomTerm(at))); } /* Error handling */ if (LOCAL_Error_TYPE) { if (Yap_HandleError("atom_concat/3")) { goto restart_aux; } else { - { - pop_text_stack(l); - return false; - } + return false; } } - pop_text_stack(l); cut_fail(); } @@ -989,19 +981,20 @@ static Int cont_atomic_concat3(USES_REGS1) { Term t3; Atom ats[2]; size_t i, max; - int l = push_text_stack(); restart_aux: t3 = Deref(ARG3); i = IntOfTerm(EXTRA_CBACK_ARG(3, 1)); max = IntOfTerm(EXTRA_CBACK_ARG(3, 2)); EXTRA_CBACK_ARG(3, 1) = MkIntTerm(i + 1); - if (!Yap_SpliceAtom(t3, ats, i, max PASS_REGS)) { + int l = push_text_stack(); + bool rc = Yap_SpliceAtom(t3, ats, i, max PASS_REGS); + pop_text_stack(l); + if (!rc) { cut_fail(); } else { Term t1 = CastToNumeric(ats[0]); Term t2 = CastToNumeric(ats[1]); if (i < max) { - pop_text_stack(l); return Yap_unify(ARG1, t1) && Yap_unify(ARG2, t2); } if (Yap_unify(ARG1, t1) && Yap_unify(ARG2, t2)) @@ -1013,10 +1006,7 @@ restart_aux: if (Yap_HandleError("string_concat/3")) { goto restart_aux; } else { - { - pop_text_stack(l); - return false; - } + return false; } } cut_fail(); @@ -1027,7 +1017,6 @@ static Int atomic_concat3(USES_REGS1) { Term t2, t3, ot; Atom at = NULL; bool g1, g2, g3; - int l = push_text_stack(); restart_aux: t1 = Deref(ARG1); t2 = Deref(ARG2); @@ -1036,32 +1025,33 @@ restart_aux: g2 = Yap_IsGroundTerm(t2); g3 = Yap_IsGroundTerm(t3); if (g1 && g2) { + int l = push_text_stack(); at = Yap_ConcatAtomics(t1, t2 PASS_REGS); + pop_text_stack(l); ot = ARG3; } else if (g1 && g3) { + int l = push_text_stack(); at = Yap_SubtractHeadAtom(t3, t1 PASS_REGS); + pop_text_stack(l); ot = ARG2; } else if (g2 && g3) { + int l = push_text_stack(); at = Yap_SubtractTailAtom(t3, t2 PASS_REGS); + pop_text_stack(l); ot = ARG1; } else if (g3) { Int len = Yap_AtomicToUnicodeLength(t3 PASS_REGS); if (len <= 0) { - pop_text_stack(l); cut_fail(); } EXTRA_CBACK_ARG(3, 1) = MkIntTerm(0); EXTRA_CBACK_ARG(3, 2) = MkIntTerm(len); - { - pop_text_stack(l); - return cont_atomic_concat3(PASS_REGS1); - } + return cont_atomic_concat3(PASS_REGS1); } else { LOCAL_Error_TYPE = INSTANTIATION_ERROR; at = NULL; } if (at) { - pop_text_stack(l); if (Yap_unify(ot, MkAtomTerm(at))) { cut_succeed(); } else { @@ -1073,13 +1063,9 @@ restart_aux: if (Yap_HandleError("atomic_concat/3")) { goto restart_aux; } else { - { - pop_text_stack(l); - return false; - } + return false; } } - pop_text_stack(l); cut_fail(); } @@ -1087,33 +1073,30 @@ static Int cont_string_concat3(USES_REGS1) { Term t3; Term ts[2]; size_t i, max; - int l; - l = push_text_stack(); restart_aux: t3 = Deref(ARG3); i = IntOfTerm(EXTRA_CBACK_ARG(3, 1)); max = IntOfTerm(EXTRA_CBACK_ARG(3, 2)); EXTRA_CBACK_ARG(3, 1) = MkIntTerm(i + 1); - if (!Yap_SpliceString(t3, ts, i, max PASS_REGS)) { + int l; + l = push_text_stack(); + bool rc = Yap_SpliceString(t3, ts, i, max PASS_REGS); + pop_text_stack(l); + if (!rc) { cut_fail(); } else { if (i < max) { - pop_text_stack(l); return Yap_unify(ARG1, ts[0]) && Yap_unify(ARG2, ts[1]); } - if (Yap_unify(ARG1, ts[0]) && Yap_unify(ARG2, ts[1])) - cut_succeed(); - cut_fail(); + return do_cut(Yap_unify(ARG1, ts[0]) && Yap_unify(ARG2, ts[1])); + cut_succeed(); } /* Error handling */ if (LOCAL_Error_TYPE) { if (Yap_HandleError("string_concat/3")) { goto restart_aux; } else { - { - pop_text_stack(l); - return FALSE; - } + return FALSE; } } cut_fail(); @@ -1124,8 +1107,6 @@ static Int string_concat3(USES_REGS1) { Term t2, t3, ot; Term tf = 0; bool g1, g2, g3; - int l; - l = push_text_stack(); restart_aux: t1 = Deref(ARG1); t2 = Deref(ARG2); @@ -1135,49 +1116,45 @@ restart_aux: g3 = Yap_IsGroundTerm(t3); if (g1 && g2) { + int l; + l = push_text_stack(); tf = Yap_ConcatStrings(t1, t2 PASS_REGS); + pop_text_stack(l); ot = ARG3; } else if (g1 && g3) { + int l; + l = push_text_stack(); tf = Yap_SubtractHeadString(t3, t1 PASS_REGS); + pop_text_stack(l); ot = ARG2; } else if (g2 && g3) { + int l; + l = push_text_stack(); tf = Yap_SubtractTailString(t3, t2 PASS_REGS); + pop_text_stack(l); ot = ARG1; } else if (g3) { Int len = Yap_StringToUnicodeLength(t3 PASS_REGS); if (len <= 0) { - pop_text_stack(l); cut_fail(); } EXTRA_CBACK_ARG(3, 1) = MkIntTerm(0); EXTRA_CBACK_ARG(3, 2) = MkIntTerm(len); - { - pop_text_stack(l); - return cont_string_concat3(PASS_REGS1); - } + { return cont_string_concat3(PASS_REGS1); } } else { LOCAL_Error_TYPE = INSTANTIATION_ERROR; } if (tf) { - pop_text_stack(l); - if (Yap_unify(ot, tf)) { - cut_succeed(); - } else { - cut_fail(); - } + return do_cut(Yap_unify(ot, tf)); } /* Error handling */ if (LOCAL_Error_TYPE) { if (Yap_HandleError("atom_concat/3")) { goto restart_aux; } else { - { - pop_text_stack(l); - return false; - } + return false; } } - pop_text_stack(l); cut_fail(); } @@ -1204,12 +1181,8 @@ restart_aux: return (Yap_unify(MkIntegerTerm(chr), ARG3) && Yap_unify(MkIntegerTerm(j + 1), ARG1)); } - if (Yap_unify(MkIntegerTerm(chr), ARG3) && - Yap_unify(MkIntegerTerm(j), ARG1)) { - cut_succeed(); - } else { - cut_fail(); - } + return do_cut(Yap_unify(MkIntegerTerm(chr), ARG3) && + Yap_unify(MkIntegerTerm(j), ARG1)); /* Error handling */ if (LOCAL_Error_TYPE) { if (Yap_HandleError("string_code/3")) { diff --git a/C/errors.c b/C/errors.c index 937ec98db..5585b42a9 100755 --- a/C/errors.c +++ b/C/errors.c @@ -41,7 +41,7 @@ bool Yap_Warning(const char *s, ...) { const char *format; char tmpbuf[MAXPATHLEN]; - LOCAL_DoingUndefp = true; + LOCAL_DoingUndefp = true; LOCAL_within_print_message = true; pred = RepPredProp(PredPropByFunc(FunctorPrintMessage, PROLOG_MODULE)); // PROCEDURE_print_message2 @@ -132,17 +132,14 @@ bool Yap_HandleError__(const char *file, const char *function, int lineno, } else { serr = s; } - if (P->opc == Yap_opcode(_try_c) || - P->opc == Yap_opcode(_try_userc) || - P->opc == Yap_opcode(_retry_c) || - P->opc == Yap_opcode(_retry_userc)) { + if (P->opc == Yap_opcode(_try_c) || P->opc == Yap_opcode(_try_userc) || + P->opc == Yap_opcode(_retry_c) || P->opc == Yap_opcode(_retry_userc)) { arity = P->y_u.OtapFs.p->ArityOfPE; } else { - arity = PREVOP(P,Osbpp)->y_u.Osbpp.p->ArityOfPE; + arity = PREVOP(P, Osbpp)->y_u.Osbpp.p->ArityOfPE; } - - + switch (err) { case RESOURCE_ERROR_STACK: if (!Yap_gc(arity, ENV, gc_P(P, CP))) { @@ -444,6 +441,7 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno, } va_end(ap); if (P == (yamop *)(FAILCODE)) { + memset(LOCAL_ActiveError, 0, sizeof(*LOCAL_ActiveError)); LOCAL_PrologMode &= ~InErrorMode; return P; } @@ -618,9 +616,9 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno, } else { error_t = Yap_MkApplTerm(fun, 2, nt); } + memset(LOCAL_ActiveError, 0, sizeof(*LOCAL_ActiveError)); Yap_JumpToEnv(error_t); P = (yamop *)FAILCODE; - LOCAL_PrologMode &= ~InErrorMode; return P; } diff --git a/C/text.c b/C/text.c index 622d7876f..003a1eed4 100644 --- a/C/text.c +++ b/C/text.c @@ -145,17 +145,11 @@ void *MallocAtLevel(size_t sz, int atL USES_REGS) { return o + 1; } -void *export_block(int i, void *protected USES_REGS) { +void *export_block( void *protected) { struct mblock *o = ((struct mblock *)protected) - 1; release_block(o); - if (i >= 0) { - o->lvl = i; - insert_block(o); - return protected; - } else { memcpy(o, protected, o->sz); return o; - } } void *Realloc(void *pt, size_t sz USES_REGS) { sz += sizeof(struct mblock); @@ -206,7 +200,7 @@ static void *codes2buf(Term t0, void *b0, bool *get_codes USES_REGS) { if (t == TermNil) { st0 = Malloc(4); st0[0] = 0; - export_block(0, st0); + st0 = export_block( st0); return st0; } if (!IsPairTerm(t)) @@ -259,7 +253,7 @@ static void *codes2buf(Term t0, void *b0, bool *get_codes USES_REGS) { } st0 = st = Malloc(length + 1); - export_block(0, st0); + export_block(st0); t = t0; if (codes) { while (IsPairTerm(t)) { @@ -909,7 +903,7 @@ bool write_Text(unsigned char *inp, seq_tv_t *out USES_REGS) { } static void *slice(size_t min, size_t max, const unsigned char *buf USES_REGS) { - unsigned char *nbuf = Malloc((max - min) * 4 + 1); + unsigned char *nbuf = BaseMalloc((max - min) * 4 + 1); const unsigned char *ptr = skip_utf8(buf, min); unsigned char *nptr = nbuf; utf8proc_int32_t chr; @@ -1049,24 +1043,15 @@ bool write_Text(unsigned char *inp, seq_tv_t *out USES_REGS) { * @return the buffer, or NULL in case of failure. If so, Yap_Error may be called. */ - const char *Yap_TextTermToText(Term t, char *buf, encoding_t enc USES_REGS) { + const char *Yap_TextTermToText(Term t USES_REGS) { seq_tv_t inp, out; inp.val.t = t; - if (IsAtomTerm(t) && t != TermNil) { - inp.type = YAP_STRING_ATOM; + inp.type = Yap_TextType(t); + inp.type = YAP_STRING_ATOM | YAP_STRING_STRING | YAP_STRING_ATOMS_CODES| YAP_STRING_TERM; inp.enc = ENC_ISO_UTF8; - } else if (IsStringTerm(t)) { - inp.type = YAP_STRING_STRING; - inp.enc = ENC_ISO_UTF8; - } else if (IsPairOrNilTerm(t)) { - inp.type = (YAP_STRING_CODES | YAP_STRING_ATOMS); - } else { - Yap_Error(TYPE_ERROR_TEXT, t, NULL); - return false; - } - out.enc = enc; + out.enc = ENC_ISO_UTF8; out.type = YAP_STRING_CHARS; - out.val.c = buf; + out.val.c = NULL; if (!Yap_CVT_Text(&inp, &out PASS_REGS)) return NULL; return out.val.c; @@ -1148,13 +1133,14 @@ bool write_Text(unsigned char *inp, seq_tv_t *out USES_REGS) { * ≈ * @return the term */ - Term Yap_MkTextTerm(const char *s, encoding_t enc, Term tguide USES_REGS) { - if (IsAtomTerm(tguide)) + Term Yap_MkTextTerm(const char *s, int guide USES_REGS) { + if (guide == YAP_STRING_ATOM) { return MkAtomTerm(Yap_LookupAtom(s)); - if (IsStringTerm(tguide)) + } else if (guide == YAP_STRING_STRING) { return MkStringTerm(s); - if (IsPairTerm(tguide) && IsAtomTerm(HeadOfTerm(tguide))) { - return Yap_CharsToListOfAtoms(s, enc PASS_REGS); + } else if (guide == YAP_STRING_ATOMS) { + return Yap_CharsToListOfAtoms(s, ENC_ISO_UTF8 PASS_REGS); + } else { + return Yap_CharsToListOfCodes(s, ENC_ISO_UTF8 PASS_REGS); } - return Yap_CharsToListOfCodes(s, enc PASS_REGS); } diff --git a/CXX/yapt.hh b/CXX/yapt.hh index e97132148..14818c2f3 100644 --- a/CXX/yapt.hh +++ b/CXX/yapt.hh @@ -230,13 +230,12 @@ public: char *os; BACKUP_MACHINE_REGS(); - if (!(os = Yap_TermToString(Yap_GetFromSlot(t), enc, - Handle_vars_f))) { + if (!(os = Yap_TermToString(Yap_GetFromSlot(t), enc, Handle_vars_f))) { RECOVER_MACHINE_REGS(); return 0; } RECOVER_MACHINE_REGS(); - size_t length = strlen(os); + size_t length = strlen(os); char *sm = (char *)malloc(length + 1); strcpy(sm, os); return sm; diff --git a/H/YapText.h b/H/YapText.h index 453296897..4f80f6f46 100644 --- a/H/YapText.h +++ b/H/YapText.h @@ -39,6 +39,7 @@ extern void Free(void *buf USES_REGS); extern void *MallocAtLevel(size_t sz, int atL USES_REGS); #define BaseMalloc(sz) MallocAtLevel(sz, 1) +extern void *export_block(void *blk); #ifndef Yap_Min #define Yap_Min(x, y) (x < y ? x : y) @@ -51,12 +52,14 @@ extern void *MallocAtLevel(size_t sz, int atL USES_REGS); extern int AllocLevel(void); #define push_text_stack() \ - (/* fprintf(stderr, "^ %*c %s:%s:%d\n", AllocLevel(), AllocLevel()+'0', __FILE__, __FUNCTION__, __LINE__), */ \ + (/* fprintf(stderr, "^ %*c %s:%s:%d\n", AllocLevel(), AllocLevel()+'0', \ + __FILE__, __FUNCTION__, __LINE__), */ \ push_text_stack__(PASS_REGS1)) extern int push_text_stack__(USES_REGS1); -#define pop_text_stack(lvl) \ - (/*fprintf(stderr, "v %*c %s:%s:%d\n", AllocLevel(), ' ', __FILE__, __FUNCTION__, __LINE__),*/ \ +#define pop_text_stack(lvl) \ + (/*fprintf(stderr, "v %*c %s:%s:%d\n", AllocLevel(), ' ', __FILE__, \ + __FUNCTION__, __LINE__),*/ \ pop_text_stack__(lvl)) extern int pop_text_stack__(int lvl USES_REGS); @@ -449,6 +452,31 @@ static inline seq_type_t mod_to_bqtype(Term mod USES_REGS) { return YAP_STRING_CODES; } +static inline seq_type_t Yap_TextType(Term t) { + if (IsVarTerm(t = Deref(t))) { + Yap_ThrowError(INSTANTIATION_ERROR, t, "expected text"); + } + if (IsAtomTerm(t)) { + return YAP_STRING_ATOM; + } + if (IsStringTerm(t)) { + return YAP_STRING_STRING; + } + if (IsPairTerm(t)) { + Term hd = HeadOfTerm(t); + if (IsVarTerm(hd)) { + Yap_ThrowError(INSTANTIATION_ERROR, t, "expected text"); + } + if (IsIntegerTerm(hd)) { + return YAP_STRING_CODES; + } + if (IsAtomTerm(hd)) { + return YAP_STRING_ATOMS; + } + } + Yap_ThrowError(TYPE_ERROR_TEXT, t, "expected text"); +} + // the routines extern unsigned char *Yap_readText(seq_tv_t *inp USES_REGS); @@ -1487,7 +1515,7 @@ static inline Term Yap_WCharsToString(const wchar_t *s USES_REGS) { static inline Atom Yap_ConcatAtoms(Term t1, Term t2 USES_REGS) { seq_tv_t inpv[2], out; inpv[0].val.t = t1; - inpv[0].type = YAP_STRING_ATOM; + inpv[0].type = YAP_STRING_ATOM | YAP_STRING_TERM; inpv[1].val.t = t2; inpv[1].type = YAP_STRING_ATOM; out.type = YAP_STRING_ATOM; @@ -1613,5 +1641,5 @@ static inline Term Yap_SubtractTailString(Term t1, Term th USES_REGS) { #endif // ≈YAP_TEXT_H -const char *Yap_TextTermToText(Term t, char *s, encoding_t e USES_REGS); -Term Yap_MkTextTerm(const char *s, encoding_t e, Term tguide); +extern const char *Yap_TextTermToText(Term t USES_REGS); +extern Term Yap_MkTextTerm(const char *s, int guide USES_REGS); diff --git a/os/files.c b/os/files.c index 55f35fd59..5c37cd46b 100644 --- a/os/files.c +++ b/os/files.c @@ -1,19 +1,19 @@ /************************************************************************* -* * -* YAP Prolog * -* * -* Yap Prolog was developed at NCCUP - Universidade do Porto * -* * -* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * -* * -************************************************************************** -* * -* File: iopreds.c * -* Last rev: 5/2/88 * -* mods: * -* comments: Input/Output C implemented predicates * -* * -*************************************************************************/ + * * + * YAP Prolog * + * * + * Yap Prolog was developed at NCCUP - Universidade do Porto * + * * + * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * + * * + ************************************************************************** + * * + * File: iopreds.c * + * Last rev: 5/2/88 * + * mods: * + * comments: Input/Output C implemented predicates * + * * + *************************************************************************/ #ifdef SCCS static char SccsId[] = "%W% %G%"; #endif @@ -32,101 +32,124 @@ static char SccsId[] = "%W% %G%"; #define SYSTEM_STAT stat #endif -bool Yap_GetFileName(Term t, char *buf, size_t len, encoding_t enc) { - while (IsApplTerm(t) && FunctorOfTerm(t) == FunctorSlash) { - if (!Yap_GetFileName(ArgOfTerm(1, t), buf, len, enc)) - return false; - size_t szl = strlen(buf); - buf += szl; - *buf++ = '/'; - t = ArgOfTerm(2, t); - len -= (szl + 1); +const char *Yap_GetFileName(Term t USES_REGS) { + char *buf = Malloc(YAP_FILENAME_MAX + 1); + if (IsApplTerm(t) && FunctorOfTerm(t) == FunctorSlash) { + snprintf(buf, YAP_FILENAME_MAX, "%s/%s", Yap_GetFileName(ArgOfTerm(1, t)), + Yap_GetFileName(ArgOfTerm(1, t))); } - return Yap_TextTermToText(t, buf, enc); + return Yap_TextTermToText(t PASS_REGS); } +/** + * @pred file_name_extension( ? BaseFile, ?Extension, ?FullNameO) + * + * Relate a file name with an extension. The extension is the filename's suffix + * and indicates the kind of the file. + * + * The predicate can be used to: + * - Given __FullName__, extract the extension as _Extension_, and the remainder + * as _BaseFile_. - Given _BaseFile_ and _?Extension_ obtain a _FullNameO_. + * ~~~~ + * ~~~~ + * Notice that: + * + if no suffix is found, file_name_extension/3 generates the empty + * suffu]kx, `''`. + the extension does not include the `,` separator; + the + * suffix may be longer thsn 3 characters + case should not matter in Windows + * and MacOS + paths may not correspond to valid file names. + * + * @return G + */ static Int file_name_extension(USES_REGS1) { - Term t1 = Deref(ARG1); - Term t2 = Deref(ARG2); + Term t1; + Term t2; Term t3 = Deref(ARG3); - char f[YAP_FILENAME_MAX + 1]; -#if __APPLE__ || _WIN32 - bool lowcase = true; -#endif - - if (!IsVarTerm((t3))) { - char *f2; - if (!Yap_GetFileName(t3, f, YAP_FILENAME_MAX, ENC_ISO_UTF8)) { + int l = push_text_stack(); + if (!IsVarTerm(t3)) { + // full path is given. + const char *f = Yap_GetFileName(t3); + const char *ext; + char *base; + bool rc = true; + seq_type_t typ = Yap_TextType(t3); + if (!f) { + pop_text_stack(l); return false; } - char *pts = strrchr(f, '/'); -#if WIN32_ - char *pts1 = strrchr(f, '\\'); - if (pts11 > pts) - pts = pts1; -#endif - char *ss = strrchr(f, '.'); - if (pts > ss) { - ss = f + strlen(f); - } else if (ss == NULL) { - ss = ""; + size_t len_b = strlen(f), lenb_b, lene_b; + char *candidate = strrchr(f, '.'); + char *file = strrchr(f, '/'); + if (candidate && file && candidate > file) { + lenb_b = candidate - f, lene_b = (f + len_b) - (candidate + 1); + ext = candidate + 1; } else { - ss++; + lenb_b = len_b; + lene_b = 0; + ext = ""; } - if (IsVarTerm(t2)) { - Term t = Yap_MkTextTerm(ss, ENC_ISO_UTF8, t3); - Yap_unify(t2, t); + base = Malloc(lenb_b + 1); + memcpy(base, f, lenb_b); + base[lenb_b] = '\0'; + if (IsVarTerm(t1 = Deref(ARG1))) { + // should always succeed + rc = Yap_unify(t1, Yap_MkTextTerm(base, typ)); } else { - f2 = ss + (strlen(ss) + 1); - if (!Yap_TextTermToText(t2, f2, ENC_ISO_UTF8)) - return false; + char *f_a = (char *)Yap_GetFileName(t1 PASS_REGS); #if __APPLE__ || _WIN32 - Yap_OverwriteUTF8BufferToLowCase(f2); - lowcase = true; + rc = strcasecmp(f_a, base) == 0; +#else + rc = strcmp(f_a, base) == 0 +#endif + } + if (rc) { + if (IsVarTerm(t2 = Deref(ARG2))) { + // should always succeed + rc = Yap_unify(t2, Yap_MkTextTerm(ext, typ)); + } else { + char *f_a = (char *)Yap_TextTermToText(t2 PASS_REGS); + if (f_a[0] == '.') { + f_a += 1; + } +#if __APPLE__ || _WIN32 + rc = strcasecmp(f_a, ext) == 0; +#else + rc = strcmp(f_a, ext) == 0 #endif - if (strcmp(f2, ss) != 0 && (ss > f && strcmp(f2, ss - 1) != 0)) { - return false; } } - if (f[0] && ss[0] && ss[0] != '.') { - ss[-1] = '\0'; - } - if (IsVarTerm(t1)) { - Term t = Yap_MkTextTerm(f, ENC_ISO_UTF8, t3); - Yap_unify(t1, t); - } else { - char f1[YAP_FILENAME_MAX + 1]; -#if __APPLE || _WIN32 - Yap_OverwriteUTF8BufferToLowCase(f); -#endif - if (!Yap_GetFileName(t2, f1, YAP_FILENAME_MAX, ENC_ISO_UTF8)) - return false; -#if __APPLE__ || _WIN32 - if (!lowcase) - Yap_OverwriteUTF8BufferToLowCase(f2); -#endif - if (strcmp(f1, f) != 0) { - return false; - } - } - return true; + pop_text_stack(l); + return rc; } else { + const char *f; char *f2; - if (!Yap_TextTermToText(t1, f, ENC_ISO_UTF8)) { + seq_type_t typ, typ1 = Yap_TextType((t1 = Deref(ARG1))), + typ2 = Yap_TextType((t2 = Deref(ARG2))); + if (typ1 == typ2) { + typ = typ1; + } else if (typ1 == YAP_STRING_ATOM || typ2 == YAP_STRING_ATOM) { + typ = YAP_STRING_ATOM; + } else { + typ = YAP_STRING_STRING; + } + if (!(f = Yap_TextTermToText(t1 PASS_REGS))) { + pop_text_stack(l); return false; } - f2 = f + strlen(f); - if (!Yap_TextTermToText(t2, f2, ENC_ISO_UTF8)) { + if (!(f2 = (char *)Yap_TextTermToText(t2 PASS_REGS))) { + pop_text_stack(l); return false; } - if (f2[0] != '.') { - memmove(f2 + 1, f2, strlen(f2) + 1); - f2[0] = '.'; + if (f2[0] == '.') { + f2++; } - Term t = Yap_MkTextTerm(f, ENC_ISO_UTF8, t1); - if (!t) - return false; - return Yap_unify(t, t3); + + size_t lenb_b = strlen(f); + char *o = Realloc((void *)f, lenb_b + strlen(f2) + 2); + o[lenb_b] = '.'; + o += lenb_b + 1; + pop_text_stack(l); + return strcpy(o, f2) && (t3 = Yap_MkTextTerm(o, typ)) && + Yap_unify(t3, ARG3); } } @@ -458,15 +481,15 @@ static Int is_absolute_file_name(USES_REGS1) { /* file_base_name(Stream,N) */ return false; } int l = push_text_stack(); - const char *buf = Yap_TextTermToText(t, NULL, LOCAL_encoding); + const char *buf = Yap_TextTermToText(t PASS_REGS); if (buf) { rc = Yap_IsAbsolutePath(buf); } else { - at = AtomOfTerm(t); + at = AtomOfTerm(t); #if _WIN32 - rc = PathIsRelative(RepAtom(at)->StrOfAE); + rc = PathIsRelative(RepAtom(at)->StrOfAE); #else - rc = RepAtom(at)->StrOfAE[0] == '/'; + rc = RepAtom(at)->StrOfAE[0] == '/'; #endif } pop_text_stack(l); @@ -523,6 +546,10 @@ static Int file_directory_name(USES_REGS1) { /* file_directory_name(Stream,N) */ if (Yap_dir_separator((int)c[i])) break; } + if (i == 0) { + s[0] = '.'; + i = 1; + } s[i] = '\0'; #endif return Yap_unify(ARG2, MkAtomTerm(Yap_LookupAtom(s))); @@ -586,13 +613,12 @@ static Int same_file(USES_REGS1) { } out = (b1->st_ino == b2->st_ino #ifdef __LCC__ - && - memcmp((const void *)&(b1->st_dev), (const void *)&(b2->st_dev), - sizeof(buf1.st_dev)) == 0 + && memcmp((const void *)&(b1->st_dev), (const void *)&(b2->st_dev), + sizeof(buf1.st_dev)) == 0 #else && b1->st_dev == b2->st_dev #endif - ); + ); return out; } #else diff --git a/os/fmem.c b/os/fmem.c index 38a54d57f..607b88628 100644 --- a/os/fmem.c +++ b/os/fmem.c @@ -23,6 +23,7 @@ static char SccsId[] = "%W% %G%"; * */ +#include "YapText.h" #include "format.h" #include "sysbits.h" @@ -162,10 +163,13 @@ open_mem_read_stream(USES_REGS1) /* $open_mem_read_stream(+List,-Stream) */ const char *buf; ti = Deref(ARG1); - buf = Yap_TextTermToText(ti, NULL, LOCAL_encoding); + int l = push_text_stack(); + buf = Yap_TextTermToText(ti); if (!buf) { return false; } + buf = export_block( buf ); + pop_text_stack(l); sno = Yap_open_buf_read_stream(buf, strlen(buf) + 1, &LOCAL_encoding, MEM_BUF_MALLOC); t = Yap_MkStream(sno); diff --git a/os/iopreds.c b/os/iopreds.c index 159d4fda0..dbc7b0990 100644 --- a/os/iopreds.c +++ b/os/iopreds.c @@ -255,7 +255,7 @@ void Yap_DefaultStreamOps(StreamDesc *st) { } st->stream_wputc = put_wchar; if (st->encoding == ENC_ISO_UTF8) - st->stream_wgetc = get_wchar_UTF8; + st->stream_wgetc = get_wchar_UTF8; else st->stream_wgetc = get_wchar; st->stream_putc = FilePutc; @@ -299,9 +299,11 @@ static void InitStdStream(int sno, SMALLUNSGN flags, FILE *file, VFS_t *vfsp) { s->encoding = ENC_ISO_UTF8; INIT_LOCK(s->streamlock); if (vfsp != NULL) { - s->u.private_data = vfsp->open(vfsp->name, (sno == StdInStream ? "read" : "write" )); + s->u.private_data = + vfsp->open(vfsp->name, (sno == StdInStream ? "read" : "write")); if (s->u.private_data == NULL) { - (PlIOError(EXISTENCE_ERROR_SOURCE_SINK, MkIntTerm(sno), "%s", vfsp->name)); + (PlIOError(EXISTENCE_ERROR_SOURCE_SINK, MkIntTerm(sno), "%s", + vfsp->name)); return; } } else { @@ -338,10 +340,9 @@ static void InitStdStream(int sno, SMALLUNSGN flags, FILE *file, VFS_t *vfsp) { } void Yap_InitStdStream(int sno, unsigned int flags, FILE *file, VFS_t *vfsp) { - InitStdStream(sno, flags, file, vfsp); + InitStdStream(sno, flags, file, vfsp); } - Term Yap_StreamUserName(int sno) { Term atname; StreamDesc *s = &GLOBAL_Stream[sno]; @@ -357,13 +358,13 @@ static void InitStdStreams(void) { CACHE_REGS if (LOCAL_sockets_io) { InitStdStream(StdInStream, Input_Stream_f, NULL, NULL); - InitStdStream(StdOutStream, Output_Stream_f, NULL, NULL); + InitStdStream(StdOutStream, Output_Stream_f, NULL, NULL); InitStdStream(StdErrStream, Output_Stream_f, NULL, NULL); } else { InitStdStream(StdInStream, Input_Stream_f, stdin, NULL); InitStdStream(StdOutStream, Output_Stream_f, stdout, NULL); InitStdStream(StdErrStream, Output_Stream_f, stderr, NULL); - } + } GLOBAL_Stream[StdInStream].name = Yap_LookupAtom("user_input"); GLOBAL_Stream[StdOutStream].name = Yap_LookupAtom("user_output"); GLOBAL_Stream[StdErrStream].name = Yap_LookupAtom("user_error"); @@ -401,6 +402,8 @@ Int PlIOError__(const char *file, const char *function, int lineno, /* and fail */ return false; } else { + pop_text_stack(0); + memset(LOCAL_ActiveError, 0, sizeof(*LOCAL_ActiveError)); return false; } } @@ -1086,10 +1089,9 @@ bool Yap_initStream(int sno, FILE *fd, const char *name, Term file_name, st->encoding = encoding; } - if (name == NULL) { char buf[YAP_FILENAME_MAX + 1]; - memset(buf, 0, YAP_FILENAME_MAX + 1); + memset(buf, 0, YAP_FILENAME_MAX + 1); name = Yap_guessFileName(fd, sno, buf, YAP_FILENAME_MAX); if (name) st->name = Yap_LookupAtom(name); @@ -1854,7 +1856,7 @@ static Int abs_file_parameters(USES_REGS1) { } static Int get_abs_file_parameter(USES_REGS1) { - Term t = Deref(ARG1), topts = ARG2; + Term t = Deref(ARG1), topts = Deref(ARG2); /* get options */ /* done */ int i = Yap_ArgKey(AtomOfTerm(t), absolute_file_name_search_defs, diff --git a/os/iopreds.h b/os/iopreds.h index e0a2fae5d..7d40ba5b9 100644 --- a/os/iopreds.h +++ b/os/iopreds.h @@ -136,7 +136,7 @@ extern void Yap_InitMems(void); extern void Yap_InitConsole(void); extern void Yap_InitReadlinePreds(void); extern bool Yap_InitReadline(Term); -extern bool Yap_readline_clear_pending_input (StreamDesc *s); +extern bool Yap_readline_clear_pending_input(StreamDesc *s); extern void Yap_InitChtypes(void); extern void Yap_InitCharsio(void); extern void Yap_InitFormat(void); diff --git a/os/sysbits.c b/os/sysbits.c index 17569c9e7..8effcdfca 100644 --- a/os/sysbits.c +++ b/os/sysbits.c @@ -787,7 +787,7 @@ static Term do_expand_file_name(Term t1, Term opts USES_REGS) { #if _WIN32 && tmpe != cmd2 #endif - ) { + ) { freeBuffer(tmpe); } return tf; @@ -845,22 +845,21 @@ static Int expand_file_name3(USES_REGS1) { static Int absolute_file_system_path(USES_REGS1) { Term t = Deref(ARG1); int l = push_text_stack(); - const char *text = Yap_TextTermToText(t, NULL, LOCAL_encoding); - const char *fp; - bool rc; + const char *text = Yap_TextTermToText(t); + const char *fp; + bool rc; if (text == NULL) { pop_text_stack(l); return false; } - if (!(fp = Yap_AbsoluteFile(RepAtom(AtomOfTerm(t))->StrOfAE, NULL, true))) { + if (!(fp = Yap_AbsoluteFile(text, NULL, true))) { pop_text_stack(l); return false; } - pop_text_stack(l); - - rc = Yap_unify(Yap_MkTextTerm(fp, LOCAL_encoding, t), ARG2); - return rc; + rc = Yap_unify(Yap_MkTextTerm(fp, Yap_TextType(t)), ARG2); + pop_text_stack(l); + return rc; } static Int prolog_to_os_filename(USES_REGS1) { @@ -1363,7 +1362,7 @@ static Int p_expand_file_name(USES_REGS1) { return FALSE; } int l = push_text_stack(); - text = Yap_TextTermToText(t, NULL, LOCAL_encoding); + text = Yap_TextTermToText(t); if (!text) { pop_text_stack(l); return false; @@ -1372,7 +1371,7 @@ static Int p_expand_file_name(USES_REGS1) { pop_text_stack(l); return false; } - bool rc = Yap_unify(ARG2, Yap_MkTextTerm(text2, LOCAL_encoding, t)); + bool rc = Yap_unify(ARG2, Yap_MkTextTerm(text2, Yap_TextType(t))); pop_text_stack(l); return rc; } @@ -1561,7 +1560,7 @@ static Int p_system(USES_REGS1) { /* '$system'(+SystCommand) */ NULL, // Use parent's starting directory &si, // Pointer to STARTUPINFO structure &pi) // Pointer to PROCESS_INFORMATION structure - ) { + ) { Yap_Error(SYSTEM_ERROR_INTERNAL, ARG1, "CreateProcess failed (%d).\n", GetLastError()); return FALSE; diff --git a/pl/absf.yap b/pl/absf.yap index e56cb6bef..aa8419d2d 100755 --- a/pl/absf.yap +++ b/pl/absf.yap @@ -30,7 +30,7 @@ add_to_path/1, add_to_path/2, path/1, - remove_from_path/1], ['$full_filename'/3, + remove_from_path/1], ['$full_filename'/2, '$system_library_directories'/2]). @@ -145,7 +145,7 @@ absolute_file_name(File,TrueFileName,Opts) :- !, absolute_file_name(File,Opts,TrueFileName). absolute_file_name(File,Opts,TrueFileName) :- - '$absolute_file_name'(File,Opts,TrueFileName,absolute_file_name(File,Opts,TrueFileName)). + '$absolute_file_name'(File,Opts,TrueFileName). /** @pred absolute_file_name(+Name:atom,+Path:atom) is nondet @@ -157,17 +157,26 @@ absolute_file_name(V,Out) :- var(V), '$do_error'(instantiation_error, absolute_file_name(V, Out)). absolute_file_name(user,user) :- !. absolute_file_name(File0,File) :- - '$absolute_file_name'(File0,[access(none),file_type(txt),file_errors(fail),solutions(first)],File,absolute_file_name(File0,File)). + '$absolute_file_name'(File0,[access(none),file_type(txt),file_errors(fail),solutions(first)],File). -'$full_filename'(F0, F, G) :- +'$full_filename'(F0, F) :- '$absolute_file_name'(F0,[access(read), file_type(prolog), file_errors(fail), solutions(first), - expand(true)],F,G). + expand(true)],F). -'$absolute_file_name'(File,LOpts,TrueFileName, G) :- +'$absolute_file_name'(File,LOpts,TrueFileName) :- % must_be_of_type( atom, File ), + % look for solutions + gated_call( + '$enter_absf'( File, LOpts, Opts, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ), + '$find_in_path'(File, Opts,TrueFileName), + Port, + '$absf_port'(Port, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ) + ). + +'$enter_absf'( File, LOpts, Opts, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ) :- ( var(File) -> instantiation_error(File) ; true), abs_file_parameters(LOpts,Opts), current_prolog_flag(open_expands_filename, OldF), @@ -177,40 +186,41 @@ absolute_file_name(File0,File) :- get_abs_file_parameter( expand, Opts, Expand ), set_prolog_flag( verbose_file_search, Verbose ), get_abs_file_parameter( file_errors, Opts, FErrors ), - get_abs_file_parameter( solutions, Opts, First ), + get_abs_file_parameter( solutions, Opts, TakeFirst ), ( FErrors == fail -> FileErrors = false ; FileErrors = true ), set_prolog_flag( fileerrors, FileErrors ), set_prolog_flag(file_name_variables, Expand), '$absf_trace'(File), '$absf_trace_options'(LOpts), - HasSol = t(no), - ( - % look for solutions - '$find_in_path'(File, Opts,TrueFileName), - ( (First == first -> ! ; nb_setarg(1, HasSol, yes) ), - set_prolog_flag( fileerrors, PreviousFileErrors ), - set_prolog_flag( open_expands_filename, OldF), - set_prolog_flag( verbose_file_search, PreviousVerbose ), - '$absf_trace'(' |------- found ~a', [TrueFileName]) - ; - set_prolog_flag( fileerrors, FileErrors ), - set_prolog_flag( verbose_file_search, Verbose ), - set_prolog_flag( file_name_variables, Expand ), - '$absf_trace'(' |------- restarted search for ~a', [File]), - fail - ) - ; - % finished - % stop_low_level_trace, - '$absf_trace'(' !------- failed.', []), - set_prolog_flag( fileerrors, PreviousFileErrors ), - set_prolog_flag( verbose_file_search, PreviousVerbose ), - set_prolog_flag(file_name_variables, OldF), - % check if no solution - arg(1,HasSol,no), - FileErrors = error, - '$do_error'(existence_error(file,File),G) - ). + HasSol = t(no). + +'$absf_port'(answer, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ) :- + '$absf_port'(exit, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ). +'$absf_port'(exit, _File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, _Expand, _Verbose, TakeFirst, _FileErrors ) :- + (TakeFirst == first -> ! ; nb_setarg(1, HasSol, yes) ), + set_prolog_flag( fileerrors, PreviousFileErrors ), + set_prolog_flag( open_expands_filename, OldF), + set_prolog_flag( verbose_file_search, PreviousVerbose ), + '$absf_trace'(' |------- found ~a', [TrueFileName]). +'$absf_port'(redo, File, _TrueFileName, _HasSol, _OldF, _PreviousFileErrors, _PreviousVerbose, Expand, Verbose, _TakeFirst, FileErrors ) :- + set_prolog_flag( fileerrors, FileErrors ), + set_prolog_flag( verbose_file_search, Verbose ), + set_prolog_flag( file_name_variables, Expand ), + '$absf_trace'(' |------- restarted search for ~a', [File]). +'$absf_port'(fail, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, _Expand, _Verbose, _TakeFirst, FileErrors ) :- + '$absf_trace'(' !------- failed.', []), + set_prolog_flag( fileerrors, PreviousFileErrors ), + set_prolog_flag( verbose_file_search, PreviousVerbose ), + set_prolog_flag(file_name_variables, OldF), + % check if no solution + arg(1,HasSol,no), + FileErrors = error, + '$do_error'(existence_error(file,File),absolute_file_name(File, TrueFileName, ['...'])). +'$absf_port'(!, _File, _TrueFileName, _HasSol, _OldF, _PreviousFileErrors, _PreviousVerbose, _Expand, _Verbose, _TakeFirst, _FileErrors ). +'$absf_port'(exception(_), File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ) :- + '$absf_port'(fail, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ). +'$absf_port'(external_exception(_), File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ) :- + '$absf_port'(fail, File, TrueFileName, HasSol, OldF, PreviousFileErrors, PreviousVerbose, Expand, Verbose, TakeFirst, FileErrors ). % This sequence must be followed: % user and user_input are special; @@ -339,7 +349,7 @@ absolute_file_name(File0,File) :- '$suffix'(Last, _Opts) --> { lists:append(_, [0'.|Alphas], Last), '$id'(Alphas, _, [] ) }, - '$absf_trace'(' suffix in ~s', [Last]), + '$absf_trace'(' suffix in ~s', [Alphas]), !. '$suffix'(_, Opts) --> { @@ -444,7 +454,6 @@ absolute_file_name(File0,File) :- % enumerate all paths separated by a path_separator. '$paths'(Cs, C) :- - atom(Cs), ( current_prolog_flag(windows, true) -> Sep = ';' ; Sep = ':' ), sub_atom(Cs, N0, 1, N, Sep), diff --git a/pl/boot.yap b/pl/boot.yap index ea1b23993..fcb52b5a7 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -269,6 +269,12 @@ private(_). '$early_print_message'(_, loading( C, F)) :- !, (yap_flag( verbose_load , silent ) -> true; format(user_error, '~*|% ~a ~w...~n', [2,C,F]) ). +'$early_print_message'(_, loaded(F,C,M,T,H)) :- !, + (yap_flag( verbose_load , silent ) -> true; + format(user_error, '~*|% ~a:~w ~a ~d bytes in ~d seconds...~n', [2, M, F ,C, H, T]) ). +'$early_print_message'(_, loaded(F,C,M,T,H)) :- !, + (yap_flag( verbose_load , silent ) -> true; + format(user_error, '~*|% ~a:~w ~a ~d bytes in ~d seconds...~n', [2, M, F ,C, H, T]) ). '$early_print_message'(_, loaded(F,C,M,T,H)) :- !, (yap_flag( verbose_load , silent ) -> true; format(user_error, '~*|% ~a:~w ~a ~d bytes in ~d seconds...~n', [2, M, F ,C, H, T]) ). @@ -659,6 +665,7 @@ number of steps. O = (:- G1) -> '$yap_strip_module'(G1, M, G2), + '$process_directive'(G2, Option, M, VL, Pos) ; '$execute_commands'(G1,VL,Pos,Option,O) @@ -1297,13 +1304,11 @@ not(G) :- \+ '$execute'(G). bootstrap(F) :- - % '$open'(F, '$csult', Stream, 0, 0, F), -% '$file_name'(Stream,File), yap_flag(verbose_load, Old, silent), - open(F, read, Stream), - stream_property(Stream, [file_name(File)]), - '$start_consult'(consult, File, LC), - file_directory_name(File, Dir), + open(F, read, Stream), + stream_property(Stream, [file_name(File)]), + '$start_consult'(consult, File, LC), + file_directory_name(File, Dir), working_directory(OldD, Dir), ( current_prolog_flag(verbose_load, silent) diff --git a/pl/consult.yap b/pl/consult.yap index 58e8dd718..8ad6b69c1 100644 --- a/pl/consult.yap +++ b/pl/consult.yap @@ -56,7 +56,7 @@ '$set_encoding'/1, '$use_module'/3]). -:- use_system_module( '$_absf', ['$full_filename'/3]). +:- use_system_module( '$_absf', ['$full_filename'/2]). :- use_system_module( '$_boot', ['$clear_reconsulting'/0, '$init_system'/0, @@ -434,7 +434,7 @@ load_files(Files,Opts) :- b_setval('$user_source_file', File), ( var(Stream) -> /* need_to_open_file */ - ( '$full_filename'(File, Y, Call) -> true ; '$do_error'(existence_error(source_sink,File),Call) ), + ( '$full_filename'(File, Y) -> true ; '$do_error'(existence_error(source_sink,File),Call) ), ( open(Y, read, Stream) -> true ; '$do_error'(permission_error(input,stream,Y),Call) ) ; stream_property(Stream, file_name(Y)) @@ -464,7 +464,7 @@ load_files(Files,Opts) :- '$start_lf'(_, Mod, PlStream, TOpts, _UserFile, File, Reexport, ImportList) :- % check if there is a qly file % start_low_level_trace, - '$absolute_file_name'(File,[access(read),file_type(qly),file_errors(fail),solutions(first),expand(true)],F,qload_file(File)), + '$absolute_file_name'(File,[access(read),file_type(qly),file_errors(fail),solutions(first),expand(true)],F), open( F, read, Stream , [type(binary)] ), ( '$q_header'( Stream, Type ), @@ -741,7 +741,7 @@ db_files(Fs) :- '$lf_opt'(qcompile, TOpts, QComp), '$lf_opt'('$source_pos', TOpts, Pos), ( QComp == auto ; QComp == large, Pos > 100*1024), - '$absolute_file_name'(UserF,[file_type(qly),solutions(first),expand(true)],F,load_files(File)), + '$absolute_file_name'(UserF,[file_type(qly),solutions(first),expand(true)],F), !, '$qsave_file_'( File, UserF, F ). '$q_do_save_file'(_File, _, _TOpts ). @@ -831,7 +831,7 @@ nb_setval('$if_le1vel',0). '$include'(Fs, Status). '$include'(X, Status) :- b_getval('$lf_status', TOpts), - '$full_filename'(X, Y , ( :- include(X)) ), + '$full_filename'(X, Y ), '$including'(Old, Y), '$lf_opt'(stream, TOpts, OldStream), '$current_module'(Mod), @@ -976,7 +976,7 @@ prolog_load_context(stream, Stream) :- %format( 'L=~w~n', [(F0)] ), ( atom_concat(Prefix, '.qly', F0 ), - '$absolute_file_name'(Prefix,[access(read),file_type(prolog),file_errors(fail),solutions(first),expand(true)],F,load_files(Prefix)) + '$absolute_file_name'(Prefix,[access(read),file_type(prolog),file_errors(fail),solutions(first),expand(true)],F) ; F0 = F ), @@ -1079,7 +1079,7 @@ make_library_index(_Directory). exists_source(File) :- - '$full_filename'(File, _AbsFile, exists_source(File)). + '$full_filename'(File, _AbsFile). % reload_file(File) :- % ' $source_base_name'(File, Compile), diff --git a/pl/debug.yap b/pl/debug.yap index 07a718c8b..e00cf020f 100644 --- a/pl/debug.yap +++ b/pl/debug.yap @@ -406,7 +406,7 @@ be lost. '$spycall'(G, M, CP, not_expanded) :- '$is_metapredicate'(G, M), !, - '$expand_meta_call'(M:G, [], G1), + '$debugger_expand_meta_call'(M:G, [], G1), '$spycall'(G1, M, CP, expanded). '$spycall'(G, M, CP, _) :- '$undefined'(G, M), !, @@ -426,7 +426,9 @@ be lost. '$re_spycall'(E, G, M, L, H) ). -'$spygoal'(G, M, GoalNumber, H) :- +%% @pred $spygoal( +Goal, +Module, +CallId, +CallInfo) +%% +%% Actually debugs a % goal! '$spygoal'(G, M, GoalNumber, H) :- '$is_source'( G, M ), % use the interpreter !, gated_call( diff --git a/pl/init.yap b/pl/init.yap index 06f083f5b..eb5819891 100644 --- a/pl/init.yap +++ b/pl/init.yap @@ -133,12 +133,15 @@ otherwise. :- bootstrap('absf.yap'). :- dynamic prolog:'$parent_module'/2. - +%:- set_prolog_flag(verbose_file_search, true ). +%:- yap_flag(write_strings,on). +%:- start_low_level_trace. :- [ 'preds.yap', 'modules.yap' ]. + :- use_module('error.yap').