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

fix broken, complicated code for slots

Browse Source
This commit is contained in:
Vitor Santos Costa 2013-11-20 22:20:51 +00:00
parent b76be1b33f
commit 48bec6b247
3 changed files with 222 additions and 69 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
C/adtdefs.c
View File

@ -1483,43 +1483,6 @@ ArgsOfSFTerm(Term t)
#endif
Int
Yap_NewSlots(int n USES_REGS)
{
Int old_slots = IntOfTerm(ASP[0]), oldn = n;
while (n > 0) {
RESET_VARIABLE(ASP);
ASP--;
n--;
}
ASP[0] = MkIntTerm(old_slots+oldn);
CurSlot = LCL0-ASP;
return((ASP+1)-LCL0);
}
Int
Yap_InitSlot(Term t USES_REGS)
{
Int old_slots = IntOfTerm(ASP[0]);
*ASP = t;
ASP--;
CurSlot ++;
ASP[0] = MkIntTerm(old_slots+1);
return((ASP+1)-LCL0);
}
int
Yap_RecoverSlots(int n USES_REGS)
{
Int old_slots = IntOfTerm(ASP[0]);
if (old_slots - n < 0) {
return FALSE;
}
ASP += n;
CurSlot -= n;
ASP[0] = MkIntTerm(old_slots-n);
return TRUE;
}
static HoldEntry *
InitAtomHold(void)

123
C/c_interface.c
View File

