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

fix throw (it should undo bindings).

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
C/exec.c
View File

@ -1495,7 +1495,6 @@ init_stack(int arity, CELL *pt, int top, choiceptr saved_b)
#endif
YENV[E_CB] = Unsigned (B);
CP = YESCODE;
}
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);
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 */
out = exec_absmi(top);
// if (out) {
@ -1879,6 +1877,8 @@ JumpToEnv(Term t) {
CELL *env;
choiceptr first_func = NULL, B0 = B;
if (!Yap_SetGlobalVal(AtomHandleThrow,t))
return FALSE;
do {
/* find the first choicepoint that may be a catch */
while (B != NULL && B->cp_ap != pos) {
@ -1925,8 +1925,6 @@ JumpToEnv(Term t) {
B->cp_env = (CELL *)env[E_E];
/* cannot recover Heap because of copy term :-( */
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
to the emulator */
B->cp_a3 = t;
@ -2036,6 +2034,7 @@ Yap_InitYaamRegs(void)
WPP = NULL;
PREG_ADDR = NULL;
#endif
Yap_AllocateDefaultArena(1024, 2);
Yap_PreAllocCodeSpace();
#ifdef CUT_C
cut_c_initialize();

54
C/globals.c
View File

@ -240,31 +240,15 @@ p_default_arena_size(void)
}
static Int
p_allocate_default_arena(void)
void
Yap_AllocateDefaultArena(Int gsize, Int attsize)
{
Term t = Deref(ARG1);
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);
GlobalArena = NewArena(gsize, 2, NULL);
#if COROUTINING
GlobalDelayArena = NewDelayArena(2);
GlobalDelayArena = NewDelayArena(attsize);
#endif
return TRUE;
}
static void
adjust_cps(UInt size)
{
@ -1186,11 +1170,25 @@ p_nb_linkval(void)
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
p_nb_setval(void)
{
Term t = Deref(ARG1), to;
GlobalEntry *ge;
Term t = Deref(ARG1);
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR,t,"nb_setval");
return (TermNil);
@ -1198,14 +1196,7 @@ p_nb_setval(void)
Yap_Error(TYPE_ERROR_ATOM,t,"nb_setval");
return (FALSE);
}
ge = GetGlobalEntry(AtomOfTerm(t));
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;
return Yap_SetGlobalVal(AtomOfTerm(t), ARG2);
}
static Int
@ -2555,7 +2546,6 @@ void Yap_InitGlobals(void)
{
Term cm = CurrentModule;
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("b_setval", 2, p_b_setval, SafePredFlag);
Yap_InitCPred("b_getval", 2, p_nb_getval, SafePredFlag);

2
H/Yapproto.h
View File

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