Commit 44ad9f47 authored by Christian Fibich's avatar Christian Fibich Committed by Stefan Tauner
Browse files

ran code through perltidy (see beautify.sh script)

parent df320a45
This diff is collapsed.
......@@ -17,61 +17,59 @@ package FIJI::AnySerialPort;
use strict;
use vars '@ISA';
BEGIN
{
my %portMap;
my $oldNew;
my $onWindows = 0;
BEGIN {
my %portMap;
my $oldNew;
my $onWindows = 0;
if ($^O eq 'MSWin32') # running on Win32
{
$onWindows = 1;
eval "use Win32::SerialPort";
*main::Device::SerialPort:: = *main::Win32::SerialPort::;
$oldNew = \&Win32::SerialPort::new;
$INC{'Device/SerialPort.pm'} = $INC{'Win32/SerialPort.pm'};
%portMap = ('/dev/ttyS0' => 'COM1:',
'/dev/ttyS1' => 'COM2:',
'/dev/ttyS2' => 'COM3:',
'/dev/ttyS3' => 'COM4:',
);
}
else # running on Unix
{
eval "use Device::SerialPort";
*main::Win32::SerialPort:: = *main::Device::SerialPort::;
$oldNew = \&Device::SerialPort::new;
$INC{'Win32/SerialPort.pm'} = $INC{'Device/SerialPort.pm'};
%portMap = ('COM1:'=> '/dev/ttyS0',
'COM2:'=> '/dev/ttyS1',
'COM3:'=> '/dev/ttyS2',
'COM4:'=> '/dev/ttyS3',
);
}
if ( $^O eq 'MSWin32' ) # running on Win32
{
$onWindows = 1;
eval "use Win32::SerialPort";
*main::Device::SerialPort:: = *main::Win32::SerialPort::;
$oldNew = \&Win32::SerialPort::new;
$INC{'Device/SerialPort.pm'} = $INC{'Win32/SerialPort.pm'};
%portMap = (
'/dev/ttyS0' => 'COM1:',
'/dev/ttyS1' => 'COM2:',
'/dev/ttyS2' => 'COM3:',
'/dev/ttyS3' => 'COM4:',
);
} else # running on Unix
{
eval "use Device::SerialPort";
*main::Win32::SerialPort:: = *main::Device::SerialPort::;
$oldNew = \&Device::SerialPort::new;
$INC{'Win32/SerialPort.pm'} = $INC{'Device/SerialPort.pm'};
%portMap = (
'COM1:' => '/dev/ttyS0',
'COM2:' => '/dev/ttyS1',
'COM3:' => '/dev/ttyS2',
'COM4:' => '/dev/ttyS3',
);
}
die "$@\n" if $@;
@ISA = 'Device::SerialPort';
die "$@\n" if $@;
@ISA = 'Device::SerialPort';
# Hook the constructor so we can map the port names
# and class if needed
*main::Device::SerialPort::new = sub {
my $class = shift;
my $portName = shift;
if ($onWindows != ($class eq 'Win32::SerialPort'))
{
$portName = $portMap{$portName} || $portName;
$class = $onWindows ? 'Win32::SerialPort' : 'Device::SerialPort';
}
$oldNew->($class, $portName, @_);
};
# Hook the constructor so we can map the port names
# and class if needed
*main::Device::SerialPort::new = sub {
my $class = shift;
my $portName = shift;
if ( $onWindows != ( $class eq 'Win32::SerialPort' ) ) {
$portName = $portMap{$portName} || $portName;
$class = $onWindows ? 'Win32::SerialPort' : 'Device::SerialPort';
}
$oldNew->( $class, $portName, @_ );
};
# Gets and/or modifies the port mapping
# Returns a hash
sub Device::SerialPort::mapPorts
{
my $self = shift;
%portMap = (%portMap, @_);
}
# Gets and/or modifies the port mapping
# Returns a hash
sub Device::SerialPort::mapPorts {
my $self = shift;
%portMap = ( %portMap, @_ );
}
}
1;
This diff is collapsed.
......@@ -18,8 +18,6 @@
#
#-------------------------------------------------------------------------------
package FIJI::Constraints;
use strict;
......@@ -31,13 +29,13 @@ sub _quartus_direct_partitions_logiclock {
my $cfg = shift;
my $DUT_TO = $cfg->{'dut_module'}.":".$cfg->{'dut_inst'};
my $FIJI_TO = $cfg->{'fiji_module'}.":".$cfg->{'fiji_inst'};
my $DUT_TO = $cfg->{'dut_module'} . ":" . $cfg->{'dut_inst'};
my $FIJI_TO = $cfg->{'fiji_module'} . ":" . $cfg->{'fiji_inst'};
my $DUT_PART_NAME = "PARTITION_".$cfg->{'dut_module'};
my $FIJI_PART_NAME = "PARTITION_".$cfg->{'fiji_module'};
my $DUT_COLOR = (sprintf("%d", 0xFF0000));
my $FIJI_COLOR = (sprintf("%d", 0x00FF00));
my $DUT_PART_NAME = "PARTITION_" . $cfg->{'dut_module'};
my $FIJI_PART_NAME = "PARTITION_" . $cfg->{'fiji_module'};
my $DUT_COLOR = ( sprintf( "%d", 0xFF0000 ) );
my $FIJI_COLOR = ( sprintf( "%d", 0x00FF00 ) );
my $time = localtime;
......@@ -49,7 +47,7 @@ sub _quartus_direct_partitions_logiclock {
END_HDR
my $fin = "# EOF";
my $partitioning =<<"END_PARTITION";
my $partitioning = <<"END_PARTITION";
set_global_assignment -name PARTITION_NETLIST_TYPE POST_SYNTH -section_id $DUT_PART_NAME
set_global_assignment -name PARTITION_COLOR $DUT_COLOR -section_id $DUT_PART_NAME
set_global_assignment -name PARTITION_NETLIST_TYPE POST_SYNTH -section_id $FIJI_PART_NAME
......@@ -60,7 +58,7 @@ set_instance_assignment -name PARTITION_HIERARCHY db/fiji1 -to $FIJI_TO -section
END_PARTITION
my $area =<<"END_LOCK";
my $area = <<"END_LOCK";
set_global_assignment -name LL_ENABLED ON -section_id $DUT_PART_NAME
set_global_assignment -name LL_AUTO_SIZE ON -section_id $DUT_PART_NAME
set_global_assignment -name LL_STATE FLOATING -section_id $DUT_PART_NAME
......@@ -78,12 +76,12 @@ set_global_assignment -name LL_ORIGIN X1_Y1 -section_id $FIJI_PART_NAME
set_instance_assignment -name LL_MEMBER_OF $FIJI_PART_NAME -to $FIJI_TO -section_id $FIJI_PART_NAME
END_LOCK
if ($cfg->{'mode'} eq "NO_OPTIMIZATION") {
if ( $cfg->{'mode'} eq "NO_OPTIMIZATION" ) {
$txt .= $partitioning;
} elsif ($cfg->{'mode'} eq "FIX_PLACEMENT") {
$txt .= $partitioning.$area;
} elsif ( $cfg->{'mode'} eq "FIX_PLACEMENT" ) {
$txt .= $partitioning . $area;
}
return $txt.$fin;
return $txt . $fin;
}
sub _synplify_quartus_partitions_logiclock {
......@@ -102,22 +100,22 @@ sub _synplify_quartus_partitions_logiclock {
END_HDR
my $fin = "# EOF";
my $partitioning = <<"END_PART";
my $partitioning = <<"END_PART";
define_compile_point {v:$DUT_NAME} -type {locked,partition} -comment "Logic under test"
define_compile_point {v:$FIJI_NAME} -type {locked,partition} -comment "Fault injection logic"
END_PART
my $area = <<"END_LOCK";
my $area = <<"END_LOCK";
define_attribute {v:$DUT_NAME} altera_logiclock_location {floating}
define_attribute {v:$FIJI_NAME} altera_logiclock_location {floating}
END_LOCK
if ($cfg->{'mode'} eq "NO_OPTIMIZATION") {
if ( $cfg->{'mode'} eq "NO_OPTIMIZATION" ) {
$txt .= $partitioning;
} elsif ($cfg->{'mode'} eq "FIX_PLACEMENT") {
$txt .= $partitioning.$area;
} elsif ( $cfg->{'mode'} eq "FIX_PLACEMENT" ) {
$txt .= $partitioning . $area;
}
return $txt.$fin;
return $txt . $fin;
}
sub _synplify_xise_partitions_placement {
......@@ -126,15 +124,17 @@ sub _synplify_xise_partitions_placement {
my $DUT_NAME = $cfg->{'dut_module'};
my $FIJI_NAME = $cfg->{'fiji_module'};
my $time = localtime;
my $time = localtime;
my $area_dut = "";
my $area_fiji = "";
if ($cfg->{'family'} =~ /^[Ss]partan/) {
if ( $cfg->{'family'} =~ /^[Ss]partan/ ) {
# AREA specified in CLBs
$area_dut = "CLB_R1C1:CLB_R1C1";
$area_fiji = "CLB_R2C2:CLB_R2C2";
} elsif ($cfg->{'family'} =~ /^[Vv]irtex/ || $cfg->{'family'} =~ /^[Zz]ync/) {
} elsif ( $cfg->{'family'} =~ /^[Vv]irtex/ || $cfg->{'family'} =~ /^[Zz]ync/ ) {
# AREA specified in LUTs
$area_dut = "LUT_X1Y1:LUT_X1Y1";
$area_fiji = "LUT_X2Y2:LUT_X2Y2";
......@@ -148,26 +148,24 @@ sub _synplify_xise_partitions_placement {
END_HDR
my $fin = "# EOF";
my $partitioning = <<"END_PART";
my $partitioning = <<"END_PART";
define_compile_point {v:$DUT_NAME} -type {locked,partition} -comment "Logic under test"
define_compile_point {v:$FIJI_NAME} -type {locked,partition} -comment "Fault injection logic"
END_PART
my $area = <<"END_LOCK";
my $area = <<"END_LOCK";
define_attribute {v:$DUT_NAME} xc_area_group {$area_dut}
define_attribute {v:$FIJI_NAME} xc_area_group {$area_fiji}
END_LOCK
if ($cfg->{'mode'} eq "NO_OPTIMIZATION") {
if ( $cfg->{'mode'} eq "NO_OPTIMIZATION" ) {
$txt .= $partitioning;
} elsif ($cfg->{'mode'} eq "FIX_PLACEMENT") {
$txt .= $partitioning.$area;
} elsif ( $cfg->{'mode'} eq "FIX_PLACEMENT" ) {
$txt .= $partitioning . $area;
}
return $txt.$fin;
return $txt . $fin;
}
my $toolhash = {
synplify_pro => {
quartus => \&_synplify_quartus_partitions_logiclock,
......@@ -178,33 +176,31 @@ my $toolhash = {
}
};
sub placement_partition_constraints {
my ($class, $synthesis_tool, $pr_tool, $cfg, $out_file) = @_;
my ( $class, $synthesis_tool, $pr_tool, $cfg, $out_file ) = @_;
my $synhash = $toolhash->{$synthesis_tool};
if(!defined $synhash) {
if ( !defined $synhash ) {
return "No entries for synthesis tool found";
}
my $sub = $synhash->{$pr_tool};
if(!defined $sub) {
if ( !defined $sub ) {
print Dumper($toolhash);
return "No entries for P&R tool found";
}
my $txt = &{$sub}($cfg);
open(my $file, ">", $out_file) or return "Cannot open file $out_file: $!";
open( my $file, ">", $out_file ) or return "Cannot open file $out_file: $!";
print $file $txt;
close($file) or return "Cannot close file $out_file: $!";
return undef;
}
1;
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
......@@ -17,11 +17,10 @@
# https://rt.cpan.org/Public/Bug/Display.html?id=33655
#-------------------------------------------------------------------------------
# https://rt.cpan.org/Public/Bug/Display.html?id=33655
require Tk::Widget;
package Tk::Widget;
use strict;
use warnings;
......@@ -29,46 +28,41 @@ use warnings;
use constant SCROLL_FACTOR => 2;
# keep Tk::Widgets namespace clean
my($motion,
$do_scroll,
$mousewheel_event,
$setup,
);
sub DynaMouseWheelBind{
my $w = shift;
my ( $motion, $do_scroll, $mousewheel_event, $setup, );
sub DynaMouseWheelBind {
my $w = shift;
my @classes = @_;
my $mw = $w->MainWindow;
my $mw = $w->MainWindow;
$setup->($mw);
for my $class (@classes) {
eval "require $class" or die $@;
# initialize class bindings so the following changes
# won't get overridden
$class->InitClass($mw);
# replace MouseWheel bindings - these should be processed
# through the $mw binding only
my @mw_events = ('<MouseWheel>',
'<4>',
'<5>',
);
$mw->bind($class,$_,'') for (@mw_events);
$mw->bind($class,'<<DynaMouseWheel>>',$do_scroll);
my @mw_events = ( '<MouseWheel>', '<4>', '<5>', );
$mw->bind( $class, $_, '' ) for (@mw_events);
$mw->bind( $class, '<<DynaMouseWheel>>', $do_scroll );
}
}
# setup two bindings to track the window under the cursor
# and globally receive <MouseWheel>
$setup = sub{
$setup = sub {
my $mw = shift;
$mw->bind('all','<Enter>',$motion);
$mw->bind('all','<MouseWheel>',[$mousewheel_event, Tk::Ev('D')]);
$mw->bind('all','<4>',[$mousewheel_event, 120]);
$mw->bind('all','<5>',[$mousewheel_event, -120]);
$mw->bind( 'all', '<Enter>', $motion );
$mw->bind( 'all', '<MouseWheel>', [ $mousewheel_event, Tk::Ev('D') ] );
$mw->bind( 'all', '<4>', [ $mousewheel_event, 120 ] );
$mw->bind( 'all', '<5>', [ $mousewheel_event, -120 ] );
};
{
my $under_cursor ;
my $under_cursor;
my $scrollable;
my $delta;
......@@ -76,24 +70,24 @@ $setup = sub{
$under_cursor = $_[0]->XEvent->Info('W');
};
$do_scroll = sub{
$scrollable->yview('scroll',
-($delta/120) * SCROLL_FACTOR,
'units');
$do_scroll = sub {
$scrollable->yview( 'scroll', -( $delta / 120 ) * SCROLL_FACTOR, 'units' );
};
$mousewheel_event = sub{
$mousewheel_event = sub {
my $widget = shift;
$delta = shift;
# just in case, the mouse has not been moved yet:
my $w = $under_cursor ||= $widget;
# print "under_cursor:[$under_cursor]\n";
# print "under_cursor:[$under_cursor]\n";
my @tags = $w->bindtags;
my $has_binding;
until ($has_binding || $w->isa('Tk::Toplevel')){
if($w->Tk::bind(ref($w),'<<DynaMouseWheel>>')){
$has_binding = 1 ;
}else{
until ( $has_binding || $w->isa('Tk::Toplevel') ) {
if ( $w->Tk::bind( ref($w), '<<DynaMouseWheel>>' ) ) {
$has_binding = 1;
} else {
$w = $w->parent;
}
}
......@@ -102,6 +96,6 @@ $setup = sub{
$w->eventGenerate('<<DynaMouseWheel>>');
}
};
} # end of scope for $under_cursor, $scrollable, $delta
} # end of scope for $under_cursor, $scrollable, $delta
1;
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
#!/bin/bash
find -iname "*.pl" -exec perltidy --backup-and-modify-in-place --cuddled-else --maximum-line-length=0 {} \;
find -iname "*.pm" -exec perltidy --backup-and-modify-in-place --cuddled-else --maximum-line-length=0 {} \;
......@@ -19,8 +19,6 @@
#
#-------------------------------------------------------------------------------
## @file
use strict;
......@@ -32,8 +30,8 @@ use FIJI::Downloader;
use Data::Dumper;
use Getopt::Long;
my $cfg = {};
my $rnd = {};
my $cfg = {};
my $rnd = {};
my $USAGE = <<END_USAGE;
Usage: perl $0 [OPTIONS]
......@@ -82,7 +80,7 @@ sub main {
my $rv;
# Validate parameters
if(!defined $cfg->{'settings_name'} || !defined $cfg->{'tests_name'} || !defined $cfg->{'mode'}) {
if ( !defined $cfg->{'settings_name'} || !defined $cfg->{'tests_name'} || !defined $cfg->{'mode'} ) {
print $USAGE;
return 1;
}
......@@ -98,35 +96,35 @@ sub main {
# Check mode and execute tests accordingly
if ( $cfg->{'mode'} eq "auto" ) {
$rv = $fiji_downloader->download_auto(\$new_tests,$cfg->{'portname'});
$rv = $fiji_downloader->download_auto( \$new_tests, $cfg->{'portname'} );
} elsif ( $cfg->{'mode'} eq "manual" ) {
$rv = $fiji_downloader->download_manual($cfg->{'portname'});
} elsif ($cfg->{'mode'} eq "random" ) {
$rv = $fiji_downloader->download_manual( $cfg->{'portname'} );
} elsif ( $cfg->{'mode'} eq "random" ) {
my $prob = 0;
for my $k (keys(%{$rnd})) {
if (!defined $rnd->{$k}) {
for my $k ( keys( %{$rnd} ) ) {
if ( !defined $rnd->{$k} ) {
$logger->error("Value for $k missing.");
print $USAGE;
return 1;
}
$prob += $rnd->{$k} if ($k =~ /^PROB/);
$prob += $rnd->{$k} if ( $k =~ /^PROB/ );
}
if($prob >= 1.0) {
if ( $prob >= 1.0 ) {
$logger->error("Invalid probabilities.");
return 1;
} else {
$fiji_downloader->update_rnd($rnd);
$rv = $fiji_downloader->download_random(\$new_tests,$cfg->{'portname'});
$rv = $fiji_downloader->download_random( \$new_tests, $cfg->{'portname'} );
}
} else {
print "$0: Invalid mode \"".$cfg->{'mode'}."\"\n";
print "$0: Invalid mode \"" . $cfg->{'mode'} . "\"\n";
print $USAGE;
return 1;
}
if(defined $rv && !ref($rv)) {
if ( defined $rv && !ref($rv) ) {
$logger->error($rv);
return 1;
}
......@@ -135,22 +133,21 @@ sub main {
return 0;
}
GetOptions ("mode=s" => \($cfg->{'mode'}),
"settings=s" => \($cfg->{'settings_name'}),
"tests=s" => \($cfg->{'tests_name'}),
"port=s" => \($cfg->{'portname'}),
"min_t1=i" => \($rnd->{'MIN_DURATION_T1'}),
"min_t2=i" => \($rnd->{'MIN_DURATION_T2'}),
"max_t1=i" => \($rnd->{'MAX_DURATION_T1'}),
"max_t2=i" => \($rnd->{'MAX_DURATION_T2'}),
"prob_s0=f" => \($rnd->{'PROB_STUCK_AT_0'}),
"prob_s1=f" => \($rnd->{'PROB_STUCK_AT_1'}),
"prob_dly=f" => \($rnd->{'PROB_DELAY'}),
"prob_seu=f" => \($rnd->{'PROB_SEU'}),
"prob_so=f" => \($rnd->{'PROB_STUCK_OPEN'}),
) or print $USAGE and die ("Invalid arguments");
GetOptions(
"mode=s" => \( $cfg->{'mode'} ),
"settings=s" => \( $cfg->{'settings_name'} ),
"tests=s" => \( $cfg->{'tests_name'} ),
"port=s" => \( $cfg->{'portname'} ),
"min_t1=i" => \( $rnd->{'MIN_DURATION_T1'} ),
"min_t2=i" => \( $rnd->{'MIN_DURATION_T2'} ),
"max_t1=i" => \( $rnd->{'MAX_DURATION_T1'} ),
"max_t2=i" => \( $rnd->{'MAX_DURATION_T2'} ),
"prob_s0=f" => \( $rnd->{'PROB_STUCK_AT_0'} ),
"prob_s1=f" => \( $rnd->{'PROB_STUCK_AT_1'} ),
"prob_dly=f" => \( $rnd->{'PROB_DELAY'} ),
"prob_seu=f" => \( $rnd->{'PROB_SEU'} ),
"prob_so=f" => \( $rnd->{'PROB_STUCK_OPEN'} ),
) or print $USAGE and die("Invalid arguments");
Log::Log4perl::init_and_watch( 'logger.conf', 'HUP' );
exit main($cfg);
This diff is collapsed.
This diff is collapsed.
Supports Markdown
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