state store and restore for paralell engines implemented

parent 838c6028
......@@ -150,6 +150,8 @@
gp-push-engine
gp-peek-engine
gp-combine-engines
gp-combine-pop
gp-combine-push
gp-combine-state
gp-current-engine-path
))
......
(define-module (logic guile-log paralell)
#:use-module (logic guile-log)
#:use-module (logic guile-log code-load)
#:use-module (logic guile-log umatch)
#:export (<pand> <pzip> f test1 test2 test3 test4))
......@@ -28,10 +29,12 @@
(<with-s> s
(<pit> s p ccc
(<with-fail> p
(<with-s> (gp-push-engine frame engine)
(<with-s> (gp-push-engine frame engine)
(<code> (gp-combine-push data))
(<code> (gp-var-set v (gp-peek-engine) S))
code ...
(<code> (set! se S))
(<code> (gp-combine-pop))
(<code> (gp-pop-engine))))))
...
(<with-s> (gp-combine-state s (list se ...))
......
......@@ -1548,8 +1548,8 @@ SCM_DEFINE(gp_pop_engine, "gp-pop-engine", 0, 0, 0, (),
SCM s_stack = SCM_CAR(gp_engine_path);
gp_engine_path = SCM_CDR(gp_engine_path);
gp_store_path = SCM_CDR(gp_store_path);
scm_fluid_set_x(gp_current_stack, SCM_CDR(SCM_CAR(gp_engine_path)));
if(!SCM_CONSP(gp_engine_path))
......@@ -1674,11 +1674,34 @@ SCM_DEFINE(gp_combine_engines, "gp-combine-engines", 1, 0, 0, (SCM l),
gp->gp_ci[0] = vec;
gp->gp_ci++;
gp_store_path = scm_cons(vec, gp_store_path);
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
SCM_DEFINE(gp_combine_pop, "gp-combine-pop", 0, 0, 0, (),
"")
#define FUNC_NAME s_gp_combine_pop
{
SCM ret = SCM_CAR(gp_store_path);
gp_store_path = SCM_CDR(gp_store_path);
return ret;
}
#undef FUNC_NAME
SCM_DEFINE(gp_combine_push, "gp-combine-push", 1, 0, 0, (SCM r),
"")
#define FUNC_NAME s_gp_combine_push
{
gp_store_path = scm_cons(r, gp_store_path);
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
SCM_DEFINE(gp_combine_state, "gp-combine-state", 2, 0, 0, (SCM s, SCM l),
"")
#define FUNC_NAME s_gp_combine_engine
......
......@@ -1349,6 +1349,7 @@ SCM_DEFINE(gp_gp_store_state, "gp-store-state", 1, 0, 0, (SCM s),
// We must make sure that we guard the state if the vlist
// Else trunction will make it fail.
gp_no_gc();
if(GP_CONSP(s))
{
SCM l = GP_GETREF(s)[2];
......@@ -1360,9 +1361,73 @@ SCM_DEFINE(gp_gp_store_state, "gp-store-state", 1, 0, 0, (SCM s),
ret = scm_cons(gp_store_state(get_gp()),
scm_cons(scm_fluid_ref(gp_current_stack) , s));
SCM lpath = gp_store_path;
SCM llpath = SCM_EOL;
SCM k = gp_engine_path;
int first = 1;
while(SCM_CONSP(lpath))
{
SCM l = SCM_CAR(lpath);
SCM ll = SCM_EOL;
SCM tag = SCM_CAR(k);
k = SCM_CDR(k);
while(SCM_CONSP(l))
{
SCM x = SCM_CAR(l);
if(GP(x) && GP_UNBOUND(GP_GETREF(x)))
ll = scm_cons(SCM_BOOL_F, ll);
else
{
SCM xx = GP_GETREF(x)[1];
if(first && scm_is_eq(xx, tag))
{
first = 0;
ll = ret;
continue;
}
SCM e = SCM_CDR(xx);
SCM s = SCM_CAR(xx);
SCM olde = scm_fluid_ref(gp_current_stack);
scm_fluid_set_x(gp_current_stack, e);
SCM r = scm_cons(gp_store_state(get_gp()),
scm_cons(e , s));
scm_fluid_set_x(gp_current_stack, olde);
ll = scm_cons(r, ll);
}
}
SCM vecout = scm_reverse(ll);
}
if(SCM_CONSP(gp_store_path))
{
SCM xx = SCM_CAR(k);
SCM e = SCM_CDR(xx);
SCM s = SCM_CAR(xx);
SCM olde = scm_fluid_ref(gp_current_stack);
scm_fluid_set_x(gp_current_stack, e);
SCM r = scm_cons(gp_store_state(get_gp()),
scm_cons(e , s));
scm_fluid_set_x(gp_current_stack, olde);
llpath = scm_cons(r, llpath);
}
else
llpath = scm_cons(ret, llpath);
gp_do_gc();
return ret;
return scm_cons(gp_store_path,
scm_cons(gp_engine_path,
scm_cons(ret, llpath)));
}
#undef FUNC_NAME
......@@ -1953,17 +2018,121 @@ static void gp_restore_state(SCM data, struct gp_stack *gp, SCM K)
//#define DB(X)
/*
we have the current state as [a,...,b,...]
we have the restore state as [c,...,b,...]
So we need to unwind to [b,...] first
then we need to resore all paths back to c
and finally restore the current engine
*/
SCM_DEFINE(gp_gp_restore_state, "gp-restore-state", 2, 0, 0, (SCM cont, SCM K),
"restore a continuation point")
#define FUNC_NAME s_gp_gp_restore_state
{
gp_no_gc();
if(SCM_CONSP(cont))
// Unpack level 1
SCM spath = SCM_CAR(cont);
SCM spathl = SCM_CDR(cont);
SCM epath = SCM_CAR(spathl);
SCM epathl = SCM_CDR(spathl);
SCM lpath = SCM_CDR(epathl);
cont = SCM_CAR(epathl);
//First we clear the head of the states
int ncur = scm_to_int(scm_length(gp_engine_path));
int nnew = scm_to_int(scm_length(epath));
// make ncur == nnew
while(ncur > nnew)
{
scm_fluid_set_x(gp_current_stack, SCM_CADR(cont));
struct gp_stack *gp = get_gp();
gp_restore_state(SCM_CAR(cont), gp, K);
SCM x = SCM_CAR(gp_engine_path);
SCM e = SCM_CDR(x);
SCM s = SCM_CAR(x);
scm_fluid_set_x(gp_current_stack, e);
gp_clear(s);
gp_engine_path = SCM_CDR(gp_engine_path);
ncur--;
}
while(nnew > ncur)
{
epath = SCM_CDR(epath);
nnew--;
}
// Unwind all stack frames untill the common b,...
while(ncur > 0)
{
if(scm_is_eq(SCM_CDAR(gp_engine_path), SCM_CDAR(epath)))
break;
SCM x = SCM_CAR(gp_engine_path);
SCM e = SCM_CDR(x);
SCM s = SCM_CAR(x);
scm_fluid_set_x(gp_current_stack, e);
gp_clear(s);
gp_engine_path = SCM_CDR(gp_engine_path);
epath = SCM_CDR(epath);
ncur--;
}
SCM dcont = SCM_CAR(lpath);
{
scm_fluid_set_x(gp_current_stack, SCM_CADR(dcont));
struct gp_stack *gp = get_gp();
gp_restore_state(SCM_CAR(dcont), gp, K);
if(scm_is_eq(dcont, cont))
{
gp_do_gc();
gp_engine_path = epath;
gp_store_path = spath;
return SCM_UNSPECIFIED;
}
}
lpath = SCM_CDR(lpath);
while(SCM_CONSP(lpath))
{
SCM ll = SCM_CAR(lpath);
int found = 0;
while(SCM_CONSP(ll))
{
SCM dcont = SCM_CAR(ll);
if(scm_is_eq(dcont, cont))
found = 1;
else
{
scm_fluid_set_x(gp_current_stack, SCM_CADR(dcont));
struct gp_stack *gp = get_gp();
gp_restore_state(SCM_CAR(dcont), gp, K);
}
}
if(found)
{
scm_fluid_set_x(gp_current_stack, SCM_CADR(dcont));
struct gp_stack *gp = get_gp();
gp_restore_state(SCM_CAR(dcont), gp, K);
gp_engine_path = epath;
gp_store_path = spath;
gp_do_gc();
return SCM_UNSPECIFIED;
}
}
gp_engine_path = epath;
gp_store_path = spath;
gp_do_gc();
return SCM_UNSPECIFIED;
}
......
......@@ -31,6 +31,7 @@ SCM tester = SCM_BOOL_F;
SCM inline get_cs(SCM v);
SCM gp_engine_path = SCM_EOL;
SCM gp_store_path = SCM_EOL;
SCM gp_current_stack = SCM_BOOL_F;
SCM current_stack = SCM_BOOL_F;
......
......@@ -161,6 +161,8 @@ SCM_API SCM gp_code_to_int(SCM x);
SCM_API SCM gp_make_null_procedure(SCM n, SCM def);
SCM_API SCM gp_fill_null_procedure(SCM proc, SCM addr, SCM l);
SCM_API SCM gp_combine_pop();
SCM_API SCM gp_combine_push(SCM r);
SCM_API SCM gp_new_engine(SCM e);
SCM_API SCM gp_set_engine(SCM path);
SCM_API SCM gp_restore_engine_guards(SCM cont);
......
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