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]).