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

various fixes

Browse Source
This commit is contained in:
Vitor Santos Costa 2019-02-21 21:03:44 +00:00
parent c792db26be
commit ccfbe3f809
16 changed files with 183 additions and 251 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
C/atomic.c
View File

@ -950,7 +950,8 @@ restart_aux:
ot = ARG1;
} else if (g3) {
Int len = Yap_AtomToUnicodeLength(t3 PASS_REGS);
if (len <= 0) {
if (len < 0) {
Yap_ThrowError(-len,ARG3,"atom_concat(-X,-Y,+atom:Z");
cut_fail();
}
EXTRA_CBACK_ARG(3, 1) = MkIntTerm(0);

11
C/errors.c
View File

@ -296,10 +296,11 @@ void Yap_InitError__(const char *file, const char *function, int lineno,
va_list ap;
va_start(ap, t);
const char *fmt;
char tmpbuf[MAXPATHLEN];
char *tmpbuf=NULL;
fmt = va_arg(ap, char *);
if (fmt != NULL) {
tmpbuf = malloc(MAXPATHLEN);
#if HAVE_VSNPRINTF
vsnprintf(tmpbuf, MAXPATHLEN - 1, fmt, ap);
#else
@ -318,7 +319,7 @@ void Yap_InitError__(const char *file, const char *function, int lineno,
LOCAL_ActiveError->errorFile = NULL;
LOCAL_ActiveError->errorFunction = NULL;
LOCAL_ActiveError->errorLine = 0;
if (fmt) {
if (fmt && tmpbuf) {
LOCAL_Error_Size = strlen(tmpbuf);
LOCAL_ActiveError->errorMsg = malloc(LOCAL_Error_Size + 1);
strcpy((char *)LOCAL_ActiveError->errorMsg, tmpbuf);
@ -752,7 +753,8 @@ yamop *Yap_Error__(bool throw, const char *file, const char *function,
CACHE_REGS
va_list ap;
char *fmt;
char s[MAXPATHLEN];
char *s = NULL;
switch (type) {
case SYSTEM_ERROR_INTERNAL: {
@ -828,6 +830,7 @@ yamop *Yap_Error__(bool throw, const char *file, const char *function,
va_start(ap, where);
fmt = va_arg(ap, char *);
if (fmt != NULL) {
s = malloc(MAXPATHLEN);
#if HAVE_VSNPRINTF
(void)vsnprintf(s, MAXPATHLEN - 1, fmt, ap);
#else
@ -1000,7 +1003,7 @@ bool Yap_RaiseException(void) {
bool Yap_ResetException(yap_error_descriptor_t *i) {
// reset error descriptor
if (!i)
return true;
i = LOCAL_ActiveError;
yap_error_descriptor_t *bf = i->top_error;
memset(i, 0, sizeof(*i));
i->top_error = bf;

4
C/exec.c
View File

@ -1079,6 +1079,7 @@ static Int _user_expand_goal(USES_REGS1) {
Yap_execute_pred(pe, NULL, false PASS_REGS)) {
return complete_ge(true, omod, sl, creeping);
}
Yap_ResetException(NULL);
ARG1 = Yap_GetFromSlot(h1);
ARG2 = cmod;
ARG3 = Yap_GetFromSlot(h2);
@ -1089,6 +1090,8 @@ static Int _user_expand_goal(USES_REGS1) {
Yap_execute_pred(pe, NULL PASS_REGS, false)) {
return complete_ge(true, omod, sl, creeping);
}
Yap_ResetException(NULL);
mg_args[0] = cmod;
mg_args[1] = Yap_GetFromSlot(h1);
ARG1 = Yap_MkApplTerm(FunctorModule, 2, mg_args);
@ -1101,6 +1104,7 @@ static Int _user_expand_goal(USES_REGS1) {
Yap_execute_pred(pe, NULL PASS_REGS, false)) {
return complete_ge(true, omod, sl, creeping);
}
Yap_ResetException(NULL);
return complete_ge(false, omod, sl, creeping);
}

1
C/qlyr.c
View File

@ -663,6 +663,7 @@ static Atom do_header(FILE *stream) {
char h1[] = "exec $exec_dir/yap $0 \"$@\"\nsaved ";
Atom at;
memset(s,0,2049);
if (!maybe_read_bytes( stream, s, 2048) )
return NIL;
if (strstr(s, h0)!= s)

4
C/stack.c
View File

@ -72,6 +72,10 @@ static StaticIndex *find_owner_static_index(StaticIndex *, yamop *);
#define IN_BLOCK(P, B, SZ) \
((CODEADDR)(P) >= (CODEADDR)(B) && (CODEADDR)(P) < (CODEADDR)(B) + (SZ))
static PredEntry *get_pred(Term t, Term tmod, char *pname) {
Term t0 = t;

271
C/terms.c
View File

@ -44,33 +44,6 @@ extern int cs[10];
int cs[10];
static int expand_vts(int args USES_REGS) {
UInt expand = LOCAL_Error_Size;
yap_error_number yap_errno = LOCAL_Error_TYPE;
LOCAL_Error_Size = 0;
LOCAL_Error_TYPE = YAP_NO_ERROR;
if (yap_errno == RESOURCE_ERROR_TRAIL) {
/* Trail overflow */
if (!Yap_growtrail(expand, false)) {
return false;
}
} else if (yap_errno == RESOURCE_ERROR_AUXILIARY_STACK) {
/* Aux space overflow */
if (expand > 4 * 1024 * 1024)
expand = 4 * 1024 * 1024;
if (!Yap_ExpandPreAllocCodeSpace(expand, NULL, true)) {
return false;
}
} else {
if (!Yap_gcl(expand, 3, ENV, gc_P(P, CP))) {
Yap_Error(RESOURCE_ERROR_STACK, TermNil, "in term_variables");
return false;
}
}
return true;
}
static inline void clean_tr(tr_fr_ptr TR0 USES_REGS) {
tr_fr_ptr pt0 = TR;
while (pt0 != TR0) {
@ -112,10 +85,17 @@ typedef struct non_single_struct_t {
#define WALK_COMPLEX_TERM__(LIST0, STRUCT0, PRIMI0) \
\
struct non_single_struct_t *to_visit = Malloc( \
1024 * sizeof(struct non_single_struct_t)), \
*to_visit0 = to_visit, \
*to_visit_max = to_visit + 1024; \
int lvl = push_text_stack();\
CELL *pt0, *pt0_end; \
size_t auxsz = 1024 * sizeof(struct non_single_struct_t);\
struct non_single_struct_t *to_visit0=NULL, *to_visit,* to_visit_max;\
to_visit0 = Realloc(to_visit0,auxsz); \
CELL *InitialH = HR;\
tr_fr_ptr TR0 = TR;\
reset:\
pt0 = pt0_; pt0_end = pt0_end_; \
to_visit = to_visit0, \
to_visit_max = to_visit + auxsz/sizeof(struct non_single_struct_t);\
\
while (to_visit >= to_visit0) { \
CELL d0; \
@ -202,24 +182,36 @@ pop_text_stack(lvl);
#define def_aux_overflow() \
aux_overflow : { \
size_t d1 = to_visit - to_visit0; \
size_t d2 = to_visit_max - to_visit0; \
to_visit0 = \
Realloc(to_visit0, (d2 + 128) * sizeof(struct non_single_struct_t)); \
to_visit = to_visit0 + d1; \
to_visit_max = to_visit0 + (d2 + 128); \
pt0--; \
while (to_visit > to_visit0) { \
to_visit--; \
CELL *ptd0 = to_visit->ptd0; \
*ptd0 = to_visit->d0; \
} \
goto restart;
#define def_trail_overflow() \
trail_overflow : { \
LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; \
LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP; \
LOCAL_Error_Size = (TR - TR0) * sizeof(tr_fr_ptr *); \
clean_tr(TR0 PASS_REGS); \
HR = InitialH; \
pop_text_stack(lvl); \
return 0L; \
} \
goto reset;
#define def_trail_overflow() \
trail_overflow : { \
while (to_visit > to_visit0) { \
to_visit--; \
CELL *ptd0 = to_visit->ptd0; \
*ptd0 = to_visit->d0; \
} \
size_t expand = (TR - TR0) * sizeof(tr_fr_ptr *); \
clean_tr(TR0 PASS_REGS); \
HR = InitialH; \
pop_text_stack(lvl); \
/* Trail overflow */ \
if (!Yap_growtrail(expand, false)) { \
Yap_ThrowError(RESOURCE_ERROR_TRAIL, TermNil, expand);\
} \
goto reset;\
}
#define def_global_overflow() \
@ -229,12 +221,15 @@ global_overflow : { \
CELL *ptd0 = to_visit->ptd0; \
*ptd0 = to_visit->d0; \
} \
pop_text_stack(lvl); \
clean_tr(TR0 PASS_REGS); \
HR = InitialH; \
LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; \
LOCAL_Error_Size = (ASP - HR) * sizeof(CELL); \
size_t expand = 0L; \
if (!Yap_gcl(expand, 3, ENV, gc_P(P, CP))) { \
Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil, sizeof(CELL)*(HR-H0)); \
return false;\
}\
goto reset;\
}
#define CYC_LIST \
@ -260,8 +255,7 @@ if (IS_VISIT_MARKER) { \
/**
@brief routine to locate all variables in a term, and its applications */
static Term cyclic_complex_term(CELL *pt0, CELL *pt0_end USES_REGS) {
int lvl = push_text_stack();
static Term cyclic_complex_term(CELL *pt0_, CELL *pt0_end_ USES_REGS) {
WALK_COMPLEX_TERM__(CYC_LIST, CYC_APPL, {});
/* leave an empty slot to fill in later */
END_WALK();
@ -306,22 +300,28 @@ static Term BREAK_LOOP(CELL d0,struct non_single_struct_t *to_visit ) {
/**
@brief routine to locate all variables in a term, and its applications */
static int cycles_in_complex_term(register CELL *pt0,
register CELL *pt0_end USES_REGS) {
static int cycles_in_complex_term( CELL *pt0_, CELL *pt0_end_ USES_REGS) {
CELL *pt0, *pt0_end;
int lvl = push_text_stack();
size_t auxsz = 1024 * sizeof(struct non_single_struct_t);\
struct non_single_struct_t *to_visit0=NULL, *to_visit, *to_visit_max;\
to_visit0 = Malloc(auxsz);
CELL *InitialH = HR;
tr_fr_ptr TR0 = TR;
reset:
pt0 = pt0_, pt0_end = pt0_end_;
to_visit= to_visit0,
to_visit_max = to_visit0 + auxsz/sizeof(struct non_single_struct_t);
int rc = 0;
CELL *ptf;
struct non_single_struct_t *to_visit = Malloc(
1024 * sizeof(struct non_single_struct_t)),
*to_visit0 = to_visit,
*to_visit_max = to_visit + 1024;
ptf = HR;
HR++;
while (to_visit >= to_visit0) {
CELL d0;
CELL *ptd0;
restart:
while (pt0 < pt0_end) {
++pt0;
ptd0 = pt0;
@ -414,7 +414,8 @@ pop_text_stack(lvl);
return rc;
def_aux_overflow();
return -1;
}
Term Yap_CyclesInTerm(Term t USES_REGS) {
@ -452,10 +453,8 @@ static Int cycles_in_term(USES_REGS1) /* cyclic_term(+T) */
/**
@brief routine to locate all variables in a term, and its applications */
static bool ground_complex_term(register CELL * pt0,
register CELL * pt0_end USES_REGS) {
static bool ground_complex_term(CELL * pt0_, CELL * pt0_end_ USES_REGS) {
int lvl = push_text_stack();
WALK_COMPLEX_TERM();
/* leave an empty slot to fill in later */
while (to_visit > to_visit0) {
@ -501,10 +500,9 @@ static Int ground(USES_REGS1) /* ground(+T) */
return Yap_IsGroundTerm(Deref(ARG1));
}
static Int var_in_complex_term(register CELL * pt0, register CELL * pt0_end,
static Int var_in_complex_term(CELL *pt0_, CELL *pt0_end_ ,
Term v USES_REGS) {
int lvl = push_text_stack();
WALK_COMPLEX_TERM();
if ((CELL)ptd0 == v) { /* we found it */
@ -563,15 +561,10 @@ static Int variable_in_term(USES_REGS1) {
/**
* @brief routine to locate all variables in a term, and its applications.
*/
static Term vars_in_complex_term(register CELL * pt0, register CELL * pt0_end,
static Term vars_in_complex_term(CELL *pt0_, CELL *pt0_end_ ,
Term inp USES_REGS) {
register tr_fr_ptr TR0 = TR;
CELL *InitialH = HR;
CELL output = AbsPair(HR);
int lvl = push_text_stack();
push_text_stack();
WALK_COMPLEX_TERM();
/* do or pt2 are unbound */
*ptd0 = TermNil;
@ -650,15 +643,8 @@ static Int variables_in_term(
}
inp = TailOfTerm(inp);
}
do {
Term t = Deref(ARG1);
out = vars_in_complex_term(&(t)-1, &(t), ARG2 PASS_REGS);
if (out == 0L) {
if (!expand_vts(3 PASS_REGS))
return false;
}
} while (out == 0L);
clean_tr(TR - count PASS_REGS);
return Yap_unify(ARG3, out);
}
@ -678,7 +664,6 @@ static Int term_variables3(
{
Term out;
cs[0]++;
do {
Term t = Deref(ARG1);
if (IsVarTerm(t)) {
Term out = Yap_MkNewPairTerm();
@ -689,11 +674,6 @@ static Int term_variables3(
} else {
out = vars_in_complex_term(&(t)-1, &(t), ARG3 PASS_REGS);
}
if (out == 0L) {
if (!expand_vts(3 PASS_REGS))
return false;
}
} while (out == 0L);
return Yap_unify(ARG2, out);
}
@ -710,7 +690,6 @@ Term Yap_TermVariables(
{
Term out;
do {
t = Deref(t);
if (IsVarTerm(t)) {
return MkPairTerm(t, TermNil);
@ -719,11 +698,6 @@ Term Yap_TermVariables(
} else {
out = vars_in_complex_term(&(t)-1, &(t), TermNil PASS_REGS);
}
if (out == 0L) {
if (!expand_vts(arity PASS_REGS))
return false;
}
} while (out == 0L);
return out;
}
@ -743,19 +717,13 @@ static Int term_variables(
Term out;
cs[1]++;
if (!Yap_IsListOrPartialListTerm(ARG2)) {
Yap_Error(TYPE_ERROR_LIST, ARG2, "term_variables/2");
Yap_ThrowError(TYPE_ERROR_LIST, ARG2, "term_variables/2");
return false;
}
do {
Term t = Deref(ARG1);
out = vars_in_complex_term(&(t)-1, &(t), TermNil PASS_REGS);
if (out == 0L) {
if (!expand_vts(3 PASS_REGS))
return false;
}
} while (out == 0L);
return Yap_unify(ARG2, out);
}
@ -767,18 +735,13 @@ typedef struct att_rec {
} att_rec_t;
static Term attvars_in_complex_term(
register CELL * pt0, register CELL * pt0_end, Term inp USES_REGS) {
register tr_fr_ptr TR0 = TR;
CELL *InitialH = HR;
CELL *pt0_, CELL *pt0_end_ , Term inp USES_REGS) {
CELL output = inp;
int lvl = push_text_stack();
WALK_COMPLEX_TERM();
if (IsAttVar(ptd0)) {
/* do or pt2 are unbound */
attvar_record *a0 = RepAttVar(ptd0);
if (a0->AttFunc == (Functor)TermNil)
goto restart;
d0 = *ptd0;
/* leave an empty slot to fill in later */
if (HR + 1024 > ASP) {
goto global_overflow;
@ -788,37 +751,29 @@ static Term attvars_in_complex_term(
if (to_visit + 32 >= to_visit_max) {
goto aux_overflow;
}
ptd0 = (CELL *)a0;
to_visit->pt0 = pt0;
to_visit->pt0_end = pt0_end;
to_visit->d0 = *ptd0;
to_visit->ptd0 = ptd0;
to_visit++;
*ptd0 = TermNil;
pt0_end = &RepAttVar(ptd0)->Atts;
pt0 = pt0_end - 1;
TrailTerm(TR++) = a0->Done;
a0->Done=TermNil;
if ((tr_fr_ptr)LOCAL_TrailTop - TR < 1024) {
if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) {
goto trail_overflow;
}
pop_text_stack(lvl);
}
pt0_end = &a0->Atts;
pt0 = pt0_end - 1;
}
END_WALK();
clean_tr(TR0 PASS_REGS);
pop_text_stack(lvl);
if (HR != InitialH) {
/* close the list */
Term t2 = Deref(inp);
if (IsVarTerm(t2)) {
RESET_VARIABLE(HR - 1);
Yap_unify((CELL)(HR - 1), t2);
} else {
HR[-1] = t2; /* don't need to trail */
}
}
/*fprintf(stderr,"<%ld at %s\n", d0, __FUNCTION__)*/;
return (output);
return output;
def_aux_overflow();
def_global_overflow();
def_trail_overflow();
}
/** @pred term_attvars(+ _Term_,- _AttVars_)
@ -830,22 +785,16 @@ static Term attvars_in_complex_term(
*/
static Int p_term_attvars(USES_REGS1) /* variables in term t */
static Int term_attvars(USES_REGS1) /* variables in term t */
{
Term out;
do {
Term t = Deref(ARG1);
if (IsPrimitiveTerm(t)) {
return Yap_unify(TermNil, ARG2);
} else {
out = attvars_in_complex_term(&(t)-1, &(t), TermNil PASS_REGS);
}
if (out == 0L) {
if (!expand_vts(3 PASS_REGS))
return false;
}
} while (out == 0L);
return Yap_unify(ARG2, out);
}
@ -853,20 +802,19 @@ static Int p_term_attvars(USES_REGS1) /* variables in term t */
* some list.
*/
static Term new_vars_in_complex_term(
register CELL * pt0, register CELL * pt0_end, Term inp USES_REGS) {
register tr_fr_ptr TR0 = TR;
CELL *InitialH = HR;
int lvl = push_text_stack();
CELL *pt0_, CELL *pt0_end_ , Term inp USES_REGS) {
HB = ASP;
CELL output = TermNil;
{
tr_fr_ptr myTR0 = TR;
while (!IsVarTerm(inp) && IsPairTerm(inp)) {
int lvl = push_text_stack();
Term t = HeadOfTerm(inp);
if (IsVarTerm(t)) {
YapBind(VarOfTerm(t), TermFoundVar);
if ((tr_fr_ptr)LOCAL_TrailTop - TR < 1024) {
if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) {
if (!Yap_growtrail((TR - myTR0) * sizeof(tr_fr_ptr *), true)) {
goto trail_overflow;
}
pop_text_stack(lvl);
@ -917,18 +865,12 @@ static Int p_new_variables_in_term(
{
Term out;
do {
Term t = Deref(ARG2);
if (IsPrimitiveTerm(t))
out = TermNil;
else {
out = new_vars_in_complex_term(&(t)-1, &(t), Deref(ARG1) PASS_REGS);
}
if (out == 0L) {
if (!expand_vts(3 PASS_REGS))
return false;
}
} while (out == 0L);
return Yap_unify(ARG3, out);
}
@ -945,21 +887,19 @@ if (d0 == TermFoundVar) { \
}
static Term vars_within_complex_term(
register CELL * pt0, register CELL * pt0_end, Term inp USES_REGS) {
CELL *pt0_, CELL *pt0_end_, Term inp USES_REGS) {
tr_fr_ptr TR0 = TR;
CELL *InitialH = HR;
CELL output = AbsPair(HR);
int lvl = push_text_stack();
while (!IsVarTerm(inp) && IsPairTerm(inp)) {
tr_fr_ptr myTR0;
Term t = HeadOfTerm(inp);
if (IsVarTerm(t)) {
CELL *ptr = VarOfTerm(t);
*ptr = TermFoundVar;
TrailTerm(TR++) = t;
if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true);
Yap_growtrail((TR - myTR0) * sizeof(tr_fr_ptr *), true);
}
}
inp = TailOfTerm(inp);
@ -997,26 +937,18 @@ static Int p_variables_within_term(USES_REGS1) /* variables within term t */
{
Term out;
do {
Term t = Deref(ARG2);
if (IsPrimitiveTerm(t))
out = TermNil;
else {
out = vars_within_complex_term(&(t)-1, &(t), Deref(ARG1) PASS_REGS);
}
if (out == 0L) {
if (!expand_vts(3 PASS_REGS))
return false;
}
} while (out == 0L);
return Yap_unify(ARG3, out);
}
static Term free_vars_in_complex_term(CELL * pt0, CELL * pt0_end,
tr_fr_ptr TR0 USES_REGS) {
static Term free_vars_in_complex_term(CELL * pt0_, CELL * pt0_end_
USES_REGS) {
Term o = TermNil;
CELL *InitialH = HR;
int lvl = push_text_stack();
WALK_COMPLEX_TERM();
/* do or pt2 are unbound */
*ptd0 = TermNil;
@ -1050,10 +982,7 @@ static Term free_vars_in_complex_term(CELL * pt0, CELL * pt0_end,
def_global_overflow();
}
static Term bind_vars_in_complex_term(CELL * pt0, CELL * pt0_end,
tr_fr_ptr TR0 USES_REGS) {
CELL *InitialH = HR;
int lvl = push_text_stack();
static Term bind_vars_in_complex_term(CELL * pt0_, CELL * pt0_end_ USES_REGS) {
WALK_COMPLEX_TERM();
/* do or pt2 are unbound */
*ptd0 = TermFoundVar;
@ -1088,7 +1017,6 @@ static Int p_free_variables_in_term(
Term t, t0;
Term found_module = 0L;
do {
tr_fr_ptr TR0 = TR;
t = t0 = Deref(ARG1);
@ -1117,12 +1045,7 @@ static Int p_free_variables_in_term(
else {
out = free_vars_in_complex_term(&(t)-1, &(t), TR0 PASS_REGS);
}
if (out == 0L) {
trail_overflow:
if (!expand_vts(3 PASS_REGS))
return false;
}
} while (out == 0L);
if (found_module && t != t0) {
Term ts[2];
ts[0] = found_module;
@ -1177,7 +1100,6 @@ static Int p_non_singletons_in_term(
Term t;
Term out;
while (true) {
t = Deref(ARG1);
if (IsVarTerm(t)) {
out = ARG2;
@ -1186,10 +1108,6 @@ static Int p_non_singletons_in_term(
} else {
out = non_singletons_in_complex_term(&(t)-1, &(t)PASS_REGS);
}
if (out != 0L) {
return Yap_unify(ARG3, out);
}
}
}
static Term numbervar(Int me USES_REGS) {
@ -1218,10 +1136,6 @@ if (singles) { \
static Int numbervars_in_complex_term(CELL * pt0, CELL * pt0_end, Int numbv,
int singles USES_REGS) {
tr_fr_ptr TR0 = TR;
CELL *InitialH = HR;
int lvl = push_text_stack();
WALK_COMPLEX_TERM__({}, {}, {});
if (IsAttVar(pt0))
@ -1256,7 +1170,6 @@ Int Yap_NumberVars(Term inp, Int numbv,
Int out;
Term t;
restart:
t = Deref(inp);
if (IsPrimitiveTerm(t)) {
return numbv;
@ -1265,11 +1178,7 @@ Int Yap_NumberVars(Term inp, Int numbv,
out = numbervars_in_complex_term(&(t)-1, &(t), numbv,
handle_singles PASS_REGS);
}
if (out < numbv) {
if (!expand_vts(3 PASS_REGS))
return false;
goto restart;
}
return out;
}
@ -1309,7 +1218,7 @@ if (FunctorOfTerm(d0) == FunctorDollarVar) { \
static int max_numbered_var(CELL * pt0, CELL * pt0_end,
Int * maxp USES_REGS) {
int lvl = push_text_stack();
WALK_COMPLEX_TERM__({}, MAX_NUMBERED, {});
END_WALK();
/* Do we still have compound terms to visit */
@ -1541,7 +1450,7 @@ void Yap_InitTermCPreds(void) {
Yap_InitCPred("$free_variables_in_term", 3, p_free_variables_in_term, 0);
Yap_InitCPred("term_attvars", 2, p_term_attvars, 0);
Yap_InitCPred("term_attvars", 2, term_attvars, 0);
CurrentModule = TERMS_MODULE;
Yap_InitCPred("variable_in_term", 2, variable_in_term, 0);

11
C/text.c
View File

@ -192,7 +192,7 @@ void *MallocAtLevel(size_t sz, int atL USES_REGS) {
void *Realloc(void *pt, size_t sz USES_REGS) {
struct mblock *old = pt, *o;
old--;
sz = ALIGN_BY_TYPE(sz + sizeof(struct mblock), CELL);
sz = ALIGN_BY_TYPE(sz + sizeof(struct mblock), Yap_Max(CELLSIZE,sizeof(struct mblock)));
o = realloc(old, sz);
if (o->next) {
o->next->prev = o;
@ -447,15 +447,16 @@ unsigned char *Yap_readText(seq_tv_t *inp USES_REGS) {
yap_error_number err0 = LOCAL_Error_TYPE;
/* we know what the term is */
if (!(inp->type & (YAP_STRING_CHARS | YAP_STRING_WCHARS))) {
if (!(inp->type & YAP_STRING_TERM)) {
seq_type_t inpt = inp->type & (YAP_STRING_TERM|YAP_STRING_ATOM|YAP_STRING_ATOMS_CODES);
if (!(inpt & YAP_STRING_TERM)) {
if (IsVarTerm(inp->val.t)) {
LOCAL_Error_TYPE = INSTANTIATION_ERROR;
} else if (!IsAtomTerm(inp->val.t) && inp->type == YAP_STRING_ATOM) {
} else if (!IsAtomTerm(inp->val.t) && inpt == YAP_STRING_ATOM) {
LOCAL_Error_TYPE = TYPE_ERROR_ATOM;
} else if (!IsStringTerm(inp->val.t) && inp->type == YAP_STRING_STRING) {
} else if (!IsStringTerm(inp->val.t) && inpt == YAP_STRING_STRING) {
LOCAL_Error_TYPE = TYPE_ERROR_STRING;
} else if (!IsPairOrNilTerm(inp->val.t) && !IsStringTerm(inp->val.t) &&
inp->type == (YAP_STRING_ATOMS_CODES | YAP_STRING_STRING)) {
inpt == (YAP_STRING_ATOMS_CODES | YAP_STRING_STRING)) {
LOCAL_ActiveError->errorRawTerm = inp->val.t;
} else if (!IsPairOrNilTerm(inp->val.t) && !IsStringTerm(inp->val.t) &&
!IsAtomTerm(inp->val.t) && !(inp->type & YAP_STRING_DATUM)) {

2
C/utilpreds.c
View File

@ -152,7 +152,7 @@ clean_complex_tr(tr_fr_ptr TR0 USES_REGS) {
#define expand_stack(S0,SP,SF,TYPE) \
{ size_t sz = SF-S0, used = SP-S0; \
S0 = Realloc(S0, (1024+sz)*sizeof(TYPE) PASS_REGS); \
S0 = Realxbloc(S0, (1024+sz)*sizeof(TYPE) PASS_REGS); \
SP = S0+used; SF = S0+sz; }
#define MIN_ARENA_SIZE (1048L)

2
H/YapText.h
View File

@ -1447,7 +1447,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 | YAP_STRING_TERM;
inpv[0].type = YAP_STRING_ATOM ;
inpv[1].val.t = t2;
inpv[1].type = YAP_STRING_ATOM;
out.type = YAP_STRING_ATOM;

1
pl/boot2.yap
View File

@ -41,7 +41,6 @@
:- '$opdec'(1150,fx,(mode),prolog).
:- dynamic 'extensions_to_present_answer'/1.
:- ['arrays.yap'].
:- multifile user:portray_message/2.

4
pl/directives.yap
View File

@ -272,12 +272,14 @@ user_defined_directive(Dir,Action) :-
'$process_directive'(D, _, M, _VL, _Pos) :-
current_prolog_flag(language_mode, iso),
!, % ISO Prolog mode, go in and do it,
'$do_error'(context_error((:- M:D),query),directive).
%
% but YAP and SICStus do.
%
'$process_directive'(G, _Mode, M, _VL, _Pos) :-
'$execute'(M:G),
'$yap_strip_module'(M:G,M1,G1),
'$execute'(M1:G1),
!.
'$process_directive'(G, _Mode, M, _VL, _Pos) :-
format(user_error,':- ~w:~w failed.~n',[M,G]).

2
pl/init.yap
View File

@ -92,7 +92,7 @@
'$init_step'(1) :-
'$version'.
'$init_step'(2) :-
set_prolog_flag(file_name_variables, _OldF, true),
set_prolog_flag(file_name_variables, true),
'$init_consult'.
%set_prolog_flag(file_name_variables, OldF),
'$init_step'(3) :-

2
pl/messages.yap
View File

@ -261,7 +261,7 @@ compose_message(Throw, _Level) -->
location( error(_,Info), Level, _LC ) -->
{ '$error_descriptor'(Info, Desc) },
{ query_exception(prologConsulting, Desc, true) },
{ query_exception(parserReadingCode, Desc, true)},
% { query_exception(parserReadingCode, Desc, true)},
!,
{
query_exception(parserFile, Desc, FileName),

5
pl/meta.yap
View File

@ -480,7 +480,12 @@ expand_goal(Input, Output) :-
'$expand_meta_call'(G, HVars, MF:GF ) :-
source_module(SM),
'$yap_strip_module'(SM:G, M, IG),
'$is_metapredicate'(IG, M),
'$expand_goals'(IG, _, GF0, M, SM, M, HVars-G),
!,
'$yap_strip_module'(M:GF0, MF, GF).
'$expand_meta_call'(G, _HVars, M:IG ) :-
source_module(SM),
'$yap_strip_module'(SM:G, M, IG).
%% @}

4
pl/top.yap
View File

@ -188,9 +188,7 @@ live :-
'$expand_term0'(T,_,T).
'$expand_term1'(T,O) :-
'$expand_meta_call'(T, [], O),
!.
'$expand_term1'(O,O).
'$expand_meta_call'(T, none, O).
'$continue_with_command'(Where,V,'$stream_position'(C,_P,A1,A2,A3),'$source_location'(_F,L):G,Source) :-
!,

51
pl/undefined.yap
View File

@ -96,29 +96,12 @@ undefined_query(G0, M0, Cut) :-
% undef handler
'$undefp'([M0|G0],MG) :-
% make sure we do not loop on undefined predicates
setup_call_cleanup(
'$undef_setup'(M0:G0, Action,Debug,Current, MGI),
('$get_undefined_predicates'( MGI, MG )
->
true
;
'$undef_error'(Current, M0:G0, MGI, MG)
),
ignore('$get_undefined_predicates'( MGI, MG )),
'$undef_cleanup'(Action,Debug,Current)
.
'$undef_error'(_, M0:G0, _, MG) :-
'$pred_exists'(unknown_predicate_handler(_,_,_,_), user),
'$yap_strip_module'(M0:G0, EM0, GM0),
user:unknown_predicate_handler(GM0,EM0,MG),
!.
'$undef_error'(error, Mod:Goal, I,_) :-
'$do_error'(existence_error(procedure,I), Mod:Goal).
'$undef_error'(warning,Mod:Goal,I,_) :-
'program_continuation'(PMod,PName,PAr),
print_message(warning,error(existence_error(procedure,I), context(Mod:Goal,PMod:PName/PAr))),
fail.
'$undef_error'(fail,_Goal,_Mod) :-
fail.
),
'$undef_error'(Action, M0:G0, MGI, MG).
'$undef_setup'(G0,Action,Debug,Current,GI) :-
yap_flag( unknown, Action, fail),
@ -138,9 +121,9 @@ undefined_query(G0, M0, Cut) :-
'$undef_cleanup'(Action,Debug, _Current) :-
yap_flag( unknown, _, Action),
yap_flag( debug, _, Debug),
'$start_creep'([prolog|true], creep).
yap_flag( debug, _, Debug).
:- abolish(prolog:'$undefp0'/2).
:- '$undefp_handler'('$undefp'(_,_), prolog).
/** @pred unknown(- _O_,+ _N_)
@ -154,6 +137,28 @@ The unknown predicate, informs about what the user wants to be done
*/
'$undef_error'(_, _, _, M:G) :-
nonvar(M),
nonvar(G),
!,
'$start_creep'([prolog|true], creep).
'$undef_error'(_, M0:G0, _, MG) :-
'$pred_exists'(unknown_predicate_handler(_,_,_,_), user),
'$yap_strip_module'(M0:G0, EM0, GM0),
user:unknown_predicate_handler(GM0,EM0,MG),
!,
'$start_creep'([prolog|true], creep).
'$undef_error'(error, Mod:Goal, I,_) :-
'$do_error'(existence_error(procedure,I), Mod:Goal).
'$undef_error'(warning,Mod:Goal,I,_) :-
'program_continuation'(PMod,PName,PAr),
print_message(warning,error(existence_error(procedure,I), context(Mod:Goal,PMod:PName/PAr))),
'$start_creep'([fail|true], creep),
fail.
'$undef_error'(fail,_Goal,_,_Mod) :-
'$start_creep'([fail|true], creep),
fail.
unknown(P, NP) :-
yap_flag( unknown, P, NP ).