fix throw (it should undo bindings).

This commit is contained in:
Vítor Santos Costa 2008-12-29 00:11:05 +00:00
parent 18d5fa12e4
commit 331d1830dd
3 changed files with 27 additions and 36 deletions

View File

@ -1495,7 +1495,6 @@ init_stack(int arity, CELL *pt, int top, choiceptr saved_b)
#endif #endif
YENV[E_CB] = Unsigned (B); YENV[E_CB] = Unsigned (B);
CP = YESCODE; CP = YESCODE;
} }
static Term static Term
@ -1507,7 +1506,6 @@ do_goal(Term t, yamop *CodeAdr, int arity, CELL *pt, int top)
init_stack(arity, pt, top, saved_b); init_stack(arity, pt, top, saved_b);
P = (yamop *) CodeAdr; P = (yamop *) CodeAdr;
S = CellPtr (RepPredProp (PredPropByFunc (Yap_MkFunctor(AtomCall, 1),0))); /* A1 mishaps */ S = CellPtr (RepPredProp (PredPropByFunc (Yap_MkFunctor(AtomCall, 1),0))); /* A1 mishaps */
S = CellPtr (RepPredProp (PredPropByFunc (Yap_MkFunctor(AtomCall, 1),0))); /* A1 mishaps */
out = exec_absmi(top); out = exec_absmi(top);
// if (out) { // if (out) {
@ -1879,6 +1877,8 @@ JumpToEnv(Term t) {
CELL *env; CELL *env;
choiceptr first_func = NULL, B0 = B; choiceptr first_func = NULL, B0 = B;
if (!Yap_SetGlobalVal(AtomHandleThrow,t))
return FALSE;
do { do {
/* find the first choicepoint that may be a catch */ /* find the first choicepoint that may be a catch */
while (B != NULL && B->cp_ap != pos) { while (B != NULL && B->cp_ap != pos) {
@ -1925,8 +1925,6 @@ JumpToEnv(Term t) {
B->cp_env = (CELL *)env[E_E]; B->cp_env = (CELL *)env[E_E];
/* cannot recover Heap because of copy term :-( */ /* cannot recover Heap because of copy term :-( */
B->cp_h = H; B->cp_h = H;
/* nor can I recover terms */
B->cp_tr = TR;
/* I could backtrack here, but it is easier to leave the unwinding /* I could backtrack here, but it is easier to leave the unwinding
to the emulator */ to the emulator */
B->cp_a3 = t; B->cp_a3 = t;
@ -2036,6 +2034,7 @@ Yap_InitYaamRegs(void)
WPP = NULL; WPP = NULL;
PREG_ADDR = NULL; PREG_ADDR = NULL;
#endif #endif
Yap_AllocateDefaultArena(1024, 2);
Yap_PreAllocCodeSpace(); Yap_PreAllocCodeSpace();
#ifdef CUT_C #ifdef CUT_C
cut_c_initialize(); cut_c_initialize();

View File

@ -240,31 +240,15 @@ p_default_arena_size(void)
} }
static Int void
p_allocate_default_arena(void) Yap_AllocateDefaultArena(Int gsize, Int attsize)
{ {
Term t = Deref(ARG1); GlobalArena = NewArena(gsize, 2, NULL);
Term t2 = Deref(ARG2);
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR,t,"allocate_arena");
return FALSE;
} else if (!IsIntegerTerm(t)) {
Yap_Error(TYPE_ERROR_INTEGER,t,"allocate_arena");
return FALSE;
}
if (IsVarTerm(t2)) {
Yap_Error(INSTANTIATION_ERROR,t2,"allocate_arena");
return FALSE;
} else if (!IsIntegerTerm(t)) {
Yap_Error(TYPE_ERROR_INTEGER,t2,"allocate_arena");
return FALSE;
}
GlobalArena = NewArena(IntegerOfTerm(t), 2, NULL);
#if COROUTINING #if COROUTINING
GlobalDelayArena = NewDelayArena(2); GlobalDelayArena = NewDelayArena(attsize);
#endif #endif
return TRUE;
} }
static void static void
adjust_cps(UInt size) adjust_cps(UInt size)
{ {
@ -1186,11 +1170,25 @@ p_nb_linkval(void)
return TRUE; return TRUE;
} }
int
Yap_SetGlobalVal(Atom at, Term t0)
{
Term to;
GlobalEntry *ge;
ge = GetGlobalEntry(at);
to = CopyTermToArena(t0, GlobalArena, FALSE, 2, &GlobalArena, &GlobalDelayArena, garena_overflow_size(ArenaPt(GlobalArena)));
if (to == 0L)
return FALSE;
WRITE_LOCK(ge->GRWLock);
ge->global=to;
WRITE_UNLOCK(ge->GRWLock);
return TRUE;
}
static Int static Int
p_nb_setval(void) p_nb_setval(void)
{ {
Term t = Deref(ARG1), to; Term t = Deref(ARG1);
GlobalEntry *ge;
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR,t,"nb_setval"); Yap_Error(INSTANTIATION_ERROR,t,"nb_setval");
return (TermNil); return (TermNil);
@ -1198,14 +1196,7 @@ p_nb_setval(void)
Yap_Error(TYPE_ERROR_ATOM,t,"nb_setval"); Yap_Error(TYPE_ERROR_ATOM,t,"nb_setval");
return (FALSE); return (FALSE);
} }
ge = GetGlobalEntry(AtomOfTerm(t)); return Yap_SetGlobalVal(AtomOfTerm(t), ARG2);
to = CopyTermToArena(ARG2, GlobalArena, FALSE, 2, &GlobalArena, &GlobalDelayArena, garena_overflow_size(ArenaPt(GlobalArena)));
if (to == 0L)
return FALSE;
WRITE_LOCK(ge->GRWLock);
ge->global=to;
WRITE_UNLOCK(ge->GRWLock);
return TRUE;
} }
static Int static Int
@ -2555,7 +2546,6 @@ void Yap_InitGlobals(void)
{ {
Term cm = CurrentModule; Term cm = CurrentModule;
Yap_InitCPred("$allocate_arena", 2, p_allocate_arena, 0); Yap_InitCPred("$allocate_arena", 2, p_allocate_arena, 0);
Yap_InitCPred("$allocate_default_arena", 2, p_allocate_default_arena, 0);
Yap_InitCPred("arena_size", 1, p_default_arena_size, 0); Yap_InitCPred("arena_size", 1, p_default_arena_size, 0);
Yap_InitCPred("b_setval", 2, p_b_setval, SafePredFlag); Yap_InitCPred("b_setval", 2, p_b_setval, SafePredFlag);
Yap_InitCPred("b_getval", 2, p_nb_getval, SafePredFlag); Yap_InitCPred("b_getval", 2, p_nb_getval, SafePredFlag);

View File

@ -185,6 +185,8 @@ void STD_PROTO(Yap_inform_profiler_of_clause,(struct yami *,struct yami *,struct
/* globals.c */ /* globals.c */
Term STD_PROTO(Yap_NewArena,(UInt,CELL *)); Term STD_PROTO(Yap_NewArena,(UInt,CELL *));
void STD_PROTO(Yap_InitGlobals,(void)); void STD_PROTO(Yap_InitGlobals,(void));
int STD_PROTO(Yap_SetGlobalVal, (Atom, Term));
void STD_PROTO(Yap_AllocateDefaultArena, (Int, Int));
/* grow.c */ /* grow.c */
Int STD_PROTO(Yap_total_stack_shift_time,(void)); Int STD_PROTO(Yap_total_stack_shift_time,(void));