From 17a75d79ff41d54598bbe027b8a26466b4c7b9ab Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Tue, 22 Jan 2019 01:47:07 +0000 Subject: [PATCH 1/4] metas --- C/globals.c | 801 ++++++++++++++++------------------ C/modules.c | 2 +- C/utilpreds.c | 22 +- packages/clpqr/clpq/itf_q.pl | 4 +- packages/clpqr/clpqr/geler.pl | 4 + packages/clpqr/clpqr/itf.pl | 4 + packages/clpqr/clpr/itf_r.pl | 4 + 7 files changed, 408 insertions(+), 433 deletions(-) diff --git a/C/globals.c b/C/globals.c index 5f5ec6963..67e401e99 100644 --- a/C/globals.c +++ b/C/globals.c @@ -1,19 +1,19 @@ /************************************************************************* -* * -* YAP Prolog * -* * -* Yap Prolog was developed at NCCUP - Universidade do Porto * -* * -* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * -* * -************************************************************************** -* * -* File: non backtrackable term support * -* Last rev: 2/8/06 * -* mods: * -* comments: non-backtrackable term support * -* * -*************************************************************************/ + * * + * YAP Prolog * + * * + * Yap Prolog was developed at NCCUP - Universidade do Porto * + * * + * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * + * * + ************************************************************************** + * * + * File: non backtrackable term support * + * Last rev: 2/8/06 * + * mods: * + * comments: non-backtrackable term support * + * * + *************************************************************************/ #ifdef SCCS static char SccsId[] = "%W% %G%"; #endif @@ -30,82 +30,82 @@ static char SccsId[] = "%W% %G%"; /** - @defgroup Global_Variables Global Variables -@ingroup builtins -@{ + @defgroup Global_Variables Global Variables + @ingroup builtins + @{ -Global variables are associations between names (atoms) and -terms. They differ in various ways from storing information using -assert/1 or recorda/3. + Global variables are associations between names (atoms) and + terms. They differ in various ways from storing information using + assert/1 or recorda/3. -+ The value lives on the Prolog (global) stack. This implies that -lookup time is independent from the size of the term. This is -particularly interesting for large data structures such as parsed XML -documents or the CHR global constraint store. + + The value lives on the Prolog (global) stack. This implies that + lookup time is independent from the size of the term. This is + particularly interesting for large data structures such as parsed XML + documents or the CHR global constraint store. -+ They support both global assignment using nb_setval/2 and -backtrackable assignment using b_setval/2. + + They support both global assignment using nb_setval/2 and + backtrackable assignment using b_setval/2. -+ Only one value (which can be an arbitrary complex Prolog term) -can be associated to a variable at a time. + + Only one value (which can be an arbitrary complex Prolog term) + can be associated to a variable at a time. -+ Their value cannot be shared among threads. Each thread has its own -namespace and values for global variables. + + Their value cannot be shared among threads. Each thread has its own + namespace and values for global variables. -Currently global variables are scoped globally. We may consider module -scoping in future versions. Both b_setval/2 and -nb_setval/2 implicitly create a variable if the referenced name -does not already refer to a variable. + Currently global variables are scoped globally. We may consider module + scoping in future versions. Both b_setval/2 and + nb_setval/2 implicitly create a variable if the referenced name + does not already refer to a variable. -Global variables may be initialized from directives to make them -available during the program lifetime, but some considerations are -necessary for saved-states and threads. Saved-states to not store -global variables, which implies they have to be declared with -initialization/1 to recreate them after loading the saved -state. Each thread has its own set of global variables, starting with -an empty set. Using `thread_initialization/1` to define a global -variable it will be defined, restored after reloading a saved state -and created in all threads that are created after the -registration. Finally, global variables can be initialized using the -exception hook called exception/3. The latter technique is used -by CHR. + Global variables may be initialized from directives to make them + available during the program lifetime, but some considerations are + necessary for saved-states and threads. Saved-states to not store + global variables, which implies they have to be declared with + initialization/1 to recreate them after loading the saved + state. Each thread has its own set of global variables, starting with + an empty set. Using `thread_initialization/1` to define a global + variable it will be defined, restored after reloading a saved state + and created in all threads that are created after the + registration. Finally, global variables can be initialized using the + exception hook called exception/3. The latter technique is used + by CHR. -SWI-Prolog global variables are associations between names (atoms) and -terms. They differ in various ways from storing information using -assert/1 or recorda/3. + SWI-Prolog global variables are associations between names (atoms) and + terms. They differ in various ways from storing information using + assert/1 or recorda/3. -+ The value lives on the Prolog (global) stack. This implies -that lookup time is independent from the size of the term. -This is particulary interesting for large data structures -such as parsed XML documents or the CHR global constraint -store. + + The value lives on the Prolog (global) stack. This implies + that lookup time is independent from the size of the term. + This is particulary interesting for large data structures + such as parsed XML documents or the CHR global constraint + store. -They support both global assignment using nb_setval/2 and -backtrackable assignment using b_setval/2. + They support both global assignment using nb_setval/2 and + backtrackable assignment using b_setval/2. -+ Only one value (which can be an arbitrary complex Prolog -term) can be associated to a variable at a time. + + Only one value (which can be an arbitrary complex Prolog + term) can be associated to a variable at a time. -+ Their value cannot be shared among threads. Each thread -has its own namespace and values for global variables. + + Their value cannot be shared among threads. Each thread + has its own namespace and values for global variables. -+ Currently global variables are scoped globally. We may -consider module scoping in future versions. + + Currently global variables are scoped globally. We may + consider module scoping in future versions. -Both b_setval/2 and nb_setval/2 implicitly create a variable if the -referenced name does not already refer to a variable. + Both b_setval/2 and nb_setval/2 implicitly create a variable if the + referenced name does not already refer to a variable. -Global variables may be initialized from directives to make them -available during the program lifetime, but some considerations are -necessary for saved-states and threads. Saved-states to not store global -variables, which implies they have to be declared with initialization/1 -to recreate them after loading the saved state. Each thread has -its own set of global variables, starting with an empty set. Using -`thread_inititialization/1` to define a global variable it will be -defined, restored after reloading a saved state and created in all -threads that are created after the registration. + Global variables may be initialized from directives to make them + available during the program lifetime, but some considerations are + necessary for saved-states and threads. Saved-states to not store global + variables, which implies they have to be declared with initialization/1 + to recreate them after loading the saved state. Each thread has + its own set of global variables, starting with an empty set. Using + `thread_inititialization/1` to define a global variable it will be + defined, restored after reloading a saved state and created in all + threads that are created after the registration. */ @@ -123,7 +123,7 @@ threads that are created after the registration. special term on the heap. Arenas automatically contract as we add terms to the front. - */ +*/ #define QUEUE_FUNCTOR_ARITY 4 @@ -148,12 +148,12 @@ threads that are created after the registration. static size_t big2arena_sz(CELL *arena_base) { return (((MP_INT *)(arena_base + 2))->_mp_alloc * sizeof(mp_limb_t) + sizeof(MP_INT) + sizeof(Functor) + 2 * sizeof(CELL)) / - sizeof(CELL); + sizeof(CELL); } static size_t arena2big_sz(size_t sz) { return sz - - (sizeof(MP_INT) + sizeof(Functor) + 2 * sizeof(CELL)) / sizeof(CELL); + (sizeof(MP_INT) + sizeof(Functor) + 2 * sizeof(CELL)) / sizeof(CELL); } /* pointer to top of an arena */ @@ -191,24 +191,24 @@ static Term NewArena(size_t size, int wid, UInt arity, CELL *where) { size_t new_size; WORKER_REGS(wid) - if (where == NULL || where == HR) { - while (HR + size > ASP - 1024) { - if (!Yap_gcl(size * sizeof(CELL), arity, ENV, P)) { - Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage); - return TermNil; + if (where == NULL || where == HR) { + while (HR + size > ASP - 1024) { + if (!Yap_gcl(size * sizeof(CELL), arity, ENV, P)) { + Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage); + return TermNil; + } } + t = CreateNewArena(HR, size); + HR += size; + } else { + if ((new_size = Yap_InsertInGlobal(where, size * sizeof(CELL))) == 0) { + Yap_Error(RESOURCE_ERROR_STACK, TermNil, + "No Stack Space for Non-Backtrackable terms"); + return TermNil; + } + size = new_size / sizeof(CELL); + t = CreateNewArena(where, size); } - t = CreateNewArena(HR, size); - HR += size; - } else { - if ((new_size = Yap_InsertInGlobal(where, size * sizeof(CELL))) == 0) { - Yap_Error(RESOURCE_ERROR_STACK, TermNil, - "No Stack Space for Non-Backtrackable terms"); - return TermNil; - } - size = new_size / sizeof(CELL); - t = CreateNewArena(where, size); - } return t; } @@ -292,30 +292,30 @@ static int GrowArena(Term arena, CELL *pt, size_t old_size, size_t size, CELL *Yap_GetFromArena(Term *arenap, size_t cells, UInt arity) { CACHE_REGS -restart : { - Term arena = *arenap; - CELL *max = ArenaLimit(arena); - CELL *base = ArenaPt(arena); - CELL *newH; - size_t old_sz = ArenaSz(arena), new_size; + restart : { + Term arena = *arenap; + CELL *max = ArenaLimit(arena); + CELL *base = ArenaPt(arena); + CELL *newH; + size_t old_sz = ArenaSz(arena), new_size; - if (IN_BETWEEN(base, HR, max)) { - base = HR; - HR += cells; + if (IN_BETWEEN(base, HR, max)) { + base = HR; + HR += cells; + return base; + } + if (base + cells > max - 1024) { + if (!GrowArena(arena, max, old_sz, old_sz + sizeof(CELL) * 1024, + arity PASS_REGS)) + return NULL; + goto restart; + } + + newH = base + cells; + new_size = old_sz - cells; + *arenap = CreateNewArena(newH, new_size); return base; } - if (base + cells > max - 1024) { - if (!GrowArena(arena, max, old_sz, old_sz + sizeof(CELL) * 1024, - arity PASS_REGS)) - return NULL; - goto restart; - } - - newH = base + cells; - new_size = old_sz - cells; - *arenap = CreateNewArena(newH, new_size); - return base; -} } static void CloseArena(CELL *oldH, CELL *oldHB, CELL *oldASP, Term *oldArenaP, @@ -340,6 +340,7 @@ static inline void clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) { if (IsVarTerm(p)) { RESET_VARIABLE(p); } else { + /* copy downwards */ TrailTerm(TR0 + 1) = TrailTerm(pt); TrailTerm(TR0) = TrailTerm(TR0 + 2) = p; @@ -351,17 +352,18 @@ 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; } +#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; } static int copy_complex_term(register CELL *pt0, register CELL *pt0_end, bool share, bool copy_att_vars, CELL *ptf, CELL *HLow USES_REGS) { int lvl = push_text_stack(); - struct cp_frame *to_visit0, *to_visit = Malloc(1024*sizeof(struct cp_frame)); + struct cp_frame *to_visit0, + *to_visit = Malloc(1024*sizeof(struct cp_frame)); struct cp_frame *to_visit_max; CELL *HB0 = HB; @@ -371,186 +373,159 @@ static int copy_complex_term(register CELL *pt0, register CELL *pt0_end, HB = HLow; to_visit0 = to_visit; to_visit_max = to_visit+1024; -loop: + loop: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; - ++pt0; - ptd0 = pt0; - d0 = *ptd0; + + ptd0 = ++pt0; + d0 = *pt0; + if (d0 != TermNil) + Yap_DebugPlWriteln(d0); + deref: deref_head(d0, copy_term_unk); copy_term_nvar : { - if (IsPairTerm(d0)) { - CELL *ap2 = RepPair(d0); - if ((share && ap2 < HB) || (ap2 >= HB && ap2 < HR)) { - /* If this is newer than the current term, just reuse */ - *ptf++ = d0; - continue; - } - *ptf = AbsPair(HR); - ptf++; -#ifdef RATIONAL_TREES - if (to_visit >= to_visit_max-32) { - expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); - } - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit->oldv = *pt0; - to_visit->ground = ground; - /* fool the system into thinking we had a variable there */ - *pt0 = AbsPair(HR); - to_visit++; -#else - if (pt0 < pt0_end) { - if (to_visit + 32 >= to_visit_max - 32) { + if (IsPairTerm(d0)) { + CELL *ap2 = RepPair(d0); + if (//(share && ap2 < HB) || + (ap2 >= HB && ap2 < HR)) { + /* If this is newer than the current term, just reuse */ + *ptf++ = d0; + continue; + } + if (to_visit >= to_visit_max-32) { expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); + } + pt0 = ap2; + to_visit->start_cp = pt0; + to_visit->end_cp = pt0_end = pt0+2; + to_visit->to = ptf; + d0 = *pt0; + to_visit->ground = ground; + /* fool the system into thinking we had a variable there */ + MaBind(pt0,AbsPair(HR)); + to_visit++; + ground = true; + HR += 2; + if (HR > ASP - MIN_ARENA_SIZE) { + goto overflow; + } + ptd0 = pt0; + goto deref; + } else if (IsApplTerm(d0)) { + register Functor f; + register CELL *ap2; + /* store the terms to visit */ + ap2 = RepAppl(d0); + if (//(share && ap2 < HB) || + (ap2 >= HB && ap2 < HR)) { + /* If this is newer than the current term, just reuse */ + *ptf++ = d0; + continue; + } + f = (Functor)(*ap2); - } - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit->ground = ground; - to_visit++; - } -#endif - ground = TRUE; - pt0 = ap2 - 1; - pt0_end = ap2 + 1; - ptf = HR; - HR += 2; - if (HR > ASP - MIN_ARENA_SIZE) { - goto overflow; - } - } else if (IsApplTerm(d0)) { - register Functor f; - register CELL *ap2; - /* store the terms to visit */ - ap2 = RepAppl(d0); - if ((share && ap2 < HB) || (ap2 >= HB && ap2 < HR)) { - /* If this is newer than the current term, just reuse */ - *ptf++ = d0; - continue; - } - f = (Functor)(*ap2); - - if (IsExtensionFunctor(f)) { - switch ((CELL)f) { - case (CELL) FunctorDBRef: - case (CELL) FunctorAttVar: - *ptf++ = d0; - break; - case (CELL) FunctorLongInt: - if (HR > ASP - (MIN_ARENA_SIZE + 3)) { - goto overflow; - } - *ptf++ = AbsAppl(HR); - HR[0] = (CELL)f; - HR[1] = ap2[1]; - HR[2] = EndSpecials; - HR += 3; - if (HR > ASP - MIN_ARENA_SIZE) { - goto overflow; - } - break; - case (CELL) FunctorDouble: - if (HR > - ASP - (MIN_ARENA_SIZE + (2 + SIZEOF_DOUBLE / sizeof(CELL)))) { - goto overflow; - } - *ptf++ = AbsAppl(HR); - HR[0] = (CELL)f; - HR[1] = ap2[1]; + if (IsExtensionFunctor(f)) { + switch ((CELL)f) { + case (CELL) FunctorDBRef: + case (CELL) FunctorAttVar: + *ptf++ = d0; + break; + case (CELL) FunctorLongInt: + if (HR > ASP - (MIN_ARENA_SIZE + 3)) { + goto overflow; + } + *ptf++ = AbsAppl(HR); + HR[0] = (CELL)f; + HR[1] = ap2[1]; + HR[2] = EndSpecials; + HR += 3; + if (HR > ASP - MIN_ARENA_SIZE) { + goto overflow; + } + break; + case (CELL) FunctorDouble: + if (HR > + ASP - (MIN_ARENA_SIZE + (2 + SIZEOF_DOUBLE / sizeof(CELL)))) { + goto overflow; + } + *ptf++ = AbsAppl(HR); + HR[0] = (CELL)f; + HR[1] = ap2[1]; #if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P - HR[2] = ap2[2]; - HR[3] = EndSpecials; - HR += 4; + HR[2] = ap2[2]; + HR[3] = EndSpecials; + HR += 4; #else - HR[2] = EndSpecials; - HR += 3; + HR[2] = EndSpecials; + HR += 3; #endif - break; - case (CELL) FunctorString: - if (ASP - HR < MIN_ARENA_SIZE + 3 + ap2[1]) { - goto overflow; - } - *ptf++ = AbsAppl(HR); - memmove(HR, ap2, sizeof(CELL) * (3 + ap2[1])); - HR += ap2[1] + 3; - break; - default: { - /* big int */ - size_t sz = (sizeof(MP_INT) + 3 * CellSize + - ((MP_INT *)(ap2 + 2))->_mp_alloc * sizeof(mp_limb_t)) / - CellSize, - i; + break; + case (CELL) FunctorString: + if (ASP - HR < MIN_ARENA_SIZE + 3 + ap2[1]) { + goto overflow; + } + *ptf++ = AbsAppl(HR); + memmove(HR, ap2, sizeof(CELL) * (3 + ap2[1])); + HR += ap2[1] + 3; + break; + default: { + /* big int */ + size_t sz = (sizeof(MP_INT) + 3 * CellSize + + ((MP_INT *)(ap2 + 2))->_mp_alloc * sizeof(mp_limb_t)) / + CellSize, + i; - if (HR > ASP - (MIN_ARENA_SIZE + sz)) { - goto overflow; - } - *ptf++ = AbsAppl(HR); - HR[0] = (CELL)f; - for (i = 1; i < sz; i++) { - HR[i] = ap2[i]; - } - HR += sz; + if (HR > ASP - (MIN_ARENA_SIZE + sz)) { + goto overflow; + } + *ptf++ = AbsAppl(HR); + HR[0] = (CELL)f; + for (i = 1; i < sz; i++) { + HR[i] = ap2[i]; + } + HR += sz; + } + } + continue; } - } - continue; + /* store the terms to visit */ + to_visit->start_cp = pt0; + to_visit->end_cp = pt0_end; + to_visit->to = ptf; + to_visit->ground = ground; + if (++to_visit >= to_visit_max-32) { + expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); + } + /* fool the system into thinking we had a variable there */ + ptf = HR; + *ptf++ = d0 = *ap2; + MaBind(ap2++,AbsAppl(HR)); + to_visit++; + ground = true; + arity_t a = ArityOfFunctor((Functor)d0); + HR = ptf+a; + if (HR > ASP - MIN_ARENA_SIZE) { + goto overflow; + } + pt0 = ap2; + pt0_end = ap2+a; + ground = (f != FunctorMutable); + } else { + /* just copy atoms or integers */ + *ptf++ = d0; } - *ptf = AbsAppl(HR); - ptf++; -/* store the terms to visit */ -#ifdef RATIONAL_TREES - if (to_visit + 32 >= to_visit_max) { - expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); - } - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit->oldv = *pt0; - to_visit->ground = ground; - /* fool the system into thinking we had a variable there */ - *pt0 = AbsAppl(HR); - to_visit++; -#else - if (pt0 < pt0_end) { - if (to_visit++ >= (CELL **)AuxSp) { - expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); - } - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit->ground = ground; - to_visit++; - } -#endif - ground = (f != FunctorMutable); - d0 = ArityOfFunctor(f); - pt0 = ap2; - pt0_end = ap2 + d0; - /* store the functor for the new term */ - HR[0] = (CELL)f; - ptf = HR + 1; - HR += 1 + d0; - if (HR > ASP - MIN_ARENA_SIZE) { - goto overflow; - } - } else { - /* just copy atoms or integers */ - *ptf++ = d0; + continue; } - continue; - } derefa_body(d0, ptd0, copy_term_unk, copy_term_nvar); - ground = FALSE; + ground = false; /* don't need to copy variables if we want to share the global term */ - if ((share && ptd0 < HB && ptd0 > H0) || (ptd0 >= HLow && ptd0 < HR)) { + if (//(share && ptd0 < HB && ptd0 > H0) || + (ptd0 >= HLow && ptd0 < HR)) { /* we have already found this cell */ *ptf++ = (CELL)ptd0; } else { -#if COROUTINING if (copy_att_vars && GlobalIsAttachedTerm((CELL)ptd0)) { /* if unbound, call the standard copy term routine */ struct cp_frame *bp; @@ -572,16 +547,13 @@ loop: Bind_and_Trail(ptd0, new); ptf++; } else { -#endif /* first time we met this term */ RESET_VARIABLE(ptf); if ((ADDR)TR > LOCAL_TrailTop - MIN_ARENA_SIZE) goto trail_overflow; - Bind_and_Trail(ptd0, (CELL)ptf); + MaBind(ptd0, (CELL)ptf); ptf++; -#ifdef COROUTINING } -#endif } } @@ -591,9 +563,6 @@ loop: pt0 = to_visit->start_cp; pt0_end = to_visit->end_cp; ptf = to_visit->to; -#ifdef RATIONAL_TREES - *pt0 = to_visit->oldv; -#endif ground = (ground && to_visit->ground); goto loop; } @@ -602,16 +571,15 @@ loop: HB = HB0; clean_dirty_tr(TR0 PASS_REGS); /* follow chain of multi-assigned variables */ - pop_text_stack(lvl); + pop_text_stack(lvl); return 0; -overflow: + overflow: /* oops, we're in trouble */ HR = HLow; /* we've done it */ /* restore our nice, friendly, term to its original state */ HB = HB0; -#ifdef RATIONAL_TREES while (to_visit > to_visit0) { to_visit--; pt0 = to_visit->start_cp; @@ -619,18 +587,16 @@ overflow: ptf = to_visit->to; *pt0 = to_visit->oldv; } -#endif reset_trail(TR0); - pop_text_stack(lvl); + pop_text_stack(lvl); return -1; -trail_overflow: + trail_overflow: /* oops, we're in trouble */ HR = HLow; /* we've done it */ /* restore our nice, friendly, term to its original state */ HB = HB0; -#ifdef RATIONAL_TREES while (to_visit > to_visit0) { to_visit--; pt0 = to_visit->start_cp; @@ -638,9 +604,8 @@ trail_overflow: ptf = to_visit->to; *pt0 = to_visit->oldv; } -#endif reset_trail(TR0); - pop_text_stack(lvl); + pop_text_stack(lvl); return -4; } @@ -654,7 +619,7 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars, int res = 0; Term tn; -restart: + restart: t = Deref(t); if (IsVarTerm(t)) { ASP = ArenaLimit(arena); @@ -787,7 +752,7 @@ restart: CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS); return tf; } -error_handler: + error_handler: HR = HB; CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS); XREGS[arity + 1] = t; @@ -835,7 +800,7 @@ static Term CreateTermInArena(Term arena, Atom Na, UInt Nar, UInt arity, Functor f = Yap_MkFunctor(Na, Nar); UInt i; -restart: + restart: HR = HB = ArenaPt(arena); ASP = ArenaLimit(arena); HB0 = HR; @@ -984,8 +949,8 @@ static Int p_nb_setarg(USES_REGS1) { to = Deref(ARG3); to = CopyTermToArena( - ARG3, LOCAL_GlobalArena, FALSE, TRUE, 3, &LOCAL_GlobalArena, - garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); + ARG3, LOCAL_GlobalArena, FALSE, TRUE, 3, &LOCAL_GlobalArena, + garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); if (to == 0L) return FALSE; @@ -1028,8 +993,8 @@ static Int p_nb_set_shared_arg(USES_REGS1) { if (pos < 1 || pos > arity) return FALSE; to = CopyTermToArena( - ARG3, LOCAL_GlobalArena, TRUE, TRUE, 3, &LOCAL_GlobalArena, - garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); + ARG3, LOCAL_GlobalArena, TRUE, TRUE, 3, &LOCAL_GlobalArena, + garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); if (to == 0L) return FALSE; if (IsPairTerm(dest)) { @@ -1110,8 +1075,8 @@ static Int p_nb_create_accumulator(USES_REGS1) { return FALSE; } to = CopyTermToArena( - t, LOCAL_GlobalArena, TRUE, TRUE, 2, &LOCAL_GlobalArena, - garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); + t, LOCAL_GlobalArena, TRUE, TRUE, 2, &LOCAL_GlobalArena, + garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); if (to == 0L) return FALSE; t2 = Deref(ARG2); @@ -1164,9 +1129,9 @@ static Int p_nb_add_to_accumulator(USES_REGS1) { } else { /* we need to create a new long int */ new = CopyTermToArena( - new, LOCAL_GlobalArena, TRUE, TRUE, 2, &LOCAL_GlobalArena, - garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) - PASS_REGS); + new, LOCAL_GlobalArena, TRUE, TRUE, 2, &LOCAL_GlobalArena, + garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) + PASS_REGS); destp = RepAppl(Deref(ARG1)); destp[1] = new; } @@ -1194,8 +1159,8 @@ static Int p_nb_add_to_accumulator(USES_REGS1) { new = Yap_Eval(new); new = CopyTermToArena( - new, LOCAL_GlobalArena, TRUE, TRUE, 2, &LOCAL_GlobalArena, - garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); + new, LOCAL_GlobalArena, TRUE, TRUE, 2, &LOCAL_GlobalArena, + garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); destp = RepAppl(Deref(ARG1)); destp[1] = new; @@ -1225,12 +1190,12 @@ static Int p_nb_accumulator_value(USES_REGS1) { Term Yap_SetGlobalVal(Atom at, Term t0) { CACHE_REGS - Term to; + Term to; GlobalEntry *ge; ge = GetGlobalEntry(at PASS_REGS); to = CopyTermToArena( - t0, LOCAL_GlobalArena, FALSE, TRUE, 2, &LOCAL_GlobalArena, - garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); + t0, LOCAL_GlobalArena, FALSE, TRUE, 2, &LOCAL_GlobalArena, + garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); if (to == 0L) return to; WRITE_LOCK(ge->GRWLock); @@ -1241,10 +1206,10 @@ Term Yap_SetGlobalVal(Atom at, Term t0) { Term Yap_SaveTerm(Term t0) { CACHE_REGS - Term to; + Term to; to = CopyTermToArena( Deref(t0), LOCAL_GlobalArena, FALSE, TRUE, 2, &LOCAL_GlobalArena, - garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); + garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); if (to == 0L) return to; return to; @@ -1274,8 +1239,8 @@ static Int p_nb_set_shared_val(USES_REGS1) { } ge = GetGlobalEntry(AtomOfTerm(t) PASS_REGS); to = CopyTermToArena( - ARG2, LOCAL_GlobalArena, TRUE, TRUE, 2, &LOCAL_GlobalArena, - garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); + ARG2, LOCAL_GlobalArena, TRUE, TRUE, 2, &LOCAL_GlobalArena, + garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS); if (to == 0L) return FALSE; WRITE_LOCK(ge->GRWLock); @@ -1359,7 +1324,7 @@ static Int p_nb_getval(USES_REGS1) { Term Yap_GetGlobal(Atom at) { CACHE_REGS - GlobalEntry *ge; + GlobalEntry *ge; Term to; ge = FindGlobalEntry(at PASS_REGS); @@ -1417,7 +1382,7 @@ static Int nbdelete(Atom at USES_REGS) { Int Yap_DeleteGlobal(Atom at) { CACHE_REGS - return nbdelete(at PASS_REGS); + return nbdelete(at PASS_REGS); } @@ -1552,7 +1517,7 @@ static Int nb_queue(UInt arena_sz USES_REGS) { return (FunctorOfTerm(t) == FunctorNBQueue); } ar[QUEUE_ARENA] = ar[QUEUE_HEAD] = ar[QUEUE_TAIL] = ar[QUEUE_SIZE] = - MkIntTerm(0); + MkIntTerm(0); queue = Yap_MkApplTerm(FunctorNBQueue, QUEUE_FUNCTOR_ARITY, ar); if (!Yap_unify(queue, ARG1)) return FALSE; @@ -1860,8 +1825,8 @@ static Int p_nb_heap(USES_REGS1) { } while ((heap = MkZeroApplTerm( - Yap_MkFunctor(AtomHeap, 2 * hsize + HEAP_START + 1), - 2 * hsize + HEAP_START + 1 PASS_REGS)) == TermNil) { + Yap_MkFunctor(AtomHeap, 2 * hsize + HEAP_START + 1), + 2 * hsize + HEAP_START + 1 PASS_REGS)) == TermNil) { if (!Yap_gcl((2 * hsize + HEAP_START + 1) * sizeof(CELL), 2, ENV, P)) { Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage); return FALSE; @@ -1959,7 +1924,7 @@ static Int p_nb_heap_add_to_heap(USES_REGS1) { if (!qd) return FALSE; -restart: + restart: hsize = IntegerOfTerm(qd[HEAP_SIZE]); hmsize = IntegerOfTerm(qd[HEAP_MAX]); if (hsize == hmsize) { @@ -2127,8 +2092,8 @@ static Int p_nb_beam(USES_REGS1) { hsize = IntegerOfTerm(tsize); } while ((beam = MkZeroApplTerm( - Yap_MkFunctor(AtomHeap, 5 * hsize + HEAP_START + 1), - 5 * hsize + HEAP_START + 1 PASS_REGS)) == TermNil) { + Yap_MkFunctor(AtomHeap, 5 * hsize + HEAP_START + 1), + 5 * hsize + HEAP_START + 1 PASS_REGS)) == TermNil) { if (!Yap_gcl((4 * hsize + HEAP_START + 1) * sizeof(CELL), 2, ENV, P)) { Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage); return FALSE; @@ -2159,7 +2124,7 @@ static Int p_nb_beam_close(USES_REGS1) { return p_nb_heap_close(PASS_REGS1); } */ static void PushBeam(CELL *pt, CELL *npt, UInt hsize, Term key, Term to) { CACHE_REGS - UInt off = hsize, off2 = hsize; + UInt off = hsize, off2 = hsize; Term toff, toff2; /* push into first queue */ @@ -2203,7 +2168,7 @@ static void PushBeam(CELL *pt, CELL *npt, UInt hsize, Term key, Term to) { static void DelBeamMax(CELL *pt, CELL *pt2, UInt sz) { CACHE_REGS - UInt off = IntegerOfTerm(pt2[1]); + UInt off = IntegerOfTerm(pt2[1]); UInt indx = 0; Term tk, ti, tv; @@ -2277,7 +2242,7 @@ static void DelBeamMax(CELL *pt, CELL *pt2, UInt sz) { static Term DelBeamMin(CELL *pt, CELL *pt2, UInt sz) { CACHE_REGS - UInt off2 = IntegerOfTerm(pt[1]); + UInt off2 = IntegerOfTerm(pt[1]); Term ov = pt2[3 * off2 + 2]; /* return value */ UInt indx = 0; Term tk, tv; @@ -2497,7 +2462,7 @@ static Int p_nb_beam_keys(USES_REGS1) { CELL *pt, *ho; UInt i; -restart: + restart: qd = GetHeap(ARG1, "beam_keys"); if (!qd) return FALSE; @@ -2598,7 +2563,7 @@ static Int init_current_nb(USES_REGS1) { /* current_atom(?Atom) */ void Yap_InitGlobals(void) { CACHE_REGS - Term cm = CurrentModule; + Term cm = CurrentModule; Yap_InitCPred("$allocate_arena", 2, p_allocate_arena, 0); Yap_InitCPred("arena_size", 1, p_default_arena_size, 0); Yap_InitCPred("b_setval", 2, p_b_setval, SafePredFlag); @@ -2606,22 +2571,22 @@ void Yap_InitGlobals(void) { /** @pred b_setval(+ _Name_, + _Value_) - Associate the term _Value_ with the atom _Name_ or replaces - the currently associated value with _Value_. If _Name_ does - not refer to an existing global variable a variable with initial value - [] is created (the empty list). On backtracking the assignment is - reversed. + Associate the term _Value_ with the atom _Name_ or replaces + the currently associated value with _Value_. If _Name_ does + not refer to an existing global variable a variable with initial value + [] is created (the empty list). On backtracking the assignment is + reversed. */ /** @pred b_setval(+ _Name_,+ _Value_) - Associate the term _Value_ with the atom _Name_ or replaces - the currently associated value with _Value_. If _Name_ does - not refer to an existing global variable a variable with initial value - `[]` is created (the empty list). On backtracking the - assignment is reversed. + Associate the term _Value_ with the atom _Name_ or replaces + the currently associated value with _Value_. If _Name_ does + not refer to an existing global variable a variable with initial value + `[]` is created (the empty list). On backtracking the + assignment is reversed. */ @@ -2630,18 +2595,18 @@ void Yap_InitGlobals(void) { /** @pred nb_setval(+ _Name_, + _Value_) - Associates a copy of _Value_ created with duplicate_term/2 with - the atom _Name_. Note that this can be used to set an initial - value other than `[]` prior to backtrackable assignment. + Associates a copy of _Value_ created with duplicate_term/2 with + the atom _Name_. Note that this can be used to set an initial + value other than `[]` prior to backtrackable assignment. */ /** @pred nb_setval(+ _Name_,+ _Value_) - Associates a copy of _Value_ created with duplicate_term/2 - with the atom _Name_. Note that this can be used to set an - initial value other than `[]` prior to backtrackable assignment. + Associates a copy of _Value_ created with duplicate_term/2 + with the atom _Name_. Note that this can be used to set an + initial value other than `[]` prior to backtrackable assignment. */ @@ -2649,25 +2614,25 @@ void Yap_InitGlobals(void) { /** @pred nb_set_shared_val(+ _Name_, + _Value_) - Associates the term _Value_ with the atom _Name_, but sharing - non-backtrackable terms. This may be useful if you want to rewrite a - global variable so that the new copy will survive backtracking, but - you want to share structure with the previous term. + Associates the term _Value_ with the atom _Name_, but sharing + non-backtrackable terms. This may be useful if you want to rewrite a + global variable so that the new copy will survive backtracking, but + you want to share structure with the previous term. - The next example shows the differences between the three built-ins: + The next example shows the differences between the three built-ins: - ~~~~~ - ?- nb_setval(a,a(_)),nb_getval(a,A),nb_setval(b,t(C,A)),nb_getval(b,B). - A = a(_A), - B = t(_B,a(_C)) ? + ~~~~~ + ?- nb_setval(a,a(_)),nb_getval(a,A),nb_setval(b,t(C,A)),nb_getval(b,B). + A = a(_A), + B = t(_B,a(_C)) ? - ?- - nb_setval(a,a(_)),nb_getval(a,A),nb_set_shared_val(b,t(C,A)),nb_getval(b,B). + ?- + nb_setval(a,a(_)),nb_getval(a,A),nb_set_shared_val(b,t(C,A)),nb_getval(b,B). - ?- nb_setval(a,a(_)),nb_getval(a,A),nb_linkval(b,t(C,A)),nb_getval(b,B). - A = a(_A), - B = t(C,a(_A)) ? - ~~~~~ + ?- nb_setval(a,a(_)),nb_getval(a,A),nb_linkval(b,t(C,A)),nb_getval(b,B). + A = a(_A), + B = t(C,a(_A)) ? + ~~~~~ */ @@ -2675,26 +2640,26 @@ void Yap_InitGlobals(void) { /** @pred nb_linkval(+ _Name_, + _Value_) - Associates the term _Value_ with the atom _Name_ without - copying it. This is a fast special-purpose variation of nb_setval/2 - intended for expert users only because the semantics on backtracking - to a point before creating the link are poorly defined for compound - terms. The principal term is always left untouched, but backtracking - behaviour on arguments is undone if the original assignment was - trailed and left alone otherwise, which implies that the history that - created the term affects the behaviour on backtracking. Please - consider the following example: + Associates the term _Value_ with the atom _Name_ without + copying it. This is a fast special-purpose variation of nb_setval/2 + intended for expert users only because the semantics on backtracking + to a point before creating the link are poorly defined for compound + terms. The principal term is always left untouched, but backtracking + behaviour on arguments is undone if the original assignment was + trailed and left alone otherwise, which implies that the history that + created the term affects the behaviour on backtracking. Please + consider the following example: - ~~~~~ - demo_nb_linkval :- - T = nice(N), - ( N = world, - nb_linkval(myvar, T), - fail - ; nb_getval(myvar, V), - writeln(V) - ). - ~~~~~ + ~~~~~ + demo_nb_linkval :- + T = nice(N), + ( N = world, + nb_linkval(myvar, T), + fail + ; nb_getval(myvar, V), + writeln(V) + ). + ~~~~~ */ @@ -2706,31 +2671,31 @@ void Yap_InitGlobals(void) { - Assigns the _Arg_-th argument of the compound term _Term_ with - the given _Value_ as setarg/3, but on backtracking the assignment - is not reversed. If _Term_ is not atomic, it is duplicated using - duplicate_term/2. This predicate uses the same technique as - nb_setval/2. We therefore refer to the description of - nb_setval/2 for details on non-backtrackable assignment of - terms. This predicate is compatible to GNU-Prolog - `setarg(A,T,V,false)`, removing the type-restriction on - _Value_. See also nb_linkarg/3. Below is an example for - counting the number of solutions of a goal. Note that this - implementation is thread-safe, reentrant and capable of handling - exceptions. Realising these features with a traditional implementation - based on assert/retract or flag/3 is much more complicated. + Assigns the _Arg_-th argument of the compound term _Term_ with + the given _Value_ as setarg/3, but on backtracking the assignment + is not reversed. If _Term_ is not atomic, it is duplicated using + duplicate_term/2. This predicate uses the same technique as + nb_setval/2. We therefore refer to the description of + nb_setval/2 for details on non-backtrackable assignment of + terms. This predicate is compatible to GNU-Prolog + `setarg(A,T,V,false)`, removing the type-restriction on + _Value_. See also nb_linkarg/3. Below is an example for + counting the number of solutions of a goal. Note that this + implementation is thread-safe, reentrant and capable of handling + exceptions. Realising these features with a traditional implementation + based on assert/retract or flag/3 is much more complicated. - ~~~~~ + ~~~~~ succeeds_n_times(Goal, Times) :- - Counter = counter(0), - ( Goal, - arg(1, Counter, N0), - N is N0 + 1, - nb_setarg(1, Counter, N), - fail - ; arg(1, Counter, Times) - ). - ~~~~~ + Counter = counter(0), + ( Goal, + arg(1, Counter, N0), + N is N0 + 1, + nb_setarg(1, Counter, N), + fail + ; arg(1, Counter, Times) + ). + ~~~~~ */ @@ -2739,9 +2704,9 @@ void Yap_InitGlobals(void) { - As nb_setarg/3, but like nb_linkval/2 it does not - duplicate the global sub-terms in _Value_. Use with extreme care - and consult the documentation of nb_linkval/2 before use. + As nb_setarg/3, but like nb_linkval/2 it does not + duplicate the global sub-terms in _Value_. Use with extreme care + and consult the documentation of nb_linkval/2 before use. */ @@ -2750,9 +2715,9 @@ void Yap_InitGlobals(void) { - As nb_setarg/3, but like nb_linkval/2 it does not - duplicate _Value_. Use with extreme care and consult the - documentation of nb_linkval/2 before use. + As nb_setarg/3, but like nb_linkval/2 it does not + duplicate _Value_. Use with extreme care and consult the + documentation of nb_linkval/2 before use. */ @@ -2760,20 +2725,20 @@ void Yap_InitGlobals(void) { /** @pred nb_delete(+ _Name_) - Delete the named global variable. + Delete the named global variable. - Global variables have been introduced by various Prolog - implementations recently. We follow the implementation of them in - SWI-Prolog, itself based on hProlog by Bart Demoen. + Global variables have been introduced by various Prolog + implementations recently. We follow the implementation of them in + SWI-Prolog, itself based on hProlog by Bart Demoen. - GNU-Prolog provides a rich set of global variables, including - arrays. Arrays can be implemented easily in YAP and SWI-Prolog using - functor/3 and `setarg/3` due to the unrestricted arity of - compound terms. + GNU-Prolog provides a rich set of global variables, including + arrays. Arrays can be implemented easily in YAP and SWI-Prolog using + functor/3 and `setarg/3` due to the unrestricted arity of + compound terms. - @} */ + @} */ Yap_InitCPred("nb_create", 3, p_nb_create, 0L); Yap_InitCPred("nb_create", 4, p_nb_create2, 0L); Yap_InitCPredBack("$nb_current", 1, 1, init_current_nb, cont_current_nb, @@ -2817,5 +2782,5 @@ void Yap_InitGlobals(void) { } /** -@} + @} */ diff --git a/C/modules.c b/C/modules.c index 798e05cb5..465025b20 100644 --- a/C/modules.c +++ b/C/modules.c @@ -24,7 +24,7 @@ static char SccsId[] = "%W% %G%"; #include "YapHeap.h" #include "Yatom.h" -static Int currgent_module(USES_REGS1); +static Int current_module(USES_REGS1); static Int current_module1(USES_REGS1); static ModEntry *LookupModule(Term a); static ModEntry *LookupSystemModule(Term a); diff --git a/C/utilpreds.c b/C/utilpreds.c index 2a60761b5..dd0d3b839 100644 --- a/C/utilpreds.c +++ b/C/utilpreds.c @@ -52,6 +52,7 @@ typedef struct non_single_struct_t { }\ LIST0;\ ptd0 = RepPair(d0);\ + if (*ptd0 == TermFreeTerm) continue;\ to_visit->pt0 = pt0;\ to_visit->pt0_end = pt0_end;\ to_visit->ptd0 = ptd0;\ @@ -59,7 +60,7 @@ typedef struct non_single_struct_t { to_visit ++;\ d0 = ptd0[0];\ pt0 = ptd0;\ - *ptd0 = TermNil;\ + *ptd0 = TermFreeTerm;\ pt0_end = pt0 + 1;\ goto list_loop;\ } else if (IsApplTerm(d0)) {\ @@ -2269,9 +2270,8 @@ static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), *to_visit0 = to_visit, *to_visit_max = to_visit+1024; + Term o = TermNil; CELL *InitialH = HR; - *HR++ = MkAtomTerm(AtomDollar); - to_visit0 = to_visit; restart: while (pt0 < pt0_end) { @@ -2284,7 +2284,7 @@ static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end deref_head(d0, vars_within_term_unk); vars_within_term_nvar: { - WALK_COMPLEX_TERM() + WALK_COMPLEX_TERM(); continue; } @@ -2293,10 +2293,13 @@ static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end *ptd0 = TermNil; /* leave an empty slot to fill in later */ if (HR+1024 > ASP) { + o = TermNil; goto global_overflow; } HR[0] = (CELL)ptd0; - HR ++; + 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 */ @@ -2318,13 +2321,8 @@ static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end } clean_tr(TR0 PASS_REGS); -pop_text_stack(lvl); - if (HR > InitialH+1) { - InitialH[0] = (CELL)Yap_MkFunctor(AtomDollar, (HR-InitialH)-1); - return AbsAppl(InitialH); - } else { - return MkAtomTerm(AtomDollar); - } + pop_text_stack(lvl); + return o; def_trail_overflow(); diff --git a/packages/clpqr/clpq/itf_q.pl b/packages/clpqr/clpq/itf_q.pl index 7add42fa7..0b6020e40 100644 --- a/packages/clpqr/clpq/itf_q.pl +++ b/packages/clpqr/clpq/itf_q.pl @@ -62,7 +62,7 @@ [ class_drop/2 ]). - + do_checks(Y,Ty,St,Li,Or,Cl,No,Later) :- numbers_only(Y), verify_nonzero(No,Y), @@ -76,7 +76,7 @@ numbers_only(Y) :- ; throw(type_error(_X = Y,2,'a rational number',Y)) ), !. - +ΓΈ % verify_nonzero(Nonzero,Y) % % if Nonzero = nonzero, then verify that Y is not zero diff --git a/packages/clpqr/clpqr/geler.pl b/packages/clpqr/clpqr/geler.pl index b3fd410bf..e04c3ce60 100644 --- a/packages/clpqr/clpqr/geler.pl +++ b/packages/clpqr/clpqr/geler.pl @@ -43,6 +43,10 @@ project_nonlin/3, collect_nonlin/3 ]). +:- use_module(library(maplist), + [ + maplist/2 + ]). % l2conj(List,Conj) % diff --git a/packages/clpqr/clpqr/itf.pl b/packages/clpqr/clpqr/itf.pl index 427d13ea0..43907c049 100644 --- a/packages/clpqr/clpqr/itf.pl +++ b/packages/clpqr/clpqr/itf.pl @@ -47,6 +47,10 @@ dump_nonzero/3, clp_type/2 ]). +:- use_module(library(maplist), + [ + maplist/2 + ]). clp_type(Var,Type) :- diff --git a/packages/clpqr/clpr/itf_r.pl b/packages/clpqr/clpr/itf_r.pl index 753e2037b..ec1754311 100644 --- a/packages/clpqr/clpr/itf_r.pl +++ b/packages/clpqr/clpr/itf_r.pl @@ -63,6 +63,10 @@ [ class_drop/2 ]). +:- use_module(library(maplist), + [ + maplist/2 + ]). do_checks(Y,Ty,St,Li,Or,Cl,No,Later) :- numbers_only(Y), From c682058942027e120688c023b178d821c9d59bec Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Tue, 22 Jan 2019 03:08:26 +0000 Subject: [PATCH 2/4] xmas --- C/stack.c | 2 +- C/yap-args.c | 4 ++-- packages/jpl/src/c/jpl.c | 2 +- packages/python/pypreds.c | 11 +++++++++++ pl/android.yap | 6 ++---- pl/undefined.yap | 3 +-- 6 files changed, 18 insertions(+), 10 deletions(-) diff --git a/C/stack.c b/C/stack.c index 4c67b57e4..618aedf02 100644 --- a/C/stack.c +++ b/C/stack.c @@ -2134,7 +2134,7 @@ static void shortstack( choiceptr b_ptr, CELL * env_ptr , buf_struct_t *bufp) { void DumpActiveGoals(USES_REGS1) { /* try to dump active goals */ void *ep = YENV; /* and current environment */ - void *cp; + void *cp ; PredEntry *pe; struct buf_struct_t buf0, *bufp = &buf0; diff --git a/C/yap-args.c b/C/yap-args.c index f03161571..ccd7083fe 100755 --- a/C/yap-args.c +++ b/C/yap-args.c @@ -175,7 +175,7 @@ static bool load_file(const char *b_file USES_REGS) { __android_log_print( ANDROID_LOG_INFO, "YAPDroid", "done init_consult %s ",b_file); if (c_stream < 0) { - fprintf(stderr, "[ FATAL ERROR: could not open file %s ]\n", b_file); + fprintf(stderr, "[ FATAL ERROR: could not open file %s\n", b_file); pop_text_stack(lvl); exit(1); } @@ -185,7 +185,7 @@ static bool load_file(const char *b_file USES_REGS) { } __android_log_print( ANDROID_LOG_INFO, "YAPDroid", "do reset %s ",b_file); - + t = 0; while (t != TermEof) { CACHE_REGS YAP_Reset(YAP_FULL_RESET, false); diff --git a/packages/jpl/src/c/jpl.c b/packages/jpl/src/c/jpl.c index ae7d24eb0..838f7bfbe 100755 --- a/packages/jpl/src/c/jpl.c +++ b/packages/jpl/src/c/jpl.c @@ -1826,7 +1826,7 @@ jni_create_jvm_c( JNIEnv *env; JPL_DEBUG(1, Sdprintf( "[creating JVM with 'java.class.path=%s']\n", classpath)); - vm_args.version = JNI_VERSION_1_6zzzz; /* "Java 1.2 please" */ + vm_args.version = JNI_VERSION_1_6; /* "Java 1.2 please" */ if ( classpath ) { cpoptp = (char *)malloc(strlen(classpath) + strlen("-Djava.class.path=")+1); diff --git a/packages/python/pypreds.c b/packages/python/pypreds.c index 9b357ea6a..c51fe48a7 100644 --- a/packages/python/pypreds.c +++ b/packages/python/pypreds.c @@ -1,4 +1,15 @@ + + + + + + + + + + + #include "Yap.h" #include "py4yap.h" diff --git a/pl/android.yap b/pl/android.yap index 488204c7c..6de2bfcfd 100644 --- a/pl/android.yap +++ b/pl/android.yap @@ -1,8 +1,6 @@ -%:- start_low_level_trace. - -%:- module(android, -% [text_to_query/2]). +:- module(android, + [text_to_query/2]). :- initialization(yap_flag(verbose,_,normal)). diff --git a/pl/undefined.yap b/pl/undefined.yap index 4d573335b..3113cbc3c 100644 --- a/pl/undefined.yap +++ b/pl/undefined.yap @@ -97,8 +97,7 @@ undefined_query(G0, M0, Cut) :- % undef handler '$undefp'([M0|G0],MG) :- - setup_call_cleanup( - % make sure we do not loop on undefined predicates +x % make sure we do not loop on undefined predicates '$undef_setup'(Action,Debug,Current), ('$get_undefined_predicates'(M0:G0, MG) -> From a6d709dabf1c8daf5ce70f302f7d03db0fe032b3 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Tue, 22 Jan 2019 19:32:19 +0000 Subject: [PATCH 3/4] copy_term --- C/globals.c | 263 +----------- C/utilpreds.c | 680 +++++++++++++++--------------- H/Yapproto.h | 3 + H/amiops.h | 6 + packages/jpl/src/c/CMakeLists.txt | 1 + pl/undefined.yap | 51 +-- 6 files changed, 372 insertions(+), 632 deletions(-) diff --git a/C/globals.c b/C/globals.c index 67e401e99..5a457f19f 100644 --- a/C/globals.c +++ b/C/globals.c @@ -352,263 +352,6 @@ 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; } - -static int copy_complex_term(register CELL *pt0, register CELL *pt0_end, - bool share, bool copy_att_vars, CELL *ptf, - CELL *HLow USES_REGS) { - - int lvl = push_text_stack(); - struct cp_frame *to_visit0, - *to_visit = Malloc(1024*sizeof(struct cp_frame)); - struct cp_frame *to_visit_max; - - CELL *HB0 = HB; - tr_fr_ptr TR0 = TR; - int ground = TRUE; - - HB = HLow; - to_visit0 = to_visit; - to_visit_max = to_visit+1024; - loop: - while (pt0 < pt0_end) { - register CELL d0; - register CELL *ptd0; - - ptd0 = ++pt0; - d0 = *pt0; - if (d0 != TermNil) - Yap_DebugPlWriteln(d0); - deref: - deref_head(d0, copy_term_unk); - copy_term_nvar : { - if (IsPairTerm(d0)) { - CELL *ap2 = RepPair(d0); - if (//(share && ap2 < HB) || - (ap2 >= HB && ap2 < HR)) { - /* If this is newer than the current term, just reuse */ - *ptf++ = d0; - continue; - } - if (to_visit >= to_visit_max-32) { - expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); - } - pt0 = ap2; - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end = pt0+2; - to_visit->to = ptf; - d0 = *pt0; - to_visit->ground = ground; - /* fool the system into thinking we had a variable there */ - MaBind(pt0,AbsPair(HR)); - to_visit++; - ground = true; - HR += 2; - if (HR > ASP - MIN_ARENA_SIZE) { - goto overflow; - } - ptd0 = pt0; - goto deref; - } else if (IsApplTerm(d0)) { - register Functor f; - register CELL *ap2; - /* store the terms to visit */ - ap2 = RepAppl(d0); - if (//(share && ap2 < HB) || - (ap2 >= HB && ap2 < HR)) { - /* If this is newer than the current term, just reuse */ - *ptf++ = d0; - continue; - } - f = (Functor)(*ap2); - - if (IsExtensionFunctor(f)) { - switch ((CELL)f) { - case (CELL) FunctorDBRef: - case (CELL) FunctorAttVar: - *ptf++ = d0; - break; - case (CELL) FunctorLongInt: - if (HR > ASP - (MIN_ARENA_SIZE + 3)) { - goto overflow; - } - *ptf++ = AbsAppl(HR); - HR[0] = (CELL)f; - HR[1] = ap2[1]; - HR[2] = EndSpecials; - HR += 3; - if (HR > ASP - MIN_ARENA_SIZE) { - goto overflow; - } - break; - case (CELL) FunctorDouble: - if (HR > - ASP - (MIN_ARENA_SIZE + (2 + SIZEOF_DOUBLE / sizeof(CELL)))) { - goto overflow; - } - *ptf++ = AbsAppl(HR); - HR[0] = (CELL)f; - HR[1] = ap2[1]; -#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P - HR[2] = ap2[2]; - HR[3] = EndSpecials; - HR += 4; -#else - HR[2] = EndSpecials; - HR += 3; -#endif - break; - case (CELL) FunctorString: - if (ASP - HR < MIN_ARENA_SIZE + 3 + ap2[1]) { - goto overflow; - } - *ptf++ = AbsAppl(HR); - memmove(HR, ap2, sizeof(CELL) * (3 + ap2[1])); - HR += ap2[1] + 3; - break; - default: { - /* big int */ - size_t sz = (sizeof(MP_INT) + 3 * CellSize + - ((MP_INT *)(ap2 + 2))->_mp_alloc * sizeof(mp_limb_t)) / - CellSize, - i; - - if (HR > ASP - (MIN_ARENA_SIZE + sz)) { - goto overflow; - } - *ptf++ = AbsAppl(HR); - HR[0] = (CELL)f; - for (i = 1; i < sz; i++) { - HR[i] = ap2[i]; - } - HR += sz; - } - } - continue; - } - /* store the terms to visit */ - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit->ground = ground; - if (++to_visit >= to_visit_max-32) { - expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); - } - /* fool the system into thinking we had a variable there */ - ptf = HR; - *ptf++ = d0 = *ap2; - MaBind(ap2++,AbsAppl(HR)); - to_visit++; - ground = true; - arity_t a = ArityOfFunctor((Functor)d0); - HR = ptf+a; - if (HR > ASP - MIN_ARENA_SIZE) { - goto overflow; - } - pt0 = ap2; - pt0_end = ap2+a; - ground = (f != FunctorMutable); - } else { - /* just copy atoms or integers */ - *ptf++ = d0; - } - continue; - } - - derefa_body(d0, ptd0, copy_term_unk, copy_term_nvar); - ground = false; - /* don't need to copy variables if we want to share the global term */ - if (//(share && ptd0 < HB && ptd0 > H0) || - (ptd0 >= HLow && ptd0 < HR)) { - /* we have already found this cell */ - *ptf++ = (CELL)ptd0; - } else { - if (copy_att_vars && GlobalIsAttachedTerm((CELL)ptd0)) { - /* if unbound, call the standard copy term routine */ - struct cp_frame *bp; - CELL new; - - bp = to_visit; - if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, - ptf PASS_REGS)) { - goto overflow; - } - to_visit = bp; - new = *ptf; - if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - /* Trail overflow */ - if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), TRUE)) { - goto trail_overflow; - } - } - Bind_and_Trail(ptd0, new); - ptf++; - } else { - /* first time we met this term */ - RESET_VARIABLE(ptf); - if ((ADDR)TR > LOCAL_TrailTop - MIN_ARENA_SIZE) - goto trail_overflow; - MaBind(ptd0, (CELL)ptf); - ptf++; - } - } - } - - /* Do we still have compound terms to visit */ - if (to_visit > to_visit0) { - to_visit--; - pt0 = to_visit->start_cp; - pt0_end = to_visit->end_cp; - ptf = to_visit->to; - ground = (ground && to_visit->ground); - goto loop; - } - - /* restore our nice, friendly, term to its original state */ - HB = HB0; - clean_dirty_tr(TR0 PASS_REGS); - /* follow chain of multi-assigned variables */ - pop_text_stack(lvl); - return 0; - - overflow: - /* oops, we're in trouble */ - HR = HLow; - /* we've done it */ - /* restore our nice, friendly, term to its original state */ - HB = HB0; - while (to_visit > to_visit0) { - to_visit--; - pt0 = to_visit->start_cp; - pt0_end = to_visit->end_cp; - ptf = to_visit->to; - *pt0 = to_visit->oldv; - } - reset_trail(TR0); - pop_text_stack(lvl); - return -1; - - trail_overflow: - /* oops, we're in trouble */ - HR = HLow; - /* we've done it */ - /* restore our nice, friendly, term to its original state */ - HB = HB0; - while (to_visit > to_visit0) { - to_visit--; - pt0 = to_visit->start_cp; - pt0_end = to_visit->end_cp; - ptf = to_visit->to; - *pt0 = to_visit->oldv; - } - reset_trail(TR0); - pop_text_stack(lvl); - return -4; -} - static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars, UInt arity, Term *newarena, size_t min_grow USES_REGS) { @@ -631,7 +374,7 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars, *HR = t; Hi = HR + 1; HR += 2; - if ((res = copy_complex_term(Hi - 2, Hi - 1, share, copy_att_vars, Hi, + if ((res = Yap_copy_complex_term(Hi - 2, Hi - 1, share, copy_att_vars, Hi, Hi PASS_REGS)) < 0) goto error_handler; CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS); @@ -665,7 +408,7 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars, Hi = HR; tf = AbsPair(HR); HR += 2; - if ((res = copy_complex_term(ap - 1, ap + 1, share, copy_att_vars, Hi, + if ((res = Yap_copy_complex_term(ap - 1, ap + 1, share, copy_att_vars, Hi, Hi PASS_REGS)) < 0) { goto error_handler; } @@ -743,7 +486,7 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars, res = -1; goto error_handler; } - if ((res = copy_complex_term(ap, ap + ArityOfFunctor(f), share, + if ((res = Yap_copy_complex_term(ap, ap + ArityOfFunctor(f), share, copy_att_vars, HB0 + 1, HB0 PASS_REGS)) < 0) { goto error_handler; diff --git a/C/utilpreds.c b/C/utilpreds.c index dd0d3b839..0d66fcb09 100644 --- a/C/utilpreds.c +++ b/C/utilpreds.c @@ -45,92 +45,92 @@ typedef struct non_single_struct_t { CELL *pt0, *pt0_end; } non_singletons_t; -#define WALK_COMPLEX_TERM__(LIST0, STRUCT0) \ - if (IsPairTerm(d0)) {\ - if (to_visit + 32 >= to_visit_max) {\ - goto aux_overflow;\ - }\ - LIST0;\ - ptd0 = RepPair(d0);\ - if (*ptd0 == TermFreeTerm) continue;\ - to_visit->pt0 = pt0;\ - to_visit->pt0_end = pt0_end;\ - to_visit->ptd0 = ptd0;\ - to_visit->d0 = *ptd0;\ - to_visit ++;\ - d0 = ptd0[0];\ - pt0 = ptd0;\ - *ptd0 = TermFreeTerm;\ - pt0_end = pt0 + 1;\ - goto list_loop;\ - } else if (IsApplTerm(d0)) {\ - register Functor f;\ - register CELL *ap2;\ - /* store the terms to visit */\ - ap2 = RepAppl(d0);\ - f = (Functor)(*ap2);\ -\ - if (IsExtensionFunctor(f)) {\ -\ - continue;\ - }\ - STRUCT0;\ - if (to_visit + 32 >= to_visit_max) {\ - goto aux_overflow;\ - }\ - to_visit->pt0 = pt0;\ - to_visit->pt0_end = pt0_end;\ - to_visit->ptd0 = ap2;\ - to_visit->d0 = *ap2;\ - to_visit ++;\ -\ - *ap2 = TermNil;\ - d0 = ArityOfFunctor(f);\ - pt0 = ap2;\ - pt0_end = ap2 + d0;\ - } +#define WALK_COMPLEX_TERM__(LIST0, STRUCT0) \ + if (IsPairTerm(d0)) { \ + if (to_visit + 32 >= to_visit_max) { \ + goto aux_overflow; \ + } \ + LIST0; \ + ptd0 = RepPair(d0); \ + if (*ptd0 == TermFreeTerm) continue; \ + to_visit->pt0 = pt0; \ + to_visit->pt0_end = pt0_end; \ + to_visit->ptd0 = ptd0; \ + to_visit->d0 = *ptd0; \ + to_visit ++; \ + d0 = ptd0[0]; \ + pt0 = ptd0; \ + *ptd0 = TermFreeTerm; \ + pt0_end = pt0 + 1; \ + goto list_loop; \ + } else if (IsApplTerm(d0)) { \ + register Functor f; \ + register CELL *ap2; \ + /* store the terms to visit */ \ + ap2 = RepAppl(d0); \ + f = (Functor)(*ap2); \ + \ + if (IsExtensionFunctor(f)) { \ + \ + continue; \ + } \ + STRUCT0; \ + if (to_visit + 32 >= to_visit_max) { \ + goto aux_overflow; \ + } \ + to_visit->pt0 = pt0; \ + to_visit->pt0_end = pt0_end; \ + to_visit->ptd0 = ap2; \ + to_visit->d0 = *ap2; \ + to_visit ++; \ + \ + *ap2 = TermNil; \ + d0 = ArityOfFunctor(f); \ + pt0 = ap2; \ + pt0_end = ap2 + d0; \ + } #define WALK_COMPLEX_TERM() WALK_COMPLEX_TERM__({}, {}) -#define def_trail_overflow() \ - trail_overflow:{ \ - while (to_visit > to_visit0) {\ - to_visit --;\ - CELL *ptd0 = to_visit->ptd0;\ - *ptd0 = to_visit->d0;\ - }\ - pop_text_stack(lvl);\ - LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL;\ - LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *);\ - clean_tr(TR0 PASS_REGS);\ - HR = InitialH;\ - return 0L;\ -} +#define def_trail_overflow() \ + trail_overflow:{ \ + while (to_visit > to_visit0) { \ + to_visit --; \ + CELL *ptd0 = to_visit->ptd0; \ + *ptd0 = to_visit->d0; \ + } \ + pop_text_stack(lvl); \ + LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; \ + LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); \ + clean_tr(TR0 PASS_REGS); \ + HR = InitialH; \ + return 0L; \ + } -#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;\ - } +#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; \ + } -#define def_global_overflow() \ +#define def_global_overflow() \ global_overflow:{ \ - while (to_visit > to_visit0) { \ - to_visit --;\ - 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; } + while (to_visit > to_visit0) { \ + to_visit --; \ + 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; } static Int p_non_singletons_in_term( USES_REGS1); @@ -140,7 +140,6 @@ static Int ground_complex_term(CELL *, CELL * CACHE_TYPE); static Int p_ground( USES_REGS1 ); static Int p_copy_term( USES_REGS1 ); static Int var_in_complex_term(CELL *, CELL *, Term CACHE_TYPE); -static int copy_complex_term(CELL *, CELL *, int, int, CELL *, CELL * CACHE_TYPE); static CELL vars_in_complex_term(CELL *, CELL *, Term CACHE_TYPE); #ifdef DEBUG @@ -159,145 +158,191 @@ clean_tr(tr_fr_ptr TR0 USES_REGS) { static inline void clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) { - if (TR != TR0) { - tr_fr_ptr pt = TR0; - - do { - Term p = TrailTerm(pt++); + tr_fr_ptr pt0 = TR; + while (pt0 != TR0) { + Term p = TrailTerm(--pt0); + if (IsApplTerm(p)) { + CELL *pt = RepAppl(p); +#ifdef FROZEN_STACKS + pt[0] = TrailVal(pt0); +#else + pt[0] = TrailTerm(pt0 - 1); + pt0 --; +#endif /* FROZEN_STACKS */ + } else { RESET_VARIABLE(p); - } while (pt != TR); - TR = TR0; - } + } + } + TR = TR0; } -static int -copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf, CELL *HLow 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; } + +#define MIN_ARENA_SIZE (1048L) + +int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, + bool share, bool copy_att_vars, CELL *ptf, + CELL *HLow USES_REGS) { + // fprintf(stderr,"+++++++++\n"); + //CELL *x = pt0; while(x != pt0_end) Yap_DebugPlWriteln(*++ x); + + int lvl = push_text_stack(); + + struct cp_frame *to_visit0, + *to_visit = Malloc(1024*sizeof(struct cp_frame)); + struct cp_frame *to_visit_max; - struct cp_frame *to_visit0, *to_visit = (struct cp_frame *)Yap_PreAllocCodeSpace() ; CELL *HB0 = HB; tr_fr_ptr TR0 = TR; - int ground = TRUE; + int ground = true; - HB = HR; + HB = HLow; to_visit0 = to_visit; + to_visit_max = to_visit+1024; loop: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; - ++ pt0; - ptd0 = pt0; + + ptd0 = ++pt0; d0 = *ptd0; + deref: deref_head(d0, copy_term_unk); - copy_term_nvar: - { + copy_term_nvar : { if (IsPairTerm(d0)) { - CELL *ap2 = RepPair(d0); - if (ap2 >= HB && ap2 < HR) { + CELL *headp = RepPair(d0); + if (//(share && headp < HB) || + (IsPairTerm(*headp) && RepPair(*headp) >= HB && RepPair(*headp) < HR)) { /* If this is newer than the current term, just reuse */ - *ptf++ = d0; + *ptf++ = *headp; continue; } + if (to_visit >= to_visit_max-32) { + expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); + } *ptf = AbsPair(HR); ptf++; - if (to_visit+1 >= (struct cp_frame *)AuxSp) { - goto heap_overflow; - } to_visit->start_cp = pt0; to_visit->end_cp = pt0_end; to_visit->to = ptf; - to_visit->oldv = *pt0; to_visit->ground = ground; - /* fool the system into thinking we had a variable there */ - *pt0 = AbsPair(HR); - to_visit ++; - ground = true; - pt0 = ap2 - 1; - pt0_end = ap2 + 1; + to_visit++; + // move to new list + d0 = *headp; + TrailedMaBind(headp, AbsPair(HR)); + pt0 = headp; + pt0_end = headp + 1; ptf = HR; + ground = true; HR += 2; - if (HR > ASP - 2048) { + if (HR > ASP - MIN_ARENA_SIZE) { goto overflow; } + ptd0 = pt0; + goto deref; } else if (IsApplTerm(d0)) { register Functor f; - register CELL *ap2; + register CELL *headp; /* store the terms to visit */ - ap2 = RepAppl(d0); - if (ap2 >= HB && ap2 <= HR) { + headp = RepAppl(d0); + if (IsApplTerm(*headp)//(share && headp < HB) || + ) { /* If this is newer than the current term, just reuse */ - *ptf++ = d0; + *ptf++ = *headp; continue; } - f = (Functor)(*ap2); + f = (Functor)(*headp); if (IsExtensionFunctor(f)) { -#if MULTIPLE_STACKS - if (f == FunctorDBRef) { - DBRef entryref = DBRefOfTerm(d0); - if (entryref->Flags & LogUpdMask) { - LogUpdClause *luclause = (LogUpdClause *)entryref; - PELOCK(100,luclause->ClPred); - UNLOCK(luclause->ClPred->PELock); - } else { - LOCK(entryref->lock); - TRAIL_REF(entryref); /* So that fail will erase it */ - INC_DBREF_COUNT(entryref); - UNLOCK(entryref->lock); + switch ((CELL)f) { + case (CELL) FunctorDBRef: + case (CELL) FunctorAttVar: + *ptf++ = d0; + break; + case (CELL) FunctorLongInt: + if (HR > ASP - (MIN_ARENA_SIZE + 3)) { + goto overflow; } - *ptf++ = d0; /* you can just copy other extensions. */ - } else + *ptf++ = AbsAppl(HR); + HR[0] = (CELL)f; + HR[1] = headp[1]; + HR[2] = EndSpecials; + HR += 3; + if (HR > ASP - MIN_ARENA_SIZE) { + goto overflow; + } + break; + case (CELL) FunctorDouble: + if (HR > + ASP - (MIN_ARENA_SIZE + (2 + SIZEOF_DOUBLE / sizeof(CELL)))) { + goto overflow; + } + *ptf++ = AbsAppl(HR); + HR[0] = (CELL)f; + HR[1] = headp[1]; +#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P + HR[2] = headp[2]; + HR[3] = EndSpecials; + HR += 4; +#else + HR[2] = EndSpecials; + HR += 3; #endif - if (!share) { - UInt sz; - - *ptf++ = AbsAppl(HR); /* you can just copy other extensions. */ - /* make sure to copy floats */ - if (f== FunctorDouble) { - sz = sizeof(Float)/sizeof(CELL)+2; - } else if (f== FunctorLongInt) { - sz = 3; - } else if (f== FunctorString) { - sz = 3+ap2[1]; - } else { - CELL *pt = ap2+1; - sz = 2+sizeof(MP_INT)+(((MP_INT *)(pt+1))->_mp_alloc*sizeof(mp_limb_t)); - } - if (HR+sz > ASP - 2048) { - goto overflow; - } - memmove((void *)HR, (void *)ap2, sz*sizeof(CELL)); - HR += sz; - } else { - *ptf++ = d0; /* you can just copy other extensions. */ + break; + case (CELL) FunctorString: + if (ASP - HR < MIN_ARENA_SIZE + 3 + headp[1]) { + goto overflow; } + *ptf++ = AbsAppl(HR); + memmove(HR, headp, sizeof(CELL) * (3 + headp[1])); + HR += headp[1] + 3; + break; + default: { + /* big int */ + size_t sz = (sizeof(MP_INT) + 3 * CellSize + + ((MP_INT *)(headp + 2))->_mp_alloc * sizeof(mp_limb_t)) / + CellSize, + i; + + if (HR > ASP - (MIN_ARENA_SIZE + sz)) { + goto overflow; + } + *ptf++ = AbsAppl(HR); + HR[0] = (CELL)f; + for (i = 1; i < sz; i++) { + HR[i] = headp[i]; + + } + HR += sz; + } + } continue; - } - *ptf = AbsAppl(HR); + } + *ptf = AbsAppl(HR); ptf++; /* store the terms to visit */ - if (to_visit+1 >= (struct cp_frame *)AuxSp) { - goto heap_overflow; - } to_visit->start_cp = pt0; to_visit->end_cp = pt0_end; to_visit->to = ptf; - to_visit->oldv = *pt0; to_visit->ground = ground; - /* fool the system into thinking we had a variable there */ - *pt0 = AbsAppl(HR); - to_visit ++; - ground = (f != FunctorMutable); - d0 = ArityOfFunctor(f); - pt0 = ap2; - pt0_end = ap2 + d0; - /* store the functor for the new term */ - HR[0] = (CELL)f; - ptf = HR+1; - HR += 1+d0; - if (HR > ASP - 2048) { + if (++to_visit >= to_visit_max-32) { + expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); + } + TrailedMaBind(headp,AbsAppl(HR)); + ptf = HR; + *ptf++ = (CELL)f; + ground = true; + arity_t a = ArityOfFunctor(f); + HR = ptf+a; + if (HR > ASP - MIN_ARENA_SIZE) { goto overflow; } + pt0 = headp; + pt0_end = headp+a; + ground = (f != FunctorMutable); } else { /* just copy atoms or integers */ *ptf++ = d0; @@ -306,66 +351,60 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf, } derefa_body(d0, ptd0, copy_term_unk, copy_term_nvar); - ground = FALSE; - if (ptd0 >= HLow && ptd0 < HR) { + ground = false; + /* don't need to copy variables if we want to share the global term */ + if (//(share && ptd0 < HB && ptd0 > H0) || + (ptd0 >= HLow && ptd0 < HR)) { /* we have already found this cell */ - *ptf++ = (CELL) ptd0; - } else -#if COROUTINING - if (newattvs && IsAttachedTerm((CELL)ptd0)) { - /* if unbound, call the standard copy term routine */ - struct cp_frame *bp; + *ptf++ = (CELL)ptd0; + } else { + if (copy_att_vars && GlobalIsAttachedTerm((CELL)ptd0)) { + /* if unbound, call the standard copy term routine */ + struct cp_frame *bp; + CELL new; - CELL new; - - bp = to_visit; - if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, ptf PASS_REGS)) { - goto overflow; - } - to_visit = bp; - new = *ptf; - Bind_NonAtt(ptd0, new); - ptf++; + bp = to_visit; + if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, + ptf PASS_REGS)) { + goto overflow; + } + to_visit = bp; + new = *ptf; + if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { + /* Trail overflow */ + if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), TRUE)) { + goto trail_overflow; + } + } + TrailedMaBind(ptd0, new); + ptf++; } else { -#endif - /* first time we met this term */ - RESET_VARIABLE(ptf); - if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - /* Trail overflow */ - if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { - goto trail_overflow; - } - } - Bind_NonAtt(ptd0, (CELL)ptf); - ptf++; + /* first time we met this term */ + RESET_VARIABLE(ptf); + if ((ADDR)TR > LOCAL_TrailTop - MIN_ARENA_SIZE) + goto trail_overflow; + TrailedMaBind(ptd0, (CELL)ptf); + ptf++; } + } } + /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { - to_visit --; - if (ground && share) { - CELL old = to_visit->oldv; - CELL *newp = to_visit->to-1; - CELL new = *newp; - - *newp = old; - if (IsApplTerm(new)) - HR = RepAppl(new); - else - HR = RepPair(new); - } + to_visit--; pt0 = to_visit->start_cp; pt0_end = to_visit->end_cp; ptf = to_visit->to; - *pt0 = to_visit->oldv; ground = (ground && to_visit->ground); goto loop; } /* restore our nice, friendly, term to its original state */ clean_dirty_tr(TR0 PASS_REGS); - HB = HB0; - return ground; + /* follow chain of multi-assigned variables */ + pop_text_stack(lvl); + return 0; + overflow: /* oops, we're in trouble */ @@ -374,14 +413,13 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf, /* restore our nice, friendly, term to its original state */ HB = HB0; while (to_visit > to_visit0) { - to_visit --; + to_visit--; pt0 = to_visit->start_cp; pt0_end = to_visit->end_cp; ptf = to_visit->to; - *pt0 = to_visit->oldv; } reset_trail(TR0); - /* follow chain of multi-assigned variables */ + pop_text_stack(lvl); return -1; trail_overflow: @@ -391,37 +429,14 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf, /* restore our nice, friendly, term to its original state */ HB = HB0; while (to_visit > to_visit0) { - to_visit --; + to_visit--; pt0 = to_visit->start_cp; pt0_end = to_visit->end_cp; ptf = to_visit->to; - *pt0 = to_visit->oldv; - } - { - tr_fr_ptr oTR = TR; - reset_trail(TR0); - if (!Yap_growtrail((oTR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { - return -4; - } - return -2; - } - - heap_overflow: - /* oops, we're in trouble */ - HR = HLow; - /* we've done it */ - /* restore our nice, friendly, term to its original state */ - HB = HB0; - while (to_visit > to_visit0) { - to_visit --; - pt0 = to_visit->start_cp; - pt0_end = to_visit->end_cp; - ptf = to_visit->to; - *pt0 = to_visit->oldv; } reset_trail(TR0); - LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0; - return -3; + pop_text_stack(lvl); + return -4; } @@ -477,7 +492,7 @@ CopyTerm(Term inp, UInt arity, int share, int newattvs USES_REGS) { *HR = t; Hi = HR+1; HR += 2; - if ((res = copy_complex_term(Hi-2, Hi-1, share, newattvs, Hi, Hi PASS_REGS)) < 0) { + if ((res = Yap_copy_complex_term(Hi-2, Hi-1, share, newattvs, Hi, Hi PASS_REGS)) < 0) { HR = Hi-1; if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L) return FALSE; @@ -501,7 +516,7 @@ CopyTerm(Term inp, UInt arity, int share, int newattvs USES_REGS) { HR += 2; { int res; - if ((res = copy_complex_term(ap-1, ap+1, share, newattvs, Hi, Hi PASS_REGS)) < 0) { + if ((res = Yap_copy_complex_term(ap-1, ap+1, share, newattvs, Hi, Hi PASS_REGS)) < 0) { HR = Hi; if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L) return FALSE; @@ -533,7 +548,7 @@ CopyTerm(Term inp, UInt arity, int share, int newattvs USES_REGS) { } else { int res; - if ((res = copy_complex_term(ap, ap+ArityOfFunctor(f), share, newattvs, HB0+1, HB0 PASS_REGS)) < 0) { + if ((res = Yap_copy_complex_term(ap, ap+ArityOfFunctor(f), share, newattvs, HB0+1, HB0 PASS_REGS)) < 0) { HR = HB0; if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L) return FALSE; @@ -640,9 +655,9 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *vout, Te copy_term_nvar: { if (IsPairTerm(d0)) { - CELL *ap2 = RepPair(d0); - //fprintf(stderr, "%d \n", RepPair(ap2[0])- ptf); - if (IsVarTerm(ap2[0]) && IN_BETWEEN(HB, (ap2[0]),HR)) { + CELL *headp = RepPair(d0); + //fprintf(stderr, "%d \n", RepPair(headp[0])- ptf); + if (IsVarTerm(headp[0]) && IN_BETWEEN(HB, (headp[0]),HR)) { Term v = MkVarTerm(); *ptf = v; vin = add_to_list(vin, (CELL)(ptf), AbsPair(ptf) ); @@ -656,19 +671,19 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *vout, Te to_visit->start_cp = pt0; to_visit->end_cp = pt0_end; to_visit->to = ptf; - to_visit->oldp = ap2; - d0 = to_visit->oldv = ap2[0]; + to_visit->oldp = headp; + d0 = to_visit->oldv = headp[0]; /* fool the system into thinking we had a variable there */ to_visit ++; - pt0 = ap2; - pt0_end = ap2 + 1; + pt0 = headp; + pt0_end = headp + 1; ptf = HR; - *ap2 = AbsPair(HR); + *headp = AbsPair(HR); HR += 2; if (HR > ASP - 2048) { goto overflow; } - if (IsVarTerm(d0) && d0 == (CELL)ap2) { + if (IsVarTerm(d0) && d0 == (CELL)headp) { RESET_VARIABLE(ptf); ptf++; continue; @@ -682,17 +697,17 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *vout, Te continue; } else if (IsApplTerm(d0)) { register Functor f; - register CELL *ap2; + register CELL *headp; /* store the terms to visit */ - ap2 = RepAppl(d0)+1; - f = (Functor)(ap2[-1]); + headp = RepAppl(d0)+1; + f = (Functor)(headp[-1]); if (IsExtensionFunctor(f)) { *ptf++ = d0; /* you can just copy other extensions. */ continue; } - if (IsApplTerm(ap2[0]) && IN_BETWEEN(HB, RepAppl(ap2[0]),HR)) { + if (IsApplTerm(headp[0]) && IN_BETWEEN(HB, RepAppl(headp[0]),HR)) { RESET_VARIABLE(ptf); - vin = add_to_list(vin, (CELL)ptf, ap2[0] ); + vin = add_to_list(vin, (CELL)ptf, headp[0] ); ptf++; continue; } @@ -705,24 +720,19 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *vout, Te to_visit->start_cp = pt0; to_visit->end_cp = pt0_end; to_visit->to = ptf; - to_visit->oldp = ap2; - d0 = to_visit->oldv = ap2[0]; + to_visit->oldp = headp; + d0 = to_visit->oldv = headp[0]; /* fool the system into thinking we had a variable there */ to_visit ++; - pt0 = ap2; - pt0_end = ap2 + (arity-1); + pt0 = headp; + pt0_end = headp + (arity-1); ptf = HR; if (HR > ASP - 2048) { goto overflow; } *ptf++ =(CELL)f; - *ap2 = AbsAppl(HR); + *headp = AbsAppl(HR); HR += (arity+1); - if (IsVarTerm(d0) && d0 == (CELL)(ap2)) { - RESET_VARIABLE(ptf); - ptf++; - continue; - } d0 = Deref(d0); if (!IsVarTerm(d0)) { goto copy_term_nvar; @@ -884,7 +894,7 @@ break_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *of, Term oi, CELL if (new) { /* mark cell as pointing to new copy */ /* we can only mark after reading the value of the first argument */ - MaBind(pt0, new); + TrailedMaBind(pt0, new); new = 0L; } deref_head(d0, break_rationals_unk); @@ -1642,7 +1652,7 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Ter *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), *to_visit0 = to_visit, *to_visit_max = to_visit+1024; - register tr_fr_ptr TR0 = TR; + register tr_fr_ptr TR0 = TR; CELL *InitialH = HR; CELL output = AbsPair(HR); @@ -1657,8 +1667,8 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Ter list_loop: deref_head(d0, vars_in_term_unk); vars_in_term_nvar: - WALK_COMPLEX_TERM(); - continue ; + WALK_COMPLEX_TERM(); + continue ; derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar); /* do or pt2 are unbound */ @@ -1681,14 +1691,14 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Ter } /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { - to_visit--; + to_visit--; pt0 = to_visit->pt0; pt0_end = to_visit->pt0_end; CELL *ptd0 = to_visit->ptd0; *ptd0 = to_visit->d0; goto loop; - } + } clean_tr(TR0 PASS_REGS); pop_text_stack(lvl); @@ -1885,63 +1895,63 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, *to_visit = Malloc(1024*sizeof( struct non_single_struct_t)), *to_visit0 = to_visit, *to_visit_max = to_visit+1024; - register tr_fr_ptr TR0 = TR; + register tr_fr_ptr TR0 = TR; CELL *InitialH = HR; CELL output = AbsPair(HR); restart: - while (pt0 < pt0_end) { - register CELL d0; - register CELL *ptd0; - ++ pt0; - ptd0 = pt0; - d0 = *ptd0; - list_loop: - deref_head(d0, attvars_in_term_unk); - attvars_in_term_nvar: - { - WALK_COMPLEX_TERM(); - continue; - } - - - derefa_body(d0, ptd0, attvars_in_term_unk, attvars_in_term_nvar); - if (IsAttVar(ptd0)) { - /* do or pt2 are unbound */ - attvar_record *a0 = RepAttVar(ptd0); - if (a0->AttFunc ==(Functor) TermNil) continue; - /* leave an empty slot to fill in later */ - if (HR+1024 > ASP) { - goto global_overflow; - } - HR[1] = AbsPair(HR+2); - HR += 2; - HR[-2] = (CELL)&(a0->Done); - /* store the terms to visit */ - 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 = ptd0; - pt0_end = &RepAttVar(ptd0)->Atts; - } + while (pt0 < pt0_end) { + register CELL d0; + register CELL *ptd0; + ++ pt0; + ptd0 = pt0; + d0 = *ptd0; + list_loop: + deref_head(d0, attvars_in_term_unk); + attvars_in_term_nvar: + { + WALK_COMPLEX_TERM(); + continue; } - /* Do we still have compound terms to visit */ - if (to_visit > to_visit0) { - to_visit--; + + + derefa_body(d0, ptd0, attvars_in_term_unk, attvars_in_term_nvar); + if (IsAttVar(ptd0)) { + /* do or pt2 are unbound */ + attvar_record *a0 = RepAttVar(ptd0); + if (a0->AttFunc ==(Functor) TermNil) continue; + /* leave an empty slot to fill in later */ + if (HR+1024 > ASP) { + goto global_overflow; + } + HR[1] = AbsPair(HR+2); + HR += 2; + HR[-2] = (CELL)&(a0->Done); + /* store the terms to visit */ + 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 = ptd0; + pt0_end = &RepAttVar(ptd0)->Atts; + } + } + /* Do we still have compound terms to visit */ + if (to_visit > to_visit0) { + to_visit--; pt0 = to_visit->pt0; pt0_end = to_visit->pt0_end; CELL *ptd0 = to_visit->ptd0; *ptd0 = to_visit->d0; goto restart; - } + } clean_tr(TR0 PASS_REGS); @@ -2089,7 +2099,7 @@ static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end, } /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { - to_visit--; + to_visit--; pt0 = to_visit->pt0; pt0_end = to_visit->pt0_end; @@ -2182,7 +2192,7 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, deref_head(d0, vars_within_term_unk); vars_within_term_nvar: { - WALK_COMPLEX_TERM(); + WALK_COMPLEX_TERM(); continue; } @@ -2208,7 +2218,7 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, } /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { - to_visit--; + to_visit--; pt0 = to_visit->pt0; pt0_end = to_visit->pt0_end; @@ -2285,7 +2295,7 @@ static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end vars_within_term_nvar: { WALK_COMPLEX_TERM(); - continue; + continue; } derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar); @@ -2334,7 +2344,7 @@ static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end static Term bind_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, tr_fr_ptr TR0 USES_REGS) { register CELL **to_visit0, - **to_visit = (CELL **)Yap_PreAllocCodeSpace(); + **to_visit = (CELL **)Yap_PreAllocCodeSpace(); CELL *InitialH = HR; to_visit0 = to_visit; @@ -2676,7 +2686,7 @@ static Int ground_complex_term(register CELL *pt0, register CELL *pt0_end USES_R return true; def_aux_overflow(); - } +} bool Yap_IsGroundTerm(Term t) { @@ -4328,11 +4338,11 @@ extern int vsc; int vsc; -#define RENUMBER_SINGLES\ - if (singles && ap2 >= InitialH && ap2 < HR) {\ - renumbervar(d0, numbv++ PASS_REGS);\ - continue;\ - } +#define RENUMBER_SINGLES \ + if (singles && ap2 >= InitialH && ap2 < HR) { \ + renumbervar(d0, numbv++ PASS_REGS); \ + continue; \ + } static Int numbervars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Int numbv, int singles USES_REGS) diff --git a/H/Yapproto.h b/H/Yapproto.h index 4171421b4..8f7b2561a 100755 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -477,6 +477,9 @@ extern void Yap_InitUserCPreds(void); extern void Yap_InitUserBacks(void); /* utilpreds.c */ +int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, + bool share, bool copy_att_vars, CELL *ptf, + CELL *HLow USES_REGS); extern Term Yap_CopyTerm(Term); extern bool Yap_Variant(Term, Term); extern size_t Yap_ExportTerm(Term, char *, size_t, UInt); diff --git a/H/amiops.h b/H/amiops.h index 12514a8c9..44718dae2 100644 --- a/H/amiops.h +++ b/H/amiops.h @@ -418,6 +418,12 @@ extern void Yap_WakeUp(CELL *v); *(VP) = (D); \ } +#define TrailedMaBind(VP, D) \ + { \ + DO_MATRAIL((VP), *(VP), (D)); \ + *(VP) = (D); \ + } + /************************************************************ Unification Routines diff --git a/packages/jpl/src/c/CMakeLists.txt b/packages/jpl/src/c/CMakeLists.txt index 9e7415b5e..2da29d17b 100644 --- a/packages/jpl/src/c/CMakeLists.txt +++ b/packages/jpl/src/c/CMakeLists.txt @@ -1,5 +1,6 @@ # set(CMAKE_MACOSX_RPATH 1) + add_library(jplYap jpl.c) include_directories (${JAVA_INCLUDE_PATH} ${JAVA_INCLUDE_PATH2} ${JAVA_AWT_PATH} ) diff --git a/pl/undefined.yap b/pl/undefined.yap index 3113cbc3c..0041a7811 100644 --- a/pl/undefined.yap +++ b/pl/undefined.yap @@ -67,12 +67,10 @@ followed by the failure of that call. :- multifile user:unknown_predicate_handler/3. undefined_query(G0, M0, Cut) :- - recorded('$import','$import'(M,M0,G,G0,_,_),_), - '$call'(G, Cut, G, M). + recorded('$import','$import'(M,M0,G,G0,_,_),_), + '$call'(G, Cut, G, M). -:- '$set_no_trace'('$handle_error'(_,_,_), prolog). - /** * @pred '$undefp_search'(+ M0:G0, -MG) * @@ -97,23 +95,22 @@ undefined_query(G0, M0, Cut) :- % undef handler '$undefp'([M0|G0],MG) :- -x % make sure we do not loop on undefined predicates - '$undef_setup'(Action,Debug,Current), - ('$get_undefined_predicates'(M0:G0, MG) - -> + % make sure we do not loop on undefined predicates + '$undef_setup'(Action,Debug,Current), + ('$get_undefined_predicates'(M0:G0, MG) + -> true - ; - '$undef_error'(M0:G0, MG) - ), - '$undef_cleanup'(Action,Debug,Current) - ). + ; + '$undef_error'(M0:G0, 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), !. - '$handle_error'(Mod:Goal,_) :- +'$handle_error'(Mod:Goal,_) :- functor(Goal,Name,Arity), '$do_error'(existence_error(procedure,Name/Arity), Mod:Goal). '$handle_error'(warning,Goal,Mod) :- @@ -123,9 +120,6 @@ x % make sure we do not loop on undefined predicates fail. '$handle_error'(fail,_Goal,_Mod) :- fail. - - - '$undefp'([M0|G0],MG) '$undef_setup'(Action,Debug,Current) :- yap_flag( unknown, Action, fail), @@ -133,29 +127,12 @@ x % make sure we do not loop on undefined predicates '$stop_creeping'(Current). -'$undef_cleanup'(fail,M0:G0,NM:NG,Action,Debug,Current) :- - '$undefp_search'(M0:G0, NM:NG), - '$pred_exists'(NG,NM), - !, +'$undef_cleanup'(Action,Debug,_Current) :- yap_flag( unknown, _, Action), yap_flag( debug, _, Debug), - nonvar(NG), - nonvar(NM), - ( - Current == true - -> - % carry on signal processing - '$start_creep'([NM|NG], creep) - ; - '$execute0'(NG, NM) - ). -'$search_def'(M0:G0,_,Action,Debug,_Current) :- - yap_flag( unknown, _, Action), - yap_flag( debug, _, Debug), -'$start_creep'([prolog|true], creep), -'$handle_error'(Action,G0,M0). + '$start_creep'([prolog|true], creep). -:- '$undefp_handler'('$undefp'(_,_), prolog). + :- '$undefp_handler'('$undefp'(_,_), prolog). /** @pred unknown(- _O_,+ _N_) From 2a090f3484d68a507ac925525dcf02567367cb87 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Wed, 23 Jan 2019 14:31:31 +0000 Subject: [PATCH 4/4] term to term --- C/globals.c | 6 +- C/utilpreds.c | 449 +++++++++++++++++++++------------------ H/TermExt.h | 3 +- H/Yapproto.h | 2 +- packages/jpl/src/c/jpl.c | 8 +- 5 files changed, 251 insertions(+), 217 deletions(-) diff --git a/C/globals.c b/C/globals.c index 5a457f19f..6d6e06d16 100644 --- a/C/globals.c +++ b/C/globals.c @@ -374,7 +374,7 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars, *HR = t; Hi = HR + 1; HR += 2; - if ((res = Yap_copy_complex_term(Hi - 2, Hi - 1, share, copy_att_vars, Hi, + if ((res = Yap_copy_complex_term(Hi - 2, Hi - 1, share, NULL, copy_att_vars, Hi, Hi PASS_REGS)) < 0) goto error_handler; CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS); @@ -408,7 +408,7 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars, Hi = HR; tf = AbsPair(HR); HR += 2; - if ((res = Yap_copy_complex_term(ap - 1, ap + 1, share, copy_att_vars, Hi, + if ((res = Yap_copy_complex_term(ap - 1, ap + 1, share, NULL, copy_att_vars, Hi, Hi PASS_REGS)) < 0) { goto error_handler; } @@ -487,7 +487,7 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars, goto error_handler; } if ((res = Yap_copy_complex_term(ap, ap + ArityOfFunctor(f), share, - copy_att_vars, HB0 + 1, HB0 PASS_REGS)) < + NULL, copy_att_vars, HB0 + 1, HB0 PASS_REGS)) < 0) { goto error_handler; } diff --git a/C/utilpreds.c b/C/utilpreds.c index 0d66fcb09..cdf66b7d5 100644 --- a/C/utilpreds.c +++ b/C/utilpreds.c @@ -184,13 +184,13 @@ clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) { #define MIN_ARENA_SIZE (1048L) int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, - bool share, bool copy_att_vars, CELL *ptf, + bool share, Term *split, bool copy_att_vars, CELL *ptf, CELL *HLow USES_REGS) { // fprintf(stderr,"+++++++++\n"); //CELL *x = pt0; while(x != pt0_end) Yap_DebugPlWriteln(*++ x); int lvl = push_text_stack(); - + Term o = TermNil; struct cp_frame *to_visit0, *to_visit = Malloc(1024*sizeof(struct cp_frame)); struct cp_frame *to_visit_max; @@ -214,229 +214,264 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, copy_term_nvar : { if (IsPairTerm(d0)) { CELL *headp = RepPair(d0); - if (//(share && headp < HB) || - (IsPairTerm(*headp) && RepPair(*headp) >= HB && RepPair(*headp) < HR)) { + if (IsPairTerm(*headp) && RepPair(*headp) >= HB && RepPair(*headp) < HR) { + if (split) { + Term v = Yap_MkNewApplTerm(FunctorEq, 2); + RepAppl(v)[1] = *headp; + *headp = *ptf++ = RepAppl(v)[0]; + o = MkPairTerm( v, o ); + } else { + /* If this is newer than the current term, just reuse */ + *ptf++ = (CELL)RepAppl(*headp); + } + } + else if (IsApplTerm(*headp) && RepAppl(*headp) >= HB && RepAppl(*headp) < HR) { + *ptf++ = AbsPair(RepAppl(*headp)); + continue; + } + if (to_visit >= to_visit_max-32) { + expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); + } + *ptf = AbsPair(HR); + ptf++; + to_visit->start_cp = pt0; + to_visit->end_cp = pt0_end; + to_visit->to = ptf; + to_visit->curp = headp; + d0 = *headp; + to_visit->oldv = d0; + to_visit->ground = ground; + to_visit++; + // move to new list + if (share) { + TrailedMaBind(headp,AbsPair(HR)); + } else { + *headp = AbsPair(HR); + } + pt0 = headp; + pt0_end = headp + 1; + ptf = HR; + ground = true; + HR += 2; + if (HR > ASP - MIN_ARENA_SIZE) { + goto overflow; + } + ptd0 = pt0; + goto deref; + } else if (IsApplTerm(d0)) { + register Functor f; + register CELL *headp; + /* store the terms to visit */ + headp = RepAppl(d0); + if (IsPairTerm(*headp)//(share && headp < HB) || + ) { + if (split) { + Term v = Yap_MkNewApplTerm(FunctorEq, 2); + RepAppl(v)[1] = *headp; + *headp = *ptf++ = RepAppl(v)[0]; + o = MkPairTerm( v, o ); + } else { /* If this is newer than the current term, just reuse */ - *ptf++ = *headp; - continue; + *ptf++ = AbsPair(RepAppl(*headp)); } - if (to_visit >= to_visit_max-32) { - expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); - } - *ptf = AbsPair(HR); - ptf++; - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit->ground = ground; - to_visit++; - // move to new list - d0 = *headp; - TrailedMaBind(headp, AbsPair(HR)); - pt0 = headp; - pt0_end = headp + 1; - ptf = HR; - ground = true; - HR += 2; - if (HR > ASP - MIN_ARENA_SIZE) { - goto overflow; - } - ptd0 = pt0; - goto deref; - } else if (IsApplTerm(d0)) { - register Functor f; - register CELL *headp; - /* store the terms to visit */ - headp = RepAppl(d0); - if (IsApplTerm(*headp)//(share && headp < HB) || - ) { - /* If this is newer than the current term, just reuse */ - *ptf++ = *headp; - continue; - } - f = (Functor)(*headp); + continue; + } + f = (Functor)(*headp); - if (IsExtensionFunctor(f)) { - switch ((CELL)f) { - case (CELL) FunctorDBRef: - case (CELL) FunctorAttVar: - *ptf++ = d0; - break; - case (CELL) FunctorLongInt: - if (HR > ASP - (MIN_ARENA_SIZE + 3)) { - goto overflow; - } - *ptf++ = AbsAppl(HR); - HR[0] = (CELL)f; - HR[1] = headp[1]; - HR[2] = EndSpecials; - HR += 3; - if (HR > ASP - MIN_ARENA_SIZE) { - goto overflow; - } - break; - case (CELL) FunctorDouble: - if (HR > - ASP - (MIN_ARENA_SIZE + (2 + SIZEOF_DOUBLE / sizeof(CELL)))) { - goto overflow; - } - *ptf++ = AbsAppl(HR); - HR[0] = (CELL)f; - HR[1] = headp[1]; + if (IsExtensionFunctor(f)) { + if (share) { + *ptf++ = d0; + continue; + } + switch ((CELL)f) { + case (CELL) FunctorDBRef: + case (CELL) FunctorAttVar: + *ptf++ = d0; + break; + case (CELL) FunctorLongInt: + if (HR > ASP - (MIN_ARENA_SIZE + 3)) { + goto overflow; + } + *ptf++ = AbsAppl(HR); + HR[0] = (CELL)f; + HR[1] = headp[1]; + HR[2] = EndSpecials; + HR += 3; + if (HR > ASP - MIN_ARENA_SIZE) { + goto overflow; + } + break; + case (CELL) FunctorDouble: + if (HR > + ASP - (MIN_ARENA_SIZE + (2 + SIZEOF_DOUBLE / sizeof(CELL)))) { + goto overflow; + } + *ptf++ = AbsAppl(HR); + HR[0] = (CELL)f; + HR[1] = headp[1]; #if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P - HR[2] = headp[2]; - HR[3] = EndSpecials; - HR += 4; + HR[2] = headp[2]; + HR[3] = EndSpecials; + HR += 4; #else - HR[2] = EndSpecials; - HR += 3; + HR[2] = EndSpecials; + HR += 3; #endif - break; - case (CELL) FunctorString: - if (ASP - HR < MIN_ARENA_SIZE + 3 + headp[1]) { - goto overflow; - } - *ptf++ = AbsAppl(HR); - memmove(HR, headp, sizeof(CELL) * (3 + headp[1])); - HR += headp[1] + 3; - break; - default: { - /* big int */ - size_t sz = (sizeof(MP_INT) + 3 * CellSize + - ((MP_INT *)(headp + 2))->_mp_alloc * sizeof(mp_limb_t)) / - CellSize, - i; - - if (HR > ASP - (MIN_ARENA_SIZE + sz)) { - goto overflow; - } - *ptf++ = AbsAppl(HR); - HR[0] = (CELL)f; - for (i = 1; i < sz; i++) { - HR[i] = headp[i]; - - } - HR += sz; + break; + case (CELL) FunctorString: + if (ASP - HR < MIN_ARENA_SIZE + 3 + headp[1]) { + goto overflow; } + *ptf++ = AbsAppl(HR); + memmove(HR, headp, sizeof(CELL) * (3 + headp[1])); + HR += headp[1] + 3; + break; + default: { + /* big int */ + size_t sz = (sizeof(MP_INT) + 3 * CellSize + + ((MP_INT *)(headp + 2))->_mp_alloc * sizeof(mp_limb_t)) / + CellSize, + i; + + if (HR > ASP - (MIN_ARENA_SIZE + sz)) { + goto overflow; } - continue; - } - *ptf = AbsAppl(HR); - ptf++; - /* store the terms to visit */ - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit->ground = ground; - if (++to_visit >= to_visit_max-32) { - expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); + *ptf++ = AbsAppl(HR); + HR[0] = (CELL)f; + for (i = 1; i < sz; i++) { + HR[i] = headp[i]; + + } + HR += sz; } - TrailedMaBind(headp,AbsAppl(HR)); - ptf = HR; - *ptf++ = (CELL)f; - ground = true; - arity_t a = ArityOfFunctor(f); - HR = ptf+a; - if (HR > ASP - MIN_ARENA_SIZE) { - goto overflow; } - pt0 = headp; - pt0_end = headp+a; - ground = (f != FunctorMutable); - } else { - /* just copy atoms or integers */ - *ptf++ = d0; + continue; } - continue; - } - - derefa_body(d0, ptd0, copy_term_unk, copy_term_nvar); - ground = false; - /* don't need to copy variables if we want to share the global term */ - if (//(share && ptd0 < HB && ptd0 > H0) || - (ptd0 >= HLow && ptd0 < HR)) { - /* we have already found this cell */ - *ptf++ = (CELL)ptd0; + *ptf = AbsAppl(HR); + ptf++; + /* store the terms to visit */ + to_visit->start_cp = pt0; + to_visit->end_cp = pt0_end; + to_visit->to = ptf; + to_visit->curp = headp; + d0 = *headp; + to_visit->oldv = d0; + to_visit->ground = ground; + if (++to_visit >= to_visit_max-32) { + expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame); + } + if (share) { + TrailedMaBind(headp,AbsPair(HR)); + } else { + *headp = AbsPair(HR); + } + ptf = HR; + ptf[-1] = (CELL)f; + ground = true; + arity_t a = ArityOfFunctor(f); + HR = ptf+a; + if (HR > ASP - MIN_ARENA_SIZE) { + goto overflow; + } + pt0 = headp; + pt0_end = headp+a; + ground = (f != FunctorMutable); } else { - if (copy_att_vars && GlobalIsAttachedTerm((CELL)ptd0)) { - /* if unbound, call the standard copy term routine */ - struct cp_frame *bp; - CELL new; + /* just copy atoms or integers */ + *ptf++ = d0; + } + continue; + } - bp = to_visit; - if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, - ptf PASS_REGS)) { - goto overflow; - } - to_visit = bp; - new = *ptf; - if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - /* Trail overflow */ - if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), TRUE)) { - goto trail_overflow; - } - } - TrailedMaBind(ptd0, new); - ptf++; - } else { - /* first time we met this term */ - RESET_VARIABLE(ptf); - if ((ADDR)TR > LOCAL_TrailTop - MIN_ARENA_SIZE) - goto trail_overflow; - TrailedMaBind(ptd0, (CELL)ptf); - ptf++; + derefa_body(d0, ptd0, copy_term_unk, copy_term_nvar); + ground = false; + /* don't need to copy variables if we want to share the global term */ + if (//(share && ptd0 < HB && ptd0 > H0) || + (ptd0 >= HLow && ptd0 < HR)) { + /* we have already found this cell */ + *ptf++ = (CELL)ptd0; + } else { + if (copy_att_vars && GlobalIsAttachedTerm((CELL)ptd0)) { + /* if unbound, call the standard copy term routine */ + struct cp_frame *bp; + CELL new; + + bp = to_visit; + if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, + ptf PASS_REGS)) { + goto overflow; } + to_visit = bp; + new = *ptf; + if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { + /* Trail overflow */ + if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), TRUE)) { + goto trail_overflow; + } + } + TrailedMaBind(ptd0, new); + ptf++; + } else { + /* first time we met this term */ + RESET_VARIABLE(ptf); + if ((ADDR)TR > LOCAL_TrailTop - MIN_ARENA_SIZE) + goto trail_overflow; + TrailedMaBind(ptd0, (CELL)ptf); + ptf++; } } +} - /* Do we still have compound terms to visit */ - if (to_visit > to_visit0) { - to_visit--; - pt0 = to_visit->start_cp; - pt0_end = to_visit->end_cp; - ptf = to_visit->to; - ground = (ground && to_visit->ground); - goto loop; - } +/* Do we still have compound terms to visit */ +if (to_visit > to_visit0) { + to_visit--; + if (!share) + *to_visit->curp = to_visit->oldv; + pt0 = to_visit->start_cp; + pt0_end = to_visit->end_cp; + ptf = to_visit->to; + ground = (ground && to_visit->ground); + goto loop; + } - /* restore our nice, friendly, term to its original state */ - clean_dirty_tr(TR0 PASS_REGS); - /* follow chain of multi-assigned variables */ - pop_text_stack(lvl); - return 0; +/* restore our nice, friendly, term to its original state */ +clean_dirty_tr(TR0 PASS_REGS); +/* follow chain of multi-assigned variables */ +pop_text_stack(lvl); +return 0; - overflow: - /* oops, we're in trouble */ - HR = HLow; - /* we've done it */ - /* restore our nice, friendly, term to its original state */ - HB = HB0; - while (to_visit > to_visit0) { - to_visit--; - pt0 = to_visit->start_cp; - pt0_end = to_visit->end_cp; - ptf = to_visit->to; - } - reset_trail(TR0); - pop_text_stack(lvl); - return -1; +overflow: +/* oops, we're in trouble */ +HR = HLow; +/* we've done it */ +/* restore our nice, friendly, term to its original state */ +HB = HB0; +while (to_visit > to_visit0) { + to_visit--; + pt0 = to_visit->start_cp; + pt0_end = to_visit->end_cp; + ptf = to_visit->to; + } +reset_trail(TR0); +pop_text_stack(lvl); +return -1; - trail_overflow: - /* oops, we're in trouble */ - HR = HLow; - /* we've done it */ - /* restore our nice, friendly, term to its original state */ - HB = HB0; - while (to_visit > to_visit0) { - to_visit--; - pt0 = to_visit->start_cp; - pt0_end = to_visit->end_cp; - ptf = to_visit->to; - } - reset_trail(TR0); - pop_text_stack(lvl); - return -4; +trail_overflow: +/* oops, we're in trouble */ +HR = HLow; +/* we've done it */ +/* restore our nice, friendly, term to its original state */ +HB = HB0; +while (to_visit > to_visit0) { + to_visit--; + pt0 = to_visit->start_cp; + pt0_end = to_visit->end_cp; + ptf = to_visit->to; + } +reset_trail(TR0); +pop_text_stack(lvl); +return -4; } @@ -492,7 +527,7 @@ CopyTerm(Term inp, UInt arity, int share, int newattvs USES_REGS) { *HR = t; Hi = HR+1; HR += 2; - if ((res = Yap_copy_complex_term(Hi-2, Hi-1, share, newattvs, Hi, Hi PASS_REGS)) < 0) { + if ((res = Yap_copy_complex_term(Hi-2, Hi-1, share, NULL, newattvs, Hi, Hi PASS_REGS)) < 0) { HR = Hi-1; if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L) return FALSE; @@ -516,7 +551,7 @@ CopyTerm(Term inp, UInt arity, int share, int newattvs USES_REGS) { HR += 2; { int res; - if ((res = Yap_copy_complex_term(ap-1, ap+1, share, newattvs, Hi, Hi PASS_REGS)) < 0) { + if ((res = Yap_copy_complex_term(ap-1, ap+1, share, NULL, newattvs, Hi, Hi PASS_REGS)) < 0) { HR = Hi; if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L) return FALSE; @@ -548,7 +583,7 @@ CopyTerm(Term inp, UInt arity, int share, int newattvs USES_REGS) { } else { int res; - if ((res = Yap_copy_complex_term(ap, ap+ArityOfFunctor(f), share, newattvs, HB0+1, HB0 PASS_REGS)) < 0) { + if ((res = Yap_copy_complex_term(ap, ap+ArityOfFunctor(f), share, NULL, newattvs, HB0+1, HB0 PASS_REGS)) < 0) { HR = HB0; if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L) return FALSE; diff --git a/H/TermExt.h b/H/TermExt.h index fed59fcbd..ccd1eb827 100755 --- a/H/TermExt.h +++ b/H/TermExt.h @@ -111,10 +111,9 @@ typedef struct cp_frame { CELL *start_cp; CELL *end_cp; CELL *to; -#ifdef RATIONAL_TREES + CELL *curp; CELL oldv; int ground; -#endif } copy_frame; #ifdef COROUTINING diff --git a/H/Yapproto.h b/H/Yapproto.h index 8f7b2561a..4750e4d5b 100755 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -478,7 +478,7 @@ extern void Yap_InitUserBacks(void); /* utilpreds.c */ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end, - bool share, bool copy_att_vars, CELL *ptf, + bool share, Term *split, bool copy_att_vars, CELL *ptf, CELL *HLow USES_REGS); extern Term Yap_CopyTerm(Term); extern bool Yap_Variant(Term, Term); diff --git a/packages/jpl/src/c/jpl.c b/packages/jpl/src/c/jpl.c index 838f7bfbe..af40c856d 100755 --- a/packages/jpl/src/c/jpl.c +++ b/packages/jpl/src/c/jpl.c @@ -48,12 +48,12 @@ refactoring (trivial): #define JPL_C_LIB_VERSION_PATCH 4 #define JPL_C_LIB_VERSION_STATUS "alpha" -#define JPL_DEBUG +//#define JPL_DEBUG #ifndef JPL_DEBUG /*#define DEBUG(n, g) ((void)0) */ #define DEBUG_LEVEL 4 -#define JPL_DEBUG(n, g) ( n >= DEBUG_LEVEL ? g : (void)0 ) +#define JPL_DEBUG(n, g) ( false && n >= DEBUG_LEVEL ? g : (void)0 ) #endif /* disable type-of-ref caching (at least until GC issues are resolved) */ @@ -642,7 +642,7 @@ static JNIEnv* jni_env(void) /* economically gets a JNIEnv pointer, valid for this thread */ { JNIEnv *env; - switch( (*jvm)->GetEnv(jvm, (void**)&env, JNI_VERSION_9) ) + switch( (*jvm)->GetEnv(jvm, (void**)&env, JNI_VERSION_1_2) ) { case JNI_OK: return env; case JNI_EDETACHED: @@ -1826,7 +1826,7 @@ jni_create_jvm_c( JNIEnv *env; JPL_DEBUG(1, Sdprintf( "[creating JVM with 'java.class.path=%s']\n", classpath)); - vm_args.version = JNI_VERSION_1_6; /* "Java 1.2 please" */ + vm_args.version = JNI_VERSION_1_2; /* "Java 1.2 please" */ if ( classpath ) { cpoptp = (char *)malloc(strlen(classpath) + strlen("-Djava.class.path=")+1);