Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
vecs
FIJI Public
Commits
a70feb42
Commit
a70feb42
authored
Jun 13, 2016
by
Christian Fibich
Committed by
Stefan Tauner
Oct 03, 2017
Browse files
Some bug fixes and refactorings
parent
1842698b
Changes
9
Hide whitespace changes
Inline
Side-by-side
bin/FIJI.pm
View file @
a70feb42
...
...
@@ -183,7 +183,7 @@ BEGIN {
default
=>
"",
phases_opt
=>
[
qw(setup download)
],
group
=>
'
clock
',
order
=>
10
,
order
=>
10
},
FREQUENCY
=>
{
description
=>
"
Clock frequency
",
...
...
@@ -672,11 +672,19 @@ BEGIN {
subtitle
=>
"",
description
=>
"
Settings concerning the clocking of the FIJI logic
",
order
=>
20
,
},
fius
=>
{
title
=>
"
FIUs
",
subtitle
=>
"",
description
=>
"
Settings concerning Fault Injection Units
",
order
=>
100
}
);
}
use
constant
\
%displaygroups
;
use
constant
DISPLAYGROUPS
=>
\
%displaygroups
;
use
constant
DISPLAYGROUPS_FIU_KEY
=>
'
fius
';
## @var public %fiumap Hash containing all FIJI::Settings for FIUs
#
...
...
@@ -709,7 +717,7 @@ BEGIN {
FIU_DRIVER_TYPE
=>
{
ini_name
=>
"
DRIVER_TYPE
",
values
=>
[
qw(PIN PORT ASSIGN)
],
default
=>
"",
default
=>
"
PIN
",
phases_opt
=>
[
qw(setup)
],
},
FIU_DRIVER_PATH
=>
{
...
...
@@ -1133,8 +1141,37 @@ sub ini2constkey {
use
base
'
Exporter
';
our
@EXPORT
=
(
keys
(
%designmap
),
keys
(
%fiumap
),
keys
(
%testpatmap
),
keys
(
%testconstmap
),
keys
(
%fiuenum
),
keys
(
%displaygroups
),
keys
(
%testguimodes
));
our
@EXPORT_OK
=
('
FIJI_DOCUMENTATION_PATH
',
'
FIJI_DIR
',
keys
(
%designmap
),
'
DESIGNMAP
',
keys
(
%fiumap
),
'
FIUMAP
',
keys
(
%testpatmap
),
'
TESTPATMAP
',
keys
(
%testconstmap
),
'
TESTCONSTMAP
',
keys
(
%fiuenum
),
'
FIUENUM
',
'
REVERSE_FIU_ENUM
',
'
DISPLAYGROUPS
',
keys
(
%displaygroups
),
'
TESTGUIMODES
',
keys
(
%testguimodes
),
'
HOST_TO_FIJI_LATENCY
',
'
DEFAULT_TIMER_VALUE
',
'
OPTIMIZATIONS
',
'
LFSR_POLY_CHOICES
');
our
@EXPORT
=
(
keys
(
%designmap
),
keys
(
%fiumap
),
keys
(
%testpatmap
),
keys
(
%testconstmap
),
keys
(
%fiuenum
),
keys
(
%displaygroups
),
keys
(
%testguimodes
));
our
@EXPORT_OK
=
('
FIJI_DOCUMENTATION_PATH
',
'
FIJI_DIR
',
keys
(
%designmap
),
'
DESIGNMAP
',
keys
(
%fiumap
),
'
FIUMAP
',
keys
(
%testpatmap
),
'
TESTPATMAP
',
keys
(
%testconstmap
),
'
TESTCONSTMAP
',
keys
(
%fiuenum
),
'
FIUENUM
',
'
REVERSE_FIU_ENUM
',
'
DISPLAYGROUPS
',
keys
(
%displaygroups
),
'
TESTGUIMODES
',
keys
(
%testguimodes
),
'
HOST_TO_FIJI_LATENCY
',
'
DEFAULT_TIMER_VALUE
',
'
OPTIMIZATIONS
',
'
LFSR_POLY_CHOICES
',
'
DISPLAYGROUPS_FIU_KEY
',
);
## @var @EXPORT_TAGS Export Tags
#
...
...
bin/FIJI/Downloader.pm
View file @
a70feb42
...
...
@@ -213,7 +213,7 @@ sub download_auto ($) {
my
$check
=
$self
->
_check_halt
(
$recv_msg
);
if
(
@
{
$check
})
{
$logger
->
error
("
Halt because of
"
.
join
("
and
",
@
{
$check
})
.
"
. Failed test:
$ti
, repetition
$ri
.
");
$logger
->
error
("
Halt because of
"
.
join
("
and
",
@
{
$check
})
.
"
. Failed test:
$ti
, repetition
$ri
.
");
goto
END
;
}
...
...
bin/FIJI/Settings.pm
View file @
a70feb42
...
...
@@ -396,6 +396,17 @@ sub validate_value {
my
$logger
=
get_logger
("");
my
(
$map_ref
,
$k
,
$v_ref
,
$dep_ref
,
$old
,
$log_func
)
=
@_
;
$log_func
=
\
&
Log::Log4perl::Logger::
trace
if
!
defined
(
$log_func
);
if
(
!
defined
(
$
{
$v_ref
}))
{
# if a key does not contain a value, e.g.
# DRIVER_TYPE=
# set the corresponding value to an empty string instead of undef
# FIXME: OK or do we need the undef value later on?
my
$orig
=
$
{
$v_ref
};
$log_func
->
(
$logger
,
"
$k
is undef, setting to empty string.
");
$
{
$v_ref
}
=
""
}
if
(
defined
(
$map_ref
->
{
$k
}
->
{'
type
'}))
{
my
$orig
=
$
{
$v_ref
};
...
...
bin/FIJI/Tests/VHDL.pm
View file @
a70feb42
package
FIJI::Tests::
VHDL
;
#use Data::Dumper;
use
FIJI
qw(:all)
;
use
POSIX
();
use
POSIX
(
ceil
);
sub
period_si
{
my
$num
=
shift
;
...
...
@@ -297,6 +297,11 @@ sub export_as_vhd_fiji_architecture {
my
$raw_bits
=
(
10
/
8
)
*
(
$cfg_bits
+
$timer_bits
+
$proto_bits
);
my
$config_duration
=
POSIX::
ceil
((
$raw_bits
/
$design_ref
->
{'
BAUDRATE
'})
*$design_ref
->
{'
FREQUENCY
'});
my
$fiu_width
=
$design_ref
->
{'
FIU_NUM
'}
-
1
;
my
$lfsr_width_multiple_of_4
=
ceil
(
$design_ref
->
{'
LFSR_WIDTH
'}
/
4
)
*
4
-
1
;
my
$lfsr_seed_hex
=
sprintf
("
%X
",
$design_ref
->
{'
LFSR_SEED
'});
my
$lfsr_poly_hex
=
sprintf
("
%X
",
$design_ref
->
{'
LFSR_POLY
'});
my
$vhdl
=
<<"END_HDR";
------------------------------------------------------------------------
-- BEGIN VHDL Fault Controller Simulation Architecture
...
...
@@ -311,10 +316,13 @@ architecture sim of fault_injection_top is
type t_fault is (NONE, STUCK_AT_0, STUCK_AT_1, SEU, DELAY, STUCK_OPEN);
type t_fault_select is array (natural range <>) of t_fault;
constant c_lfsr_seed_mul4 : std_logic_vector($lfsr_width_multiple_of_4 downto 0) := X"$lfsr_seed_hex";
constant c_lfsr_poly_mul4 : std_logic_vector($lfsr_width_multiple_of_4 downto 0) := X"$lfsr_poly_hex";
constant c_fiu_num : natural := $design_ref->{'FIU_NUM'};
constant c_lfsr_width : natural := $design_ref->{'LFSR_WIDTH'};
constant c_lfsr_seed : std_logic_vector(c_lfsr_width-1 downto 0) :=
std_logic_vector(to_unsigned($design_ref->{'LFSR_SEED'},
c_lfsr_width
)
);
constant c_lfsr_poly : std_logic_vector(c_lfsr_width-1 downto 0) :=
std_logic_vector(to_unsigned($design_ref->{'LFSR_POLY'},
c_lfsr_width
)
);
constant c_lfsr_seed : std_logic_vector(c_lfsr_width-1 downto 0) :=
c_lfsr_seed_mul4(
c_lfsr_width
-1 downto 0
);
constant c_lfsr_poly : std_logic_vector(c_lfsr_width-1 downto 0) :=
c_lfsr_poly_mul4(
c_lfsr_width
-1 downto 0
);
signal s_lfsr : std_logic_vector(c_lfsr_width-1 downto 0);
signal s_open : std_logic_vector(c_fiu_num-1 downto 0);
...
...
bin/FIJI/VHDL.pm
View file @
a70feb42
...
...
@@ -34,7 +34,7 @@ use strict;
use
warnings
;
use
Data::
Dumper
;
use
Log::
Log4perl
qw(get_logger)
;
use
POSIX
qw(ceil)
;
use
FIJI::
Settings
;
# FIJI_USERDATA_xxx is intended as key for the port->userdata{} hash
...
...
@@ -109,6 +109,7 @@ sub generate_config_package {
# LFSR initial value is given as a 0-padded hex number
my
$lfsr_fmt
=
sprintf
("
X
\"
%%0%dx
\"
",
$fiji_consts
->
{'
LFSR_WIDTH
'}
/
4
);
my
$lfsr_width_multiple_of_4
=
ceil
(
$fiji_consts
->
{'
LFSR_WIDTH
'}
/
4
)
*
4
-
1
;
my
@fiu_configs
=
();
# generate the fiu_config record contents
...
...
@@ -182,9 +183,11 @@ package public_config_pkg is
-- Width of the LFSR for random FIU enable & stuck-open
constant c_lfsr_width : natural := $fiji_consts->{'LFSR_WIDTH'};
-- Polynomial for the LFSR
constant c_lfsr_poly : std_logic_vector(c_lfsr_width-1 downto 0) := $lfsr_poly_string;
constant c_lfsr_poly_mul4 : std_logic_vector($lfsr_width_multiple_of_4 downto 0) := $lfsr_poly_string;
constant c_lfsr_poly : std_logic_vector(c_lfsr_width-1 downto 0) := c_lfsr_poly_mul4(c_lfsr_width-1 downto 0);
-- Initial value for the LFSR
constant c_lfsr_seed : std_logic_vector(c_lfsr_width-1 downto 0) := $lfsr_seed_string;
constant c_lfsr_seed_mul4 : std_logic_vector($lfsr_width_multiple_of_4 downto 0) := $lfsr_seed_string;
constant c_lfsr_seed : std_logic_vector(c_lfsr_width-1 downto 0) := c_lfsr_seed_mul4(c_lfsr_width-1 downto 0);
------------------------------------------------------------------------------
-- Controller Configuration
...
...
bin/Tk/FIJISettingsViewer.pm
View file @
a70feb42
...
...
@@ -341,7 +341,9 @@ sub update {
# and a readonly entry field for the path as child 1
((
$valw
->
children
)[
1
])
->
configure
('
-text
'
=>
(
defined
$val
)
?
$val
:
"");
}
elsif
(
$type
eq
'
net
')
{
((
$valw
->
children
)[
1
])
->
configure
('
-text
'
=>
(
defined
$val
)
?
$val
:
"");
my
$entry
=
(
$valw
->
children
)[
1
];
$entry
->
configure
('
-text
'
=>
(
defined
$val
)
?
$val
:
"");
$entry
->
validate
();
}
}
else
{
...
...
@@ -511,8 +513,12 @@ sub _populate_widget {
# create canvas widget which draws a block diagram of the current settings
$self
->
{'
settings_canvas
'}
=
$fr
->
FIJISettingsCanvas
(
-
relief
=>
"
solid
",
-
borderwidth
=>
"
1
",
-
takefocus
=>
"
0
",
-
settings_ref
=>
\
(
$self
->
{'
settings
'}))
->
pack
(
-
anchor
=>
"
nw
",
-
side
=>
"
top
",
-
fill
=>
"
x
");
# Loop through tab descriptions ('display groups') and create the tabs
foreach
my
$displaygroup
(
sort
{
DISPLAYGROUPS
->
{
$a
}
->
{'
order
'}
<=>
DISPLAYGROUPS
->
{
$b
}
->
{'
order
'}
}
keys
(
%
{
$dg_ref
}))
{
# The FIU panel is generated separately
next
if
$displaygroup
eq
DISPLAYGROUPS_FIU_KEY
;
# filter out just the Settings Fields in this Display group
my
@keys
=
map
{
my
$foo
=
$_
;
(
defined
DESIGNMAP
->
{
$foo
}
->
{'
group
'}
&&
DESIGNMAP
->
{
$foo
}
->
{'
group
'}
eq
$displaygroup
)
?
(
$_
)
:
()
}
keys
(
%
{
$dm_ref
});
...
...
@@ -593,8 +599,18 @@ sub _populate_widget {
# entry for NET
$entry
=
$config_frame
->
Frame
();
$entry
->
Button
(
-
text
=>
"
Select
",
my
$b
=
$entry
->
Button
(
-
text
=>
"
Select
");
my
$e
=
$entry
->
Entry
();
$e
->
{'
displaygroup
'}
=
$displaygroup
;
$e
->
{'
key
'}
=
$k
;
$e
->
configure
(
-
state
=>
"
readonly
",
-
validatecommand
=>
sub
{
my
$new
=
shift
;
$self
->
_highlight_widget
(
$e
,
(
$b
->
cget
(
-
state
)
ne
"
disabled
"
&&
$new
eq
""));
return
1
},
-
textvariable
=>\
$self
->
{'
settings
'}
->
{'
design
'}
->
{
$k
},
-
takefocus
=>
0
);
$b
->
configure
(
-
command
=>
sub
{
my
$netname
=
$self
->
{'
settings
'}
->
{'
design
'}
->
{
$k
};
my
$rv
=
$self
->
_select_net_dialog
(
\
$netname
,"
Select Net for
$k
");
...
...
@@ -612,22 +628,21 @@ sub _populate_widget {
}
elsif
(
defined
$netname
)
{
$self
->
{'
settings
'}
->
{'
design
'}
->
{
$k
}
=
$netname
;
$self
->
update
;
$self
->
_highlight_widget
(
$e
,
0
);
}
$self
->
_check_change
();
}
)
->
grid
(
-
row
=>
0
,
-
column
=>
1
,
-
sticky
=>
"
ew
"
);
$entry
->
Entry
(
-
state
=>
"
readonly
",
-
textvariable
=>\
$self
->
{'
settings
'}
->
{'
design
'}
->
{
$k
},
-
takefocus
=>
0
)
->
grid
(
-
row
=>
0
,
-
column
=>
0
,
-
sticky
=>
"
ew
");
);
$b
->
grid
(
-
row
=>
0
,
-
column
=>
1
,
-
sticky
=>
"
ew
");
$e
->
grid
(
-
row
=>
0
,
-
column
=>
0
,
-
sticky
=>
"
ew
");
$entry
->
gridColumnconfigure
(
0
,
-
weight
=>
1
);
$entry
->
grid
(
-
row
=>
$row
,
-
column
=>
2
,
'
-sticky
'
=>
'
ew
'
);
}
elsif
(
defined
(
$type
)
&&
$type
eq
'
external_port
')
{
# entry for an external port name
...
...
@@ -777,8 +792,9 @@ sub _populate_widget {
# Widget description is needed for widget-based error messages such as
# "Forbids"
$entry
->
{'
description
'}
=
DESIGNMAP
->
{
$k
}
->
{'
description
'};
$entry
->
{'
key
'}
=
$k
;
$entry
->
{'
description
'}
=
DESIGNMAP
->
{
$k
}
->
{'
description
'};
$entry
->
{'
displaygroup
'}
=
$displaygroup
;
$entry
->
{'
key
'}
=
$k
;
$row
++
;
}
$description_frame
->
pack
(
-
anchor
=>
"
nw
",
-
side
=>
"
left
",
-
fill
=>
"
x
",
-
padx
=>
5
,
-
pady
=>
5
);
...
...
@@ -794,15 +810,15 @@ sub _populate_widget {
##############
$self
->
{'
page_fius
'}
=
$self
->
{'
nb
'}
->
add
(
'
fius
'
,
-
label
=>
'
FIUs
'
,
DISPLAYGROUPS_FIU_KEY
,
-
label
=>
DISPLAYGROUPS
->
{
DISPLAYGROUPS_FIU_KEY
}
->
{'
title
'}
,
# FIXME: Menubar overrides the ALT-(Key) bindings, how can we propagate the events to the notebook?
#-underline => 0
);
# add frame for Block Diagram / Description
my
$description_frame
=
$self
->
{'
page_fius
'}
->
Frame
();
$description_frame
->
Label
(
-
text
=>
"
Settings concerning Fault Injection Units
"
)
->
pack
(
-
fill
=>
"
both
");
$description_frame
->
Label
(
-
text
=>
DISPLAYGROUPS
->
{
DISPLAYGROUPS_FIU_KEY
}
->
{'
description
'}
)
->
pack
(
-
fill
=>
"
both
");
# add frame for configuration widgets
my
$config_frame
=
$self
->
{'
page_fius
'}
->
Frame
();
...
...
@@ -813,7 +829,7 @@ sub _populate_widget {
# if the tab is changed, delete the existing canvas
# and create a new one in the tab currently shown.
$self
->
{'
nb
'}
->
pageconfigure
(
"
fius
"
,
DISPLAYGROUPS_FIU_KEY
,
-
raisecmd
=>
sub
{
$self
->
{'
settings_canvas
'}
->
packForget
()
if
defined
$self
->
{'
settings_canvas
'};
$self
->
{'
settings_canvas
'}
->
pack
(
-
in
=>
$description_frame
);
...
...
@@ -929,13 +945,16 @@ sub _add_fiu ($$) {
-
takefocus
=>
0
,
-
state
=>
"
readonly
",
);
$net_entry
->
{'
displaygroup
'}
=
DISPLAYGROUPS_FIU_KEY
;
$net_entry
->
{'
key
'}
=
"
FIU
${i}
_NET_NAME
";
# read-only driver path
my
$drv_entry
=
$fr_fiu
->
Entry
(
'
-textvariable
'
=>
\
$fiu
->
{'
FIU_DRIVER_PATH
'},
-
takefocus
=>
0
,
-
state
=>
"
readonly
",
);
$drv_entry
->
{'
displaygroup
'}
=
DISPLAYGROUPS_FIU_KEY
;
$drv_entry
->
{'
key
'}
=
"
FIU
${i}
_DRIVER_PATH
";
# Menu to select the fault model implemented by this FIU
my
$model_menu
=
$fr_fiu
->
Optionmenu
(
...
...
@@ -973,10 +992,11 @@ sub _add_fiu ($$) {
my
$rvn
=
_validate_fiu_net
(
$self
,
$i
);
# try to validate the selected driver
# this will likely fail if a different net has been selected
$self
->
{'
mw
'}
->
Busy
;
my
$rvd
=
_validate_single_fiu_driver
(
$self
,
$i
);
_highlight_widget
(
$drv_entry
,
(
defined
$rvd
));
_highlight_widget
(
$net_entry
,
(
defined
$rvn
));
$self
->
{'
mw
'}
->
Unbusy
;
$self
->
_highlight_widget
(
$drv_entry
,
(
defined
$rvd
));
$self
->
_highlight_widget
(
$net_entry
,
(
defined
$rvn
));
if
(
defined
$rvd
||
defined
$rvn
)
{
my
$msg
=
((
defined
$rvd
)
?
$rvd
:
"")
.
((
defined
$rvn
)
?
$rvn
:
"");
...
...
@@ -1012,7 +1032,7 @@ sub _add_fiu ($$) {
-
buttons
=>
["
OK
"]);
$d
->
Show
();
}
else
{
_highlight_widget
(
$drv_entry
,
0
);
$self
->
_highlight_widget
(
$drv_entry
,
0
);
}
$self
->
_check_change
();
}
...
...
@@ -1034,6 +1054,8 @@ sub _add_fiu ($$) {
'
-validate
'
=>
'
key
',
'
-validatecommand
'
=>
[
\
&_validate_fiu_entry
,
$self
,
$mask_entry
,
'
FIU_LFSR_MASK
',
$i
],
);
$mask_entry
->
{'
displaygroup
'}
=
DISPLAYGROUPS_FIU_KEY
;
$mask_entry
->
{'
key
'}
=
"
FIU
${i}
_LFSR_MASK
";
$mask_entry
->
bind
(
'
<Control-a>
',
sub
{
...
...
@@ -1205,8 +1227,12 @@ sub _set_fields {
$f
->
configure
('
-state
'
=>
'
normal
');
}
else
{
$f
->
configure
('
-state
'
=>
'
disabled
');
}
}
if
(
ref
(
$f
)
eq
'
Tk::Entry
'
||
ref
(
$f
)
eq
'
Tk::CompleteEntry
')
{
$f
->
validate
;
}
}
}
...
...
@@ -1308,6 +1334,7 @@ sub _validate_toplevel_port_entry {
if
(
defined
(
DESIGNMAP
->
{
$name
}
->
{'
depends_on
'}))
{
my
$dep_ref
=
\
$self
->
{'
settings
'}
->
{'
design
'}
->
{
DESIGNMAP
->
{
$name
}
->
{'
depends_on
'}};
$self
->
_highlight_widget
(
$widget
,
0
);
# don't validate if this entry is disabled
$self
->
{'
settings_validation_results
'}
->
{
$name
}
=
1
;
$logger
->
debug
("
Don't validate
$name
as it is disabled.
")
if
(
$$dep_ref
==
0
);
...
...
@@ -1324,10 +1351,12 @@ sub _validate_toplevel_port_entry {
$self
->
{'
settings
'}
->
{'
design
'}
->
{
$name
}
=
$new
;
$logger
->
warn
("
Port name
$new
already exists as DUT port
")
if
(
!
$ok
&&
$excl
);
$logger
->
warn
("
Port name
$new
does not refer to a DUT port
")
if
(
!
$ok
&&
!
$excl
);
$ok
=
$ok
&
(
$new
ne
"");
$logger
->
warn
("
Port name is empty
")
if
(
$new
eq
"");
}
else
{
$logger
->
debug
("
Cannot validate port name (yet). No netlist loaded.
");
}
_highlight_widget
(
$widget
,
(
!
$ok
));
$self
->
_highlight_widget
(
$widget
,
(
!
$ok
));
$self
->
{'
settings_validation_results
'}
->
{
$name
}
=
$ok
;
return
1
;
# always allow the new value and show the user what happened.
}
...
...
@@ -1349,7 +1378,7 @@ sub _validate_net_entry {
if
(
$w
->
isa
("
Tk::Entry
"))
{
if
(
!
$ok
)
{
$
{
$w
->
cget
('
-textvariable
')}
=
"";
_highlight_widget
(
$w
,
1
);
$self
->
_highlight_widget
(
$w
,
1
);
}
}
elsif
(
$w
->
isa
("
Tk::Button
"))
{
# Buttons are disabled if dependency did not validate successfully
...
...
@@ -1364,7 +1393,7 @@ sub _validate_net_entry {
$logger
->
debug
("
Cannot validate net name (yet). No netlist loaded.
");
}
_highlight_widget
(
$widget
,
(
!
$ok
));
$self
->
_highlight_widget
(
$widget
,
(
!
$ok
));
# widget->configure('-validate' => 'key');
return
1
;
# always allow the new value and show the user what happened.
...
...
@@ -1541,13 +1570,13 @@ sub _validate_entry {
if
(
defined
(
$map
->
{
$name
}
->
{'
depends_on
'}))
{
$dep_ref
=
\
$self
->
{'
settings
'}
->
{'
design
'}
->
{
$map
->
{
$name
}
->
{'
depends_on
'}};
# don't validate if this entry is disabled
$self
->
_highlight_widget
(
$widget
,
0
);
$self
->
{'
settings_validation_results
'}
->
{
$name
}
=
1
;
$logger
->
debug
("
Don't validate
$name
as it is disabled.
")
if
(
$$dep_ref
==
0
);
return
1
if
(
$$dep_ref
==
0
);
}
my
$ok
=
FIJI::Settings::
validate_value
(
$map
,
$name
,
$new_ref
,
$dep_ref
,
$$old_ref
,
\
&
Log::Log4perl::Logger::
warn
);
_highlight_widget
(
$widget
,
(
!
$ok
));
$self
->
_highlight_widget
(
$widget
,
(
!
$ok
));
# Validate all matching or depending widgets
if
(
$char_idx
!=
-
1
)
{
...
...
@@ -1585,14 +1614,30 @@ sub _validate_entry {
return
1
;
# always allow the new value and show the user what happened.
}
## @method _highlight_widget(%$widget,$enable)
# Highlight a widget and display a tab indicator "[!]" depending on the $enable parameter
# Maintains a hash of highlit widgets for each tab. The tab indicator is
# only switched off if no widgets in a tab are highlit.
# Depends on two hash keys for $widget:
# * $widget->{'displaygroup'} contains the key to the DISPLAYGROUPS constant hash which contains the tab description (title,...)
# and also serves as the tab name in the TK::Notebook widget in $self->{'nb'}
# * $widget->{'key'} contains a unique name per entry widget
sub
_highlight_widget
($$)
{
my
(
$widget
,
$enable
)
=
@_
;
my
$logger
=
get_logger
("");
my
(
$self
,
$widget
,
$enable
)
=
@_
;
my
$bg_option
=
(
$widget
->
cget
("
-state
")
ne
"
readonly
")
?
"
-bg
"
:
"
-readonlybackground
";
if
(
$enable
)
{
my
$name
=
$widget
->
{'
key
'};
my
$displaygroup
=
$widget
->
{'
displaygroup
'};
my
$title
=
DISPLAYGROUPS
->
{
$displaygroup
}
->
{'
title
'};
$title
.=
"
:
"
.
DISPLAYGROUPS
->
{
$displaygroup
}
->
{'
subtitle
'}
if
DISPLAYGROUPS
->
{
$displaygroup
}
->
{'
subtitle
'}
ne
"";
if
(
$enable
&&
$widget
->
cget
(
-
state
)
ne
'
disabled
')
{
$widget
->
configure
(
$bg_option
=>
'
orange red
');
$self
->
{'
highlit_widgets
'}
->
{
$displaygroup
}
->
{
$name
}
=
1
;
}
else
{
# the 3rd element returned for '-bg' is the default background, usually.
# Apparently it is something darker on Linux so the following does
# not work as intended. :(
...
...
@@ -1601,7 +1646,17 @@ sub _highlight_widget ($$) {
# use that instead.
my
$bg_color
=
(
$widget
->
cget
("
-state
")
ne
"
readonly
")
?
$widget_background
:
$widget_ro_background
;
$widget
->
configure
(
$bg_option
=>
$widget_background
);
delete
$self
->
{'
highlit_widgets
'}
->
{
$displaygroup
}
->
{
$name
}
if
defined
$self
->
{'
highlit_widgets
'}
->
{
$displaygroup
}
->
{
$name
};
}
# if the hash for the current displaygroup is not empty, add the
# tab indicator
if
(
keys
(
%
{
$self
->
{'
highlit_widgets
'}
->
{
$displaygroup
}})
>
0
)
{
$title
.=
"
[!]
";
$logger
->
debug
("
Displaygroup
$displaygroup
contains highlit widgets. Indicator on.
");
}
$self
->
{'
nb
'}
->
pageconfigure
(
$displaygroup
,
-
label
=>
$title
);
}
sub
set_state_as_original
{
...
...
bin/fiji_setup.pl
View file @
a70feb42
...
...
@@ -104,6 +104,8 @@ Optional command-line arguments:
-h, --help display this help and exit
END_USAGE
my
$rv
;
sub
main
{
my
$logger
=
get_logger
("");
my
$name
=
$
0
;
...
...
@@ -118,6 +120,10 @@ sub main {
"
netlist-file=s
"
=>
\
$netlist_filename
,
"
help
"
=>
\
$help
);
my
$only_load
=
(
defined
$ENV
{
FIJI_BENCHMARK
}
&&
$ENV
{
FIJI_BENCHMARK
}
eq
"
ONLY_LOAD
");
$logger
->
warn
("
Benchmarking mode: Terminating after loading settings and netlist
")
if
$only_load
;
if
(
!
$parse
)
{
print
STDERR
$usage
;
return
-
1
;
...
...
@@ -224,8 +230,11 @@ sub main {
-
text
=>
$msg
,
-
title
=>
'
Open FIJI Settings failed!
',
-
buttons
=>
["
OK
"]);
$d
->
Show
();
goto
bailout
if
(
!
defined
(
$tmp_settings
));
$d
->
Show
()
if
!
$only_load
;
if
(
!
defined
(
$tmp_settings
))
{
$rv
=
1
;
goto
bailout
;
}
}
if
(
!
defined
(
$self
->
{'
FIJISettingsViewer
'}
->
settings
(
$tmp_settings
)))
{
my
$msg
=
"
Could not update GUI correctly with new settings.
";
...
...
@@ -237,7 +246,8 @@ sub main {
-
text
=>
$msg
,
-
title
=>
'
Open FIJI Settings failed!
',
-
buttons
=>
["
OK
"]);
$d
->
Show
();
$d
->
Show
()
if
!
$only_load
;
$rv
=
1
;
goto
bailout
;
}
$self
->
{'
settings
'}
=
$tmp_settings
;
...
...
@@ -249,12 +259,13 @@ sub main {
$self
->
_load_netlist_file
(
$netlist_filename
)
if
(
defined
$netlist_filename
);
MainLoop
;
MainLoop
if
!
$only_load
;
bailout:
$self
->
_cleanup
();
$logger
->
trace
("
=== Stopping execution ===
");
return
$rv
if
defined
$rv
;
return
0
;
}
...
...
@@ -662,9 +673,11 @@ sub _save_file {
}
# Check if all drivers are set, prompt for missing ones
$self
->
{'
mw
'}
->
Busy
;
my
$drv
=
$self
->
{'
FIJISettingsViewer
'}
->
validate_all_drivers
();
my
$dup
=
$self
->
{'
FIJISettingsViewer
'}
->
validate_duplicate_nets
();
my
$dsgn
=
$self
->
{'
FIJISettingsViewer
'}
->
validate_all_design_settings
();
$self
->
{'
mw
'}
->
Unbusy
;
# Warn the user if not all drivers could be validated successfully
my
$rv
;
...
...
docs/demos/tmr_demo/fiji_test_1/fiji/fiji.cfg
View file @
a70feb42
; FIJI::ConfigSorted 0.1
;
Thu Apr 28 10:33:08
2016
;
Mon May 9 08:54:46
2016
[CONSTS]
BAUDRATE=115200
...
...
docs/demos/tmr_demo/fiji_test_2/fiji/fiji.cfg
View file @
a70feb42
; FIJI::ConfigSorted 0.1
;
Thu Apr 28 10:35:11
2016
;
Mon May 9 09:10:00
2016
[CONSTS]
BAUDRATE=115200
...
...
Write
Preview
Supports
Markdown
0%
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!
Cancel
Please
register
or
sign in
to comment