fix throw (it should undo bindings).
This commit is contained in:
parent
18d5fa12e4
commit
331d1830dd
7
C/exec.c
7
C/exec.c
@ -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();
|
||||||
|
54
C/globals.c
54
C/globals.c
@ -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);
|
||||||
|
@ -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));
|
||||||
|
Reference in New Issue
Block a user