Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
verimag
synchrone
sasa
Commits
917a7891
Commit
917a7891
authored
Apr 16, 2021
by
erwan
Browse files
Chore: more code refactoring
parent
df5741b0
Pipeline
#64955
passed with stages
in 3 minutes and 16 seconds
Changes
4
Pipelines
2
Hide whitespace changes
Inline
Side-by-side
lib/sasa/sasaRun.ml
View file @
917a7891
...
...
@@ -65,11 +65,6 @@ let (compute_legitimate: bool -> 'v SimuState.t -> bool) =
in
f
pidl
get_info
(* update the network processes w.r.t. the config *)
let
update_network
config
network
=
List
.
map
(
fun
(
p
,
nl
)
->
p
,
Sasacore
.
SimuState
.
update_neighbor_env
config
nl
)
network
open
SimuState
let
(
make_do
:
string
array
->
'
v
SimuState
.
t
->
RdbgPlugin
.
t
)
=
fun
argv
st
->
...
...
@@ -98,8 +93,7 @@ let (make_do: string array -> 'v SimuState.t -> RdbgPlugin.t) =
(* Do the same job as SasaSimuState.simustep *)
let
(
step_custom
:
RdbgPlugin
.
sl
->
RdbgPlugin
.
sl
)
=
fun
sl_in
->
let
st
=
{
st
with
SimuState
.
network
=
update_network
!
sasa_config
st
.
network
;
SimuState
.
config
=
!
sasa_config
}
in
let
st
=
Sasacore
.
SimuState
.
update_config
!
sasa_config
st
in
match
!
pre_enable_processes_opt
with
|
None
->
(
(* the first step *)
(* 1: Get enable processes *)
...
...
@@ -122,7 +116,7 @@ let (make_do: string array -> 'v SimuState.t -> RdbgPlugin.t) =
in
(* 3: Do the steps *)
let
ne
=
Sasacore
.
Step
.
f
pnal
st
.
config
in
let
nst
=
{
st
with
network
=
update_network
ne
st
.
network
;
config
=
ne
}
in
let
nst
=
update_
config
ne
st
in
let
sasa_nenv
=
from_sasa_env
nst
in
(* 1': Get enable processes *)
let
pnall
,
enab_ll
=
Sasacore
.
SimuState
.
get_enable_processes
nst
in
...
...
@@ -137,8 +131,7 @@ let (make_do: string array -> 'v SimuState.t -> RdbgPlugin.t) =
let
(
step_internal_daemon
:
RdbgPlugin
.
sl
->
RdbgPlugin
.
sl
)
=
fun
sl_in
->
(* in this mode, sasa does not play first *)
let
st
=
{
st
with
SimuState
.
network
=
update_network
!
sasa_config
st
.
network
;
SimuState
.
config
=
!
sasa_config
}
in
let
st
=
update_config
!
sasa_config
st
in
(* 1: Get enable processes *)
let
pnall
,
enab_ll
=
Sasacore
.
SimuState
.
get_enable_processes
st
in
let
pot_sl
=
compute_potentiel
st
in
...
...
lib/sasacore/simuState.ml
View file @
917a7891
(* Time-stamp: <modified the 16/04/2021 (at 1
3:28
) by Erwan Jahier> *)
(* Time-stamp: <modified the 16/04/2021 (at 1
5:39
) by Erwan Jahier> *)
open
Register
...
...
@@ -37,17 +37,25 @@ let (dump_process: string -> 'v Process.t * 'v Register.neighbor list -> unit) =
open
Process
open
SasArg
type
'
v
t
=
{
sasarg
:
SasArg
.
t
;
network
:
(
'
v
Process
.
t
*
'
v
Register
.
neighbor
list
)
list
;
config
:
'
v
Env
.
t
}
let
(
update_neighbor_env
:
'
v
Env
.
t
->
'
v
Register
.
neighbor
list
->
'
v
Register
.
neighbor
list
)
=
fun
e
nl
->
List
.
map
(
fun
n
->
{
n
with
state
=
Env
.
get_copy
e
n
.
Register
.
pid
})
nl
let
update_network
config
network
=
List
.
map
(
fun
(
p
,
nl
)
->
p
,
update_neighbor_env
config
nl
)
network
type
'
v
t
=
{
sasarg
:
SasArg
.
t
;
n
et
work
:
(
'
v
Process
.
t
*
'
v
Register
.
neighbor
list
)
list
;
config
:
'
v
Env
.
t
}
let
(
update_config
:
'
v
Env
.
t
->
'
v
t
->
'
v
t
)
=
fun
e
st
->
l
et
verb
=
!
Register
.
verbose_level
>
0
in
if
verb
then
Printf
.
eprintf
" ===> update_neighbor_env
\n
%!"
;
{
st
with
network
=
update_network
e
st
.
network
;
config
=
e
}
type
'
v
enable_processes
=
(
'
v
Process
.
t
*
'
v
Register
.
neighbor
list
*
Register
.
action
)
list
list
*
bool
list
list
...
...
@@ -297,7 +305,7 @@ let (make : bool -> string array -> 'v t) =
pl
;
Printf
.
eprintf
"Ignoring the first vectors of sasa inputs
\n
%!"
;
);
if
!
Register
.
verbose_level
>
0
then
Printf
.
eprintf
"==>
Main
.make done !
\n
%!"
;
if
!
Register
.
verbose_level
>
0
then
Printf
.
eprintf
"==>
SimuState
.make done !
\n
%!"
;
{
sasarg
=
args
;
network
=
pl_n
;
...
...
lib/sasacore/simuState.mli
View file @
917a7891
(* Time-stamp: <modified the 16/04/2021 (at 15:
07
) by Erwan Jahier> *)
(* Time-stamp: <modified the 16/04/2021 (at 15:
31
) by Erwan Jahier> *)
(** The module is used by
- the main sasa simulation loop (in ../../src/sasaMain.ml)
...
...
@@ -21,7 +21,8 @@ type 'v enable_processes =
val
get_enable_processes
:
'
v
t
->
'
v
enable_processes
val
update_neighbor_env
:
'
v
Env
.
t
->
'
v
Register
.
neighbor
list
->
'
v
Register
.
neighbor
list
(** update the config and network processes *)
val
update_config
:
'
v
Env
.
t
->
'
v
t
->
'
v
t
(* For SasaRun *)
val
get_inputs_rif_decl
:
SasArg
.
t
->
'
v
Process
.
t
list
->
(
string
*
string
)
list
...
...
src/sasaMain.ml
View file @
917a7891
...
...
@@ -75,14 +75,6 @@ let legitimate p_nl_l e =
open
Sasacore
.
SimuState
(* update the network processes w.r.t. the config *)
let
update_network
config
network
=
let
verb
=
!
Register
.
verbose_level
>
0
in
if
verb
then
Printf
.
eprintf
" ===> update_neighbor_env
\n
%!"
;
List
.
map
(
fun
(
p
,
nl
)
->
p
,
Sasacore
.
SimuState
.
update_neighbor_env
config
nl
)
network
let
inject_fault
ff
st
=
let
update_nodes
e
(
p
,
nl
)
=
let
pid
=
p
.
Process
.
pid
in
...
...
@@ -91,7 +83,7 @@ let inject_fault ff st =
Env
.
set
e
pid
v
in
let
e
=
List
.
fold_left
update_nodes
st
.
config
st
.
network
in
{
st
with
network
=
update_network
e
st
.
network
;
config
=
e
}
update_
config
e
st
let
plur
i
=
if
i
>
1
then
"s"
else
""
...
...
@@ -179,7 +171,7 @@ let (simustep: int -> int -> string -> 'v SimuState.t -> 'v SimuState.t * string
if
st
.
sasarg
.
daemon
<>
Daemon
.
Custom
then
print_step
n
i
pot
st
.
sasarg
st
.
config
pl
next_activate_val
enab_ll
;
let
ne
=
Sasacore
.
Step
.
f
pnal
st
.
config
in
let
st
=
{
st
with
network
=
update_network
ne
st
.
network
;
config
=
ne
}
in
let
st
=
update_
config
ne
st
in
st
,
next_activate_val
let
rec
(
simuloop
:
int
->
int
->
string
->
'
v
SimuState
.
t
->
unit
)
=
...
...
Write
Preview
Supports
Markdown
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