diff --git a/C/c_interface.c b/C/c_interface.c index 71779eb9e..f91da68b5 100755 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -1954,7 +1954,7 @@ X_API Int YAP_RunGoalOnce(Term t) { } // should we catch the exception or pass it through? // We'll pass it through - Yap_RaiseException(); + // Yap_RaiseException(); if (out) { choiceptr cut_pt, ob; diff --git a/C/errors.c b/C/errors.c index 8772bf880..d2862aeca 100755 --- a/C/errors.c +++ b/C/errors.c @@ -201,10 +201,11 @@ bool Yap_Warning(const char *s, ...) { Term ts[2]; const char *fmt; char tmpbuf[MAXPATHLEN]; + yap_error_number err; LOCAL_DoingUndefp = true; - if (LOCAL_PrologMode & InErrorMode) { - fprintf(stderr, "%% ERROR WITHIN ERROR %d: %s\n", LOCAL_Error_TYPE, tmpbuf); + if (LOCAL_PrologMode & InErrorMode && (err = LOCAL_ActiveError->errorNo)) { + fprintf(stderr, "%% Warning %s WITHIN ERROR %s %s\n", s, Yap_errorClassName( Yap_errorClass(err)), Yap_errorName(err)); Yap_RestartYap(1); } LOCAL_PrologMode |= InErrorMode; @@ -504,6 +505,7 @@ void Yap_pushErrorContext(yap_error_descriptor_t *new_error) { memset(new_error, 0, sizeof(yap_error_descriptor_t)); new_error->top_error = LOCAL_ActiveError; LOCAL_ActiveError = new_error; + LOCAL_PrologMode = UserMode; } /* static void */ @@ -524,6 +526,10 @@ yap_error_descriptor_t *Yap_popErrorContext(bool pass) { sizeof(yap_error_descriptor_t)); yap_error_descriptor_t *new_error = LOCAL_ActiveError; LOCAL_ActiveError = LOCAL_ActiveError->top_error; + if (LOCAL_ActiveError == YAP_NO_ERROR) + LOCAL_PrologMode = UserMode; + else + LOCAL_PrologMode = InErrorMode; return new_error; } @@ -590,10 +596,11 @@ yamop *Yap_Error__(bool throw, const char *file, const char *function, int linen va_list ap; char *fmt; char s[MAXPATHLEN]; + yap_error_number err; /* disallow recursive error handling */ - if (LOCAL_PrologMode & InErrorMode) { - fprintf(stderr, "%% ERROR WITHIN ERROR %d: %s\n", LOCAL_Error_TYPE, tmpbuf); + if (LOCAL_PrologMode & InErrorMode && (err = LOCAL_ActiveError->errorNo)) { + fprintf(stderr, "%% ERROR %s %s WITHIN ERROR %s %s\n", Yap_errorClassName( Yap_errorClass(type)), Yap_errorName(type), Yap_errorClassName( Yap_errorClass(err)), Yap_errorName(err)); Yap_RestartYap(1); } if (LOCAL_DoingUndefp && type == EVALUATION_ERROR_UNDEFINED) { diff --git a/C/exec.c b/C/exec.c index 09a37e521..c8910008d 100755 --- a/C/exec.c +++ b/C/exec.c @@ -1385,7 +1385,7 @@ static Int execute_depth_limit(USES_REGS1) { #endif static bool exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) { - int lval, out; + int lval = 0, out; Int OldBorder = LOCAL_CBorder; LOCAL_CBorder = LCL0 - ENV; @@ -2031,9 +2031,11 @@ bool is_cleanup_cp(choiceptr cp_b) { // DBTerm *dbt = Yap_RefToException(); while (handler && Yap_PredForChoicePt(handler, NULL) != PredDollarCatch - // && LOCAL_CBorder < LCL0 - (CELL *)handler && handler->cp_ap != NOCODE - // && handler->cp_b != NULL + //&& LOCAL_CBorder < LCL0 - (CELL *)handler && handler->cp_ap != NOCODE + //&& handler->cp_b != NULL ) { + if (handler->cp_ap != NOCODE) + handler->cp_ap = TRUSTFAILCODE; handler = handler->cp_b; } pop_text_stack(1); @@ -2041,7 +2043,7 @@ bool is_cleanup_cp(choiceptr cp_b) { Yap_signal(YAP_FAIL_SIGNAL); } - B = handler; + //B = handler; P = FAILCODE; return true; } diff --git a/C/utilpreds.c b/C/utilpreds.c index 3464ac0dc..941200430 100644 --- a/C/utilpreds.c +++ b/C/utilpreds.c @@ -1649,28 +1649,38 @@ Yap_TermVariables( Term t, UInt arity USES_REGS ) /* variables in term t */ return out; } +typedef struct att_rec { + CELL *beg, *end; + CELL oval; +} att_rec_t; + static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS) { - - register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace(); + int lvl = push_text_stack(); + att_rec_t *to_visit0, *to_visit = Malloc(1024*sizeof(att_rec_t)); + att_rec_t *to_visit_max; register tr_fr_ptr TR0 = TR; CELL *InitialH = HR; CELL output = AbsPair(HR); to_visit0 = to_visit; - loop: + to_visit_max = to_visit0+1024; + restart: + do { while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; ++ pt0; ptd0 = pt0; d0 = *ptd0; + printf("%p--%p -> %lx\n", ptd0, pt0_end, d0); + //Yap_DebugPlWriteln(d0); deref_head(d0, attvars_in_term_unk); attvars_in_term_nvar: { if (IsPairTerm(d0)) { - if (to_visit + 1024 >= (CELL **)AuxSp) { + if (to_visit + 32 >= to_visit_max) { goto aux_overflow; } { @@ -1682,10 +1692,10 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, } } #ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; + to_visit->beg = pt0; + to_visit->end = pt0_end; + to_visit->oval = *pt0; + to_visit ++; *pt0 = TermNil; #else if (pt0 < pt0_end) { @@ -1697,8 +1707,8 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, pt0 = RepPair(d0) - 1; pt0_end = pt0+2; } else if (IsApplTerm(d0)) { - register Functor f; - register CELL *ap2; + Functor f; + CELL *ap2; /* store the terms to visit */ ap2 = RepAppl(d0); f = (Functor)(*ap2); @@ -1706,14 +1716,14 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, continue; } /* store the terms to visit */ - if (to_visit + 1024 >= (CELL **)AuxSp) { + if (to_visit + 1024 >= to_visit_max) { goto aux_overflow; } #ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; + to_visit->beg = pt0; + to_visit->end = pt0_end; + to_visit->oval = *pt0; + to_visit ++; *pt0 = TermNil; #else if (pt0 < pt0_end) { @@ -1722,9 +1732,10 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, to_visit += 2; } #endif - d0 = ArityOfFunctor(f); + arity_t a = ArityOfFunctor(f); + printf("%p %d %p\n", f, a, ap2); pt0 = ap2; - pt0_end = ap2 + d0; + pt0_end = ap2 + a; } continue; } @@ -1750,15 +1761,16 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, HR += 2; HR[-2] = (CELL)ptd0; /* store the terms to visit */ - if (to_visit + 1024 >= (CELL **)AuxSp) { + if (to_visit + 32 >= to_visit_max) { goto aux_overflow; } #ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; + + to_visit->beg = pt0; + to_visit->end = pt0_end; + to_visit->oval = *pt0; + to_visit ++; + *pt0 = TermNil; #else if (pt0 < pt0_end) { to_visit[0] = pt0; @@ -1769,24 +1781,25 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, pt0 = &RepAttVar(ptd0)->Value; pt0_end = &RepAttVar(ptd0)->Atts; } + continue; } /* Do we still have compound terms to visit */ - if (to_visit > to_visit0) { + if (to_visit == to_visit0) + break; #ifdef RATIONAL_TREES - to_visit -= 3; - pt0 = to_visit[0]; - pt0_end = to_visit[1]; + to_visit --; + pt0 = to_visit->beg; + pt0_end = to_visit->end; *pt0 = (CELL)to_visit[2]; #else to_visit -= 2; pt0 = to_visit[0]; pt0_end = to_visit[1]; #endif - goto loop; - } + } while(true); clean_tr(TR0 PASS_REGS); - Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); + pop_text_stack(lvl); if (HR != InitialH) { /* close the list */ Term t2 = Deref(inp); @@ -1812,24 +1825,20 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); clean_tr(TR0 PASS_REGS); - Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); + pop_text_stack(lvl); HR = InitialH; return 0L; aux_overflow: - LOCAL_Error_Size = (to_visit-to_visit0)*sizeof(CELL **); -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit -= 3; - pt0 = to_visit[0]; - *pt0 = (CELL)to_visit[2]; - } -#endif - LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK; - clean_tr(TR0 PASS_REGS); - Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); - HR = InitialH; - return 0L; + { + size_t d1 = to_visit-to_visit0; + size_t d2 = to_visit_max-to_visit0; + to_visit0 = Realloc(to_visit0,d2*sizeof(CELL*)+64*1024); + to_visit = to_visit0+d1; + to_visit_max = to_visit0+(d2+(64*1024))/sizeof(CELL **); +} +pt0--; +goto restart; global_overflow: #ifdef RATIONAL_TREES @@ -1840,7 +1849,7 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, } #endif clean_tr(TR0 PASS_REGS); - Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); +pop_text_stack(lvl); HR = InitialH; LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; LOCAL_Error_Size = (ASP-HR)*sizeof(CELL); @@ -1866,6 +1875,8 @@ p_term_attvars( USES_REGS1 ) /* variables in term t */ } else { Functor f = FunctorOfTerm(t); + if (IsExtensionFunctor(f)) + return Yap_unify(TermNil, ARG2); out = attvars_in_complex_term(RepAppl(t), RepAppl(t)+ ArityOfFunctor(f), TermNil PASS_REGS); diff --git a/H/YapHeap.h b/H/YapHeap.h index 9b56a38d7..7dd5ca76b 100755 --- a/H/YapHeap.h +++ b/H/YapHeap.h @@ -263,7 +263,7 @@ INLINE_ONLY EXTERN inline ADDR Yap_PreAllocCodeSpace(void); INLINE_ONLY EXTERN inline ADDR Yap_PreAllocCodeSpace(void) { CACHE_REGS - return AuxBase; + return AuxBase; } #endif /* HEAP_H */ diff --git a/pl/top.yap b/pl/top.yap index f95cd4925..09a316d9c 100644 --- a/pl/top.yap +++ b/pl/top.yap @@ -936,6 +936,7 @@ catch(G, C, A) :- '$catch'(M:G,C,A). '$catch'(MG,_,_) :- + writeln(MG), '$$save_by'(CP0), '$execute'(MG), '$$save_by'(CP1),