Skip to content
Projects
Groups
Snippets
Help
This project
Loading...
Sign in / Register
Toggle navigation
G
Guile Log
Overview
Overview
Details
Activity
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Locked Files
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
Wiki
Wiki
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Commits
Issue Boards
Open sidebar
gule-log
Guile Log
Commits
cce39ef3
Commit
cce39ef3
authored
Sep 24, 2016
by
Stefan Israelsson Tampe
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
state store and restore for paralell engines implemented
parent
838c6028
Hide whitespace changes
Inline
Side-by-side
Showing
6 changed files
with
208 additions
and
8 deletions
+208
-8
code-load.scm
logic/guile-log/code-load.scm
+2
-0
paralell.scm
logic/guile-log/paralell.scm
+4
-1
state.c
logic/guile-log/src/state.c
+25
-2
unify-undo-redo.c
logic/guile-log/src/unify-undo-redo.c
+174
-5
unify.c
logic/guile-log/src/unify.c
+1
-0
unify.h
logic/guile-log/src/unify.h
+2
-0
No files found.
logic/guile-log/code-load.scm
View file @
cce39ef3
...
@@ -150,6 +150,8 @@
...
@@ -150,6 +150,8 @@
gp-push-engine
gp-push-engine
gp-peek-engine
gp-peek-engine
gp-combine-engines
gp-combine-engines
gp-combine-pop
gp-combine-push
gp-combine-state
gp-combine-state
gp-current-engine-path
gp-current-engine-path
))
))
...
...
logic/guile-log/paralell.scm
View file @
cce39ef3
(
define-module
(
logic
guile-log
paralell
)
(
define-module
(
logic
guile-log
paralell
)
#
:use-module
(
logic
guile-log
)
#
:use-module
(
logic
guile-log
)
#
:use-module
(
logic
guile-log
code-load
)
#
:use-module
(
logic
guile-log
umatch
)
#
:use-module
(
logic
guile-log
umatch
)
#
:export
(
<pand>
<pzip>
f
test1
test2
test3
test4
))
#
:export
(
<pand>
<pzip>
f
test1
test2
test3
test4
))
...
@@ -28,10 +29,12 @@
...
@@ -28,10 +29,12 @@
(
<with-s>
s
(
<with-s>
s
(
<pit>
s
p
ccc
(
<pit>
s
p
ccc
(
<with-fail>
p
(
<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>
(
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
...
))
...
...
logic/guile-log/src/state.c
View file @
cce39ef3
...
@@ -1548,8 +1548,8 @@ SCM_DEFINE(gp_pop_engine, "gp-pop-engine", 0, 0, 0, (),
...
@@ -1548,8 +1548,8 @@ 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_
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
)));
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
))
...
@@ -1674,11 +1674,34 @@ SCM_DEFINE(gp_combine_engines, "gp-combine-engines", 1, 0, 0, (SCM l),
...
@@ -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
[
0
]
=
vec
;
gp
->
gp_ci
++
;
gp
->
gp_ci
++
;
gp_store_path
=
scm_cons
(
vec
,
gp_store_path
);
return
SCM_UNSPECIFIED
;
return
SCM_UNSPECIFIED
;
}
}
#undef FUNC_NAME
#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
),
SCM_DEFINE
(
gp_combine_state
,
"gp-combine-state"
,
2
,
0
,
0
,
(
SCM
s
,
SCM
l
),
""
)
""
)
#define FUNC_NAME s_gp_combine_engine
#define FUNC_NAME s_gp_combine_engine
...
...
logic/guile-log/src/unify-undo-redo.c
View file @
cce39ef3
...
@@ -1349,6 +1349,7 @@ SCM_DEFINE(gp_gp_store_state, "gp-store-state", 1, 0, 0, (SCM s),
...
@@ -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
// We must make sure that we guard the state if the vlist
// Else trunction will make it fail.
// Else trunction will make it fail.
gp_no_gc
();
gp_no_gc
();
if
(
GP_CONSP
(
s
))
if
(
GP_CONSP
(
s
))
{
{
SCM
l
=
GP_GETREF
(
s
)[
2
];
SCM
l
=
GP_GETREF
(
s
)[
2
];
...
@@ -1360,9 +1361,73 @@ SCM_DEFINE(gp_gp_store_state, "gp-store-state", 1, 0, 0, (SCM s),
...
@@ -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
()),
ret
=
scm_cons
(
gp_store_state
(
get_gp
()),
scm_cons
(
scm_fluid_ref
(
gp_current_stack
)
,
s
));
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
();
gp_do_gc
();
return
ret
;
return
scm_cons
(
gp_store_path
,
scm_cons
(
gp_engine_path
,
scm_cons
(
ret
,
llpath
)));
}
}
#undef FUNC_NAME
#undef FUNC_NAME
...
@@ -1953,17 +2018,121 @@ static void gp_restore_state(SCM data, struct gp_stack *gp, SCM K)
...
@@ -1953,17 +2018,121 @@ static void gp_restore_state(SCM data, struct gp_stack *gp, SCM K)
//#define DB(X)
//#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
),
SCM_DEFINE
(
gp_gp_restore_state
,
"gp-restore-state"
,
2
,
0
,
0
,
(
SCM
cont
,
SCM
K
),
"restore a continuation point"
)
"restore a continuation point"
)
#define FUNC_NAME s_gp_gp_restore_state
#define FUNC_NAME s_gp_gp_restore_state
{
{
gp_no_gc
();
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
));
SCM
x
=
SCM_CAR
(
gp_engine_path
);
struct
gp_stack
*
gp
=
get_gp
();
SCM
e
=
SCM_CDR
(
x
);
gp_restore_state
(
SCM_CAR
(
cont
),
gp
,
K
);
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
();
gp_do_gc
();
return
SCM_UNSPECIFIED
;
return
SCM_UNSPECIFIED
;
}
}
...
...
logic/guile-log/src/unify.c
View file @
cce39ef3
...
@@ -31,6 +31,7 @@ SCM tester = SCM_BOOL_F;
...
@@ -31,6 +31,7 @@ SCM tester = SCM_BOOL_F;
SCM
inline
get_cs
(
SCM
v
);
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_current_stack
=
SCM_BOOL_F
;
SCM
gp_current_stack
=
SCM_BOOL_F
;
SCM
current_stack
=
SCM_BOOL_F
;
SCM
current_stack
=
SCM_BOOL_F
;
...
...
logic/guile-log/src/unify.h
View file @
cce39ef3
...
@@ -161,6 +161,8 @@ SCM_API SCM gp_code_to_int(SCM x);
...
@@ -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_make_null_procedure
(
SCM
n
,
SCM
def
);
SCM_API
SCM
gp_fill_null_procedure
(
SCM
proc
,
SCM
addr
,
SCM
l
);
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_new_engine
(
SCM
e
);
SCM_API
SCM
gp_set_engine
(
SCM
path
);
SCM_API
SCM
gp_set_engine
(
SCM
path
);
SCM_API
SCM
gp_restore_engine_guards
(
SCM
cont
);
SCM_API
SCM
gp_restore_engine_guards
(
SCM
cont
);
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment