diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

generic tmp alloc fixes.

Browse Source
This commit is contained in:
Vitor Santos Costa 2017-10-02 08:58:51 +01:00
parent c06dd92761
commit 9f1ef65ff5
15 changed files with 341 additions and 307 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

143
C/atomic.c
View File

@ -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")) {

16
C/errors.c
View File

@ -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;
}

46
C/text.c
View File

@ -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);
}

5
CXX/yapt.hh
View File

@ -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;

40
H/YapText.h
View File

@ -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);

220
os/files.c
View File

@ -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

6
os/fmem.c
View File

@ -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);

22
os/iopreds.c
View File

@ -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,

2
os/iopreds.h
View File

@ -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);

23
os/sysbits.c
View File

@ -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;

83
pl/absf.yap
View File

@ -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),

17
pl/boot.yap
View File

@ -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)

14
pl/consult.yap
View File

@ -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),

6
pl/debug.yap
View File

@ -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(

5
pl/init.yap
View File

@ -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').