persistance now works a little again

parent c7d10417
......@@ -157,6 +157,11 @@ inline SCM logical_lookup3(SCM x, SCM l)
retry:
gp_debug0("logical3\n");
if(!vlist_p(l))
scm_misc_error("lookup",
"nota vlist: ~a",
scm_list_1(l));
v = vhash_assq_unify(x,l);
if(!scm_is_eq(v, SCM_UNSPECIFIED))
......
......@@ -535,6 +535,9 @@ gp_stack_mark0(SCM obj, int unlocked,
GC_MARK(GP_UNREF(gp->gp_stack));
GC_MARK(GP_UNREF(gp->gp_cons_stack));
//The first frame needs to be referenced
GC_MARK(gp->gp_cstack[0]);
GC_MARK(gp->gp_frstack[0]);
GC_MARK(gp->gp_frstack[1]);
GC_MARK(gp->gp_frstack[2]);
......
......@@ -650,10 +650,7 @@ static void gp_unwind0(SCM *fr, SCM *ci, SCM *si, SCM *cs, struct gp_stack *gp)
if(si_store)
{
gp_debug0("store\n");
if(GP(*i))
{
*i = SCM_BOOL_F;
}
*i = SCM_BOOL_F;
}
else
{
......@@ -694,10 +691,7 @@ static void gp_unwind0(SCM *fr, SCM *ci, SCM *si, SCM *cs, struct gp_stack *gp)
if(cs_store)
{
gp_debug0("store\n");
if(GP(*i))
{
*i = SCM_BOOL_F;
}
*i = SCM_BOOL_F;
}
else
{
......@@ -1311,6 +1305,9 @@ static int gp_rewind(SCM pp, SCM pend, struct gp_stack *gp)
}
gp_debug0("entering a do rewind frame\n");
if(gp->gp_ci == gp->gp_cstack + 1)
gp->gp_ci[-1] = pend;
sp--;
while(sp >= 0)
......@@ -1417,11 +1414,16 @@ static int gp_rewind_fr(SCM pp, SCM pend, struct gp_stack *gp)
gp_debug0("entering a do rewind frame\n");
if(gp->gp_fr == gp->gp_frstack + GP_FRAMESIZE)
{
gp->gp_fr[-1] = pp;
}
sp--;
while(sp >= 0)
{
gp_debug1("iter> fr = %p\n", gp->gp_fr - gp->gp_cstack);
pp = stack[sp];
pp = stack[sp];
q = SCM_CAR(pp);
int i = 0;
......@@ -1686,6 +1688,9 @@ static void gp_restore_state(SCM data, struct gp_stack *gp, SCM K)
gp_debug0("check ci stack\n");
check("valstack", ci, pp_c, path);
gp_format2("=========pp_c=======~%~a~%========pp_x========~%~a~%",
pp_c, pp_x);
gp_debug0("rewind ci\n");
gp_rewind(path, pp_c, gp);
......@@ -1792,4 +1797,4 @@ SCM_DEFINE(gp_add_unwind_hook, "gp-add-unwind-hook", 1, 0, 0, (SCM x),
}
#undef FUNC_NAME
#define DB(X)
//#define DB(X)
......@@ -431,7 +431,7 @@ static inline SCM gp_make_closure_heap(int n, SCM **closure)
s = scm_cons(fr,lnew); \
}
inline SCM gp_make_s(SCM ci, SCM *l)
inline SCM gp_make_s(SCM frci, SCM *l)
{
SCM ll;
if(vlist_p(l[0]))
......@@ -441,7 +441,7 @@ inline SCM gp_make_s(SCM ci, SCM *l)
{
ll = l[0];
}
return scm_cons(ci,ll);
return scm_cons(frci,ll);
}
static inline void gp_store_var_2(SCM *id, int simple, struct gp_stack *gp)
......@@ -4086,8 +4086,7 @@ SCM_DEFINE(gp_verify_gp, "gp-ok?",1,0,0,(SCM x),"")
SCM_DEFINE(gp_make_pure_cons, "gp-make-pure-cons",0,0,0,(),"")
{
struct gp_stack *gp = get_gp();
return GP_UNREF(get_gp_cons_pure(gp));
return GP_UNREF(gp_make_cons());
}
SCM_DEFINE(gp_cons_set_1_x, "gp-cons-set-1!",2,0,0,(SCM c, SCM x),"")
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment