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

Include new instruction execute_cpred to perform tail optimisation for

Browse Source 
builtins. Required changes:
- be careful about creeping in deallocate: it may be followed by
something that is not a cut nor a proceed.
- include new instruction in absmi.c: it is a merge of execute and
call_cpred.
- change compiler to generate execute even for C builtins.
- be careful with dexecute: it may not be done if execute_op is a C
builtin.
- if we are in execute_cpred, the garbage collector cannot trust P:
instead it must look at CP to find out the size of the current
environment. The macro gc_P receives that information.
- We don't need to change CP if we do a meta-call from within
execute_cpred (and we in fact cannot). Check places where we do
meta-calls: exec, clause in cdmgr, and lu_recorded.
This commit is contained in:
Vítor Santos Costa 2008-08-28 04:43:00 +01:00
parent ff12e2bdbf
commit 17ba194c1e
21 changed files with 190 additions and 69 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

92
C/absmi.c
View File

@ -2500,7 +2500,7 @@ Yap_absmi(int inp)
goto NoStackExec;
/* dexecute Label */
/* joint deallocate and execute */
/* joint deallocate and execute */
BOp(dexecute, pp);
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace)
@ -2702,7 +2702,12 @@ Yap_absmi(int inp)
{
CELL cut_b = LCL0-(CELL *)(SREG[E_CB]);
if (ActiveSignals & YAP_CREEP_SIGNAL) {
/*
don't do a creep here; also, if our instruction is followed by
a execute_c, just wait a bit more */
if (ActiveSignals & YAP_CREEP_SIGNAL &&
Yap_op_from_opcode(PREG->opc) != Yap_opcode(_procceed) &&
Yap_op_from_opcode(PREG->opc) != Yap_opcode(_cut_e)) {
GONext();
}
ASP = YREG+E_CB;
@ -7339,7 +7344,6 @@ Yap_absmi(int inp)
BOp(call_cpred, sbpp);
if (!(PREG->u.sbpp.p->PredFlags & (SafePredFlag|HiddenPredFlag))) {
CACHE_Y_AS_ENV(YREG);
check_stack(NoStackCall, H);
@ -7385,6 +7389,88 @@ Yap_absmi(int inp)
JMPNext();
ENDBOp();
/* execute Label */
BOp(execute_cpred, pp);
{
PredEntry *pt0;
BEGD(d0);
CACHE_Y_AS_ENV(YREG);
#ifdef FROZEN_STACKS
{
choiceptr top_b = PROTECT_FROZEN_B(B);
#ifdef SBA
if (YREG > (CELL *) top_b || YREG < H) ASP = (CELL *)top_b;
#else
if (YREG > (CELL *) top_b) ASP = (CELL *)top_b;
#endif /* SBA */
else ASP = YREG+E_CB;
}
#else
if (YREG > (CELL *) B) {
ASP = (CELL *) B;
} else {
ASP = YREG+E_CB;
}
/* for slots to work */
#endif /* FROZEN_STACKS */
pt0 = PREG->u.pp.p;
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
low_level_trace(enter_pred,pt0,XREGS+1);
}
#endif /* LOW_LEVEL_TRACE */
CACHE_A1();
BEGD(d0);
d0 = (CELL)B;
#ifndef NO_CHECKING
check_stack(NoStackExecute, H);
#endif
/* for profiler */
save_pc();
ENV_YREG[E_CB] = d0;
ENDD(d0);
#ifdef DEPTH_LIMIT
if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is prolog */
if (pt0->ModuleOfPred) {
if (DEPTH == MkIntTerm(0))
FAIL();
else DEPTH = RESET_DEPTH();
}
} else if (pt0->ModuleOfPred)
DEPTH -= MkIntConstant(2);
#endif /* DEPTH_LIMIT */
/* now call C-Code */
CPredicate f = PREG->u.pp.p->cs.f_code;
yamop *oldPREG = PREG;
saveregs();
d0 = (f)();
setregs();
#ifdef SHADOW_S
SREG = Yap_REGS.S_;
#endif
if (!d0) {
FAIL();
}
if (oldPREG == PREG) {
/* we did not update PREG */
/* we can proceed */
PREG = CPREG;
ENV_YREG = ENV;
#ifdef DEPTH_LIMIT
DEPTH = ENV_YREG[E_DEPTH];
#endif
WRITEBACK_Y_AS_ENV();
} else {
/* call the new code */
CACHE_A1();
}
JMPNext();
ENDCACHE_Y_AS_ENV();
ENDD(d0);
}
ENDBOp();
/* Like previous, the only difference is that we do not */
/* trust the C-function we are calling and hence we must */
/* guarantee that *all* machine registers are saved and */

12
C/amasm.c
View File

@ -1224,7 +1224,8 @@ a_p(op_numbers opcode, clause_info *clinfo, yamop *code_p, int pass_no, struct i
return a_e(op, code_p, pass_no);
}
}
if (Flags & CPredFlag) {
if (Flags & CPredFlag &&
opcode == _call) {
code_p = check_alloc(clinfo, code_p, pass_no, cip);
if (clinfo->commit_lab && (Flags & TestPredFlag)) {
if (pass_no) {
@ -1307,6 +1308,10 @@ a_p(op_numbers opcode, clause_info *clinfo, yamop *code_p, int pass_no, struct i
else if (opcode == _execute ||
opcode == _dexecute) {
if (pass_no) {
if (opcode == _execute &&
(RepPredProp(fe)->PredFlags & CPredFlag)) {
code_p->opc = emit_op(_execute_cpred);
}
code_p->u.pp.p = RepPredProp(fe);
code_p->u.pp.p0 = clinfo->CurrentPred;
}
@ -2112,13 +2117,14 @@ a_glist(int *do_not_optimise_uatomp, yamop *code_p, int pass_no, struct intermed
return a_r(cip->cpc->rnd2, _get_list, code_p, pass_no);
}
#define NEXTOPC (cip->cpc->nextInst)->op
#define NEXTOPC (cip->cpc->nextInst->op)
static yamop *
a_deallocate(clause_info *clinfo, yamop *code_p, int pass_no, struct intermediates *cip)
{
if (clinfo->alloc_found == 1) {
if (NEXTOPC == execute_op) {
if (NEXTOPC == execute_op &&
!(RepPredProp((Prop)(cip->cpc->nextInst->rnd1))->PredFlags & CPredFlag)) {
cip->cpc = cip->cpc->nextInst;
code_p = a_p(_dexecute, clinfo, code_p, pass_no, cip);
} else

10
C/arrays.c
View File

@ -157,7 +157,7 @@ GetTermFromArray(DBTerm *ref)
}
} else {
Yap_Error_TYPE = YAP_NO_ERROR;
if (!Yap_gcl(Yap_Error_Size, 3, ENV, P)) {
if (!Yap_gcl(Yap_Error_Size, 3, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return TermNil;
}
@ -810,7 +810,7 @@ p_create_array(void)
farray = Yap_MkFunctor(AtomArray, size);
if (H+1+size > ASP-1024) {
if (!Yap_gcl((1+size)*sizeof(CELL), 2, ENV, P)) {
if (!Yap_gcl((1+size)*sizeof(CELL), 2, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage);
return(FALSE);
} else {
@ -848,7 +848,7 @@ p_create_array(void)
if (EndOfPAEntr(pp)) {
if (H+1+size > ASP-1024) {
WRITE_UNLOCK(ae->ARWLock);
if (!Yap_gcl((1+size)*sizeof(CELL), 2, ENV, P)) {
if (!Yap_gcl((1+size)*sizeof(CELL), 2, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage);
return(FALSE);
} else
@ -870,7 +870,7 @@ p_create_array(void)
ae->StrOfAE);
} else {
if (H+1+size > ASP-1024) {
if (!Yap_gcl((1+size)*sizeof(CELL), 2, ENV, P)) {
if (!Yap_gcl((1+size)*sizeof(CELL), 2, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage);
return(FALSE);
} else
@ -2308,7 +2308,7 @@ p_static_array_to_term(void)
CELL *base;
while (H+1+dim > ASP-1024) {
if (!Yap_gcl((1+dim)*sizeof(CELL), 2, ENV, P)) {
if (!Yap_gcl((1+dim)*sizeof(CELL), 2, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage);
return(FALSE);
} else {

6
C/attvar.c
View File

@ -471,7 +471,7 @@ p_put_att(void) {
mfun= Yap_MkFunctor(modname,ar);
if (IsVarTerm(tatts = SearchAttsForModule(attv->Atts,mfun))) {
while (!(tatts = BuildAttTerm(mfun,ar))) {
if (!Yap_gcl(Yap_Error_Size, 5, ENV, P)) {
if (!Yap_gcl(Yap_Error_Size, 5, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}
@ -549,7 +549,7 @@ p_rm_att(void) {
mfun= Yap_MkFunctor(modname,ar);
if (IsVarTerm(tatts = SearchAttsForModule(attv->Atts,mfun))) {
while (!(tatts = BuildAttTerm(mfun,ar))) {
if (!Yap_gcl(Yap_Error_Size, 4, ENV, P)) {
if (!Yap_gcl(Yap_Error_Size, 4, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}
@ -882,7 +882,7 @@ p_all_attvars(void)
base = (attvar_record *)Yap_ReadTimedVar(AttsMutableList);
if (!(out = AllAttVars(base))) {
if (!Yap_gcl(Yap_Error_Size, 1, ENV, P)) {
if (!Yap_gcl(Yap_Error_Size, 1, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}

2
C/c_interface.c
View File

@ -536,7 +536,7 @@ doexpand(UInt sz)
} else {
arity = 0;
}
if (!Yap_gcl(sz, arity, ENV, P)) {
if (!Yap_gcl(sz, arity, ENV, gc_P(P,CP))) {
return FALSE;
}
return TRUE;

26
C/cdmgr.c
View File

@ -3850,6 +3850,7 @@ ClauseInfoForCode(yamop *codeptr, CODEADDR *startp, CODEADDR *endp) {
break;
case _execute:
case _dexecute:
case _execute_cpred:
clause_code = TRUE;
pp = pc->u.pp.p0;
pc = NEXTOP(pc,pp);
@ -4939,11 +4940,13 @@ fetch_next_lu_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr, ya
XREGS[i+1] = pt[i];
}
/* don't need no ENV */
if (first_time) {
if (first_time &&
P->opc != Yap_opcode(_execute_cpred)) {
CP = P;
ENV = YENV;
YENV = ASP;
YENV[E_CB] = (CELL) B;
}
P = cl->ClCode;
#if defined(YAPOR) || defined(THREADS)
@ -4971,7 +4974,7 @@ fetch_next_lu_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr, ya
}
} else {
Yap_Error_TYPE = YAP_NO_ERROR;
if (!Yap_gcl(Yap_Error_Size, 7, YENV, P)) {
if (!Yap_gcl(Yap_Error_Size, 7, YENV, gc_P(P,CP))) {
UNLOCK(pe->PELock);
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
@ -4984,7 +4987,7 @@ fetch_next_lu_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr, ya
ARG6 = th;
ARG7 = tb;
ARG8 = tr;
if (!Yap_gcl(Yap_Error_Size, 8, ENV, CP)) {
if (!Yap_gcl(Yap_Error_Size, 8, ENV, gc_P(P,CP))) {
UNLOCK(pe->PELock);
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
@ -5072,7 +5075,8 @@ fetch_next_lu_clause_erase(PredEntry *pe, yamop *i_code, Term th, Term tb, Term
XREGS[i+1] = pt[i];
}
/* don't need no ENV */
if (first_time) {
if (first_time &&
P->opc != Yap_opcode(_execute_cpred)) {
CP = P;
ENV = YENV;
YENV = ASP;
@ -5106,7 +5110,7 @@ fetch_next_lu_clause_erase(PredEntry *pe, yamop *i_code, Term th, Term tb, Term
}
} else {
Yap_Error_TYPE = YAP_NO_ERROR;
if (!Yap_gcl(Yap_Error_Size, 7, YENV, P)) {
if (!Yap_gcl(Yap_Error_Size, 7, YENV, gc_P(P,CP))) {
UNLOCK(pe->PELock);
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
@ -5196,7 +5200,8 @@ fetch_next_lu_clause0(PredEntry *pe, yamop *i_code, Term th, Term tb, yamop *cp_
XREGS[i+1] = pt[i];
}
/* don't need no ENV */
if (first_time) {
if (first_time &&
P->opc != Yap_opcode(_execute_cpred)) {
CP = P;
ENV = YENV;
YENV = ASP;
@ -5225,7 +5230,7 @@ fetch_next_lu_clause0(PredEntry *pe, yamop *i_code, Term th, Term tb, yamop *cp_
}
} else {
Yap_Error_TYPE = YAP_NO_ERROR;
if (!Yap_gcl(Yap_Error_Size, 4, YENV, P)) {
if (!Yap_gcl(Yap_Error_Size, 4, YENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}
@ -5472,7 +5477,7 @@ fetch_next_static_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr
XREGS[i+1] = pt[i];
}
/* don't need no ENV */
if (first_time) {
if (first_time && P->opc != Yap_opcode(_execute_cpred)) {
CP = P;
ENV = YENV;
YENV = ASP;
@ -5497,7 +5502,8 @@ fetch_next_static_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr
XREGS[i+1] = pt[i];
}
/* don't need no ENV */
if (first_time) {
if (first_time &&
P->opc != Yap_opcode(_execute_cpred)) {
CP = P;
ENV = YENV;
YENV = ASP;
@ -5532,7 +5538,7 @@ fetch_next_static_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr
ARG5 = th;
ARG6 = tb;
ARG7 = tr;
if (!Yap_gc(7, YENV, P)) {
if (!Yap_gc(7, YENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}

7
C/compiler.c
View File

@ -1881,7 +1881,10 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
}
}
else {
if (p->PredFlags & (CPredFlag | AsmPredFlag | ModuleTransparentPredFlag)) {
if ((p->PredFlags & (AsmPredFlag |
ModuleTransparentPredFlag |
UserCPredFlag)) ||
p->FunctorOfPred == FunctorExecuteInMod) {
#ifdef YAPOR
if (p->PredFlags & SyncPredFlag)
Yap_emit(sync_op, (CELL)p, (CELL)(p->ArityOfPE), &cglobs->cint);
@ -3123,7 +3126,7 @@ Yap_cclause(volatile Term inp_clause, int NOfArgs, int mod, volatile Term src)
ARG3 = src;
YAPLeaveCriticalSection();
if (!Yap_gcl(Yap_Error_Size, NOfArgs, ENV, P)) {
if (!Yap_gcl(Yap_Error_Size, NOfArgs, ENV, gc_P(P,CP))) {
Yap_Error_TYPE = OUT_OF_STACK_ERROR;
Yap_Error_Term = inp_clause;
}

30
C/dbase.c
View File

@ -261,7 +261,7 @@ recover_from_record_error(int nargs)
{
switch(Yap_Error_TYPE) {
case OUT_OF_STACK_ERROR:
if (!Yap_gcl(Yap_Error_Size, nargs, ENV, P)) {
if (!Yap_gcl(Yap_Error_Size, nargs, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}
@ -3434,11 +3434,13 @@ lu_recorded(PredEntry *pe) {
if (opc == _procceed) {
P = pe->CodeOfPred;
} else {
CP = P;
if (P->opc != Yap_opcode(_execute_cpred)) {
CP = P;
ENV = YENV;
YENV = ASP;
YENV[E_CB] = (CELL) B;
}
P = pe->CodeOfPred;
ENV = YENV;
YENV = ASP;
YENV[E_CB] = (CELL) B;
}
if (pe->PredFlags & ProfiledPredFlag) {
LOCK(pe->StatisticsForPred.lock);
@ -3512,7 +3514,7 @@ p_recorded(void)
}
} else {
Yap_Error_TYPE = YAP_NO_ERROR;
if (!Yap_gcl(Yap_Error_Size, 3, ENV, P)) {
if (!Yap_gcl(Yap_Error_Size, 3, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}
@ -3659,7 +3661,7 @@ p_first_instance(void)
}
} else {
Yap_Error_TYPE = YAP_NO_ERROR;
if (!Yap_gcl(Yap_Error_Size, 3, ENV, P)) {
if (!Yap_gcl(Yap_Error_Size, 3, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}
@ -4528,7 +4530,7 @@ static_instance(StaticClause *cl)
}
} else {
Yap_Error_TYPE = YAP_NO_ERROR;
if (!Yap_gcl(Yap_Error_Size, 2, ENV, P)) {
if (!Yap_gcl(Yap_Error_Size, 2, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}
@ -4641,7 +4643,7 @@ p_instance(void)
}
} else {
Yap_Error_TYPE = YAP_NO_ERROR;
if (!Yap_gcl(Yap_Error_Size, 2, ENV, P)) {
if (!Yap_gcl(Yap_Error_Size, 2, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
UNLOCK(ap->PELock);
return FALSE;
@ -4663,7 +4665,7 @@ p_instance(void)
}
} else {
Yap_Error_TYPE = YAP_NO_ERROR;
if (!Yap_gcl(Yap_Error_Size, 2, ENV, P)) {
if (!Yap_gcl(Yap_Error_Size, 2, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}
@ -4693,7 +4695,7 @@ Yap_LUInstance(LogUpdClause *cl, UInt arity)
}
} else {
Yap_Error_TYPE = YAP_NO_ERROR;
if (!Yap_gcl(Yap_Error_Size, arity, ENV, P)) {
if (!Yap_gcl(Yap_Error_Size, arity, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return 0L;
}
@ -5140,7 +5142,7 @@ p_dequeue(void)
}
} else {
Yap_Error_TYPE = YAP_NO_ERROR;
if (!Yap_gcl(Yap_Error_Size, 2, YENV, P)) {
if (!Yap_gcl(Yap_Error_Size, 2, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}
@ -5184,7 +5186,7 @@ p_dequeue_unlocked(void)
}
} else {
Yap_Error_TYPE = YAP_NO_ERROR;
if (!Yap_gcl(Yap_Error_Size, 2, YENV, P)) {
if (!Yap_gcl(Yap_Error_Size, 2, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}
@ -5241,7 +5243,7 @@ p_peek_queue(void)
}
} else {
Yap_Error_TYPE = YAP_NO_ERROR;
if (!Yap_gcl(Yap_Error_Size, 2, YENV, P)) {
if (!Yap_gcl(Yap_Error_Size, 2, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}

16
C/exec.c
View File

@ -69,7 +69,12 @@ CallPredicate(PredEntry *pen, choiceptr cut_pt, yamop *code) {
} else if (pen->ModuleOfPred)
DEPTH -= MkIntConstant(2);
#endif /* DEPTH_LIMIT */
CP = P;
if (P->opc != Yap_opcode(_execute_cpred)) {
CP = P;
ENV = YENV;
YENV = ASP;
YENV[E_CB] = (CELL) cut_pt;
}
P = code;
/* vsc: increment reduction counter at meta-call entry */
if (pen->PredFlags & ProfiledPredFlag) {
@ -77,9 +82,6 @@ CallPredicate(PredEntry *pen, choiceptr cut_pt, yamop *code) {
pen->StatisticsForPred.NOfEntries++;
UNLOCK(pen->StatisticsForPred.lock);
}
ENV = YENV;
YENV = ASP;
YENV[E_CB] = (CELL) cut_pt;
return TRUE;
}
@ -627,7 +629,7 @@ p_execute_clause(void)
static Int
p_execute_in_mod(void)
{ /* '$execute'(Goal) */
return(do_execute(Deref(ARG1), IntOfTerm(Deref(ARG2))));
return(do_execute(Deref(ARG1), Deref(ARG2)));
}
static Int
@ -1898,8 +1900,10 @@ JumpToEnv(Term t) {
/* is it a continuation? */
env = B->cp_env;
while (env > ENV)
ENV = (CELL *)ENV[E_E];
ENV = ENV_Parent(ENV);
/* yes, we found it ! */
while (env < ENV)
env = ENV_Parent(env);
if (env == ENV) break;
/* oops, try next */
B = B->cp_b;

25
C/heapgc.c
View File

@ -1557,8 +1557,8 @@ mark_environments(CELL_PTR gc_ENV, OPREG size, CELL *pvbmap)
return;
MARK(gc_ENV+E_CB);
size = EnvSize((CELL_PTR) (gc_ENV[E_CP])); /* size = EnvSize(CP) */
pvbmap = EnvBMap((CELL_PTR) (gc_ENV[E_CP]));
size = EnvSize((yamop *) (gc_ENV[E_CP])); /* size = EnvSize(CP) */
pvbmap = EnvBMap((yamop *) (gc_ENV[E_CP]));
#if 0
if (size < 0) {
PredEntry *pe = EnvPreg(gc_ENV[E_CP]);
@ -1913,8 +1913,8 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
if (opnum != _table_completion)
#endif /* TABLING */
mark_environments((CELL_PTR) gc_B->cp_env,
EnvSize((CELL_PTR) (gc_B->cp_cp)),
EnvBMap((CELL_PTR) (gc_B->cp_cp)));
EnvSize((yamop *) (gc_B->cp_cp)),
EnvBMap((yamop *) (gc_B->cp_cp)));
/* extended choice point */
restart_cp:
switch (opnum) {
@ -2641,8 +2641,8 @@ sweep_environments(CELL_PTR gc_ENV, OPREG size, CELL *pvbmap)
return;
UNMARK(gc_ENV+E_CB);
size = EnvSize((CELL_PTR) (gc_ENV[E_CP])); /* size = EnvSize(CP) */
pvbmap = EnvBMap((CELL_PTR) (gc_ENV[E_CP]));
size = EnvSize((yamop *) (gc_ENV[E_CP])); /* size = EnvSize(CP) */
pvbmap = EnvBMap((yamop *) (gc_ENV[E_CP]));
gc_ENV = (CELL_PTR) gc_ENV[E_E]; /* link to prev
* environment */
}
@ -2672,8 +2672,8 @@ sweep_b(choiceptr gc_B, UInt arity)
register CELL_PTR saved_reg;
sweep_environments(gc_B->cp_env,
EnvSize((CELL_PTR) (gc_B->cp_cp)),
EnvBMap((CELL_PTR) (gc_B->cp_cp)));
EnvSize((yamop *) (gc_B->cp_cp)),
EnvBMap((yamop *) (gc_B->cp_cp)));
/* for each saved register */
for (saved_reg = &gc_B->cp_a1;
@ -3458,7 +3458,7 @@ marking_phase(tr_fr_ptr old_TR, CELL *current_env, yamop *curp, CELL *max)
mark_regs(old_TR); /* active registers & trail */
/* active environments */
mark_delays((attvar_record *)max, (attvar_record *)H0);
mark_environments(current_env, EnvSize(curp), EnvBMap((CELL *)curp));
mark_environments(current_env, EnvSize(curp), EnvBMap(curp));
mark_choicepoints(B, old_TR, is_gc_very_verbose()); /* choicepoints, and environs */
#ifdef EASY_SHUNTING
set_conditionals(sTR);
@ -3527,7 +3527,7 @@ compaction_phase(tr_fr_ptr old_TR, CELL *current_env, yamop *curp, CELL *max)
#ifdef COROUTINING
sweep_delays(max, myH0);
#endif
sweep_environments(current_env, EnvSize(curp), EnvBMap((CELL *)curp));
sweep_environments(current_env, EnvSize(curp), EnvBMap(curp));
sweep_choicepoints(B);
sweep_trail(B, old_TR);
#ifdef HYBRID_SCHEME
@ -3941,7 +3941,10 @@ p_gc(void)
{
int res;
Yap_PrologMode |= GCMode;
res = do_gc(0, ENV, P) >= 0;
if (P->opc == Yap_opcode(_execute_cpred))
res = do_gc(0, ENV, CP) >= 0;
else
res = do_gc(0, ENV, P) >= 0;
LeaveGCMode();
return res;
}

2
C/index.c
View File

@ -944,6 +944,7 @@ has_cut(yamop *pc)
break;
case _execute:
case _dexecute:
case _p_execute_cpred:
pc = NEXTOP(pc,pp);
break;
/* instructions type l */
@ -2467,6 +2468,7 @@ add_info(ClauseDef *clause, UInt regno)
case _retry_profiled:
case _count_retry:
case _execute:
case _execute_cpred:
case _dexecute:
case _jump:
case _move_back:

2
C/inlines.c
View File

@ -712,7 +712,7 @@ p_functor(void) /* functor(?,?,?) */
*pt1++ = d0;
d0 = AbsAppl(H);
if (pt1+d1 > ENV - CreepFlag) {
if (!Yap_gcl((1+d1)*sizeof(CELL), 3, ENV, P)) {
if (!Yap_gcl((1+d1)*sizeof(CELL), 3, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}

4
C/iopreds.c
View File

@ -3284,7 +3284,7 @@ p_peek_mem_write_stream (void)
if (H + 1024 >= ASP) {
UNLOCK(Stream[sno].streamlock);
H = HI;
if (!Yap_gcl((ASP-HI)*sizeof(CELL), 3, ENV, P)) {
if (!Yap_gcl((ASP-HI)*sizeof(CELL), 3, ENV, gc_P(P,CP))) {
UNLOCK(Stream[sno].streamlock);
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
@ -5842,7 +5842,7 @@ p_same_file(void) {
{
struct stat *b1, *b2;
while ((char *)H+sizeof(struct stat)*2 > (char *)(ASP-1024)) {
if (!Yap_gcl(2*sizeof(struct stat), 2, ENV, P)) {
if (!Yap_gcl(2*sizeof(struct stat), 2, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}

2
C/readutil.c
View File

@ -124,7 +124,7 @@ p_stream_to_codes(void)
RESET_VARIABLE(h0);
ARG4 = AbsPair(HBASE);
ARG5 = (CELL)h0;
if (!Yap_gcl((ASP-HBASE)*sizeof(CELL), 5, ENV, P)) {
if (!Yap_gcl((ASP-HBASE)*sizeof(CELL), 5, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, ARG1, "read_stream_to_codes/3");
return FALSE;
}

2
C/sort.c
View File

@ -58,7 +58,7 @@ build_new_list(CELL *pt, Term t)
}
pt += 2;
if (pt > ASP - 4096) {
if (!Yap_gcl((ASP-H)*sizeof(CELL), 2, ENV, P)) {
if (!Yap_gcl((ASP-H)*sizeof(CELL), 2, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
}

6
C/stdpreds.c
View File

@ -2299,7 +2299,7 @@ p_univ(void)
if (H > ASP - 1024) {
/* restore space */
H = Ar;
if (!Yap_gcl((ASP-H)*sizeof(CELL), 2, ENV, P)) {
if (!Yap_gcl((ASP-H)*sizeof(CELL), 2, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}
@ -2364,7 +2364,7 @@ p_univ(void)
}
twork = Yap_ArrayToList(CellPtr(TR), argno - 1);
while (IsIntTerm(twork)) {
if (!Yap_gc(2, ENV, P)) {
if (!Yap_gc(2, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
}
@ -2374,7 +2374,7 @@ p_univ(void)
#endif
{
while (H+arity*2 > ASP-1024) {
if (!Yap_gcl((arity*2)*sizeof(CELL), 2, ENV, P)) {
if (!Yap_gcl((arity*2)*sizeof(CELL), 2, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
}

1
C/tracer.c
View File

@ -164,6 +164,7 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
LOCK(Yap_heap_regs->low_level_trace_lock);
sc = Yap_heap_regs;
vsc_count++;
return;
#ifdef THREADS
Yap_heap_regs->thread_handle[worker_id].thread_inst_count++;
#endif

6
C/utilpreds.c
View File

@ -393,7 +393,7 @@ handle_cp_overflow(int res, UInt arity, Term t)
XREGS[arity+1] = t;
switch(res) {
case -1:
if (!Yap_gcl((ASP-H)*sizeof(CELL), arity+1, ENV, P)) {
if (!Yap_gcl((ASP-H)*sizeof(CELL), arity+1, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return 0L;
}
@ -733,7 +733,7 @@ expand_vts(void)
return FALSE;
}
} else {
if (!Yap_gcl(expand, 3, ENV, P)) {
if (!Yap_gcl(expand, 3, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, "in term_variables");
return FALSE;
}
@ -1787,7 +1787,7 @@ p_variant(void) /* variant terms t1 and t2 */
}
error:
if (out == -1) {
if (!Yap_gcl((ASP-H)*sizeof(CELL), 2, ENV, P)) {
if (!Yap_gcl((ASP-H)*sizeof(CELL), 2, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, "in variant");
return FALSE;
}

1
H/YapOpcodes.h
View File

@ -180,6 +180,7 @@
OPCODE(pop_n ,s),
OPCODE(pop ,e),
OPCODE(call_cpred ,sbpp),
OPCODE(execute_cpred ,pp),
OPCODE(call_usercpred ,sbpp),
OPCODE(call_c_wfail ,sdlp),
OPCODE(try_c ,apFs),

6
H/Yapproto.h
View File

@ -437,3 +437,9 @@ void STD_PROTO(Yap_init_socks,(char *, long));
void STD_PROTO(Yap_init_optyap_preds,(void));
static inline
yamop *
gc_P(yamop *p, yamop *cp)
{
return (p->opc == Yap_opcode(_execute_cpred) ? cp : p);
}

1
H/rclause.h
View File

@ -232,6 +232,7 @@ restore_opcodes(yamop *pc)
break;
case _execute:
case _dexecute:
case _execute_cpred:
pc->u.pp.p = PtoPredAdjust(pc->u.pp.p);
pc->u.pp.p0 = PtoPredAdjust(pc->u.pp.p0);
pc = NEXTOP(pc,pp);