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

fix bad handling of choice-points in backtrackable predicates (SWI code

Browse Source 
does not clean frames on exit )
This commit is contained in:
Vítor Santos Costa 2014-07-15 18:40:15 -05:00
parent 6ba88f8cc0
commit 4d7b270ce4
2 changed files with 29 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
C/c_interface.c
View File

@ -1279,7 +1279,7 @@ typedef Int (*CPredicate9)(Int,Int,Int,Int,Int,Int,Int,Int,Int);
typedef Int (*CPredicate10)(Int,Int,Int,Int,Int,Int,Int,Int,Int,Int); typedef Int (*CPredicate10)(Int,Int,Int,Int,Int,Int,Int,Int,Int,Int);
typedef Int (*CPredicateV)(Int,Int,struct foreign_context *); typedef Int (*CPredicateV)(Int,Int,struct foreign_context *);
static Int static
execute_cargs(PredEntry *pe, CPredicate exec_code USES_REGS) execute_cargs(PredEntry *pe, CPredicate exec_code USES_REGS)
{ {
switch (pe->ArityOfPE) { switch (pe->ArityOfPE) {
@ -1388,19 +1388,19 @@ execute_cargs(PredEntry *pe, CPredicate exec_code USES_REGS)
} }
} }
typedef Int (*CBPredicate)(struct foreign_context *); typedef uintptr_t (*CBPredicate)(struct foreign_context *);
typedef Int (*CBPredicate1)(Int,struct foreign_context *); typedef uintptr_t (*CBPredicate1)(Int,struct foreign_context *);
typedef Int (*CBPredicate2)(Int,Int,struct foreign_context *); typedef uintptr_t (*CBPredicate2)(Int,Int,struct foreign_context *);
typedef Int (*CBPredicate3)(Int,Int,Int,struct foreign_context *); typedef uintptr_t (*CBPredicate3)(Int,Int,Int,struct foreign_context *);
typedef Int (*CBPredicate4)(Int,Int,Int,Int,struct foreign_context *); typedef uintptr_t (*CBPredicate4)(Int,Int,Int,Int,struct foreign_context *);
typedef Int (*CBPredicate5)(Int,Int,Int,Int,Int,struct foreign_context *); typedef uintptr_t (*CBPredicate5)(Int,Int,Int,Int,Int,struct foreign_context *);
typedef Int (*CBPredicate6)(Int,Int,Int,Int,Int,Int,struct foreign_context *); typedef uintptr_t (*CBPredicate6)(Int,Int,Int,Int,Int,Int,struct foreign_context *);
typedef Int (*CBPredicate7)(Int,Int,Int,Int,Int,Int,Int,struct foreign_context *); typedef uintptr_t (*CBPredicate7)(Int,Int,Int,Int,Int,Int,Int,struct foreign_context *);
typedef Int (*CBPredicate8)(Int,Int,Int,Int,Int,Int,Int,Int,struct foreign_context *); typedef uintptr_t (*CBPredicate8)(Int,Int,Int,Int,Int,Int,Int,Int,struct foreign_context *);
typedef Int (*CBPredicate9)(Int,Int,Int,Int,Int,Int,Int,Int,Int,struct foreign_context *); typedef uintptr_t (*CBPredicate9)(Int,Int,Int,Int,Int,Int,Int,Int,Int,struct foreign_context *);
typedef Int (*CBPredicate10)(Int,Int,Int,Int,Int,Int,Int,Int,Int,Int,struct foreign_context *); typedef uintptr_t (*CBPredicate10)(Int,Int,Int,Int,Int,Int,Int,Int,Int,Int,struct foreign_context *);
static Int static uintptr_t
execute_cargs_back(PredEntry *pe, CPredicate exec_code, struct foreign_context *ctx USES_REGS) execute_cargs_back(PredEntry *pe, CPredicate exec_code, struct foreign_context *ctx USES_REGS)
{ {
switch (pe->ArityOfPE) { switch (pe->ArityOfPE) {
@ -1418,9 +1418,10 @@ execute_cargs_back(PredEntry *pe, CPredicate exec_code, struct foreign_context *
case 2: case 2:
{ {
CBPredicate2 code2 = (CBPredicate2)exec_code; CBPredicate2 code2 = (CBPredicate2)exec_code;
return ((code2)(&B->cp_a1-LCL0, uintptr_t val = ((code2)(&B->cp_a1-LCL0,
&B->cp_a2-LCL0, &B->cp_a2-LCL0,
ctx)); ctx));
return val;
} }
case 3: case 3:
{ {
@ -1519,7 +1520,7 @@ execute_cargs_back(PredEntry *pe, CPredicate exec_code, struct foreign_context *
} }
} }
static Int static uintptr_t
complete_fail(choiceptr ptr, int has_cp USES_REGS) complete_fail(choiceptr ptr, int has_cp USES_REGS)
{ {
// this case is easy, jut be sure to throw everything // this case is easy, jut be sure to throw everything
@ -1532,7 +1533,7 @@ complete_fail(choiceptr ptr, int has_cp USES_REGS)
return FALSE; return FALSE;
} }
static int static uintptr_t
complete_exit(choiceptr ptr, int has_cp, int cut_all USES_REGS) complete_exit(choiceptr ptr, int has_cp, int cut_all USES_REGS)
{ {
// the user often leaves open frames, especially in forward execution // the user often leaves open frames, especially in forward execution
@ -1632,8 +1633,8 @@ YAP_ExecuteFirst(PredEntry *pe, CPredicate exec_code)
CELL ocp = LCL0-(CELL *)B; CELL ocp = LCL0-(CELL *)B;
/* for slots to work */ /* for slots to work */
Int CurSlot = Yap_StartSlots( PASS_REGS1 ); Int CurSlot = Yap_StartSlots( PASS_REGS1 );
if (pe->PredFlags & (SWIEnvPredFlag|CArgsPredFlag)) { if (pe->PredFlags & (SWIEnvPredFlag|CArgsPredFlag|ModuleTransparentPredFlag)) {
Int val; uintptr_t val;
CPredicateV codev = (CPredicateV)exec_code; CPredicateV codev = (CPredicateV)exec_code;
struct foreign_context *ctx = (struct foreign_context *)(&EXTRA_CBACK_ARG(pe->ArityOfPE,1)); struct foreign_context *ctx = (struct foreign_context *)(&EXTRA_CBACK_ARG(pe->ArityOfPE,1));
@ -1667,7 +1668,8 @@ YAP_ExecuteFirst(PredEntry *pe, CPredicate exec_code)
ctx->context = (uintptr_t)(val & ~REDO_PTR); ctx->context = (uintptr_t)(val & ~REDO_PTR);
else else
ctx->context = (uintptr_t)((val & ~REDO_PTR)>>FRG_REDO_BITS); ctx->context = (uintptr_t)((val & ~REDO_PTR)>>FRG_REDO_BITS);
return TRUE; /* fix dropped cps */
return complete_exit(((choiceptr)(LCL0-ocp)), FALSE, FALSE PASS_REGS);
} }
} else { } else {
Int ret = (exec_code)( PASS_REGS1 ); Int ret = (exec_code)( PASS_REGS1 );
@ -1796,7 +1798,8 @@ YAP_ExecuteNext(PredEntry *pe, CPredicate exec_code)
else else
ctx->context = (uintptr_t)((val & ~REDO_PTR)>>FRG_REDO_BITS); ctx->context = (uintptr_t)((val & ~REDO_PTR)>>FRG_REDO_BITS);
} }
return TRUE; /* fix dropped cps */
return complete_exit(((choiceptr)(LCL0-ocp)), FALSE, FALSE PASS_REGS);
} else { } else {
Int ret = (exec_code)( PASS_REGS1 ); Int ret = (exec_code)( PASS_REGS1 );
LOCAL_CurSlot = CurSlot; LOCAL_CurSlot = CurSlot;
@ -2301,6 +2304,7 @@ YAP_EnterGoal(PredEntry *pe, Term *ptr, YAP_dogoalinfo *dgi)
out = run_emulator(dgi PASS_REGS); out = run_emulator(dgi PASS_REGS);
RECOVER_MACHINE_REGS(); RECOVER_MACHINE_REGS();
if (out) { if (out) {
dgi->EndSlot = LOCAL_CurSlot;
Yap_StartSlots( PASS_REGS1 ); Yap_StartSlots( PASS_REGS1 );
} else { } else {
LOCAL_CurSlot = dgi->CurSlot; // ignore any slots created within the called goal LOCAL_CurSlot = dgi->CurSlot; // ignore any slots created within the called goal
@ -2325,7 +2329,7 @@ YAP_RetryGoal(YAP_dogoalinfo *dgi)
P = FAILCODE; P = FAILCODE;
/* make sure we didn't leave live slots when we backtrack */ /* make sure we didn't leave live slots when we backtrack */
ASP = (CELL *)B; ASP = (CELL *)B;
LOCAL_CurSlot = dgi->CurSlot; LOCAL_CurSlot = dgi->EndSlot;
out = run_emulator(dgi PASS_REGS); out = run_emulator(dgi PASS_REGS);
RECOVER_MACHINE_REGS(); RECOVER_MACHINE_REGS();
if (out) { if (out) {

5
C/init.c
View File

@ -776,6 +776,7 @@ Yap_InitCPredBack_(const char *Name, UInt Arity,
else { else {
StaticClause *cl; StaticClause *cl;
yamop *code = ((StaticClause *)NULL)->ClCode; yamop *code = ((StaticClause *)NULL)->ClCode;
UInt sz = (CELL)NEXTOP(NEXTOP(NEXTOP(NEXTOP(code,OtapFs),OtapFs),OtapFs),l);
if (flags & UserCPredFlag) if (flags & UserCPredFlag)
pe->PredFlags = UserCPredFlag | BackCPredFlag| CompiledPredFlag | StandardPredFlag | flags; pe->PredFlags = UserCPredFlag | BackCPredFlag| CompiledPredFlag | StandardPredFlag | flags;
else else
@ -785,7 +786,7 @@ Yap_InitCPredBack_(const char *Name, UInt Arity,
pe->PredFlags |= SequentialPredFlag; pe->PredFlags |= SequentialPredFlag;
#endif /* YAPOR */ #endif /* YAPOR */
cl = (StaticClause *)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(NEXTOP(NEXTOP(code,OtapFs),OtapFs),OtapFs),l)); cl = (StaticClause *)Yap_AllocCodeSpace(sz);
if (cl == NULL) { if (cl == NULL) {
Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"No Heap Space in InitCPredBack"); Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"No Heap Space in InitCPredBack");
@ -793,7 +794,7 @@ Yap_InitCPredBack_(const char *Name, UInt Arity,
} }
cl->ClFlags = StaticMask; cl->ClFlags = StaticMask;
cl->ClNext = NULL; cl->ClNext = NULL;
Yap_ClauseSpace += (CELL)NEXTOP(NEXTOP(NEXTOP(NEXTOP(code,OtapFs),OtapFs),OtapFs),l); Yap_ClauseSpace += sz;
cl->ClSize = cl->ClSize =
(CELL)NEXTOP(NEXTOP(NEXTOP(NEXTOP(code,OtapFs),OtapFs),OtapFs),e); (CELL)NEXTOP(NEXTOP(NEXTOP(NEXTOP(code,OtapFs),OtapFs),OtapFs),e);
cl->usc.ClLine = Yap_source_line_no(); cl->usc.ClLine = Yap_source_line_no();