paralell engines improvement

parent cce39ef3
...@@ -34,7 +34,6 @@ ...@@ -34,7 +34,6 @@
(<code> (gp-var-set v (gp-peek-engine) S)) (<code> (gp-var-set v (gp-peek-engine) S))
code ... code ...
(<code> (set! se S)) (<code> (set! se S))
(<code> (gp-combine-pop))
(<code> (gp-pop-engine)))))) (<code> (gp-pop-engine))))))
... ...
(<with-s> (gp-combine-state s (list se ...)) (<with-s> (gp-combine-state s (list se ...))
......
...@@ -1549,7 +1549,9 @@ SCM_DEFINE(gp_pop_engine, "gp-pop-engine", 0, 0, 0, (), ...@@ -1549,7 +1549,9 @@ SCM_DEFINE(gp_pop_engine, "gp-pop-engine", 0, 0, 0, (),
SCM s_stack = SCM_CAR(gp_engine_path); SCM s_stack = SCM_CAR(gp_engine_path);
gp_store_path = SCM_CDR(gp_store_path); gp_store_path = SCM_CDR(gp_store_path);
gp_paths = scm_cons(gp_engine_path, gp_store_path);
scm_fluid_set_x(gp_current_stack, SCM_CDR(SCM_CAR(gp_engine_path))); scm_fluid_set_x(gp_current_stack, SCM_CDR(SCM_CAR(gp_engine_path)));
if(!SCM_CONSP(gp_engine_path)) if(!SCM_CONSP(gp_engine_path))
...@@ -1586,6 +1588,9 @@ SCM_DEFINE(gp_push_engine, "gp-push-engine", 2, 0, 0, (SCM s, SCM e), ...@@ -1586,6 +1588,9 @@ SCM_DEFINE(gp_push_engine, "gp-push-engine", 2, 0, 0, (SCM s, SCM e),
struct gp_stack *gp = get_gp(); struct gp_stack *gp = get_gp();
int logical = gp->_logical_; int logical = gp->_logical_;
gp_engine_path = scm_cons(x , gp_engine_path); gp_engine_path = scm_cons(x , gp_engine_path);
gp_paths = scm_cons(gp_engine_path, SCM_BOOL_F);
scm_fluid_set_x(gp_current_stack,e); scm_fluid_set_x(gp_current_stack,e);
gp = get_gp(); gp = get_gp();
...@@ -1609,7 +1614,7 @@ SCM_DEFINE(gp_push_engine, "gp-push-engine", 2, 0, 0, (SCM s, SCM e), ...@@ -1609,7 +1614,7 @@ SCM_DEFINE(gp_push_engine, "gp-push-engine", 2, 0, 0, (SCM s, SCM e),
cdr = scm_cons(SCM_EOL,SCM_EOL); cdr = scm_cons(SCM_EOL,SCM_EOL);
} }
ss = scm_cons(carss , scm_cons(SCM_CAR(cdr), gp_engine_path)); ss = scm_cons(carss , scm_cons(SCM_CAR(cdr), gp_paths));
SCM_SETCAR(x, s); SCM_SETCAR(x, s);
...@@ -1622,13 +1627,18 @@ SCM_DEFINE(gp_new_engine, "gp-new-engine", 1, 0, 0, (SCM e), ...@@ -1622,13 +1627,18 @@ SCM_DEFINE(gp_new_engine, "gp-new-engine", 1, 0, 0, (SCM e),
#define FUNC_NAME s_gp_new_engine #define FUNC_NAME s_gp_new_engine
{ {
SCM x = scm_cons(SCM_EOL,e); SCM x = scm_cons(SCM_EOL,e);
SCM path = gp_engine_path; SCM path = gp_paths;
gp_debug0("Push Engine>\n"); gp_debug0("Push Engine>\n");
gp_engine_path = scm_cons(x , SCM_EOL); gp_engine_path = scm_cons(x , SCM_EOL);
gp_paths = scm_cons(gp_engine_path, SCM_EOL);
gp_store_path = SCM_EOL;
scm_fluid_set_x(gp_current_stack,e); scm_fluid_set_x(gp_current_stack,e);
{ {
...@@ -1638,7 +1648,7 @@ SCM_DEFINE(gp_new_engine, "gp-new-engine", 1, 0, 0, (SCM e), ...@@ -1638,7 +1648,7 @@ SCM_DEFINE(gp_new_engine, "gp-new-engine", 1, 0, 0, (SCM e),
SCM carss = gp_car(ss,ss); SCM carss = gp_car(ss,ss);
SCM cdr = scm_cons(SCM_EOL, gp_engine_path); SCM cdr = scm_cons(SCM_EOL, gp_paths);
ss = scm_cons(carss , cdr); ss = scm_cons(carss , cdr);
...@@ -1648,15 +1658,18 @@ SCM_DEFINE(gp_new_engine, "gp-new-engine", 1, 0, 0, (SCM e), ...@@ -1648,15 +1658,18 @@ SCM_DEFINE(gp_new_engine, "gp-new-engine", 1, 0, 0, (SCM e),
#undef FUNC_NAME #undef FUNC_NAME
SCM_DEFINE(gp_set_engine, "gp-set-engine", 1, 0, 0, (SCM path), SCM_DEFINE(gp_set_engine, "gp-set-engine", 1, 0, 0, (SCM paths),
"") "")
#define FUNC_NAME s_gp_set_engine #define FUNC_NAME s_gp_set_engine
{ {
SCM e = SCM_CDR(SCM_CAR(path)); SCM e = SCM_CDR(SCM_CAR(paths));
SCM pathout = gp_engine_path; SCM pathout = gp_paths;
gp_engine_path = path; gp_engine_path = SCM_CAR(paths);
gp_store_path = SCM_CDR(paths);
gp_paths = paths;
scm_fluid_set_x(gp_current_stack,e); scm_fluid_set_x(gp_current_stack,e);
return pathout; return pathout;
...@@ -1676,6 +1689,7 @@ SCM_DEFINE(gp_combine_engines, "gp-combine-engines", 1, 0, 0, (SCM l), ...@@ -1676,6 +1689,7 @@ SCM_DEFINE(gp_combine_engines, "gp-combine-engines", 1, 0, 0, (SCM l),
gp->gp_ci++; gp->gp_ci++;
gp_store_path = scm_cons(vec, gp_store_path); gp_store_path = scm_cons(vec, gp_store_path);
SCM_SETCDR(gp_paths, gp_store_path);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
......
...@@ -897,11 +897,17 @@ static inline void gp_unwind_(SCM s , int ncons, int nvar, int nci, ...@@ -897,11 +897,17 @@ static inline void gp_unwind_(SCM s , int ncons, int nvar, int nci,
SCM path, SCM lpath) SCM path, SCM lpath)
{ {
SCM lt = SCM_EOL; SCM lt = SCM_EOL;
SCM spath = gp_store_path;
SCM paths = gp_paths;
if(scm_is_false(lpath)) if(scm_is_false(lpath))
{ {
lt = gp_gp_cdr(s,s); lt = gp_gp_cdr(s,s);
if(SCM_CONSP(lt)) if(SCM_CONSP(lt))
path = SCM_CDR(lt); {
paths = SCM_CADR(lt);
path = SCM_CAR(paths);
spath = SCM_CDR(paths);
}
else else
path = gp_engine_path; path = gp_engine_path;
...@@ -955,6 +961,9 @@ static inline void gp_unwind_(SCM s , int ncons, int nvar, int nci, ...@@ -955,6 +961,9 @@ static inline void gp_unwind_(SCM s , int ncons, int nvar, int nci,
{ {
if(scm_is_true(lpath)) if(scm_is_true(lpath))
{ {
gp_store_path = spath;
gp_paths = paths;
s = SCM_CAR(lpath); s = SCM_CAR(lpath);
lpath = SCM_CDR(lpath); lpath = SCM_CDR(lpath);
ncons = scm_to_int(SCM_CAR(lpath)); ncons = scm_to_int(SCM_CAR(lpath));
...@@ -1425,9 +1434,8 @@ SCM_DEFINE(gp_gp_store_state, "gp-store-state", 1, 0, 0, (SCM s), ...@@ -1425,9 +1434,8 @@ SCM_DEFINE(gp_gp_store_state, "gp-store-state", 1, 0, 0, (SCM s),
gp_do_gc(); gp_do_gc();
return scm_cons(gp_store_path, return scm_cons(gp_paths,
scm_cons(gp_engine_path, scm_cons(ret, llpath));
scm_cons(ret, llpath)));
} }
#undef FUNC_NAME #undef FUNC_NAME
...@@ -2035,12 +2043,12 @@ SCM_DEFINE(gp_gp_restore_state, "gp-restore-state", 2, 0, 0, (SCM cont, SCM K), ...@@ -2035,12 +2043,12 @@ SCM_DEFINE(gp_gp_restore_state, "gp-restore-state", 2, 0, 0, (SCM cont, SCM K),
gp_no_gc(); gp_no_gc();
// Unpack level 1 // Unpack level 1
SCM spath = SCM_CAR(cont); SCM paths = SCM_CAR(cont);
SCM spathl = SCM_CDR(cont); SCM pathsl = SCM_CDR(cont);
SCM epath = SCM_CAR(spathl); SCM spath = SCM_CDR(paths);
SCM epathl = SCM_CDR(spathl); SCM epath = SCM_CAR(paths);
SCM lpath = SCM_CDR(epathl); SCM lpath = SCM_CDR(pathsl);
cont = SCM_CAR(epathl); cont = SCM_CAR(pathsl);
//First we clear the head of the states //First we clear the head of the states
...@@ -2133,6 +2141,8 @@ SCM_DEFINE(gp_gp_restore_state, "gp-restore-state", 2, 0, 0, (SCM cont, SCM K), ...@@ -2133,6 +2141,8 @@ SCM_DEFINE(gp_gp_restore_state, "gp-restore-state", 2, 0, 0, (SCM cont, SCM K),
gp_engine_path = epath; gp_engine_path = epath;
gp_store_path = spath; gp_store_path = spath;
gp_paths = paths;
gp_do_gc(); gp_do_gc();
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
......
...@@ -32,6 +32,7 @@ SCM inline get_cs(SCM v); ...@@ -32,6 +32,7 @@ SCM inline get_cs(SCM v);
SCM gp_engine_path = SCM_EOL; SCM gp_engine_path = SCM_EOL;
SCM gp_store_path = SCM_EOL; SCM gp_store_path = SCM_EOL;
SCM gp_paths = SCM_EOL;
SCM gp_current_stack = SCM_BOOL_F; SCM gp_current_stack = SCM_BOOL_F;
SCM current_stack = SCM_BOOL_F; SCM current_stack = SCM_BOOL_F;
...@@ -1263,7 +1264,7 @@ static inline SCM gp_newframe(SCM s) ...@@ -1263,7 +1264,7 @@ static inline SCM gp_newframe(SCM s)
else else
{ {
s = SCM_PACK(0); s = SCM_PACK(0);
l = scm_cons(SCM_EOL, gp_engine_path); l = scm_cons(SCM_EOL, gp_paths);
} }
if(scm_is_eq(l, SCM_UNBOUND)) if(scm_is_eq(l, SCM_UNBOUND))
...@@ -1326,7 +1327,7 @@ static inline SCM gp_newframe_choice(SCM s) ...@@ -1326,7 +1327,7 @@ static inline SCM gp_newframe_choice(SCM s)
else else
{ {
s = SCM_PACK(0); s = SCM_PACK(0);
l = scm_cons(SCM_EOL,gp_engine_path); l = scm_cons(SCM_EOL,gp_paths);
} }
if(scm_is_eq(l, SCM_UNBOUND)) if(scm_is_eq(l, SCM_UNBOUND))
......
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