From 48bec6b247cb27504f83eb5eab659333cdd056b0 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Wed, 20 Nov 2013 22:20:51 +0000 Subject: [PATCH] fix broken, complicated code for slots --- C/adtdefs.c | 37 -------------- C/c_interface.c | 123 +++++++++++++++++++++++++++++++++------------ H/YapHandles.h | 131 ++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 222 insertions(+), 69 deletions(-) create mode 100644 H/YapHandles.h diff --git a/C/adtdefs.c b/C/adtdefs.c index 18b0954ce..86e456c7c 100755 --- a/C/adtdefs.c +++ b/C/adtdefs.c @@ -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) diff --git a/C/c_interface.c b/C/c_interface.c index 91335835e..ee3a33d7a 100644 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -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; diff --git a/H/YapHandles.h b/H/YapHandles.h new file mode 100644 index 000000000..90f8a05cc --- /dev/null +++ b/H/YapHandles.h @@ -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