@ -1210,7 +1210,6 @@ YAP_cut_up(void)
pointer back to where cut_up called it. Slots depend on it. */
if (ENV > B->cp_env) {
ASP = B->cp_env;
Yap_PopSlots( PASS_REGS1 );
}
#ifdef YAPOR
{
@ -1636,16 +1635,67 @@ execute_cargs_back(PredEntry *pe, CPredicate exec_code, struct foreign_context *
}
}
static Int
complete_fail(choiceptr ptr, int has_cp USES_REGS)
{
// this case is easy, jut be sure to throw everything
// after the old B;
while (B != ptr) {
B = B->cp_b;
}
if (has_cp)
return do_cut( FALSE );
return FALSE;
}
static int
complete_exit(choiceptr ptr, int has_cp, int cut_all USES_REGS)
{
// the user often leaves open frames, especially in forward execuryion
while (B && (!ptr || B < ptr)) {
if (cut_all || B->cp_ap == NOCODE) {/* separator */
do_cut( TRUE ); // pushes B up
continue;
} else if (B->cp_ap->opc == RETRY_USERC_OPCODE && B->cp_b == ptr) {
// started the current choicepoint, I hope
return do_cut( TRUE );
} else
break; // oops, there is something else
}
if (!ptr || B < ptr) {
// we're still not there yet
choiceptr new = B;
while (new && new < ptr) {
if (new->cp_ap == NOCODE) /* separator */
new->cp_ap = FAILCODE; // there are choice-points above but at least, these won't harm innocent code
else if (new->cp_ap->opc == RETRY_USERC_OPCODE && new->cp_b == ptr) {
// I can't cut, but I can tag it as done
new->cp_ap = FAILCODE; // there are choice-points above but at least, these won't harm innocent code
}
new = new->cp_b;
}
}
if (has_cp) {
if (B == ptr) {
return do_cut( TRUE );
} else {
ptr->cp_ap = FAILCODE;
}
}
return TRUE;
}
Int
YAP_Execute(PredEntry *pe, CPredicate exec_code)
{
CACHE_REGS
Int ret;
Int OASP = LCL0-(CELL *)B;
// Term omod = CurrentModule;
//if (pe->PredFlags & CArgsPredFlag) {
// CurrentModule = pe->ModuleOfPred;
//}
Int CurSlot = Yap_StartSlots( PASS_REGS1 );
if (pe->PredFlags & SWIEnvPredFlag) {
CPredicateV codev = (CPredicateV)exec_code;
struct foreign_context ctx;
@ -1666,6 +1716,12 @@ YAP_Execute(PredEntry *pe, CPredicate exec_code)
ret = (exec_code)( PASS_REGS1 );
}
PP = NULL;
// check for junk: open frames, etc */
LOCAL_CurSlot = CurSlot;
if (ret)
complete_exit(((choiceptr)(LCL0-OASP)), FALSE, FALSE PASS_REGS);
else
complete_fail(((choiceptr)(LCL0-OASP)), FALSE PASS_REGS);
//CurrentModule = omod;
if (!ret) {
Term t;
@ -1689,12 +1745,13 @@ Int
YAP_ExecuteFirst(PredEntry *pe, CPredicate exec_code)
{
CACHE_REGS
CELL ocp = LCL0-(CELL *)B;
/* for slots to work */
Int CurSlot = Yap_StartSlots( PASS_REGS1 );
if (pe->PredFlags & (SWIEnvPredFlag|CArgsPredFlag)) {
Int val;
CPredicateV codev = (CPredicateV)exec_code;
struct foreign_context *ctx = (struct foreign_context *)(&EXTRA_CBACK_ARG(pe->ArityOfPE,1));
struct open_query_struct *oexec = LOCAL_execution;
extern void PL_close_foreign_frame(struct open_query_struct *);
PP = pe;
ctx->control = FRG_FIRST_CALL;
@ -1705,9 +1762,7 @@ YAP_ExecuteFirst(PredEntry *pe, CPredicate exec_code)
} else {
val = ((codev)(B->cp_args-LCL0,0,ctx));
}
/* make sure we clean up the frames left by the user */
while (LOCAL_execution != oexec)
PL_close_foreign_frame(LOCAL_execution);
LOCAL_CurSlot = CurSlot;
PP = NULL;
if (val == 0) {
Term t;
@ -1720,9 +1775,9 @@ YAP_ExecuteFirst(PredEntry *pe, CPredicate exec_code)
Yap_JumpToEnv(t);
return FALSE;
}
cut_fail();
return complete_fail(((choiceptr)(LCL0-ocp)), TRUE PASS_REGS);
} else if (val == 1) { /* TRUE */
cut_succeed();
return complete_exit(((choiceptr)(LCL0-ocp)), TRUE, FALSE PASS_REGS);
} else {
if ((val & REDO_PTR) == REDO_PTR)
ctx->context = (int *)(val & ~REDO_PTR);
@ -1758,22 +1813,19 @@ YAP_ExecuteOnCut(PredEntry *pe, CPredicate exec_code, struct cut_c_str *top)
Int val;
CPredicateV codev = (CPredicateV)exec_code;
struct foreign_context *ctx = (struct foreign_context *)(&EXTRA_CBACK_ARG(pe->ArityOfPE,1));
struct open_query_struct *oexec = LOCAL_execution;
extern void PL_close_foreign_frame(struct open_query_struct *);
CELL *args = B->cp_args;
B = oB;
PP = pe;
ctx->control = FRG_CUTTED;
ctx->engine = NULL; //(PL_local_data *)Yap_regp;
/* for slots to work */
Yap_StartSlots( PASS_REGS1 );
if (pe->PredFlags & CArgsPredFlag) {
val = execute_cargs_back(pe, exec_code, ctx PASS_REGS);
} else {
val = ((codev)(args-LCL0,0,ctx));
}
/* make sure we clean up the frames left by the user */
while (LOCAL_execution != oexec)
PL_close_foreign_frame(LOCAL_execution);
PP = NULL;
// B = LCL0-(CELL*)oB;
@ -1792,9 +1844,12 @@ YAP_ExecuteOnCut(PredEntry *pe, CPredicate exec_code, struct cut_c_str *top)
return TRUE;
}
} else {
Int ret;
Int ret, CurSlot;
B = oB;
/* for slots to work */
CurSlot = Yap_StartSlots( PASS_REGS1 );
ret = (exec_code)( PASS_REGS1 );
LOCAL_CurSlot = CurSlot;
if (!ret) {
Term t;
@ -1814,12 +1869,13 @@ Int
YAP_ExecuteNext(PredEntry *pe, CPredicate exec_code)
{
CACHE_REGS
/* for slots to work */
Int CurSlot = Yap_StartSlots( PASS_REGS1 );
UInt ocp = LCL0-(CELL *)B;
if (pe->PredFlags & (SWIEnvPredFlag|CArgsPredFlag)) {
Int val;
CPredicateV codev = (CPredicateV)exec_code;
struct foreign_context *ctx = (struct foreign_context *)(&EXTRA_CBACK_ARG(pe->ArityOfPE,1));
struct open_query_struct *oexec = LOCAL_execution;
extern void PL_close_foreign_frame(struct open_query_struct *);
PP = pe;
ctx->control = FRG_REDO;
@ -1828,9 +1884,9 @@ YAP_ExecuteNext(PredEntry *pe, CPredicate exec_code)
} else {
val = ((codev)(B->cp_args-LCL0,0,ctx));
}
LOCAL_CurSlot = CurSlot;
/* we are below the original choice point ?? */
/* make sure we clean up the frames left by the user */
while (LOCAL_execution != oexec)
PL_close_foreign_frame(LOCAL_execution);
PP = NULL;
if (val == 0) {
Term t;
@ -1843,10 +1899,10 @@ YAP_ExecuteNext(PredEntry *pe, CPredicate exec_code)
Yap_JumpToEnv(t);
return FALSE;
} else {
cut_fail();
return complete_fail(((choiceptr)(LCL0-ocp)), TRUE PASS_REGS);
}
} else if (val == 1) { /* TRUE */
cut_succeed();
return complete_exit(((choiceptr)(LCL0-ocp)), TRUE, FALSE PASS_REGS);
} else {
if ((val & REDO_PTR) == REDO_PTR)
ctx->context = (int *)(val & ~REDO_PTR);
@ -2251,8 +2307,6 @@ run_emulator(YAP_dogoalinfo *dgi USES_REGS)
LOCAL_PrologMode = UserMode;
out = Yap_absmi(0);
LOCAL_PrologMode = UserCCallMode;
if (out)
Yap_StartSlots(PASS_REGS1);
return out;
}
@ -2265,12 +2319,17 @@ YAP_EnterGoal(PredEntry *pe, Term *ptr, YAP_dogoalinfo *dgi)
BACKUP_MACHINE_REGS();
dgi->p = P;
dgi->cp = CP;
dgi->CurSlot = LOCAL_CurSlot;
// ensure our current ENV receives current P.
Yap_PrepGoal(pe->ArityOfPE, ptr, B PASS_REGS);
P = pe->CodeOfPred;
dgi->b = LCL0-(CELL*)B;
out = run_emulator(dgi PASS_REGS);
RECOVER_MACHINE_REGS();
if (out) {
LOCAL_CurSlot = dgi->CurSlot; // ignore any slots created within the called goal
Yap_StartSlots( PASS_REGS1 );
}
return out;
}
@ -2291,9 +2350,13 @@ YAP_RetryGoal(YAP_dogoalinfo *dgi)
P = FAILCODE;
/* make sure we didn't leave live slots when we backtrack */
ASP = (CELL *)B;
Yap_PopSlots( PASS_REGS1 );
LOCAL_CurSlot = dgi->CurSlot;
out = run_emulator(dgi PASS_REGS);
RECOVER_MACHINE_REGS();
if (out) {
LOCAL_CurSlot = dgi->CurSlot;
Yap_StartSlots( PASS_REGS1 );
}
return out;
}
@ -2343,7 +2406,6 @@ YAP_LeaveGoal(int backtrack, YAP_dogoalinfo *dgi)
/* ASP should be set to the top of the local stack when we
did the call */
ASP = B->cp_env;
Yap_PopSlots(PASS_REGS1);
/* YENV should be set to the current environment */
YENV = ENV = (CELL *)((B->cp_env)[E_E]);
B = B->cp_b;
@ -2351,6 +2413,7 @@ YAP_LeaveGoal(int backtrack, YAP_dogoalinfo *dgi)
HB = PROTECT_FROZEN_H(B);
CP = dgi->cp;
P = dgi->p;
LOCAL_CurSlot = dgi->CurSlot;
RECOVER_MACHINE_REGS();
return TRUE;
}
@ -2361,6 +2424,7 @@ YAP_RunGoal(Term t)
CACHE_REGS
Term out;
yamop *old_CP = CP;
Int CurSlot = LOCAL_CurSlot;
BACKUP_MACHINE_REGS();
LOCAL_AllowRestart = FALSE;
@ -2372,6 +2436,7 @@ YAP_RunGoal(Term t)
ENV = (CELL *)ENV[E_E];
CP = old_CP;
LOCAL_AllowRestart = TRUE;
// we are back to user code again, need slots */
Yap_StartSlots( PASS_REGS1 );
} else {
ENV = B->cp_env;
@ -2379,8 +2444,9 @@ YAP_RunGoal(Term t)
CP = old_CP;
B = B->cp_b;
LOCAL_AllowRestart = FALSE;
ASP = ENV;
LOCAL_CurSlot = CurSlot;
}
RECOVER_MACHINE_REGS();
return out;
}
@ -2451,13 +2517,11 @@ YAP_RunGoalOnce(Term t)
Term out;
yamop *old_CP = CP;
Int oldPrologMode = LOCAL_PrologMode;
Int oldSlot = CurSlot;
BACKUP_MACHINE_REGS();
LOCAL_PrologMode = UserMode;
out = Yap_RunTopGoal(t);
LOCAL_PrologMode = oldPrologMode;
CurSlot = oldSlot;
if (!(oldPrologMode & UserCCallMode)) {
/* called from top-level */
LOCAL_AllowRestart = FALSE;
@ -2509,8 +2573,6 @@ YAP_RestartGoal(void)
if (LOCAL_AllowRestart) {
P = (yamop *)FAILCODE;
LOCAL_PrologMode = UserMode;
// exec_absmi destroys slots on top of stack....
Yap_CloseSlots( PASS_REGS1 );
out = Yap_exec_absmi(TRUE);
LOCAL_PrologMode = UserCCallMode;
if (out == FALSE) {
@ -2557,7 +2619,6 @@ YAP_ShutdownGoal(int backtrack)
}
/* we can always recover the stack */
ASP = cut_pt->cp_env;
Yap_PopSlots( PASS_REGS1 );
ENV = (CELL *)ASP[E_E];
B = (choiceptr)ASP[E_CB];
Yap_TrimTrail();
@ -3237,8 +3298,6 @@ YAP_Reset(void)
ASP = (CELL *)B;
/* the first real choice-point will also have AP=FAIL */
/* always have an empty slots for people to use */
CurSlot = 0;
Yap_StartSlots( PASS_REGS1 );
P = CP = YESCODE;
RECOVER_MACHINE_REGS();
return res;

131
H/YapHandles.h Normal file
View File

@ -0,0 +1,131 @@
/*************************************************************************
* *
* YAP Prolog %W% %G% *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: YapHandles.h *
* mods: *
* comments: term handles for YAP: basic ops *
* version: $Id: Yap.h,v 1.38 2008-06-18 10:02:27 vsc Exp $ *
*************************************************************************/
#ifndef YAP_HANDLES_H
#define YAP_HANDLES_H 1
/*************************************************************************************************
slots
Also known as term handles, they provide a way to access terms without being exposed to stack shifts in gc.
They should always be used as local variables.
They are organized as follows:
---- Tagged Offset of next pointer in chain
---- Tagged Number of entries
Entry
Entry
Entry
Entry
---- Tagged Number of entries
They are not known to the yaam. Instead,
they are created when entering user code (see YAP_Execute* functions). They are also created:
- by SWI PL_foreign_frame function,
- by YAP_*Goal routines, when they exit successfully. Notice that all handles created by c-goals within
a *Goal execution should not be used afterwards.
*************************************************************************************************/
static inline Int
Yap_StartSlots( USES_REGS1 ) {
Int CurSlot = LOCAL_CurSlot;
// if (CurSlot == LCL0-(ASP+(IntOfTerm(ASP[0])+2)))
// return CurSlot;
/* new slot */
*--ASP = MkIntegerTerm(CurSlot);
LOCAL_CurSlot = LCL0-ASP;
*--ASP = MkIntTerm(0);
*--ASP = MkIntTerm(0);
return CurSlot;
}
static inline Int
Yap_CurrentSlot( USES_REGS1 ) {
return IntOfTerm(ASP[0]);
}
static inline Term
Yap_GetFromSlot(Int slot USES_REGS)
{
return(Deref(LCL0[slot]));
}
static inline Term
Yap_GetDerefedFromSlot(Int slot USES_REGS)
{
return LCL0[slot];
}
static inline Term
Yap_GetPtrFromSlot(Int slot USES_REGS)
{
return(LCL0[slot]);
}
static inline Term *
Yap_AddressFromSlot(Int slot USES_REGS)
{
return(LCL0+slot);
}
static inline void
Yap_PutInSlot(Int slot, Term t USES_REGS)
{
LCL0[slot] = t;
}
static inline Int
Yap_NewSlots(int n USES_REGS)
{
Int old_slots = IntOfTerm(ASP[0]), oldn = n;
while (n > 0) {
RESET_VARIABLE(ASP);
ASP--;
n--;
}
ASP[old_slots+oldn+1] = ASP[0] = MkIntTerm(old_slots+oldn);
return((ASP+1)-LCL0);
}
static inline Int
Yap_InitSlot(Term t USES_REGS)
{
Int old_slots = IntOfTerm(ASP[0]);
*ASP = t;
ASP--;
ASP[old_slots+2] = ASP[0] = MkIntTerm(old_slots+1);
return((ASP+1)-LCL0);
}
static inline int
Yap_RecoverSlots(int n USES_REGS)
{
Int old_slots = IntOfTerm(ASP[0]);
if (old_slots - n < 0) {
return FALSE;
}
ASP += n;
ASP[old_slots+(n-old_slots+1)] = ASP[0] = MkIntTerm(old_slots-n);
return TRUE;
}
#endif