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

overflows

This commit is contained in:
Vitor Santos Costa 2019-02-19 15:53:36 +00:00
parent c792db26be
commit f483838610
17 changed files with 217 additions and 300 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);
}

8
C/globals.c
View File

@ -354,7 +354,7 @@ static inline void clean_dirty_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); \
SP = S0+used; SF = S0+sz; }
SP = S0+used; SF = S0+(1024+sz); }
static int copy_complex_term(register CELL *pt0, register CELL *pt0_end,
int share, int copy_att_vars, CELL *ptf,
@ -808,10 +808,8 @@ error_handler:
}
break;
default: /* temporary space overflow */
if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) {
Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, TermNil, LOCAL_ErrorMessage);
return 0L;
}
return 0;
}
}
oldH = HR;

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;

380
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,11 +85,18 @@ 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;\
CELL *InitialH = HR;\
tr_fr_ptr TR0 = TR;\
reset:\
pt0 = pt0_; pt0_end = pt0_end_; \
to_visit0 = Realloc(to_visit0,auxsz); \
to_visit = to_visit0, \
to_visit_max = to_visit + auxsz/sizeof(struct non_single_struct_t);\
\
while (to_visit >= to_visit0) { \
CELL d0; \
CELL *ptd0; \
@ -202,24 +182,31 @@ 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--; \
} \
goto restart;
while (to_visit > to_visit0) { \
to_visit--; \
CELL *ptd0 = to_visit->ptd0; \
*ptd0 = to_visit->d0; \
} \
clean_tr(TR0 PASS_REGS); \
auxsz += auxsz;\
goto reset; }
#define def_trail_overflow() \
trail_overflow : { \
LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; \
LOCAL_Error_Size = (TR - TR0) * sizeof(tr_fr_ptr *); \
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); \
return 0L; \
/* Trail overflow */ \
if (!Yap_growtrail(expand, false)) { \
Yap_ThrowError(RESOURCE_ERROR_TRAIL, TermNil, expand);\
} \
goto reset;\
}
#define def_global_overflow() \
@ -229,12 +216,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); \
return false; \
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 +250,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 +295,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;
CELL *InitialH = HR;
tr_fr_ptr TR0 = TR;
reset:
pt0 = pt0_, pt0_end = pt0_end_;
to_visit0 = Realloc(to_visit0,auxsz);
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 +409,8 @@ pop_text_stack(lvl);
return rc;
def_aux_overflow();
return -1;
}
Term Yap_CyclesInTerm(Term t USES_REGS) {
@ -452,10 +448,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,11 +495,10 @@ 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();
WALK_COMPLEX_TERM();
if ((CELL)ptd0 == v) { /* we found it */
/* Do we still have compound terms to visit */
@ -563,16 +556,29 @@ 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;
Int count=0;
while (!IsVarTerm(inp) && IsPairTerm(inp)) {
Term t = HeadOfTerm(inp);
if (IsVarTerm(t)) {
CELL *ptr = VarOfTerm(t);
*ptr = TermFoundVar;
TrailTerm(TR++) = t;
count++;
if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
clean_tr(TR - count PASS_REGS);
if (!Yap_growtrail(count * sizeof(tr_fr_ptr *), false)) {
return false;
}
}
}
inp = TailOfTerm(inp);
}
CELL output = AbsPair(HR);
int lvl = push_text_stack();
push_text_stack();
WALK_COMPLEX_TERM();
WALK_COMPLEX_TERM();
/* do or pt2 are unbound */
*ptd0 = TermNil;
/* leave an empty slot to fill in later */
@ -593,7 +599,7 @@ static Term vars_in_complex_term(register CELL * pt0, register CELL * pt0_end,
END_WALK();
clean_tr(TR0 PASS_REGS);
clean_tr(TR0-count PASS_REGS);
pop_text_stack(lvl);
if (HR != InitialH) {
@ -628,37 +634,10 @@ static Int variables_in_term(
USES_REGS1) /* variables in term t */
{
Term out, inp;
int count;
restart:
count = 0;
inp = Deref(ARG2);
while (!IsVarTerm(inp) && IsPairTerm(inp)) {
Term t = HeadOfTerm(inp);
if (IsVarTerm(t)) {
CELL *ptr = VarOfTerm(t);
*ptr = TermFoundVar;
TrailTerm(TR++) = t;
count++;
if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
clean_tr(TR - count PASS_REGS);
if (!Yap_growtrail(count * sizeof(tr_fr_ptr *), false)) {
return false;
}
goto restart;
}
}
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);
out = vars_in_complex_term(&(t)-1, &(t), inp PASS_REGS);
return Yap_unify(ARG3, out);
}
@ -678,7 +657,6 @@ static Int term_variables3(
{
Term out;
cs[0]++;
do {
Term t = Deref(ARG1);
if (IsVarTerm(t)) {
Term out = Yap_MkNewPairTerm();
@ -689,11 +667,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,8 +683,7 @@ Term Yap_TermVariables(
{
Term out;
do {
t = Deref(t);
t = Deref(t);
if (IsVarTerm(t)) {
return MkPairTerm(t, TermNil);
} else if (IsPrimitiveTerm(t)) {
@ -719,11 +691,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;
}
@ -741,22 +708,15 @@ static Int term_variables(
USES_REGS1) /* variables in term t */
{
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);
return Yap_unify(ARG2, out);
}
/** routine to locate attributed variables */
@ -767,18 +727,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 output = inp;
int lvl = push_text_stack();
CELL *pt0_, CELL *pt0_end_ , Term inp USES_REGS) {
CELL output = inp;
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 +743,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;
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,46 +777,39 @@ 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);
return Yap_unify(ARG2, out);
}
/** @brief output the difference between variables in _T_ and variables in
* 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();
HB = ASP;
CELL *pt0_, CELL *pt0_end_ , Term inp USES_REGS) {
Int n=0;
CELL output = TermNil;
{
tr_fr_ptr myTR0 = TR;
while (!IsVarTerm(inp) && IsPairTerm(inp)) {
Term t = HeadOfTerm(inp);
if (IsVarTerm(t)) {
YapBind(VarOfTerm(t), TermFoundVar);
n++;
TrailTerm(TR++) = t;
*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);
}
}
inp = TailOfTerm(inp);
@ -877,7 +817,8 @@ static Term new_vars_in_complex_term(
}
WALK_COMPLEX_TERM();
output = MkPairTerm((CELL)ptd0, output);
YapBind(ptd0, TermFoundVar);
TrailTerm(TR++) = *ptd0;
*ptd0 = TermFoundVar;
if ((tr_fr_ptr)LOCAL_TrailTop - TR < 1024) {
if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) {
goto trail_overflow;
@ -889,7 +830,7 @@ if (HR + 1024 > ASP) {
}
END_WALK();
clean_tr(TR0 PASS_REGS);
clean_tr(TR0-n PASS_REGS);
pop_text_stack(lvl);
HB = B->cp_h;
return output;
@ -917,19 +858,13 @@ 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);
return Yap_unify(ARG3, out);
}
#define FOUND_VAR() \
@ -945,21 +880,19 @@ if (d0 == TermFoundVar) { \
}
static Term vars_within_complex_term(
register CELL * pt0, register CELL * pt0_end, Term inp USES_REGS) {
tr_fr_ptr TR0 = TR;
CELL *InitialH = HR;
CELL *pt0_, CELL *pt0_end_, Term inp USES_REGS) {
Int n=0;
CELL output = AbsPair(HR);
int lvl = push_text_stack();
while (!IsVarTerm(inp) && IsPairTerm(inp)) {
Term t = HeadOfTerm(inp);
if (IsVarTerm(t)) {
CELL *ptr = VarOfTerm(t);
*ptr = TermFoundVar;
n++;
TrailTerm(TR++) = t;
if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true);
Yap_growtrail(2*n * sizeof(tr_fr_ptr *), true);
}
}
inp = TailOfTerm(inp);
@ -969,7 +902,7 @@ static Term vars_within_complex_term(
goto restart;
END_WALK();
clean_tr(TR0 PASS_REGS);
clean_tr(TR0-n PASS_REGS);
pop_text_stack(lvl);
if (HR != InitialH) {
HR[-1] = TermNil;
@ -997,26 +930,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);
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 +975,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;
@ -1081,25 +1003,19 @@ static Term bind_vars_in_complex_term(CELL * pt0, CELL * pt0_end,
def_trail_overflow();
}
/* variables within term t */
static Int p_free_variables_in_term(
USES_REGS1) /* variables within term t */
USES_REGS1)
{
Term out;
Term t, t0;
Term found_module = 0L;
do {
tr_fr_ptr TR0 = TR;
t = t0 = Deref(ARG1);
t = t0 = Deref(ARG1);
while (!IsVarTerm(t) && IsApplTerm(t)) {
Functor f = FunctorOfTerm(t);
if (f == FunctorHat) {
out = bind_vars_in_complex_term(RepAppl(t), RepAppl(t) + 1,
TR0 PASS_REGS);
if (out == 0L) {
goto trail_overflow;
}
out = bind_vars_in_complex_term(RepAppl(t), RepAppl(t) + 1 PASS_REGS);
} else if (f == FunctorModule) {
found_module = ArgOfTerm(1, t);
} else if (f == FunctorCall) {
@ -1115,14 +1031,9 @@ static Int p_free_variables_in_term(
if (IsPrimitiveTerm(t))
out = TermNil;
else {
out = free_vars_in_complex_term(&(t)-1, &(t), TR0 PASS_REGS);
out = free_vars_in_complex_term(&(t)-1, &(t) 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;
@ -1143,13 +1054,11 @@ if (d0 == TermFoundVar) { \
*pt2 = TermRefoundVar; \
}
static Term non_singletons_in_complex_term(CELL * pt0,
CELL * pt0_end USES_REGS) {
tr_fr_ptr TR0 = TR;
CELL *InitialH = HR;
static Term non_singletons_in_complex_term(CELL * pt0_,
CELL * pt0_end_ USES_REGS) {
HB = (CELL *)ASP;
CELL output = AbsPair(HR);
int lvl = push_text_stack();
WALK_COMPLEX_TERM__({}, {}, FOUND_VAR_AGAIN());
/* do or pt2 are unbound */
YapBind(ptd0, TermFoundVar);
@ -1177,8 +1086,7 @@ static Int p_non_singletons_in_term(
Term t;
Term out;
while (true) {
t = Deref(ARG1);
t = Deref(ARG1);
if (IsVarTerm(t)) {
out = ARG2;
} else if (IsPrimitiveTerm(t)) {
@ -1186,11 +1094,8 @@ 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);
}
}
}
return out;
}
static Term numbervar(Int me USES_REGS) {
Term ts[1];
@ -1215,13 +1120,9 @@ if (singles) { \
goto restart; \
}
static Int numbervars_in_complex_term(CELL * pt0, CELL * pt0_end, Int numbv,
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,8 +1157,7 @@ Int Yap_NumberVars(Term inp, Int numbv,
Int out;
Term t;
restart:
t = Deref(inp);
t = Deref(inp);
if (IsPrimitiveTerm(t)) {
return numbv;
} else {
@ -1265,11 +1165,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;
}
@ -1307,9 +1203,9 @@ if (FunctorOfTerm(d0) == FunctorDollarVar) { \
goto restart; \
}
static int max_numbered_var(CELL * pt0, CELL * pt0_end,
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 +1437,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
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.

6
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).
'$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),

15
pl/meta.yap
View File

@ -477,10 +477,15 @@ meta_predicate(P) :-
expand_goal(Input, Output) :-
'$expand_meta_call'(Input, none, Output ).
'$expand_meta_call'(G, HVars, MF:GF ) :-
source_module(SM),
'$yap_strip_module'(SM:G, M, IG),
'$expand_goals'(IG, _, GF0, M, SM, M, HVars-G),
'$yap_strip_module'(M:GF0, MF, GF).
'$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).
%% @}

6
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) :-
!,
@ -637,7 +635,7 @@ write_query_answer( Bindings ) :-
'$do_error'(instantiation_error,call(G0)).
'$call'(M:G,CP,G0,_M0) :- !,
'$expand_meta_call'(M:G, [], NG),
'$yap_strip_module'(NG,NM,NC),
'$yap_strip_module'(NG,NM,NC),
'$call'(NC,CP,G0,NM).
'$call'((X,Y),CP,G0,M) :- !,
'$call'(X,CP,G0,M),

59
pl/undefined.yap
View File

@ -95,30 +95,13 @@ undefined_query(G0, M0, Cut) :-
% undef handler
'$undefp'([M0|G0],MG) :-
% make sure we do not loop on undefined predicates
'$undef_setup'(M0:G0, Action,Debug,Current, MGI),
('$get_undefined_predicates'( MGI, MG )
->
true
;
'$undef_error'(Current, M0:G0, 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.
% make sure we do not loop on undefined predicates
setup_call_cleanup(
'$undef_setup'(M0:G0, Action,Debug,Current, MGI),
ignore('$get_undefined_predicates'( MGI, MG )),
'$undef_cleanup'(Action,Debug,Current)
),
'$undef_error'(Action, M0:G0, MGI, MG).
'$undef_setup'(G0,Action,Debug,Current,GI) :-
yap_flag( unknown, Action, fail),
@ -136,11 +119,11 @@ undefined_query(G0, M0, Cut) :-
!,
functor(G, Na, Ar).
'$undef_cleanup'(Action,Debug,_Current) :-
'$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 ).

2
regression/cyclics.yap
View File

@ -13,7 +13,7 @@ main :-
test( cyclic_term(X), [X]).
test( ground(X), [X]).
test( (variables_in_term(X, O), writeln(X=O) ), [X, [], O]).
test( (term_variables(X, O), writeln(X=O) ), [X, [], O]).
test( (new_variables_in_term(L,X, O), writeln(X+L=O) ), [X, L, O]).
test( (variables_within_term(L,X, O), writeln(X+L=O) ), [X, L, O]).
test( writeln(X), [X]).