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

more upgrades to new coroutining code.

Browse Source
This commit is contained in:
Vitor Santos Costa 2010-03-10 14:06:07 +00:00
parent 4a6bfe1fa0
commit 3d10482cc7
4 changed files with 157 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

69
C/attvar.c
View File

@ -79,7 +79,6 @@ BuildNewAttVar(void)
RESET_VARIABLE(&(newv->Value));
RESET_VARIABLE(&(newv->Done));
RESET_VARIABLE(&(newv->Atts));
HB = PROTECT_FROZEN_H(B);
return newv;
}
@ -104,7 +103,6 @@ CopyAttVar(CELL *orig, struct cp_frame **to_visit_ptr, CELL *res)
to_visit->to = &(newv->Atts);
}
to_visit->oldv = vt[-1];
/* you're coming from a variable */
to_visit->ground = FALSE;
*to_visit_ptr = to_visit+1;
*res = (CELL)&(newv->Done);
@ -879,10 +877,75 @@ p_swi_all_atts(void) {
}
}
static Term
AllAttVars(void) {
CELL *pt = H0;
CELL *myH = H;
while (pt < H) {
switch(*pt) {
case (CELL)FunctorAttVar:
if (IsUnboundVar(pt+1)) {
if (ASP - myH < 1024) {
Yap_Error_Size = (ASP-H)*sizeof(CELL);
return 0L;
}
if (myH != H) {
myH[-1] = AbsPair(myH);
}
myH[0] = AbsAttVar((attvar_record *)pt);
myH += 2;
}
pt += (1+ATT_RECORD_ARITY);
break;
case (CELL)FunctorDouble:
#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT
pt += 4;
#else
pt += 3;
#endif
break;
case (CELL)FunctorBigInt:
{
Int sz = 3 +
(sizeof(MP_INT)+
(((MP_INT *)(pt+2))->_mp_alloc*sizeof(mp_limb_t)))/sizeof(CELL);
pt += sz;
}
break;
case (CELL)FunctorLongInt:
pt += 3;
break;
default:
pt++;
}
}
if (myH != H) {
Term out = AbsPair(H);
myH[-1] = TermNil;
H = myH;
return out;
} else {
return TermNil;
}
}
static Int
p_all_attvars(void)
{
return Yap_unify(ARG1,TermNil);
do {
Term out;
if (!(out = AllAttVars())) {
if (!Yap_gcl(Yap_Error_Size, 1, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}
} else {
return Yap_unify(ARG1,out);
}
} while (TRUE);
}
static Int

44
C/heapgc.c
View File

@ -1150,6 +1150,33 @@ check_global(void) {
/* mark a heap object and all heap objects accessible from it */
static void
mark_variable(CELL_PTR current);
static void
mark_att_var(CELL *hp)
{
if (!MARKED_PTR(hp-1)) {
MARK(hp-1);
PUSH_POINTER(hp-1);
total_marked++;
if (hp < HGEN) {
total_oldies++;
}
}
if (!MARKED_PTR(hp)) {
MARK(hp);
PUSH_POINTER(hp);
total_marked++;
if (hp < HGEN) {
total_oldies++;
}
}
mark_variable(hp+1);
mark_variable(hp+2);
}
static void
mark_variable(CELL_PTR current)
{
@ -1173,7 +1200,10 @@ mark_variable(CELL_PTR current)
next = GET_NEXT(ccur);
if (IsVarTerm(ccur)) {
if (ONHEAP(next)) {
if (IsAttVar(current) && current==next) {
mark_att_var(current);
POP_CONTINUATION();
} else if (ONHEAP(next)) {
#ifdef EASY_SHUNTING
CELL cnext;
/* do variable shunting between variables in the global */
@ -1576,18 +1606,6 @@ mark_environments(CELL_PTR gc_ENV, OPREG size, CELL *pvbmap)
}
}
static void
mark_att_var(CELL *hp)
{
attvar_record *attv = RepAttVar(hp);
Functor *cptr = &(attv->AttFunc);
mark_external_reference2(CellPtr(cptr));
mark_external_reference2(&attv->Done);
mark_external_reference2(&attv->Value);
mark_external_reference2(&attv->Atts);
}
/*
Cleaning the trail should be quick and simple, right? Well, not
really :-(. The problem is that the trail includes a dumping ground

43
C/utilpreds.c
View File

@ -69,8 +69,11 @@ clean_dirty_tr(tr_fr_ptr TR0) {
RESET_VARIABLE(p);
} else {
/* copy downwards */
#ifdef FROZEN_STACKS
#else
TrailTerm(TR0+1) = TrailTerm(pt);
TrailTerm(TR0) = TrailTerm(TR0+2) = p;
#endif
pt+=2;
TR0 += 3;
}
@ -89,7 +92,7 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf,
tr_fr_ptr TR0 = TR;
int ground = TRUE;
#ifdef COROUTINING
CELL *dvars = NULL;
CELL *dvarsmin = NULL, *dvarsmax=NULL;
#endif
HB = HLow;
@ -251,32 +254,25 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf,
#if COROUTINING
if (newattvs && IsAttachedTerm((CELL)ptd0)) {
/* if unbound, call the standard copy term routine */
struct cp_frame *bp[1];
struct cp_frame *bp;
if (dvars == NULL) {
dvars = H0;
}
if (ptd0 < dvars) {
if (IN_BETWEEN(dvarsmin, ptd0, dvarsmax)) {
*ptf++ = (CELL) ptd0;
} else {
tr_fr_ptr CurTR;
CELL new;
CurTR = TR;
bp[0] = to_visit;
HB = HB0;
if (!attas[ExtFromCell(ptd0)].copy_term_op(ptd0, bp, ptf)) {
bp = to_visit;
if (!attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, ptf)) {
goto overflow;
}
to_visit = bp[0];
HB = HLow;
ptf++;
if (TR > (tr_fr_ptr)Yap_TrailTop - 256) {
/* Trail overflow */
if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) {
goto trail_overflow;
}
to_visit = bp;
new = *ptf;
Bind(ptd0, new);
if (dvarsmin == NULL) {
dvarsmin = CellPtr(new);
}
Bind(ptd0, ptf[-1]);
dvarsmax = CellPtr(new)+1;
ptf++;
}
} else {
#endif
@ -288,8 +284,7 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf,
goto trail_overflow;
}
}
Bind(ptd0, (CELL)ptf);
ptf++;
Bind(ptd0, (CELL)ptf++);
#ifdef COROUTINING
}
#endif
@ -320,8 +315,8 @@ 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;
clean_dirty_tr(TR0);
HB = HB0;
return ground;
overflow:
@ -521,7 +516,7 @@ Yap_CopyTermNoShare(Term inp) {
static Int
p_copy_term(void) /* copy term t to a new instance */
{
Term t = CopyTerm(ARG1, 2, TRUE, TRUE);
v Term t = CopyTerm(ARG1, 2, TRUE, TRUE);
if (t == 0L)
return FALSE;
/* be careful, there may be a stack shift here */

56
pl/corout.yap
View File

@ -37,27 +37,17 @@
'$show_frozen_goals'(Level))).
'$project_and_delayed_goals'(G,LGs) :-
'$att_vars'(G, LAV),
attributes:all_attvars(LAV),
LAV = [_|_], !,
% SICStus compatible step,
% just try to simplify store by projecting constraints
% over query variables.
'$project_attributes'(LAV, G),
% now get a list of frozen goals.
'$att_vars'(G, NLAV),
attributes:all_attvars(NLAV),
'$get_goalist_from_attvars'(NLAV, LGs).
'$project_and_delayed_goals'(_,[]).
'$att_vars'(Term, LAV) :-
term_variables(Term, TVars),
'$select_atts'(TVars, LAV).
'$select_atts'([], []).
'$select_atts'(V.TVars, V.LAV) :-
attvar(V), !,
'$select_atts'(TVars, LAV).
'$select_atts'(V.TVars, LAV) :-
'$select_atts'(TVars, LAV).
%
% wake_up_goal is called by the system whenever a suspended goal
@ -563,8 +553,7 @@ frozen(V, LG) :-
'$fetch_same_done_goals'(G0, D0, LV, GF).
/*
call_residue_vars(Goal,Vars) :-
call_residue_vars(Goal,Residue) :-
attributes:all_attvars(Vs0),
call(Goal),
attributes:all_attvars(Vs),
@ -586,13 +575,50 @@ call_residue_vars(Goal,Vars) :-
;
'$ord_remove'([V1|Vss], Vs0s, Residue)
).
*/
copy_term(Term, Copy, Goals) :-
term_variables(Term, TVars),
'$get_goalist_from_attvars'(TVars, Goals0),
copy_term_nat([Term|Goals0], [Copy|Goals]).
call_residue(Goal,Residue) :-
var(Goal), !,
'$do_error'(instantiation_error,call_residue(Goal,Residue)).
call_residue(Module:Goal,Residue) :-
atom(Module), !,
'$call_residue'(Goal,Module,Residue).
call_residue(Goal,Residue) :-
'$current_module'(Module),
'$call_residue'(Goal,Module,Residue).
'$call_residue'(Goal,Module,Residue) :-
'$read_svar_list'(OldAttsList),
copy_term_nat(Goal, NGoal),
( '$set_svar_list'(CurrentAttsList),
'$system_catch'(NGoal,Module,Error,'$residue_catch_trap'(Error,OldAttsList)),
'$project_and_delayed_goals'(NGoal,Residue0),
'$add_vs_to_vlist'(Residue0, Residue),
( '$set_svar_list'(OldAttsList),
copy_term_nat(NGoal+NResidue, Goal+Residue)
;
'$set_svar_list'(CurrentAttsList), fail
)
;
'$set_svar_list'(OldAttsList), fail
).
'$add_vs_to_vlist'([], []).
'$add_vs_to_vlist'([G|Residue0], [Vs-G|Residue]) :-
term_variables(G, TVs),
'$pick_att_vars'(TVs, Vs),
'$add_vs_to_vlist'(Residue0, Residue).
% make sure we set the suspended goal list to its previous state!
'$residue_catch_trap'(Error,OldAttsList) :-
'$set_svar_list'(OldAttsList),
throw(Error).
% make sure we have installed a SICStus like constraint solver.
'$project_attributes'(_, _) :-
'$undefined'(modules_with_attributes(_),attributes), !.