From f4838386102219305bbca05406fbeeda916c9322 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Tue, 19 Feb 2019 15:53:36 +0000 Subject: [PATCH 1/4] overflows --- C/atomic.c | 3 +- C/errors.c | 11 +- C/exec.c | 4 + C/globals.c | 8 +- C/qlyr.c | 1 + C/stack.c | 4 + C/terms.c | 380 +++++++++++++++-------------------------- C/text.c | 11 +- H/YapText.h | 2 +- pl/boot2.yap | 1 - pl/directives.yap | 6 +- pl/init.yap | 2 +- pl/messages.yap | 2 +- pl/meta.yap | 15 +- pl/top.yap | 6 +- pl/undefined.yap | 59 ++++--- regression/cyclics.yap | 2 +- 17 files changed, 217 insertions(+), 300 deletions(-) diff --git a/C/atomic.c b/C/atomic.c index 96be7955b..c6e1bae85 100755 --- a/C/atomic.c +++ b/C/atomic.c @@ -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); diff --git a/C/errors.c b/C/errors.c index 4e4648f1e..ed1cbd6f2 100755 --- a/C/errors.c +++ b/C/errors.c @@ -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; diff --git a/C/exec.c b/C/exec.c index 687c532b6..89fa21500 100755 --- a/C/exec.c +++ b/C/exec.c @@ -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); } diff --git a/C/globals.c b/C/globals.c index 59be2a42b..0a5031fe2 100644 --- a/C/globals.c +++ b/C/globals.c @@ -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; diff --git a/C/qlyr.c b/C/qlyr.c index c961dc7b9..cd67ce30a 100755 --- a/C/qlyr.c +++ b/C/qlyr.c @@ -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) diff --git a/C/stack.c b/C/stack.c index 95bbac32b..d393cde7e 100644 --- a/C/stack.c +++ b/C/stack.c @@ -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; diff --git a/C/terms.c b/C/terms.c index f5dc8a3c0..e6230f90e 100644 --- a/C/terms.c +++ b/C/terms.c @@ -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); diff --git a/C/text.c b/C/text.c index e64e41bf3..ddb1ba01d 100644 --- a/C/text.c +++ b/C/text.c @@ -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)) { diff --git a/H/YapText.h b/H/YapText.h index 7f76514f3..822bd8bec 100644 --- a/H/YapText.h +++ b/H/YapText.h @@ -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; diff --git a/pl/boot2.yap b/pl/boot2.yap index 7b0bef42f..27ad68501 100644 --- a/pl/boot2.yap +++ b/pl/boot2.yap @@ -41,7 +41,6 @@ :- '$opdec'(1150,fx,(mode),prolog). :- dynamic 'extensions_to_present_answer'/1. - :- ['arrays.yap']. :- multifile user:portray_message/2. diff --git a/pl/directives.yap b/pl/directives.yap index 38540758b..1af3b202d 100644 --- a/pl/directives.yap +++ b/pl/directives.yap @@ -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]). diff --git a/pl/init.yap b/pl/init.yap index 8f0e729ae..008b7be68 100644 --- a/pl/init.yap +++ b/pl/init.yap @@ -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) :- diff --git a/pl/messages.yap b/pl/messages.yap index bd0f4f3f4..cc0124eb7 100644 --- a/pl/messages.yap +++ b/pl/messages.yap @@ -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), diff --git a/pl/meta.yap b/pl/meta.yap index 56054217e..93b4a5e12 100644 --- a/pl/meta.yap +++ b/pl/meta.yap @@ -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). %% @} diff --git a/pl/top.yap b/pl/top.yap index 4c85aa0c0..13197f25c 100644 --- a/pl/top.yap +++ b/pl/top.yap @@ -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), diff --git a/pl/undefined.yap b/pl/undefined.yap index 3852845f8..980259645 100644 --- a/pl/undefined.yap +++ b/pl/undefined.yap @@ -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 ). diff --git a/regression/cyclics.yap b/regression/cyclics.yap index 120568cd4..19c19ef9b 100644 --- a/regression/cyclics.yap +++ b/regression/cyclics.yap @@ -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]). From cb0f5ec4dbbe98efe442f1ca2e8d54a2dce45948 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Tue, 19 Feb 2019 15:56:22 +0000 Subject: [PATCH 2/4] errors --- C/exec.c | 47 ++++++++++++++++++++--------------------------- 1 file changed, 20 insertions(+), 27 deletions(-) diff --git a/C/exec.c b/C/exec.c index 687c532b6..cb35bcb5b 100755 --- a/C/exec.c +++ b/C/exec.c @@ -1065,7 +1065,7 @@ static Int _user_expand_goal(USES_REGS1) { ARG1 = g; if ((pe = RepPredProp(Yap_GetPredPropByFunc(FunctorGoalExpansion2, cmod))) && pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE && - Yap_execute_pred(pe, NULL, false PASS_REGS)) { + Yap_execute_pred(pe, NULL, true PASS_REGS)) { return complete_ge(true, omod, sl, creeping); } /* system:goal_expansion(A,B) */ @@ -1076,7 +1076,7 @@ static Int _user_expand_goal(USES_REGS1) { if ((pe = RepPredProp( Yap_GetPredPropByFunc(FunctorGoalExpansion2, SYSTEM_MODULE))) && pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE && - Yap_execute_pred(pe, NULL, false PASS_REGS)) { + Yap_execute_pred(pe, NULL, true PASS_REGS)) { return complete_ge(true, omod, sl, creeping); } ARG1 = Yap_GetFromSlot(h1); @@ -1086,7 +1086,7 @@ static Int _user_expand_goal(USES_REGS1) { if ((pe = RepPredProp( Yap_GetPredPropByFunc(FunctorGoalExpansion, USER_MODULE))) && pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE && - Yap_execute_pred(pe, NULL PASS_REGS, false)) { + Yap_execute_pred(pe, NULL, true PASS_REGS)) { return complete_ge(true, omod, sl, creeping); } mg_args[0] = cmod; @@ -1098,7 +1098,7 @@ static Int _user_expand_goal(USES_REGS1) { (pe = RepPredProp( Yap_GetPredPropByFunc(FunctorGoalExpansion2, USER_MODULE))) && pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE && - Yap_execute_pred(pe, NULL PASS_REGS, false)) { + Yap_execute_pred(pe, NULL, true PASS_REGS)) { return complete_ge(true, omod, sl, creeping); } return complete_ge(false, omod, sl, creeping); @@ -1719,13 +1719,6 @@ bool Yap_execute_pred(PredEntry *ppe, CELL *pt, bool pass_ex USES_REGS) { /* restore the old environment */ /* get to previous environment */ cut_B = (choiceptr)ENV[E_CB]; - { - /* Note that - cut_B == (choiceptr)ENV[E_CB] */ - while (POP_CHOICE_POINT(ENV[E_CB])) { - POP_EXECUTE(); - } - } #ifdef YAPOR CUT_prune_to(cut_B); #endif /* YAPOR */ @@ -1750,21 +1743,20 @@ bool Yap_execute_pred(PredEntry *ppe, CELL *pt, bool pass_ex USES_REGS) { /* we have failed, and usually we would backtrack to this B, trouble is, we may also have a delayed cut to do */ if (B != NULL) - HB = B->cp_h; YENV = ENV; // should we catch the exception or pass it through? - // We'll pass it through - if (pass_ex && Yap_HasException()) { - if ((LOCAL_PrologMode & BootMode) || !CurrentModule ) { - Yap_ResetException(LOCAL_ActiveError); + // We'll pass it through + if ( Yap_HasException()) { + if (pass_ex && + ((LOCAL_PrologMode & BootMode) || !CurrentModule )) { + Yap_ResetException(LOCAL_ActiveError); + } else { + Yap_RaiseException(); + } return false; } - - Yap_RaiseException(); - return false; - } - return true; + return true; } else if (out == 0) { P = saved_p; CP = saved_cp; @@ -1782,12 +1774,13 @@ bool Yap_execute_pred(PredEntry *ppe, CELL *pt, bool pass_ex USES_REGS) { HB = PROTECT_FROZEN_H(B); // should we catch the exception or pass it through? // We'll pass it through - if (pass_ex) { - if ((LOCAL_PrologMode & BootMode) || !CurrentModule ) { - Yap_ResetException(LOCAL_ActiveError); - return false; - } - Yap_RaiseException(); + if ( Yap_HasException()) { + if (pass_ex && + ((LOCAL_PrologMode & BootMode) || !CurrentModule )) { + Yap_ResetException(LOCAL_ActiveError); + } else { + Yap_RaiseException(); + } } return false; } else { From 84721e1005caa38a727a86c27b0581456b869500 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Wed, 20 Feb 2019 10:45:21 +0000 Subject: [PATCH 3/4] copy --- C/terms.c | 43 +++++++++++------------- C/utilpreds.c | 8 ++--- pl/debug.yap | 90 +++++++++++++++++++++++++++++---------------------- pl/top.yap | 2 +- 4 files changed, 74 insertions(+), 69 deletions(-) diff --git a/C/terms.c b/C/terms.c index e6230f90e..3e325f01e 100644 --- a/C/terms.c +++ b/C/terms.c @@ -981,16 +981,8 @@ static Term bind_vars_in_complex_term(CELL * pt0_, CELL * pt0_end_ USES_REGS) { *ptd0 = TermFoundVar; /* next make sure noone will see this as a variable again */ if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - /* Trail overflow */ - if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) { - while (to_visit > to_visit0) { - to_visit--; - CELL *ptd0 = to_visit->ptd0; - *ptd0 = to_visit->d0; - } goto trail_overflow; } - } TrailTerm(TR++) = (CELL)ptd0; END_WALK(); @@ -1043,41 +1035,42 @@ if (found_module && t != t0) { return Yap_unify(ARG2, t) && Yap_unify(ARG3, out); } -#define FOUND_VAR_AGAIN() \ -if (d0 == TermFoundVar) { \ - CELL *pt2 = pt0; \ - while (IsVarTerm(*pt2)) \ - pt2 = (CELL *)(*pt2); \ - HR[1] = AbsPair(HR + 2); \ - HR[0] = (CELL)pt2; \ - HR += 2; \ - *pt2 = TermRefoundVar; \ -} +#define FOUND_VAR_AGAIN() \ + if (d0 == TermFoundVar) \ + { \ + HR[0] = (CELL)ptd0; \ + HR[1] = AbsPair(HR + 2); \ + HR += 2; \ + *ptd0 = TermRefoundVar; \ + } static Term non_singletons_in_complex_term(CELL * pt0_, CELL * pt0_end_ USES_REGS) { - HB = (CELL *)ASP; - CELL output = AbsPair(HR); WALK_COMPLEX_TERM__({}, {}, FOUND_VAR_AGAIN()); /* do or pt2 are unbound */ - YapBind(ptd0, TermFoundVar); - goto restart; + *ptd0 = TermFoundVar; + /* next make sure noone will see this as a variable again */ + if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) + { + goto trail_overflow; + } + TrailTerm(TR++) = (CELL)ptd0; END_WALK(); clean_tr(TR0 PASS_REGS); pop_text_stack(lvl); - HB = (CELL *)B->cp_b; if (HR != InitialH) { /* close the list */ HR[-1] = Deref(ARG2); - return output; + return AbsPair(InitialH); } else { return ARG2; } def_aux_overflow(); + def_trail_overflow(); } static Int p_non_singletons_in_term( @@ -1094,7 +1087,7 @@ static Int p_non_singletons_in_term( } else { out = non_singletons_in_complex_term(&(t)-1, &(t)PASS_REGS); } - return out; + return Yap_unify(ARG3,out); } static Term numbervar(Int me USES_REGS) { diff --git a/C/utilpreds.c b/C/utilpreds.c index 092ea2ced..89d18adff 100644 --- a/C/utilpreds.c +++ b/C/utilpreds.c @@ -395,9 +395,9 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, RESET_VARIABLE(ptf); *ptd0 = (CELL)ptf; ptf++; - if ((ADDR)TR > LOCAL_TrailTop - 16) + TrailTerm(TR++) = (CELL)ptd0; + if ((ADDR)TR > LOCAL_TrailTop - 16) goto trail_overflow; - } } @@ -521,7 +521,7 @@ CopyTerm(Term inp, UInt arity, int share, int newattvs USES_REGS) { Term Yap_CopyTerm(Term inp) { CACHE_REGS - return CopyTerm(inp, 0, TRUE, TRUE PASS_REGS); + return CopyTerm(inp, 0, false, TRUE PASS_REGS); } Term @@ -533,7 +533,7 @@ Yap_CopyTermNoShare(Term inp) { static Int p_copy_term( USES_REGS1 ) /* copy term t to a new instance */ { - Term t = CopyTerm(ARG1, 2, TRUE, TRUE PASS_REGS); + Term t = CopyTerm(ARG1, 2, false, TRUE PASS_REGS); if (t == 0L) return FALSE; /* be careful, there may be a stack shift here */ diff --git a/pl/debug.yap b/pl/debug.yap index ca648226f..cc6abede9 100644 --- a/pl/debug.yap +++ b/pl/debug.yap @@ -16,7 +16,7 @@ *************************************************************************/ -:- system_module( '$_debug', [], ['$trace_query'/4, +:- system_module( '$_debug', [], ['$trace_plan'/4, '$init_debugger'/0, '$skipeol'/1]). @@ -254,7 +254,7 @@ be lost. * * The debugger is an interpreter. with main predicates: * - $trace: this is the API - * - $trace_query: reduce a query to a goal + * - $trace_plan: reduce a query to a goal * - $trace_goal: execute: * + using the source, Luke * + hooking into the WAM procedure call mechanism @@ -308,7 +308,7 @@ be lost. '$execute_nonstop'(G,Mod). '$trace'(Mod:G) :- '$$save_by'(CP), - '$trace_query'(G, Mod, CP, G, EG), + '$trace_plan'(G, Mod, CP, G, EG), gated_call( '$debugger_io', EG, @@ -415,42 +415,54 @@ be lost. '$trace_meta_call'( G, M, CP ) :- - '$trace_query'(G, M, CP, G, EG ), + '$trace_plan'(G, M, CP, G, EG ), call(EG). -%% @pred '$trace_query'( +G, +M, +CP, +Expanded) +%% @pred '$trace_plan'( +G, +M, +CP, +Expanded) % % debug a complex query % -'$trace_query'(V, M, _CP, _, call(M:V)) :- +'$trace_plan'(V, M, _CP, _, call(M:V)) :- var(V), !. -'$trace_query'(!, _, CP, _, '$$cut_by'(CP)) :- +'$trace_plan'(!, _, CP, _, '$$cut_by'(CP)) :- !. -'$trace_query'('$cut_by'(M), _, _, _, '$$cut_by'(M)) :- +'$trace_plan'('$cut_by'(M), _, _, _, '$$cut_by'(M)) :- !. -'$trace_query'('$$cut_by'(M), _, _, _, '$$cut_by'(M)) :- +'$trace_plan'('$$cut_by'(M), _, _, _, '$$cut_by'(M)) :- !. -'$trace_query'(true, _, _, _, true) :- !. -'$trace_query'(fail, _, _, _, '$trace'(fail)) :- !. -'$trace_query'(M:G, _, CP,S, Expanded) :- - !, - '$yap_strip_module'(M:G, M0, G0), - '$trace_query'(G0, M0, CP,S, Expanded ). -'$trace_query'((A,B), M, CP, S, (EA,EB)) :- !, - '$trace_query'(A, M, CP, S, EA), - '$trace_query'(B, M, CP, S, EB). -'$trace_query'((A->B), M, CP, S, (EA->EB)) :- !, - '$trace_query'(A, M, CP, S, EA), - '$trace_query'(B, M, CP, S, EB). -'$trace_query'((A;B), M, CP, S, (EA;EB)) :- !, - '$trace_query'(A, M, CP, S, EA), - '$trace_query'(B, M, CP, S, EB). -'$trace_query'((A|B), M, CP, S, (EA|EB)) :- !, - '$trace_query'(A, M, CP, S, EA), - '$trace_query'(B, M, CP, S, EB). -'$trace_query'((\+ A), M, CP, S, (\+ EA)) :- !, - '$trace_query'(A, M, CP, S, EA). -'$trace_query'(G, M, _CP, _, ( +'$trace_plan'(true, _, _, _, true) :- !. +'$trace_plan'(fail, _, _, _, '$trace'(fail)) :- !. +'$trace_plan'((A,B), M, CP, S, (EA,EB)) :- !, + '$trace_plan'(A, M, CP, S, EA), + '$trace_plan'(B, M, CP, S, EB). +'$trace_plan'((A->B), M, CP, S, (EA->EB)) :- !, + '$trace_plan'(A, M, CP, S, EA), + '$trace_plan'(B, M, CP, S, EB). +'$trace_plan'((A;B), M, CP, S, (EA;EB)) :- !, + '$trace_plan'(A, M, CP, S, EA), + '$trace_plan'(B, M, CP, S, EB). +'$trace_plan'((A|B), M, CP, S, (EA|EB)) :- !, + '$trace_plan'(A, M, CP, S, EA), + '$trace_plan'(B, M, CP, S, EB). + '$trace_plan'(C, M, CP, S, EC), +'$trace_plan'((A->*B), M, CP, S, (EA->EB)) :- !, + '$trace_plan'(A, M, CP, S, EA), + '$trace_plan'(B, M, CP, S, EB). +'$trace_plan'((A->*B;C), M, CP, S, (EA->EB;EC)) :- !, + '$trace_plan'(A, M, CP, S, EA), + '$trace_plan'(B, M, CP, S, EB), + '$trace_plan'(C, M, CP, S, EC). +'$trace_plan'(if(A,B,C), M, CP, S, (EA->EB;EC)) :- !, + '$trace_plan'(A, M, CP, S, EA), + '$trace_plan'(B, M, CP, S, EB), + '$trace_plan'(C, M, CP, S, EC). +'$trace_plan'((\+ A), M, CP, S, ( EA -> fail ; true)) :- !, + '$trace_plan'(A, M, CP, S, EA). +'$trace_plan'(once(A), M, CP, S, ( EA -> true)) :- !, + '$trace_plan'(A, M, CP, S, EA). +'$trace_plan'(ignore(A), M, CP, S, ( EA -> true; true)) :- !, + '$trace_plan'(A, M, CP, S, EA). +'$trace_plan'(G, M, _CP, _, ( % spy a literal '$id_goal'(L), catch( @@ -487,9 +499,9 @@ be lost. ). % meta system '$trace_goal'(G, M, GoalNumber, H) :- - '$is_metapredicate'(G, prolog), - !, - '$debugger_expand_meta_call'(M:G, [], G1), + '$is_metapredicate'(G, prolog), + !, + '$debugger_expand_meta_call'(M:G, [], G1), strip_module(G1, MF, NG), gated_call( '$enter_trace'(GoalNumber, G, M, H), @@ -604,7 +616,7 @@ be lost. '$$save_by'(CP), clause(M:G, Cl, _), '$retry_clause'(GoalNumber, G, M, Info, X), - '$trace_query'(Cl, M, CP, Cl, ECl), + '$trace_plan'(Cl, M, CP, Cl, ECl), '$execute0'(ECl,M). '$creep_step'(GoalNumber, G, M, Info) :- @@ -654,7 +666,7 @@ be lost. %%% - abort: forward throw while the call is newer than goal -%% @pred '$re_trace_query'( Exception, +Goal, +Mod, +GoalID ) +%% @pred '$re_trace_plan'( Exception, +Goal, +Mod, +GoalID ) % % debugger code for exceptions. Recognised cases are: % - abort always forwarded @@ -1046,10 +1058,10 @@ be lost. '$cps'([]). -'$debugger_skip_trace_query'([CP|CPs],CPs1) :- - yap_hacks:choicepoint(CP,_,prolog,'$trace_query',4,(_;_),_), !, - '$debugger_skip_trace_query'(CPs,CPs1). -'$debugger_skip_trace_query'(CPs,CPs). +'$debugger_skip_trace_plan'([CP|CPs],CPs1) :- + yap_hacks:choicepoint(CP,_,prolog,'$trace_plan',4,(_;_),_), !, + '$debugger_skip_trace_plan'(CPs,CPs1). +'$debugger_skip_trace_plan'(CPs,CPs). '$debugger_skip_traces'([CP|CPs],CPs1) :- yap_hacks:choicepoint(CP,_,prolog,'$port',4,(_;_),_), !, diff --git a/pl/top.yap b/pl/top.yap index 13197f25c..3f84a9c56 100644 --- a/pl/top.yap +++ b/pl/top.yap @@ -295,7 +295,7 @@ live :- '$write_answer'(Vs, LGs, Written), '$write_query_answer_true'(Written), ( - '$prompt_alternatives_on'(determinism), CP == NCP, DCP = 0 + yap_flag(prompt_alternatives_on,determinism), CP == NCP, DCP = 0 -> format(user_error, '.~n', []), ! From 7dca1f13900a98bb6d85faa1f6f88815ce7c8eb0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Thu, 21 Feb 2019 20:19:31 +0000 Subject: [PATCH 4/4] fixes --- C/terms.c | 129 +++++++++++++++++---------------------------------- pl/setof.yap | 1 + 2 files changed, 44 insertions(+), 86 deletions(-) diff --git a/C/terms.c b/C/terms.c index 3e325f01e..1a8ea4118 100644 --- a/C/terms.c +++ b/C/terms.c @@ -580,8 +580,7 @@ static Term vars_in_complex_term(CELL *pt0_, CELL *pt0_end_ , CELL output = AbsPair(HR); WALK_COMPLEX_TERM(); /* do or pt2 are unbound */ - *ptd0 = TermNil; - /* leave an empty slot to fill in later */ + if (HR + 1024 > ASP) { goto global_overflow; } @@ -591,12 +590,10 @@ static Term vars_in_complex_term(CELL *pt0_, CELL *pt0_end_ , /* next make sure noone will see this as a variable again */ if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { /* Trail overflow */ - if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) { goto trail_overflow; - } } TrailTerm(TR++) = (CELL)ptd0; - + *ptd0 = TermFoundVar; END_WALK(); clean_tr(TR0-count PASS_REGS); @@ -607,7 +604,7 @@ static Term vars_in_complex_term(CELL *pt0_, CELL *pt0_end_ , Term t2 = Deref(inp); if (IsVarTerm(t2)) { RESET_VARIABLE(HR - 1); - Yap_unify((CELL)(HR - 1), inp); + Yap_unify((CELL)(HR - 1), t2); } else { HR[-1] = t2; /* don't need to trail */ } @@ -694,6 +691,22 @@ Term Yap_TermVariables( return out; } +static Term Yap_TermAddVariables( + Term t, Term vs USES_REGS) /* variables in term t */ +{ + Term out; + + t = Deref(t); + if (IsVarTerm(t)) { + return MkPairTerm(t, TermNil); + } else if (IsPrimitiveTerm(t)) { + return TermNil; + } else { + out = vars_in_complex_term(&(t)-1, &(t), vs PASS_REGS); + } + return out; +} + /** @pred term_variables(? _Term_, - _Variables_) is iso @@ -798,7 +811,6 @@ static Term new_vars_in_complex_term( Int n=0; CELL output = TermNil; { - tr_fr_ptr myTR0 = TR; while (!IsVarTerm(inp) && IsPairTerm(inp)) { Term t = HeadOfTerm(inp); if (IsVarTerm(t)) { @@ -807,7 +819,7 @@ static Term new_vars_in_complex_term( *VarOfTerm(t) = TermFoundVar; if ((tr_fr_ptr)LOCAL_TrailTop - TR < 1024) { - if (!Yap_growtrail((TR - myTR0) * sizeof(tr_fr_ptr *), true)) { + if (!Yap_growtrail(n * sizeof(tr_fr_ptr *), true)) { goto trail_overflow; } } @@ -820,9 +832,7 @@ static Term new_vars_in_complex_term( 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; - } } /* leave an empty slot to fill in later */ if (HR + 1024 > ASP) { @@ -832,7 +842,7 @@ END_WALK(); clean_tr(TR0-n PASS_REGS); pop_text_stack(lvl); -HB = B->cp_h; + return output; def_aux_overflow(); @@ -939,91 +949,37 @@ static Int p_variables_within_term(USES_REGS1) /* variables within term t */ return Yap_unify(ARG3, out); } -static Term free_vars_in_complex_term(CELL * pt0_, CELL * pt0_end_ - USES_REGS) { - Term o = TermNil; - WALK_COMPLEX_TERM(); - /* do or pt2 are unbound */ - *ptd0 = TermNil; - /* leave an empty slot to fill in later */ - if (HR + 1024 > ASP) { - o = TermNil; - goto global_overflow; - } - HR[0] = (CELL)ptd0; - HR[1] = o; - o = AbsPair(HR); - HR += 2; - /* next make sure noone will see this as a variable again */ - if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - /* Trail overflow */ - if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) { - goto trail_overflow; - } - } - TrailTerm(TR++) = (CELL)ptd0; - END_WALK(); - - clean_tr(TR0 PASS_REGS); - pop_text_stack(lvl); - return o; - - def_aux_overflow(); - - def_trail_overflow(); - - def_global_overflow(); -} - -static Term bind_vars_in_complex_term(CELL * pt0_, CELL * pt0_end_ USES_REGS) { - WALK_COMPLEX_TERM(); - /* do or pt2 are unbound */ - *ptd0 = TermFoundVar; - /* next make sure noone will see this as a variable again */ - if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - goto trail_overflow; - } - TrailTerm(TR++) = (CELL)ptd0; - - END_WALK(); - - pop_text_stack(lvl); - return TermNil; - - def_aux_overflow(); - - def_trail_overflow(); -} - /* variables within term t */ -static Int p_free_variables_in_term( +static Int free_variables_in_term( USES_REGS1) { Term out; Term t, t0; Term found_module = 0L; + Term vlist = TermNil; - 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 PASS_REGS); - } else if (f == FunctorModule) { - found_module = ArgOfTerm(1, t); - } else if (f == FunctorCall) { - t = ArgOfTerm(1, t); - } else if (f == FunctorExecuteInMod) { - found_module = ArgOfTerm(2, t); - t = ArgOfTerm(1, t); - } else { - break; - } - t = ArgOfTerm(2, t); + t = t0 = Deref(ARG1); + Int delta = 0; + while (!IsVarTerm(t) && IsApplTerm(t)) { + Functor f = FunctorOfTerm(t); + if (f == FunctorHat) { + vlist = Yap_TermAddVariables(ArgOfTerm(1,t), vlist PASS_REGS); + } else if (f == FunctorModule) { + found_module = ArgOfTerm(1, t); + } else if (f == FunctorCall) { + t = ArgOfTerm(1, t); + } else if (f == FunctorExecuteInMod) { + found_module = ArgOfTerm(2, t); + t = ArgOfTerm(1, t); + } else { + break; + } + t = ArgOfTerm(2, t); } if (IsPrimitiveTerm(t)) out = TermNil; else { - out = free_vars_in_complex_term(&(t)-1, &(t) PASS_REGS); + out = new_vars_in_complex_term(&(t)-1, &(t), vlist PASS_REGS); } if (found_module && t != t0) { @@ -1428,7 +1384,8 @@ void Yap_InitTermCPreds(void) { Yap_InitCPred("term_variables", 3, term_variables3, 0); Yap_InitCPred("$variables_in_term", 3, variables_in_term, 0); - Yap_InitCPred("$free_variables_in_term", 3, p_free_variables_in_term, 0); + Yap_InitCPred("$free_variables_in_term", 3, free_variables_in_term, 0); + Yap_InitCPred("free_variables_in_term", 3, free_variables_in_term, 0); Yap_InitCPred("term_attvars", 2, term_attvars, 0); diff --git a/pl/setof.yap b/pl/setof.yap index 5ad05131c..118c65a2e 100644 --- a/pl/setof.yap +++ b/pl/setof.yap @@ -230,6 +230,7 @@ bagof(Template, Generator, Bag) :- '$bagof'(Template, Generator, Bag) :- '$free_variables_in_term'(Template^Generator, StrippedGenerator, Key), %format('TemplateV=~w v=~w ~w~n',[TemplateV,Key, StrippedGenerator]), + ( Key \== '$' -> '$findall_with_common_vars'(Key-Template, StrippedGenerator, Bags0), '$keysort'(Bags0, Bags),