Skip to content
GitLab
Explore
Sign in
Primary navigation
Search or go to…
Project
S
sasa
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Snippets
Build
Pipelines
Jobs
Pipeline schedules
Artifacts
Deploy
Releases
Container Registry
Model registry
Operate
Environments
Monitor
Incidents
Analyze
Value stream analytics
Contributor analytics
CI/CD analytics
Repository analytics
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
verimag
synchrone
sasa
Commits
1db6a5ac
Commit
1db6a5ac
authored
2 years ago
by
erwan
Browse files
Options
Downloads
Patches
Plain Diff
fix: rdbgui4sasa in salut mode
parent
8cf702ba
No related branches found
No related tags found
No related merge requests found
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
tools/rdbg4sasa/gtkgui.ml
+13
-10
13 additions, 10 deletions
tools/rdbg4sasa/gtkgui.ml
tools/rdbg4sasa/sasa-rdbg-cmds.ml
+1
-1
1 addition, 1 deletion
tools/rdbg4sasa/sasa-rdbg-cmds.ml
with
14 additions
and
11 deletions
tools/rdbg4sasa/gtkgui.ml
+
13
−
10
View file @
1db6a5ac
(* Time-stamp: <modified the 1
5
/06/2022 (at 1
1
:50) by Erwan Jahier> *)
(* Time-stamp: <modified the
2
1/06/2022 (at 1
7
:50) by Erwan Jahier> *)
#
thread
#
thread
#
require
"lablgtk3"
#
require
"lablgtk3"
...
@@ -62,7 +62,8 @@ let refresh () =
...
@@ -62,7 +62,8 @@ let refresh () =
Hashtbl
.
iter
(
fun
str
f
->
f
()
)
refresh_fun_tbl
Hashtbl
.
iter
(
fun
str
f
->
f
()
)
refresh_fun_tbl
(** Met en place le hook *)
(** Met en place le hook *)
let
daemongui_activate
=
Hashtbl
.
create
1
let
daemongui_activate
:
(
string
,
bool
)
Hashtbl
.
t
=
Hashtbl
.
create
1
(* states whether a node should be activated *)
let
(
fake_val_of_type
:
Data
.
t
->
Data
.
v
)
=
function
let
(
fake_val_of_type
:
Data
.
t
->
Data
.
v
)
=
function
|
Bool
->
B
false
|
Bool
->
B
false
...
@@ -143,8 +144,9 @@ let goto_top e =
...
@@ -143,8 +144,9 @@ let goto_top e =
let
init_rdbg_hook
()
=
let
init_rdbg_hook
()
=
let
guidaemon
sl
=
let
guidaemon
sl
=
if
sl
=
[]
then
if
sl
=
[]
then
(* when called first (salut), its activation output will be
(* when called first (salut), its activation output will be
ignored, so we can give fake values for Enab ans state values *)
ignored; nevertheless, we need to provide give fake values
for Enab and state values that will be ignored *)
let
res
=
List
.
map
(
fun
(
n
,
t
)
->
let
res
=
List
.
map
(
fun
(
n
,
t
)
->
let
v
=
fake_val_of_type
t
in
let
v
=
fake_val_of_type
t
in
(* Printf.printf "tossing a value for %s -> %s \n%!" n *)
(* Printf.printf "tossing a value for %s -> %s \n%!" n *)
...
@@ -254,7 +256,7 @@ let custom_daemon p gtext vbox step_button back_step_button round_button
...
@@ -254,7 +256,7 @@ let custom_daemon p gtext vbox step_button back_step_button round_button
node
(
str_of_sasa_event
false
!
e
)
in
node
(
str_of_sasa_event
false
!
e
)
in
(* gtext#buffer#set_text txt; *)
(* gtext#buffer#set_text txt; *)
blue
gtext
#
buffer
txt
;
blue
gtext
#
buffer
txt
;
Hashtbl
.
filter_map_inplace
(
fun
n
status
->
Some
(
n
=
node
))
daemongui_activate
;
Hashtbl
.
filter_map_inplace
(
fun
n
_prev_
status
->
Some
(
n
=
node
))
daemongui_activate
;
)
)
|
Manual
->
|
Manual
->
let
txt
=
Printf
.
sprintf
"Manual step:
\n\n
%s"
(
str_of_sasa_event
false
!
e
)
in
let
txt
=
Printf
.
sprintf
"Manual step:
\n\n
%s"
(
str_of_sasa_event
false
!
e
)
in
...
@@ -647,13 +649,13 @@ let main () =
...
@@ -647,13 +649,13 @@ let main () =
e
e
in
in
let
rec
next_round_gui_loop
rn
=
let
rec
next_round_gui_loop
rn
=
if
is_silent
!
e
then
(
if
is_silent
~
dflt
:
false
!
e
then
(
if
not
args
.
salut_mode
&&
!
e
.
kind
<>
Ltop
then
if
not
args
.
salut_mode
&&
!
e
.
kind
<>
Ltop
then
(* go to Ltop so that the round number can be updated *)
(* go to Ltop so that the round number can be updated *)
e
:=
next_cond
!
e
(
fun
e
->
e
.
kind
=
Ltop
);
e
:=
next_cond
!
e
(
fun
e
->
e
.
kind
=
Ltop
);
)
)
else
e
:=
a_gui_step
!
e
;
else
e
:=
a_gui_step
!
e
;
if
(
get_round
!
e
)
||
is_silent
!
e
then
()
else
(
next_round_gui_loop
rn
);
if
(
get_round
!
e
)
||
is_silent
~
dflt
:
false
!
e
then
()
else
(
next_round_gui_loop
rn
);
in
in
let
next_round_gui
()
=
let
next_round_gui
()
=
if
!
custom_mode_ref
then
(
if
!
custom_mode_ref
then
(
...
@@ -739,14 +741,15 @@ let main () =
...
@@ -739,14 +741,15 @@ let main () =
~
callback
:
(
button_cb
true
false
back_step_gui
));
~
callback
:
(
button_cb
true
false
back_step_gui
));
let
step
()
=
let
step
()
=
if
not
(
is_silent
!
e
)
||
(
not
args
.
salut_mode
&&
!
e
.
kind
<>
Ltop
)
then
(
if
not
(
is_silent
~
dflt
:
false
!
e
)
||
(
not
args
.
salut_mode
&&
!
e
.
kind
<>
Ltop
)
then
(
Printf
.
printf
"a_gui_step is called
\n
%!"
;
e
:=
a_gui_step
!
e
;
e
:=
a_gui_step
!
e
;
d
()
d
()
)
)
in
in
let
rec
legitimate_gui
()
=
let
rec
legitimate_gui
()
=
if
is_silent
!
e
then
()
else
e
:=
a_gui_step
!
e
;
if
is_silent
~
dflt
:
false
!
e
then
()
else
e
:=
a_gui_step
!
e
;
if
is_legitimate
!
e
||
is_silent
!
e
then
(
if
is_legitimate
!
e
||
is_silent
~
dflt
:
false
!
e
then
(
if
not
args
.
salut_mode
&&
!
e
.
kind
<>
Ltop
then
if
not
args
.
salut_mode
&&
!
e
.
kind
<>
Ltop
then
e
:=
next_cond
!
e
(
fun
e
->
e
.
kind
=
Ltop
);
e
:=
next_cond
!
e
(
fun
e
->
e
.
kind
=
Ltop
);
)
)
...
...
This diff is collapsed.
Click to expand it.
tools/rdbg4sasa/sasa-rdbg-cmds.ml
+
1
−
1
View file @
1db6a5ac
...
@@ -48,7 +48,7 @@ let enabled pl = (* returns the enabled processes *)
...
@@ -48,7 +48,7 @@ let enabled pl = (* returns the enabled processes *)
(* called at each event via the time-travel hook *)
(* called at each event via the time-travel hook *)
let
(
round
:
RdbgEvent
.
t
->
bool
)
=
let
(
round
:
RdbgEvent
.
t
->
bool
)
=
fun
e
->
fun
e
->
if
e
.
kind
=
Exit
&&
e
.
name
=
"sasa"
then
get_round
e
||
is_legitimate
e
else
false
if
e
.
kind
=
Exit
&&
e
.
name
=
"sasa"
then
get_round
e
(*
|| is_legitimate e
*)
else
false
let
sasa_next
e
=
let
sasa_next
e
=
let
ne
=
e
.
next
()
in
let
ne
=
e
.
next
()
in
...
...
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment