mirror of
https://github.com/wfjm/w11.git
synced 2026-01-13 15:37:43 +00:00
perl scripts: add and use bailout
This commit is contained in:
wfjm
parent
5bf5d405c3
commit
a73bda34de
@ -87,6 +87,7 @@ The full set of tests is only run for tagged releases.
|
||||
- tools changes
|
||||
- xviv_msg_filter: display INFO Common 17-14 'further message disabled'
|
||||
- tbrun: add --all option
|
||||
- (all perl scripts): add and use bailout instead of die
|
||||
- viv_tools_build.tcl: increase message limits (all 200, some 5000)
|
||||
- tbench changes:
|
||||
- tst_sram: don't test memory controller reset anymore
|
||||
|
||||
@ -1,7 +1,7 @@
|
||||
#!/usr/bin/perl -w
|
||||
# $Id: config_wrapper 985 2018-01-03 08:59:40Z mueller $
|
||||
# $Id: config_wrapper 1089 2018-12-19 10:45:41Z mueller $
|
||||
#
|
||||
# Copyright 2010-2013 by Walter F.J. Mueller <W.F.J.Mueller@gsi.de>
|
||||
# Copyright 2010-2018 by Walter F.J. Mueller <W.F.J.Mueller@gsi.de>
|
||||
#
|
||||
# This program is free software; you may redistribute and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free
|
||||
@ -14,6 +14,7 @@
|
||||
#
|
||||
# Revision History:
|
||||
# Date Rev Version Comment
|
||||
# 2018-12-18 1089 1.1.9 add and use bailout
|
||||
# 2013-09-21 534 1.1.8 add nexys4 support
|
||||
# 2013-01-02 467 1.1.7 jconfig: prepend '0x' to support 'jtag #2007'
|
||||
# 2012-02-11 457 1.1.6 jconfig: use RETRO_FX2_VID/PID for USB VID/PID
|
||||
@ -38,7 +39,8 @@ use Getopt::Long;
|
||||
|
||||
my %opts = ();
|
||||
|
||||
GetOptions(\%opts, "help", "dry_run", "board=s", "path=s") or exit 1;
|
||||
GetOptions(\%opts, "help", "dry_run", "board=s", "path=s")
|
||||
or bailout("bad command options");
|
||||
|
||||
# setup defaults for board and path
|
||||
if (not defined $opts{board}) {
|
||||
@ -53,14 +55,10 @@ if (not defined $opts{path}) {
|
||||
$opts{path} = "xc6slx45t" if $opts{board} eq "sp605";
|
||||
}
|
||||
|
||||
sub print_help;
|
||||
sub run_command;
|
||||
|
||||
|
||||
autoflush STDOUT 1 if (-p STDOUT); # autoflush if output into pipe
|
||||
|
||||
if (exists $opts{help}) {
|
||||
print_help;
|
||||
print_help();
|
||||
exit 0;
|
||||
}
|
||||
|
||||
@ -107,9 +105,7 @@ if ($board eq "s3board" && $ipath eq "xc3s200") { # S3BOARD-200
|
||||
@plist = ("xccace", $ipath);
|
||||
$pfpga = 2;
|
||||
} else {
|
||||
print STDERR
|
||||
"config_wrapper-E: only s3board/nexys2,3/atlys/sp605 supported\n";
|
||||
exit 1;
|
||||
bailout("only s3board/nexys2,3/atlys/sp605 supported");
|
||||
}
|
||||
|
||||
my @blist;
|
||||
@ -121,39 +117,25 @@ foreach my $part (@plist) {
|
||||
elsif ($part =~ m/^xc7a\d*t?$/) { push @blist, "artix7/data" } # 7-a
|
||||
elsif ($part =~ m/^xccace$/) { push @blist, "acempm/data" } # sys-ace
|
||||
else {
|
||||
print STDERR "config_wrapper-E: no bsdl path known for $part\n";
|
||||
exit 1;
|
||||
bailout("no bsdl path known for $part");
|
||||
}
|
||||
}
|
||||
|
||||
my $cmd = shift @ARGV;
|
||||
my $file = shift @ARGV;
|
||||
|
||||
if (! defined $cmd) {
|
||||
print STDERR "config_wrapper-E: no command specified\n";
|
||||
exit 1;
|
||||
}
|
||||
|
||||
if (! defined $file) {
|
||||
print STDERR "config_wrapper-E: no bit or svf file specified\n";
|
||||
exit 1;
|
||||
}
|
||||
if (! -r $file) {
|
||||
print STDERR "config_wrapper-E: input file not found or readable\n";
|
||||
exit 1;
|
||||
}
|
||||
bailout("no command specified") if (! defined $cmd);
|
||||
bailout("no bit or svf file specified") if (! defined $file);
|
||||
bailout("input file not found or readable") if (! -r $file);
|
||||
|
||||
my $xilpath = $ENV{XILINX};
|
||||
if (! defined $xilpath) {
|
||||
print STDERR "config_wrapper-E: XILINX environment variable not defined\n";
|
||||
exit 1;
|
||||
}
|
||||
bailout("XILINX environment variable not defined") if (! defined $xilpath);
|
||||
|
||||
# ----- iconfig action --------------------------------------------------------
|
||||
if ($cmd eq "iconfig") {
|
||||
|
||||
my $tmpfile = "tmp_config_wrapper.cmd";
|
||||
open (OFILE, ">$tmpfile") or die "Couldn't open tmp cmd file: $!";
|
||||
open (OFILE, ">$tmpfile") or bailout("Couldn't open tmp cmd file: $!");
|
||||
|
||||
print OFILE "setMode -bs\n";
|
||||
print OFILE "setCable -p auto\n";
|
||||
@ -164,7 +146,7 @@ if ($cmd eq "iconfig") {
|
||||
printf OFILE "program -p %d -verify\n", $pfpga;
|
||||
print OFILE "quit\n";
|
||||
|
||||
close (OFILE) or die "Couldn't close tmp cmd file: $!";
|
||||
close (OFILE) or bailout("Couldn't close tmp cmd file: $!");
|
||||
|
||||
my $rc = run_command("impact -batch", $tmpfile);
|
||||
exit $rc;
|
||||
@ -175,7 +157,7 @@ if ($cmd eq "iconfig") {
|
||||
my $bpath = join ";", map "$xilpath/$_",@blist;
|
||||
|
||||
my $tmpfile = "tmp_config_wrapper.cmd";
|
||||
open (OFILE, ">$tmpfile") or die "Couldn't open tmp cmd file: $!";
|
||||
open (OFILE, ">$tmpfile") or bailout("Couldn't open tmp cmd file: $!");
|
||||
|
||||
# the UrJtag and Xilinx impact have different chain and part number schemes
|
||||
# impact: 1-based, 1 is first in chain;
|
||||
@ -213,7 +195,7 @@ if ($cmd eq "iconfig") {
|
||||
printf OFILE "part %d\n", $jtag_part;
|
||||
printf OFILE "svf %s\n", $file;
|
||||
|
||||
close (OFILE) or die "Couldn't close tmp cmd file: $!";
|
||||
close (OFILE) or bailout("Couldn't close tmp cmd file: $!");
|
||||
|
||||
my $rc = run_command("jtag", $tmpfile);
|
||||
exit $rc;
|
||||
@ -224,7 +206,7 @@ if ($cmd eq "iconfig") {
|
||||
$ofile =~ s/\.bit/\.svf/;
|
||||
|
||||
my $tmpfile = "tmp_config_wrapper.cmd";
|
||||
open (OFILE, ">$tmpfile") or die "Couldn't open tmp cmd file: $!";
|
||||
open (OFILE, ">$tmpfile") or bailout("Couldn't open tmp cmd file: $!");
|
||||
|
||||
print OFILE "setMode -bs\n";
|
||||
printf OFILE "setCable -port svf -file %s\n", $ofile;
|
||||
@ -232,14 +214,13 @@ if ($cmd eq "iconfig") {
|
||||
print OFILE "program -p 1\n";
|
||||
print OFILE "quit\n";
|
||||
|
||||
close (OFILE) or die "Couldn't close tmp cmd file: $!";
|
||||
close (OFILE) or bailout("Couldn't close tmp cmd file: $!");
|
||||
|
||||
my $rc = run_command("impact -batch", $tmpfile);
|
||||
exit $rc;
|
||||
}
|
||||
|
||||
print STDERR "config_wrapper-E: command must be bit2svf, iconfig or jconfig\n";
|
||||
exit 1;
|
||||
bailout("command must be bit2svf, iconfig or jconfig");
|
||||
|
||||
#-------------------------------------------------------------------------------
|
||||
|
||||
@ -267,12 +248,20 @@ sub run_command {
|
||||
}
|
||||
}
|
||||
|
||||
unlink $tmpfile or die "Couldn't delete tmp cmd file: $!";
|
||||
unlink $tmpfile or bailout("Couldn't delete tmp cmd file: $!");
|
||||
return $rc;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------------------
|
||||
|
||||
sub bailout {
|
||||
my ($msg) = @_;
|
||||
print STDERR "config_wrapper-F: $msg\n";
|
||||
exit 1;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------------------
|
||||
|
||||
sub print_help {
|
||||
print "usage: config_wrapper [--help] [--board=b] [--path=p] cmd file\n";
|
||||
print " cmd bit2svf or iconfig or jconfig\n";
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
#!/usr/bin/perl -w
|
||||
# $Id: create_disk 1059 2018-10-27 10:34:16Z mueller $
|
||||
# $Id: create_disk 1089 2018-12-19 10:45:41Z mueller $
|
||||
#
|
||||
# Copyright 2013-2018 by Walter F.J. Mueller <W.F.J.Mueller@gsi.de>
|
||||
#
|
||||
@ -14,6 +14,7 @@
|
||||
#
|
||||
# Revision History:
|
||||
# Date Rev Version Comment
|
||||
# 2018-12-18 1089 1.1.3 add and use bailout
|
||||
# 2015-06-21 692 1.1.2 use sysseek rather seek; add RM80
|
||||
# 2015-04-06 665 1.1.1 add alias RM03 (for RM02) and RP05 (for RP04)
|
||||
# 2014-06-14 562 1.1 BUGFIX: repair --boot; add RM02,RM05,RP04,RP07
|
||||
@ -31,12 +32,7 @@ my %opts = ();
|
||||
|
||||
GetOptions(\%opts, "help", "typ=s", "ini=s", "bad", "boot"
|
||||
)
|
||||
or exit 1;
|
||||
|
||||
sub do_inipatt;
|
||||
sub do_badtable;
|
||||
sub do_boot;
|
||||
sub print_help;
|
||||
or bailout("bad command options");
|
||||
|
||||
# disk type table
|
||||
my %disktype = (
|
||||
@ -71,14 +67,14 @@ if (-e $fnam) {
|
||||
exit 1;
|
||||
}
|
||||
|
||||
bailout("missing --typ specification") unless defined $opts{typ};
|
||||
my $typ = uc($opts{typ});
|
||||
|
||||
$typ = "RM03" if defined $typ && $typ eq "RM02"; # RM02 is equivalent to RM03
|
||||
$typ = "RP05" if defined $typ && $typ eq "RP04"; # RM04 is equivalent to RP05
|
||||
|
||||
unless (defined $typ && exists $disktype{$typ}) {
|
||||
print STDERR "create_disk-E: no or invalid --typ specification, use --help\n";
|
||||
exit 1;
|
||||
bailout("invalid --typ specification, use --help");
|
||||
}
|
||||
|
||||
my $cyl = $disktype{$typ}{cyl};
|
||||
@ -87,33 +83,30 @@ my $sec = $disktype{$typ}{sec};
|
||||
my $bps = $disktype{$typ}{bps};
|
||||
my $bad = $disktype{$typ}{bad};
|
||||
|
||||
if ($opts{bad} && !$bad) {
|
||||
print STDERR "create_disk-E: --bad not supported for type '$typ', abort\n";
|
||||
exit 1;
|
||||
}
|
||||
bailout("--bad not supported for type '$typ'") if ($opts{bad} && !$bad);
|
||||
|
||||
my $nblk = $cyl*$hd*$sec;
|
||||
my $cap = $nblk * $bps;
|
||||
|
||||
my $fh = new FileHandle;
|
||||
sysopen($fh, $fnam, O_RDWR|O_CREAT)
|
||||
or die "failed to create '$fnam': $!";
|
||||
or bailout("failed to create '$fnam': $!");
|
||||
|
||||
# seek to end, write 1 byte at end
|
||||
my $rc = sysseek($fh, $cap-1, SEEK_SET);
|
||||
if (not $rc) {die "seek failed: $!";}
|
||||
bailout("seek failed: $!") if (not $rc);
|
||||
my $buf = pack('C1',0);
|
||||
$rc = syswrite($fh, $buf, length($buf));
|
||||
if ($rc<=0) {die "write failed: $!";}
|
||||
bailout("write failed: $!") if ($rc<=0);
|
||||
|
||||
# handle init patterns
|
||||
do_inipatt if $opts{ini};
|
||||
do_inipatt() if $opts{ini};
|
||||
|
||||
# handle factory bad block table
|
||||
do_badtable if $opts{bad};
|
||||
do_badtable() if $opts{bad};
|
||||
|
||||
# write dummy boot block
|
||||
do_boot if $opts{boot};
|
||||
do_boot() if $opts{boot};
|
||||
|
||||
#-------------------------------------------------------------------------------
|
||||
|
||||
@ -129,10 +122,10 @@ sub do_inipatt {
|
||||
}
|
||||
my $buf = pack('v*',@dat);
|
||||
my $rc = sysseek($fh, 0, SEEK_SET);
|
||||
if (not $rc) {die "seek failed: $!";}
|
||||
bailout("seek failed: $!") if (not $rc);
|
||||
for (my $i=0; $i<$nblk; $i++) {
|
||||
$rc = syswrite($fh, $buf, length($buf));
|
||||
if ($rc<=0) {die "write failed: $!";}
|
||||
bailout("write failed: $!") if ($rc<=0);
|
||||
}
|
||||
|
||||
} elsif ($ini eq 'test') {
|
||||
@ -141,7 +134,7 @@ sub do_inipatt {
|
||||
my $cur_trk = 0;
|
||||
my $cur_cyl = 0;
|
||||
my $rc = sysseek($fh, 0, SEEK_SET);
|
||||
if (not $rc) {die "seek failed: $!";}
|
||||
bailout("seek failed: $!") if (not $rc);
|
||||
for (my $i=0; $i<$nblk; $i++) {
|
||||
my @dat;
|
||||
for (my $i=0; $i<$bps/16; $i++) {
|
||||
@ -153,7 +146,7 @@ sub do_inipatt {
|
||||
}
|
||||
my $buf = pack('v*',@dat);
|
||||
$rc = syswrite($fh, $buf, length($buf));
|
||||
if ($rc<=0) {die "write failed: $!";}
|
||||
bailout("write failed: $!") if ($rc<=0);
|
||||
$cur_sec += 1;
|
||||
if ($cur_sec >= $sec) {
|
||||
$cur_sec = 0;
|
||||
@ -184,11 +177,11 @@ sub do_badtable {
|
||||
|
||||
my $pos = $cap - $sec*$bps; # position of last track
|
||||
my $rc = sysseek($fh, $pos, SEEK_SET);
|
||||
if (not $rc) {die "seek failed: $!";}
|
||||
bailout("seek failed: $!") if (not $rc);
|
||||
my $nsec = ($sec > 10) ? 10 : $sec; # write last track, at most 10 sec
|
||||
for (my $i=0; $i<$nsec; $i++) {
|
||||
$rc = syswrite($fh, $buf, length($buf));
|
||||
if ($rc<=0) {die "write failed: $!";}
|
||||
bailout("write failed: $!") if ($rc<=0);
|
||||
}
|
||||
return;
|
||||
}
|
||||
@ -209,9 +202,9 @@ sub do_boot {
|
||||
|
||||
my $buf = pack('v*',@dat);
|
||||
my $rc = sysseek($fh, 0, SEEK_SET);
|
||||
if (not $rc) {die "seek failed: $!";}
|
||||
bailout("seek failed: $!") if (not $rc);
|
||||
$rc = syswrite($fh, $buf, length($buf));
|
||||
if ($rc<=0) {die "write failed: $!";}
|
||||
bailout("write failed: $!") if ($rc<=0);
|
||||
|
||||
$buf = "\r\n";
|
||||
$buf .= "\r\n";
|
||||
@ -234,15 +227,23 @@ sub do_boot {
|
||||
# don't add more text, all has been said anyway !!
|
||||
|
||||
$rc = sysseek($fh ,0100, SEEK_SET);
|
||||
if (not $rc) {die "seek failed: $!";}
|
||||
bailout("seek failed: $!") if (not $rc);
|
||||
$rc = syswrite($fh, $buf, length($buf));
|
||||
if ($rc<=0) {die "write failed: $!";}
|
||||
bailout("write failed: $!") if ($rc<=0);
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------------------
|
||||
|
||||
sub bailout {
|
||||
my ($msg) = @_;
|
||||
print STDERR "create_disk-F: $msg\n";
|
||||
exit 1;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------------------
|
||||
|
||||
sub print_help {
|
||||
my ($ptyp) = @_;
|
||||
print "usage: create_disk [options] <file>\n";
|
||||
|
||||
@ -1,7 +1,7 @@
|
||||
#!/usr/bin/perl -w
|
||||
# $Id: dmscntanal 985 2018-01-03 08:59:40Z mueller $
|
||||
# $Id: dmscntanal 1089 2018-12-19 10:45:41Z mueller $
|
||||
#
|
||||
# Copyright 2015- by Walter F.J. Mueller <W.F.J.Mueller@gsi.de>
|
||||
# Copyright 2015-2018 by Walter F.J. Mueller <W.F.J.Mueller@gsi.de>
|
||||
#
|
||||
# This program is free software; you may redistribute and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free
|
||||
@ -14,6 +14,7 @@
|
||||
#
|
||||
# Revision History:
|
||||
# Date Rev Version Comment
|
||||
# 2018-12-18 1089 1.0.1 add and use bailout
|
||||
# 2015-06-28 696 1.0 Initial version
|
||||
#
|
||||
|
||||
@ -25,13 +26,7 @@ use Getopt::Long;
|
||||
my %opts = ();
|
||||
|
||||
GetOptions(\%opts, "help", "raw")
|
||||
or die "bad options";
|
||||
|
||||
sub print_help;
|
||||
sub read_file;
|
||||
sub show_raw;
|
||||
sub add_groups;
|
||||
sub group_new;
|
||||
or bailout("bad command options");
|
||||
|
||||
my @snum2nam;
|
||||
my %snam2num;
|
||||
@ -45,7 +40,7 @@ my $sum_um;
|
||||
autoflush STDOUT 1 if (-p STDOUT); # autoflush if output into pipe
|
||||
|
||||
if (exists $opts{help}) {
|
||||
print_help;
|
||||
print_help();
|
||||
exit 0;
|
||||
}
|
||||
|
||||
@ -70,7 +65,7 @@ sub read_file {
|
||||
$sum_km = 0;
|
||||
$sum_um = 0;
|
||||
|
||||
open IFILE,"<$file" or die "failed to open $file";
|
||||
open IFILE,"<$file" or bailout("failed to open '$file': $!");
|
||||
|
||||
while (<IFILE>) {
|
||||
chomp;
|
||||
@ -161,8 +156,8 @@ sub show_frac {
|
||||
sub print_frac {
|
||||
my ($pre,$text,$nom,$denom) = @_;
|
||||
|
||||
die "print_frac: bad key '$nom'" unless defined $snam2num{$nom};
|
||||
die "print_frac: bad key '$denom'" unless defined $snam2num{$denom};
|
||||
bailout("print_frac: bad key '$nom'") unless defined $snam2num{$nom};
|
||||
bailout("print_frac: bad key '$denom'") unless defined $snam2num{$denom};
|
||||
|
||||
my $fact = ($pre eq '%') ? 100. : 1.;
|
||||
printf " %-22s %7.2f%s %7.2f%s %7.2f%s\n",
|
||||
@ -460,8 +455,8 @@ sub group_new {
|
||||
my $snum = shift @_;
|
||||
my $snam = shift @_;
|
||||
|
||||
die "group_new: bad snum '$snum'" if defined $snum2nam[$snum];
|
||||
die "group_new: bad snam '$snam'" if defined $snam2num{$snam};
|
||||
bailout("group_new: bad snum '$snum'") if defined $snum2nam[$snum];
|
||||
bailout("group_new: bad snam '$snam'") if defined $snam2num{$snam};
|
||||
|
||||
$snum2nam[$snum] = $snam;
|
||||
$snam2num{$snam} = $snum;
|
||||
@ -473,7 +468,7 @@ sub group_new {
|
||||
foreach my $val (@_) {
|
||||
if ($val eq '+') { $sign = 1.; next;}
|
||||
if ($val eq '-') { $sign = -1.; next;}
|
||||
die "bad action '$val'" unless defined $snam2num{$val};
|
||||
bailout("bad action '$val'") unless defined $snam2num{$val};
|
||||
$dat_all{$snam} += $sign * $dat_all{$val};
|
||||
$dat_km{$snam} += $sign * $dat_km{$val};
|
||||
$dat_um{$snam} += $sign * $dat_um{$val};
|
||||
@ -482,6 +477,14 @@ sub group_new {
|
||||
|
||||
#-------------------------------------------------------------------------------
|
||||
|
||||
sub bailout {
|
||||
my ($msg) = @_;
|
||||
print STDERR "dmscntanal-F: $msg\n";
|
||||
exit 1;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------------------
|
||||
|
||||
sub print_help {
|
||||
print "usage: dmscntanal file\n";
|
||||
print " --help this message\n";
|
||||
|
||||
@ -1,7 +1,7 @@
|
||||
#!/usr/bin/perl -w
|
||||
# $Id: dmscntconv 985 2018-01-03 08:59:40Z mueller $
|
||||
# $Id: dmscntconv 1089 2018-12-19 10:45:41Z mueller $
|
||||
#
|
||||
# Copyright 2015- by Walter F.J. Mueller <W.F.J.Mueller@gsi.de>
|
||||
# Copyright 2015-2018 by Walter F.J. Mueller <W.F.J.Mueller@gsi.de>
|
||||
#
|
||||
# This program is free software; you may redistribute and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free
|
||||
@ -14,6 +14,7 @@
|
||||
#
|
||||
# Revision History:
|
||||
# Date Rev Version Comment
|
||||
# 2018-12-18 1089 1.0.2 add and use bailout
|
||||
# 2015-12-28 721 1.0.1 adopt to new syntax of STATE2SNUM mapper
|
||||
# 2015-06-27 695 1.0 Initial version
|
||||
#
|
||||
@ -26,11 +27,7 @@ use Getopt::Long;
|
||||
my %opts = ();
|
||||
|
||||
GetOptions(\%opts, "help", "src=s")
|
||||
or die "bad options";
|
||||
|
||||
sub print_help;
|
||||
sub do_src;
|
||||
sub do_file;
|
||||
or bailout("bad command options");
|
||||
|
||||
my @snum2nam;
|
||||
my %snam2num;
|
||||
@ -41,13 +38,13 @@ my %dat_um;
|
||||
autoflush STDOUT 1 if (-p STDOUT); # autoflush if output into pipe
|
||||
|
||||
if (exists $opts{help}) {
|
||||
print_help;
|
||||
print_help();
|
||||
exit 0;
|
||||
}
|
||||
|
||||
if (scalar(@ARGV) == 0) {
|
||||
print STDERR "dmscntconv-E: no input file specified\n";
|
||||
print_help;
|
||||
print_help();
|
||||
exit 1;
|
||||
}
|
||||
|
||||
@ -98,7 +95,7 @@ for (my $snum=0; $snum<scalar(@snum2nam); $snum++) {
|
||||
sub do_src {
|
||||
my ($file) = @_;
|
||||
|
||||
open SFILE,"<$file" or die "failed to open $file";
|
||||
open SFILE,"<$file" or bailout("failed to open '$file': $!");
|
||||
|
||||
my $begin_seen;
|
||||
while (<SFILE>) {
|
||||
@ -136,7 +133,7 @@ sub do_file {
|
||||
%dat_um = ();
|
||||
%dat_all = ();
|
||||
|
||||
open IFILE,"<$file" or die "failed to open $file";
|
||||
open IFILE,"<$file" or bailout("failed to open '$file': $!");
|
||||
|
||||
while (<IFILE>) {
|
||||
chomp;
|
||||
@ -176,6 +173,13 @@ sub do_file {
|
||||
|
||||
#-------------------------------------------------------------------------------
|
||||
|
||||
sub bailout {
|
||||
my ($msg) = @_;
|
||||
print STDERR "dmscntconv-F: $msg\n";
|
||||
exit 1;
|
||||
}
|
||||
#-------------------------------------------------------------------------------
|
||||
|
||||
sub print_help {
|
||||
print "usage: dmscntconv [--src=source] file\n";
|
||||
print " --help this message\n";
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
#!/usr/bin/perl -w
|
||||
# $Id: fx2load_wrapper 985 2018-01-03 08:59:40Z mueller $
|
||||
# $Id: fx2load_wrapper 1089 2018-12-19 10:45:41Z mueller $
|
||||
#
|
||||
# Copyright 2011-2014 by Walter F.J. Mueller <W.F.J.Mueller@gsi.de>
|
||||
#
|
||||
@ -51,15 +51,10 @@ if (not defined $opts{ihx_path}) {
|
||||
$opts{ihx_path} = $ENV{RETROBASE} . "/tools/fx2/bin";
|
||||
}
|
||||
|
||||
sub print_help;
|
||||
sub run_command;
|
||||
sub get_usb_id;
|
||||
sub get_usb_prodinfo;
|
||||
|
||||
autoflush STDOUT 1 if (-p STDOUT); # autoflush if output into pipe
|
||||
|
||||
if (exists $opts{help}) {
|
||||
print_help;
|
||||
print_help();
|
||||
exit 0;
|
||||
}
|
||||
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
#!/usr/bin/perl -w
|
||||
# $Id: github_md2html 1057 2018-10-19 15:06:42Z mueller $
|
||||
# $Id: github_md2html 1089 2018-12-19 10:45:41Z mueller $
|
||||
#
|
||||
# Copyright 2016-2018 by Walter F.J. Mueller <W.F.J.Mueller@gsi.de>
|
||||
#
|
||||
@ -14,6 +14,7 @@
|
||||
#
|
||||
# Revision History:
|
||||
# Date Rev Version Comment
|
||||
# 2018-12-18 1089 1.1.4 add and use bailout
|
||||
# 2018-10-19 1057 1.1.3 add --verbose; don't list up-to-date files anymore
|
||||
# 2018-07-02 1033 1.1.2 use non-greedy match in -stand code
|
||||
# 2018-05-13 1021 1.1.1 handle fragment identifiers in -standalone mapping
|
||||
@ -31,21 +32,19 @@ my %opts = ();
|
||||
|
||||
GetOptions(\%opts,
|
||||
"context:s", "force", "standalone", "trace", "verbose",
|
||||
"dump", "help") || exit 1;
|
||||
"dump", "help")
|
||||
or bailout("bad command options");
|
||||
|
||||
my $url_ghapi_md = "https://api.github.com/markdown";
|
||||
my $url_ghapi_mdraw = "https://api.github.com/markdown/raw";
|
||||
my $url_css_ghmd = "https://wfjm.github.io/css/github-markdown.css";
|
||||
my $url_css_ghmdbody = "https://wfjm.github.io/css/github-markdown-body.css";
|
||||
|
||||
sub print_help;
|
||||
sub do_md2html;
|
||||
|
||||
autoflush STDOUT 1 if (-p STDOUT); # autoflush if output into pipe
|
||||
autoflush STDOUT 1 if (-t STDOUT); # autoflush if output into term
|
||||
|
||||
if (exists $opts{help}) {
|
||||
print_help;
|
||||
print_help();
|
||||
exit 0;
|
||||
}
|
||||
|
||||
@ -57,7 +56,7 @@ foreach my $arg (@ARGV) {
|
||||
push @flist, $arg;
|
||||
} elsif (-d $arg) {
|
||||
open (FFILE, "find $arg -name '*.md' -type f | sort |")
|
||||
or die "Failed to run 'find $arg': $!";
|
||||
or bailout("Failed to run 'find $arg': $!");
|
||||
while (<FFILE>) {
|
||||
chomp;
|
||||
push @flist, $_;
|
||||
@ -72,7 +71,7 @@ foreach my $arg (@ARGV) {
|
||||
|
||||
unless (scalar @flist) {
|
||||
print STDERR "github_md2html-E: no files specified of found\n";
|
||||
print_help;
|
||||
print_help();
|
||||
exit 1;
|
||||
}
|
||||
|
||||
@ -150,7 +149,7 @@ sub do_md2html {
|
||||
my $idata;
|
||||
{
|
||||
local $/; # slurp file ...
|
||||
open IFILE, $ifile or die "file open read failed";
|
||||
open IFILE, $ifile or bailout("file read open for '$ifile' failed: $!");
|
||||
$idata = <IFILE>;
|
||||
close IFILE;
|
||||
}
|
||||
@ -212,7 +211,7 @@ sub do_md2html {
|
||||
}gex;
|
||||
}
|
||||
|
||||
open OFILE, ">$ofile" or die "file open write failed";
|
||||
open OFILE, ">$ofile" or bailout("file write open for '$ofile' failed: $!");
|
||||
print OFILE '<!DOCTYPE html>',"\n";
|
||||
print OFILE '<html>',"\n";
|
||||
print OFILE '<head>',"\n";
|
||||
@ -248,6 +247,14 @@ sub do_md2html {
|
||||
|
||||
#-------------------------------------------------------------------------------
|
||||
|
||||
sub bailout {
|
||||
my ($msg) = @_;
|
||||
print STDERR "github_md2html-F: $msg\n";
|
||||
exit 1;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------------------
|
||||
|
||||
sub print_help {
|
||||
print "usage: github_md2html [opts] files...\n";
|
||||
print " --force update all (default: check timestamps)\n";
|
||||
|
||||
@ -1,7 +1,7 @@
|
||||
#!/usr/bin/perl -w
|
||||
# $Id: ip_inspect 985 2018-01-03 08:59:40Z mueller $
|
||||
# $Id: ip_inspect 1089 2018-12-19 10:45:41Z mueller $
|
||||
#
|
||||
# Copyright 2017- by Walter F.J. Mueller <W.F.J.Mueller@gsi.de>
|
||||
# Copyright 2017-2018 by Walter F.J. Mueller <W.F.J.Mueller@gsi.de>
|
||||
#
|
||||
# This program is free software; you may redistribute and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free
|
||||
@ -14,6 +14,7 @@
|
||||
#
|
||||
# Revision History:
|
||||
# Date Rev Version Comment
|
||||
# 2018-12-18 1089 0.1.1 add and use bailout
|
||||
# 2017-04-08 872 0.1 First draft
|
||||
#
|
||||
|
||||
@ -26,20 +27,13 @@ my %opts = ();
|
||||
|
||||
GetOptions(\%opts,
|
||||
)
|
||||
or exit 1;
|
||||
|
||||
sub print_usage;
|
||||
sub do_defeif;
|
||||
sub do_addr4;
|
||||
sub do_defroute;
|
||||
or bailout("bad command options");
|
||||
|
||||
autoflush STDOUT 1 if (-p STDOUT); # autoflush if output into pipe
|
||||
|
||||
my $cmd = shift @ARGV;
|
||||
unless (defined $cmd) {
|
||||
printf STDERR "ip_inspect-E: missing command; use 'ip_inspect help'\n";
|
||||
exit 1;
|
||||
}
|
||||
|
||||
bailout("missing command; use 'ip_inspect help'") unless (defined $cmd);
|
||||
|
||||
if ($cmd eq "help") {
|
||||
print_usage();
|
||||
@ -50,8 +44,7 @@ if ($cmd eq "help") {
|
||||
} elsif ($cmd eq "defroute") {
|
||||
do_defroute();
|
||||
} else {
|
||||
printf STDERR "ip_inspect-E: invalid command '$cmd'\n";
|
||||
exit 1;
|
||||
bailout("invalid command '$cmd'");
|
||||
}
|
||||
exit 0;
|
||||
|
||||
@ -59,7 +52,7 @@ exit 0;
|
||||
|
||||
sub do_defeif {
|
||||
my @devs;
|
||||
open (IPRES, "ip link show|") or die "failed to call ip";
|
||||
open (IPRES, "ip link show|") or bailout("failed to call ip");
|
||||
while (<IPRES>) {
|
||||
chomp;
|
||||
next unless m|^\d+:\s*(\w+):|;
|
||||
@ -68,14 +61,10 @@ sub do_defeif {
|
||||
push @devs,$dev;
|
||||
}
|
||||
close (IPRES);
|
||||
if (scalar(@devs) == 0) {
|
||||
printf STDERR "ip_inspect-E: failed to detect default device\n";
|
||||
exit 1;
|
||||
}
|
||||
bailout("failed to detect default device") if (scalar(@devs) == 0);
|
||||
if (scalar(@devs) > 1) {
|
||||
printf STDERR "ip_inspect-E: multiple ethernet interfaces '%s'\n",
|
||||
join ',',@devs;
|
||||
exit 1;
|
||||
my $devstr = join ',',@devs;
|
||||
bailout("multiple ethernet interfaces '$devstr'");
|
||||
}
|
||||
print "$devs[0]\n";
|
||||
return;
|
||||
@ -86,15 +75,12 @@ sub do_defeif {
|
||||
sub do_addr4 {
|
||||
my $dev = shift @ARGV;
|
||||
my $fld = shift @ARGV;
|
||||
unless (defined $dev && defined $fld) {
|
||||
printf STDERR "ip_inspect-E: missing device or field\n";
|
||||
exit 1;
|
||||
}
|
||||
bailout("missing device or field") unless (defined $dev && defined $fld);
|
||||
|
||||
my $addr;
|
||||
my $size;
|
||||
my $bcast;
|
||||
open (IPRES, "ip addr show dev $dev|") or die "failed to call ip";
|
||||
open (IPRES, "ip addr show dev $dev|") or bailout("failed to call ip");
|
||||
while (<IPRES>) {
|
||||
chomp;
|
||||
next unless m|^\s+inet\s+([0-9.]+)/(\d+)\s+brd\s+([0-9.]+)|;
|
||||
@ -113,8 +99,7 @@ sub do_addr4 {
|
||||
} elsif ($fld eq "bcast") {
|
||||
print "$bcast\n";
|
||||
} else {
|
||||
printf STDERR "ip_inspect-E: invalid field '$fld'\n";
|
||||
exit 1;
|
||||
bailout("invalid field '$fld'");
|
||||
}
|
||||
return;
|
||||
}
|
||||
@ -122,7 +107,7 @@ sub do_addr4 {
|
||||
#-------------------------------------------------------------------------------
|
||||
|
||||
sub do_defroute {
|
||||
open (IPRES, "ip route show|") or die "failed to call ip";
|
||||
open (IPRES, "ip route show|") or bailout("failed to call ip");
|
||||
while (<IPRES>) {
|
||||
chomp;
|
||||
if (m|^default via\s+([0-9.]+)|) {
|
||||
@ -131,8 +116,7 @@ sub do_defroute {
|
||||
return;
|
||||
}
|
||||
}
|
||||
printf STDERR "ip_inspect-E: failed to find default route\n";
|
||||
exit 1;
|
||||
bailout("failed to find default route");
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------------------
|
||||
@ -149,6 +133,14 @@ sub size2mask {
|
||||
|
||||
#-------------------------------------------------------------------------------
|
||||
|
||||
sub bailout {
|
||||
my ($msg) = @_;
|
||||
print STDERR "ip_inspect-F: $msg\n";
|
||||
exit 1;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------------------
|
||||
|
||||
sub print_usage {
|
||||
print "usage: ip_inspect <command> <args>\n";
|
||||
print " ip_inspect defeif # get default eth interface\n";
|
||||
|
||||
@ -1,7 +1,7 @@
|
||||
#!/usr/bin/perl -w
|
||||
# $Id: njobihtm 985 2018-01-03 08:59:40Z mueller $
|
||||
# $Id: njobihtm 1089 2018-12-19 10:45:41Z mueller $
|
||||
#
|
||||
# Copyright 2016- by Walter F.J. Mueller <W.F.J.Mueller@gsi.de>
|
||||
# Copyright 2016-2018 by Walter F.J. Mueller <W.F.J.Mueller@gsi.de>
|
||||
#
|
||||
# This program is free software; you may redistribute and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free
|
||||
@ -14,6 +14,7 @@
|
||||
#
|
||||
# Revision History:
|
||||
# Date Rev Version Comment
|
||||
# 2018-12-18 1089 1.0.1 add and use bailout
|
||||
# 2016-10-01 810 1.0 Initial version
|
||||
#
|
||||
|
||||
@ -26,10 +27,7 @@ my %opts = ();
|
||||
|
||||
GetOptions(\%opts, "verbose", "mem=s"
|
||||
)
|
||||
or die "bad options";
|
||||
|
||||
sub get_cpuinfo;
|
||||
sub get_meminfo;
|
||||
or bailout("bad command options");
|
||||
|
||||
my $ncpu;
|
||||
my $ntpc;
|
||||
@ -39,12 +37,8 @@ my $njob = 1;
|
||||
get_cpuinfo();
|
||||
get_meminfo();
|
||||
|
||||
if (defined $ncpu && defined $ntpc && defined $nkb) {
|
||||
} else {
|
||||
print STDERR "njobihtm-F: failed to obtain cpu or mem size\n";
|
||||
exit 1;
|
||||
}
|
||||
|
||||
bailout("failed to obtain cpu or mem size")
|
||||
unless (defined $ncpu && defined $ntpc && defined $nkb);
|
||||
|
||||
my $ncore = $ncpu / $ntpc; # number of cores
|
||||
my $nht = $ncpu - $ncore;
|
||||
@ -71,8 +65,7 @@ if (defined $opts{mem}) {
|
||||
$njob = $njobm;
|
||||
}
|
||||
} else {
|
||||
print STDERR "njobihtm-F: bad -mem option '$opts{mem}', must be nnn[MG]\n";
|
||||
exit 1;
|
||||
bailout("bad -mem option '$opts{mem}', must be nnn[MG]");
|
||||
}
|
||||
}
|
||||
|
||||
@ -83,7 +76,7 @@ exit 0;
|
||||
#-------------------------------------------------------------------------------
|
||||
sub get_cpuinfo {
|
||||
open (LSCPU, "lscpu|")
|
||||
or die "failed to open 'lscpu|': $!";
|
||||
or bailout("failed to open 'lscpu|': $!");
|
||||
|
||||
while (<LSCPU>) {
|
||||
chomp;
|
||||
@ -102,7 +95,7 @@ sub get_cpuinfo {
|
||||
#-------------------------------------------------------------------------------
|
||||
sub get_meminfo {
|
||||
open (MEMINFO, "/proc/meminfo")
|
||||
or die "failed to open '/proc/meminfo': $!";
|
||||
or bailout("failed to open '/proc/meminfo': $!");
|
||||
|
||||
while (<MEMINFO>) {
|
||||
chomp;
|
||||
@ -117,3 +110,10 @@ sub get_meminfo {
|
||||
return;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------------------
|
||||
|
||||
sub bailout {
|
||||
my ($msg) = @_;
|
||||
print STDERR "njobihtm-F: $msg\n";
|
||||
exit 1;
|
||||
}
|
||||
|
||||
@ -1,7 +1,7 @@
|
||||
#!/usr/bin/perl -w
|
||||
# $Id: svn_set_ignore 985 2018-01-03 08:59:40Z mueller $
|
||||
# $Id: svn_set_ignore 1089 2018-12-19 10:45:41Z mueller $
|
||||
#
|
||||
# Copyright 2007-2017 by Walter F.J. Mueller <W.F.J.Mueller@gsi.de>
|
||||
# Copyright 2007-2018 by Walter F.J. Mueller <W.F.J.Mueller@gsi.de>
|
||||
#
|
||||
# This program is free software; you may redistribute and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free
|
||||
@ -14,6 +14,7 @@
|
||||
#
|
||||
# Revision History:
|
||||
# Date Rev Vers Comment
|
||||
# 2018-12-18 1089 1.2.2 add and use bailout
|
||||
# 2017-05-27 899 1.2.1 check svn:ignore existance before reading it
|
||||
# 2016-12-17 821 1.2 use .gitignore rather .cvsignore
|
||||
# 2014-11-04 601 1.1 use 'svn info' rather /.svn check for svn >= 1.7
|
||||
@ -26,21 +27,19 @@ use strict; # require strict checking
|
||||
|
||||
use Getopt::Long;
|
||||
|
||||
sub do_dir;
|
||||
|
||||
my @dirlist;
|
||||
my %ignores;
|
||||
|
||||
my %opts = ();
|
||||
|
||||
GetOptions(\%opts, "trace", "dry-run")
|
||||
or die "bad options";
|
||||
or bailout("bad command options");
|
||||
|
||||
if (@ARGV) {
|
||||
push @dirlist, @ARGV;
|
||||
} else {
|
||||
@dirlist = `find -type d | sort`;
|
||||
die "bad find|grep" if $?;
|
||||
bailout("bad find|grep") if $?;
|
||||
chomp @dirlist;
|
||||
# drop some directories at this level
|
||||
@dirlist = grep {! /\/(\.svn|\.Xil)/} @dirlist;
|
||||
@ -74,7 +73,7 @@ sub do_dir {
|
||||
if (-r "$d/.gitignore") {
|
||||
print "read $d/.gitignore\n" if exists $opts{trace};
|
||||
open (CVSIG, "$d/.gitignore")
|
||||
or die "failed to read $d/.gitignore";
|
||||
or bailout("failed to read '$d/.gitignore': $!");
|
||||
while (<CVSIG>) {
|
||||
chomp;
|
||||
next if /^\s*$/; # ignore empty or space only lines
|
||||
@ -95,7 +94,7 @@ sub do_dir {
|
||||
# check whether svn:ignore already defined
|
||||
my $has_ignore = 0;
|
||||
open (SVN, "svn pl $dirname|")
|
||||
or die "failed to open svn pl pipe for '$dirname'";
|
||||
or bailout("failed to open svn pl pipe for '$dirname': $!");
|
||||
while (<SVN>) {
|
||||
chomp;
|
||||
if (m/^\s*svn:ignore\s*$/) {
|
||||
@ -108,7 +107,7 @@ sub do_dir {
|
||||
# read svn:ignore, if it exists
|
||||
if ($has_ignore) {
|
||||
open (SVN, "svn pg svn:ignore $dirname|")
|
||||
or die "failed to open svn pg pipe for '$dirname'";
|
||||
or bailout("failed to open svn pg pipe for '$dirname': $!");
|
||||
while (<SVN>) {
|
||||
chomp;
|
||||
next if /^\s*$/; # ignore empty or space only lines
|
||||
@ -129,14 +128,24 @@ sub do_dir {
|
||||
print " ", join("\n ",@new_ipat),"\n";
|
||||
|
||||
if (not exists $opts{"dry-run"}) {
|
||||
open (TMP, ">/tmp/svn_set_ignore_$$") or die "failed to open tmp file";
|
||||
open (TMP, ">/tmp/svn_set_ignore_$$")
|
||||
or bailout("failed to open tmp file: $1");
|
||||
print TMP join("\n",@new_ipat),"\n";
|
||||
close (TMP);
|
||||
print `svn ps svn:ignore -F /tmp/svn_set_ignore_$$ $dirname`;
|
||||
die "bad svn ps" if $?;
|
||||
unlink "/tmp/svn_set_ignore_$$" or die "failed to delete tmp file";
|
||||
bailout("bad svn ps") if $?;
|
||||
unlink "/tmp/svn_set_ignore_$$"
|
||||
or bailout("failed to delete tmp file: $!");
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------------------
|
||||
|
||||
sub bailout {
|
||||
my ($msg) = @_;
|
||||
print STDERR "svn_set_ignore-F: $msg\n";
|
||||
exit 1;
|
||||
}
|
||||
|
||||
@ -1,7 +1,7 @@
|
||||
#!/usr/bin/perl -w
|
||||
# $Id: tap2file 985 2018-01-03 08:59:40Z mueller $
|
||||
# $Id: tap2file 1089 2018-12-19 10:45:41Z mueller $
|
||||
#
|
||||
# Copyright 2015- by Walter F.J. Mueller <W.F.J.Mueller@gsi.de>
|
||||
# Copyright 2015-2018 by Walter F.J. Mueller <W.F.J.Mueller@gsi.de>
|
||||
#
|
||||
# This program is free software; you may redistribute and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free
|
||||
@ -14,6 +14,7 @@
|
||||
#
|
||||
# Revision History:
|
||||
# Date Rev Version Comment
|
||||
# 2018-12-18 1089 1.0.2 add and use bailout
|
||||
# 2015-06-03 686 1.0.1 add print_usage; cleanups
|
||||
# 2015-05-24 684 1.0 Initial version
|
||||
#
|
||||
@ -29,20 +30,17 @@ use Getopt::Long;
|
||||
my %opts = ();
|
||||
|
||||
GetOptions(\%opts, "pref=s", "help")
|
||||
or die "bad options";
|
||||
|
||||
sub close_ofile;
|
||||
sub print_usage;
|
||||
or bailout("bad command options");
|
||||
|
||||
if (scalar(@ARGV) == 0 || exists $opts{help}) {
|
||||
print_usage;
|
||||
print_usage();
|
||||
exit 0;
|
||||
}
|
||||
|
||||
my $ifile = shift @ARGV;
|
||||
exit 0 unless defined $ifile;
|
||||
|
||||
open(IFILE, "<$ifile") || die("Can't open $ifile: $!");
|
||||
open(IFILE, "<$ifile") or bailout("Can't open '$ifile': $!");
|
||||
|
||||
my $basename = $ifile;
|
||||
$basename = $1 if $ifile =~ m|.*/(.*)|;
|
||||
@ -64,7 +62,7 @@ while ($nb = read(IFILE, $block, 4)) {
|
||||
my $metabeg = unpack("V", $block);
|
||||
|
||||
if ($metabeg == 0x00000000) {
|
||||
close_ofile;
|
||||
close_ofile();
|
||||
$nfile += 1;
|
||||
next;
|
||||
}
|
||||
@ -74,7 +72,7 @@ while ($nb = read(IFILE, $block, 4)) {
|
||||
|
||||
unless (defined fileno OFILE) {
|
||||
$ofile = sprintf("%s%02d.dat", $pref,$nfile);
|
||||
open(OFILE, ">$ofile") || die("Can't open $ofile: $!");
|
||||
open(OFILE, ">$ofile") or bailout("Can't open '$ofile': $!");
|
||||
}
|
||||
|
||||
$nb = read(IFILE, $block, $metabeg);
|
||||
@ -100,7 +98,7 @@ while ($nb = read(IFILE, $block, 4)) {
|
||||
}
|
||||
}
|
||||
|
||||
close_ofile;
|
||||
close_ofile();
|
||||
exit 0;
|
||||
|
||||
# ----------------------------------------------------------------------------
|
||||
@ -119,6 +117,14 @@ sub close_ofile {
|
||||
$rlmax = 0;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------------------
|
||||
|
||||
sub bailout {
|
||||
my ($msg) = @_;
|
||||
print STDERR "tap2file-F: $msg\n";
|
||||
exit 1;
|
||||
}
|
||||
|
||||
# ----------------------------------------------------------------------------
|
||||
sub print_usage {
|
||||
print "usage: tap2file [options] ifile\n";
|
||||
|
||||
@ -1,7 +1,7 @@
|
||||
#!/usr/bin/perl -w
|
||||
# $Id: tbw 985 2018-01-03 08:59:40Z mueller $
|
||||
# $Id: tbw 1089 2018-12-19 10:45:41Z mueller $
|
||||
#
|
||||
# Copyright 2007-2016 by Walter F.J. Mueller <W.F.J.Mueller@gsi.de>
|
||||
# Copyright 2007-2018 by Walter F.J. Mueller <W.F.J.Mueller@gsi.de>
|
||||
#
|
||||
# This program is free software; you may redistribute and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free
|
||||
@ -14,6 +14,7 @@
|
||||
#
|
||||
# Revision History:
|
||||
# Date Rev Version Comment
|
||||
# 2018-12-18 1089 1.5.5 add and use bailout
|
||||
# 2016-09-03 805 1.5.4 use {} as delimiter for immediate mode data
|
||||
# 2016-08-28 804 1.5.3 BUGFIX: xsim: append -R to ARGV (was prepended...)
|
||||
# 2016-07-02 782 1.5.2 add TBW_GHDL_OPTS
|
||||
@ -68,18 +69,16 @@ my @file_dsc; # file descriptors from tbw.dat
|
||||
|
||||
my $ghdl_opts = $ENV{TBW_GHDL_OPTS}; # ghdl extra options
|
||||
|
||||
sub print_usage;
|
||||
|
||||
autoflush STDOUT 1; # autoflush, so nothing lost on exec later
|
||||
|
||||
if (scalar(@ARGV) && $ARGV[0] =~ m/^-+help$/) { # -help or --help given
|
||||
print_usage;
|
||||
print_usage();
|
||||
exit 0;
|
||||
}
|
||||
|
||||
if (scalar(@ARGV) == 0) {
|
||||
print "tbw-E: name of test bench code missing\n";
|
||||
print_usage;
|
||||
print_usage();
|
||||
exit 1;
|
||||
}
|
||||
|
||||
@ -124,11 +123,7 @@ if ($tb_code_stem =~ /_XSim$/) { # is it an XSim executable ?
|
||||
|
||||
$is_ghdl = not ($is_isim or $is_xsim);
|
||||
|
||||
if (not -e $tb_code) {
|
||||
print "tbw-E: $tb_code not existing or not executable\n";
|
||||
print_usage;
|
||||
exit 1;
|
||||
}
|
||||
bailout("'$tb_code' not existing or not executable") if (not -e $tb_code);
|
||||
|
||||
#
|
||||
# read tbw.dat file in current directory or directory of executable
|
||||
@ -141,7 +136,7 @@ if (-r $tbwdat_file) {
|
||||
my $ok = 0;
|
||||
my $done = 0;
|
||||
|
||||
open (TBW, $tbwdat_file) or die "failed to open $tbwdat_file: $!";
|
||||
open (TBW, $tbwdat_file) or bailout("failed to open '$tbwdat_file': $!");
|
||||
while (<TBW>) {
|
||||
chomp;
|
||||
next if /^#/;
|
||||
@ -194,20 +189,14 @@ unless (scalar (@file_dsc)) {
|
||||
$ok += 1;
|
||||
}
|
||||
}
|
||||
if ($ok == 0) {
|
||||
print STDERR "tbw-F: can't match named argument: $arg\n";
|
||||
exit 1;
|
||||
} elsif ($ok > 1) {
|
||||
print STDERR "tbw-F: ambiguous match for named argument: $arg\n";
|
||||
exit 1;
|
||||
}
|
||||
bailout("can't match named argument: $arg") if ($ok == 0);
|
||||
bailout("ambiguous match for named argument: $arg") if ($ok > 1);
|
||||
|
||||
} else { # positional argument
|
||||
if ($ind < scalar(@file_dsc)) {
|
||||
$file_dsc[$ind]->{val} = $arg;
|
||||
} else {
|
||||
print STDERR "tbw-F: too many positional arguments: $arg\n";
|
||||
exit 1;
|
||||
bailout("too many positional arguments: $arg");
|
||||
}
|
||||
$ind += 1;
|
||||
}
|
||||
@ -232,14 +221,15 @@ foreach my $dsc (@file_dsc) {
|
||||
if ($val eq "<fifo>") { # handle FIFO's
|
||||
next if (-p $tag);
|
||||
print "tbw-I: create FIFO $tag\n";
|
||||
mkfifo($tag, 0666) || die "can't mkfifo $tag: $!";
|
||||
mkfifo($tag, 0666) or bailout("can't mkfifo '$tag': $!");
|
||||
|
||||
} else { # handle link to file cases
|
||||
|
||||
if ($val =~ /^\{(.*)\}$/) { # immediate data case: "{line1;line2;...}"
|
||||
my @lines = split /;/, $1;
|
||||
my $fname = "$tag\_tmp.tmp";
|
||||
open TFILE,">$fname" or die "can't create temporary file $fname: $!";
|
||||
open TFILE,">$fname"
|
||||
or bailout("can't create temporary file '$fname': $!");
|
||||
foreach (@lines) {
|
||||
s/^\s*//;
|
||||
s/\s*$//;
|
||||
@ -264,8 +254,7 @@ foreach my $dsc (@file_dsc) {
|
||||
}
|
||||
|
||||
if (not -r $val) {
|
||||
print "tbw-F: file for '$tag' not existing or not readable: $val\n";
|
||||
exit 1;
|
||||
bailout("file for '$tag' not existing or not readable: $val");
|
||||
}
|
||||
|
||||
if (-l $tag) {
|
||||
@ -273,18 +262,17 @@ foreach my $dsc (@file_dsc) {
|
||||
if ($cur_link ne $val) {
|
||||
print "tbw-I: redefine $tag -> $val\n";
|
||||
unlink $tag
|
||||
or die "failed to unlink: $!";
|
||||
or bailout("failed to unlink '$tag': $!");
|
||||
symlink $val, $tag
|
||||
or die "failed to symlink 1: $!";
|
||||
or bailout("failed to symlink 1: $!");
|
||||
}
|
||||
} else {
|
||||
if (-e $tag) {
|
||||
print "tbw-F: $tag exists but is not a symlink\n";
|
||||
exit 1;
|
||||
bailout("$tag exists but is not a symlink");
|
||||
} else {
|
||||
print "tbw-I: define $tag -> $val\n";
|
||||
symlink $val, $tag
|
||||
or die "failed to symlink 2: $!";
|
||||
or bailout("failed to symlink 2: $!");
|
||||
}
|
||||
}
|
||||
}
|
||||
@ -304,16 +292,24 @@ if ($is_ghdl && defined $ghdl_opts) {
|
||||
if ($is_isim_run) { # handle for isim 'run all'
|
||||
my $cmd = "xtwi" . " " . $tb_code . " " . join " ",@ARGV;
|
||||
open (ISIM_RUN, "| $cmd")
|
||||
or die "failed to open process pipe to isim: $!";
|
||||
or bailout("failed to open process pipe to isim: $!");
|
||||
print ISIM_RUN "run all\n";
|
||||
print ISIM_RUN "quit\n";
|
||||
close (ISIM_RUN)
|
||||
or die "failed to close process pipe to isim: $!";
|
||||
or bailout("failed to close process pipe to isim: $!");
|
||||
|
||||
} else { # otherwise just exec
|
||||
# print ($tb_code . " " . join(" ",@ARGV) . "\n");
|
||||
exec $tb_code,@ARGV
|
||||
or die "failed to exec: $!";
|
||||
or bailout("failed to exec: $!");
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------------------
|
||||
|
||||
sub bailout {
|
||||
my ($msg) = @_;
|
||||
print STDERR "tbw-F: $msg\n";
|
||||
exit 1;
|
||||
}
|
||||
|
||||
# ----------------------------------------------------------------------------
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
#!/usr/bin/perl -w
|
||||
# $Id: ti_w11 916 2017-06-25 13:30:07Z mueller $
|
||||
# $Id: ti_w11 1089 2018-12-19 10:45:41Z mueller $
|
||||
#
|
||||
# Copyright 2013-2017 by Walter F.J. Mueller <W.F.J.Mueller@gsi.de>
|
||||
# License disclaimer see License.txt in $RETROBASE directory
|
||||
@ -27,8 +27,6 @@ use 5.14.0; # require Perl 5.14 or higher
|
||||
use strict; # require strict checking
|
||||
use FileHandle;
|
||||
|
||||
sub print_usage;
|
||||
|
||||
autoflush STDOUT 1; # autoflush, so nothing lost on exec later
|
||||
|
||||
my $sysbase = "$ENV{RETROBASE}/rtl/sys_gen/w11a";
|
||||
|
||||
@ -1,7 +1,7 @@
|
||||
#!/usr/bin/perl -w
|
||||
# $Id: ticonv_pdpcp 985 2018-01-03 08:59:40Z mueller $
|
||||
# $Id: ticonv_pdpcp 1089 2018-12-19 10:45:41Z mueller $
|
||||
#
|
||||
# Copyright 2013-2016 by Walter F.J. Mueller <W.F.J.Mueller@gsi.de>
|
||||
# Copyright 2013-2018 by Walter F.J. Mueller <W.F.J.Mueller@gsi.de>
|
||||
#
|
||||
# This program is free software; you may redistribute and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free
|
||||
@ -14,6 +14,7 @@
|
||||
#
|
||||
# Revision History:
|
||||
# Date Rev Version Comment
|
||||
# 2018-12-18 1089 1.3.3 add and use bailout
|
||||
# 2016-08-07 795 1.3.2 avoid GetOptions =f (bug in perl v5.22.1)
|
||||
# 2015-05-08 675 1.3.1 start/stop/suspend overhaul
|
||||
# 2015-04-03 661 1.3 adopt to new stat checking and mask polarity
|
||||
@ -37,24 +38,18 @@ my %opts = ();
|
||||
|
||||
GetOptions(\%opts, "tout=s", "cmax=i"
|
||||
)
|
||||
or die "bad options";
|
||||
|
||||
sub cmdlist_do;
|
||||
sub add_edata;
|
||||
or bailout("bad command options");
|
||||
|
||||
my @cmdlist;
|
||||
|
||||
if (scalar(@ARGV) != 2) {
|
||||
print STDERR "ticonv_pdpcp-E: usage: ticonv_pdpcp <cpucmd> <filename>\n";
|
||||
exit 1;
|
||||
}
|
||||
bailout("usage: ticonv_pdpcp <cpucmd> <filename>") if (scalar(@ARGV) != 2);
|
||||
|
||||
my $cpu = $ARGV[0];
|
||||
my $fnam = $ARGV[1];
|
||||
my $tout = $opts{tout} || 10.;
|
||||
my $cmax = $opts{cmax} || 6;
|
||||
|
||||
open IFILE, $fnam or die "failed to open '$fnam'";
|
||||
open IFILE, $fnam or bailout("failed to open '$fnam': $!");
|
||||
|
||||
print "set old_statvalue [rlc get statvalue]\n";
|
||||
print "set old_statmask [rlc get statmask]\n";
|
||||
@ -94,10 +89,7 @@ while (<IFILE>) {
|
||||
|
||||
# .mode mode -> accept only 'pdpcp', quit otherwise ----------------
|
||||
} elsif ($cmd =~ /^\.mode\s+(.*)$/) {
|
||||
if ($1 ne "pdpcp") {
|
||||
print "# FAIL: $cmd not supported\n";
|
||||
exit 1;
|
||||
}
|
||||
bailout("# FAIL: $cmd not supported") if ($1 ne "pdpcp");
|
||||
|
||||
# .sdef s=ref[,msk] ------------------------------------------------
|
||||
} elsif ($cmd =~ /^\.sdef\s+s=([01]+),?([01]*)$/) {
|
||||
@ -189,7 +181,7 @@ while (<IFILE>) {
|
||||
push @mask, "0";
|
||||
$domask = 1;
|
||||
} else {
|
||||
exit 1;
|
||||
bailout("# FAIL: unsupported brm construct");
|
||||
}
|
||||
$i++;
|
||||
}
|
||||
@ -233,8 +225,7 @@ while (<IFILE>) {
|
||||
print "## TODO... $cmd\n";
|
||||
|
||||
} else {
|
||||
print "# FAIL: no match for '$cmd'\n";
|
||||
exit 1;
|
||||
bailout("# FAIL: no match for '$cmd'");
|
||||
}
|
||||
|
||||
cmdlist_do() if scalar(@cmdlist) >= $cmax;
|
||||
@ -274,3 +265,10 @@ sub cmdlist_do {
|
||||
return;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------------------
|
||||
|
||||
sub bailout {
|
||||
my ($msg) = @_;
|
||||
print STDERR "ticonv_pdpcp-F: $msg\n";
|
||||
exit 1;
|
||||
}
|
||||
|
||||
@ -1,7 +1,7 @@
|
||||
#!/usr/bin/perl -w
|
||||
# $Id: ticonv_rri 985 2018-01-03 08:59:40Z mueller $
|
||||
# $Id: ticonv_rri 1089 2018-12-19 10:45:41Z mueller $
|
||||
#
|
||||
# Copyright 2014-2017 by Walter F.J. Mueller <W.F.J.Mueller@gsi.de>
|
||||
# Copyright 2014-2018 by Walter F.J. Mueller <W.F.J.Mueller@gsi.de>
|
||||
#
|
||||
# This program is free software; you may redistribute and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free
|
||||
@ -14,6 +14,7 @@
|
||||
#
|
||||
# Revision History:
|
||||
# Date Rev Version Comment
|
||||
# 2018-12-18 1089 1.2.3 add and use bailout
|
||||
# 2017-05-01 891 1.2.2 use 'rlc rawwblk' instead of 'rlc rawio -wblk'
|
||||
# 2016-08-07 795 1.2.1 avoid GetOptions =f (bug in perl v5.22.1)
|
||||
# 2015-04-03 661 1.2 adopt to new stat checking and mask polarity
|
||||
@ -62,20 +63,7 @@ my %opts = ();
|
||||
|
||||
GetOptions(\%opts, "tout=s", "cmax=i"
|
||||
)
|
||||
or die "bad options";
|
||||
|
||||
sub cmdlist_do;
|
||||
sub add_addr;
|
||||
sub add_data;
|
||||
sub add_edata;
|
||||
sub add_edata;
|
||||
|
||||
sub cget_chkblank; # check for unused chars in cmd line
|
||||
sub cget_tagval2_gdat; # get tag=v1[,v2], generic base
|
||||
sub cget_tagval_gdat; # get tag=val, generic base
|
||||
sub cget_gdat; # get generic base value
|
||||
sub sget_bdat; # convert 01 string -> binary value
|
||||
sub get_line;
|
||||
or bailout("bad command options");
|
||||
|
||||
my $cmd_line;
|
||||
my $cmd_rest;
|
||||
@ -84,10 +72,7 @@ my $dbase = 2; # use binary as default data radix
|
||||
my @cmdfh;
|
||||
my @cmdlist;
|
||||
|
||||
if (scalar(@ARGV) != 1) {
|
||||
print STDERR "ticonv_rri-E: usage: ticonv_rri <filename>\n";
|
||||
exit 1;
|
||||
}
|
||||
bailout("usage: ticonv_rri <filename>") if (scalar(@ARGV) != 1);
|
||||
|
||||
my $fnam = $ARGV[0];
|
||||
my $tout = $opts{tout} || 10.;
|
||||
@ -98,7 +83,7 @@ my $msk_sdef = 0xf8; # ignore the status bits + attn flag
|
||||
my $chk_ndef = 1; # dcnt default check on by default
|
||||
|
||||
my $fh = new FileHandle;
|
||||
$fh->open("<$fnam") or die "failed to open '$fnam'";
|
||||
$fh->open("<$fnam") or bailout("failed to open '$fnam': $!");
|
||||
push @cmdfh, $fh;
|
||||
|
||||
print "set save_config_basedata [rlc get basedata]\n";
|
||||
@ -114,10 +99,7 @@ while (1) {
|
||||
|
||||
# .mode mode -> accept only 'rri', quit otherwise ------------------
|
||||
if ($cmd =~ /^\.mode\s+(.*)$/) {
|
||||
if ($1 ne "rri") {
|
||||
print "# FAIL: $cmd not supported\n";
|
||||
exit 1;
|
||||
}
|
||||
bailout("# FAIL: $cmd not supported") if ($1 ne "rri");
|
||||
next;
|
||||
|
||||
# .dbaso n ---------------------------------------------------------
|
||||
@ -285,8 +267,7 @@ while (1) {
|
||||
|
||||
# unknown commands -------------------------------------------------
|
||||
} else {
|
||||
print "# FAIL: no match for '$cmd'\n";
|
||||
exit 1;
|
||||
bailout("# FAIL: no match for '$cmd'");
|
||||
}
|
||||
|
||||
cget_chkblank();
|
||||
@ -377,8 +358,8 @@ sub cmdlist_do {
|
||||
sub cget_chkblank { # check for unused chars in cmd line
|
||||
$cmd_rest =~ s/^\s*//;
|
||||
if ($cmd_rest ne "") {
|
||||
print "ticonv_rri-E: extra data ignored: \"$cmd_rest\"\n";
|
||||
print " for command: \"$cmd_line\"\n";
|
||||
print STDERR "ticonv_rri-E: extra data ignored: \"$cmd_rest\"\n";
|
||||
print STDERR " for command: \"$cmd_line\"\n";
|
||||
exit 1;
|
||||
}
|
||||
}
|
||||
@ -464,18 +445,13 @@ sub cget_gdat { # get generic base value
|
||||
}
|
||||
}
|
||||
|
||||
if (not defined $dat) {
|
||||
print "ticonv_rri-E: cget_gdat error in \"$cmd_rest\" (base=$dbase)\n";
|
||||
exit 1;
|
||||
}
|
||||
bailout("cget_gdat error in \"$cmd_rest\" (base=$dbase)") unless defined $dat;
|
||||
|
||||
if (defined $min && $dat < $min) {
|
||||
print "ticonv_rri-E: cget_gdat range error, $dat < $min\n";
|
||||
exit 1;
|
||||
bailout("cget_gdat range error, $dat < $min");
|
||||
}
|
||||
if (defined $max && $dat > $max) {
|
||||
print "ticonv_rri-E: cget_gdat range error, $dat > $max\n";
|
||||
exit 1;
|
||||
bailout("cget_gdat range error, $dat > $max");
|
||||
}
|
||||
|
||||
return $dat;
|
||||
@ -488,10 +464,7 @@ sub sget_bdat { # convert 01 string -> binary value
|
||||
my $nchar = length($str);
|
||||
my $odat = 0;
|
||||
|
||||
if ($nchar != $nbit) {
|
||||
print "ticonv_rri-E: sget_bdat error \'$str\' has not length $nbit\n";
|
||||
exit 1;
|
||||
}
|
||||
bailout("sget_bdat error '$str' has not length $nbit") if $nchar != $nbit;
|
||||
|
||||
for (my $i = 0; $i < $nchar; $i++) {
|
||||
$odat *= 2;
|
||||
@ -517,7 +490,7 @@ sub get_line {
|
||||
if ($cmd =~ /^@(.+)/) {
|
||||
my $fnam = $1;
|
||||
my $fh = new FileHandle;
|
||||
$fh->open("<$fnam") or die "failed to open '$fnam'";
|
||||
$fh->open("<$fnam") or bailout("failed to open '$fnam': $!");
|
||||
push @cmdfh, $fh;
|
||||
next;
|
||||
}
|
||||
@ -545,3 +518,11 @@ sub get_line {
|
||||
return $cmd;
|
||||
}
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------------------
|
||||
|
||||
sub bailout {
|
||||
my ($msg) = @_;
|
||||
print STDERR "ticonv_rri-F: $msg\n";
|
||||
exit 1;
|
||||
}
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
#!/usr/bin/perl -w
|
||||
# $Id: tmuconv 1053 2018-10-06 20:34:52Z mueller $
|
||||
# $Id: tmuconv 1089 2018-12-19 10:45:41Z mueller $
|
||||
#
|
||||
# Copyright 2008-2018 by Walter F.J. Mueller <W.F.J.Mueller@gsi.de>
|
||||
#
|
||||
@ -14,6 +14,7 @@
|
||||
#
|
||||
# Revision History:
|
||||
# Date Rev Version Comment
|
||||
# 2018-12-18 1089 1.1.3 add and use bailout
|
||||
# 2018-10-05 1053 1.1.2 use 'ca.*' instead of 'sy.*' fields
|
||||
# 2015-11-01 712 1.1.1 BUGFIX: fix '.' handling for br/sob instructions
|
||||
# BUGFIX: correct xor (now r,dst, and not src,r)
|
||||
@ -92,12 +93,7 @@ my %opts = ();
|
||||
|
||||
GetOptions(\%opts, "help", "dump", "cdump",
|
||||
"t_id", "t_ru", "t_em", "t_ib")
|
||||
or die "bad options";
|
||||
|
||||
sub print_help;
|
||||
sub do_file;
|
||||
sub code2mnemo;
|
||||
sub regmod;
|
||||
or bailout("bad command options");
|
||||
|
||||
my @var_name;
|
||||
my @var_type;
|
||||
@ -449,7 +445,7 @@ my %pdp11_regs = ( # use simh naming convention
|
||||
autoflush STDOUT 1 if (-p STDOUT); # autoflush if output into pipe
|
||||
|
||||
if (exists $opts{help}) {
|
||||
print_help;
|
||||
print_help();
|
||||
exit 0;
|
||||
}
|
||||
|
||||
@ -473,7 +469,7 @@ foreach my $file (@ARGV) {
|
||||
sub do_file {
|
||||
my ($file) = @_;
|
||||
|
||||
open IFILE,"<$file" or die "failed to open $file";
|
||||
open IFILE,"<$file" or bailout("failed to open '$file': $!");
|
||||
|
||||
my $idec_cyc = 0;
|
||||
my $change_cyc = 0;
|
||||
@ -958,6 +954,14 @@ sub regmod {
|
||||
|
||||
#-------------------------------------------------------------------------------
|
||||
|
||||
sub bailout {
|
||||
my ($msg) = @_;
|
||||
print STDERR "tmuconv-F: $msg\n";
|
||||
exit 1;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------------------
|
||||
|
||||
sub print_help {
|
||||
print "usage: tmuconf <command> file\n";
|
||||
print " --help this message\n";
|
||||
|
||||
@ -1,7 +1,7 @@
|
||||
#!/usr/bin/perl -w
|
||||
# $Id: xise_msg_filter 985 2018-01-03 08:59:40Z mueller $
|
||||
# $Id: xise_msg_filter 1089 2018-12-19 10:45:41Z mueller $
|
||||
#
|
||||
# Copyright 2011-2015 by Walter F.J. Mueller <W.F.J.Mueller@gsi.de>
|
||||
# Copyright 2011-2018 by Walter F.J. Mueller <W.F.J.Mueller@gsi.de>
|
||||
#
|
||||
# This program is free software; you may redistribute and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free
|
||||
@ -14,6 +14,7 @@
|
||||
#
|
||||
# Revision History:
|
||||
# Date Rev Version Comment
|
||||
# 2018-12-18 1089 1.1.3 add and use bailout
|
||||
# 2015-01-30 640 1.1.2 renamed from isemsg_filter
|
||||
# 2014-02-01 550 1.1.1 rename --pack to --pacc (accepted is meant here)
|
||||
# 2012-01-04 450 1.1 preliminary check for par 'all constraints met'
|
||||
@ -28,11 +29,8 @@ use Getopt::Long;
|
||||
|
||||
my %opts = ();
|
||||
|
||||
GetOptions(\%opts, "help", "pacc") || exit 1;
|
||||
|
||||
sub print_help;
|
||||
sub read_mfs;
|
||||
sub read_log;
|
||||
GetOptions(\%opts, "help", "pacc")
|
||||
or bailout("bad command options");
|
||||
|
||||
my $type = shift @ARGV;
|
||||
my $mfsnam = shift @ARGV;
|
||||
@ -47,19 +45,16 @@ my $misscnt = 0;
|
||||
autoflush STDOUT 1; # autoflush, so nothing lost on exec later
|
||||
|
||||
if (exists $opts{help}) {
|
||||
print_help;
|
||||
print_help();
|
||||
exit 0;
|
||||
}
|
||||
|
||||
if (!defined $type || !defined $mfsnam || !defined $lognam) {
|
||||
print STDERR "xise_msg_filter-E: one of 'type mfset log' missing \n\n";
|
||||
print_help;
|
||||
exit 1;
|
||||
bailout("one of 'type mfset log' missing");
|
||||
}
|
||||
|
||||
if ($type !~ m{^(xst|tra|map|par|twr|bgn)$}) {
|
||||
print STDERR "xise_msg_filter-E: type must be xst,tra,map,par,twr, or bgn\n";
|
||||
exit 1;
|
||||
bailout("type must be xst,tra,map,par,twr, or bgn");
|
||||
}
|
||||
|
||||
if (read_mfs()) {exit 1;}
|
||||
@ -126,7 +121,7 @@ sub read_mfs {
|
||||
return 1;
|
||||
}
|
||||
|
||||
open (FFILE, $mfsnam) or die "can't open for read $mfsnam: $!";
|
||||
open (FFILE, $mfsnam) or bailout("can't open for read $mfsnam: $!");
|
||||
|
||||
my $intyp = 0;
|
||||
|
||||
@ -160,7 +155,7 @@ sub read_log {
|
||||
return 1;
|
||||
}
|
||||
|
||||
open (LFILE, $lognam) or die "can't open for read $lognam: $!";
|
||||
open (LFILE, $lognam) or bailout("can't open for read $lognam: $!");
|
||||
|
||||
my $msgorig = "";
|
||||
my $msgflat = "";
|
||||
@ -203,6 +198,14 @@ sub read_log {
|
||||
|
||||
#-------------------------------------------------------------------------------
|
||||
|
||||
sub bailout {
|
||||
my ($msg) = @_;
|
||||
print STDERR "xise_msg_filter-F: $msg\n";
|
||||
exit 1;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------------------
|
||||
|
||||
sub print_help {
|
||||
print "usage: xise_msg_filter [options] type mfset log\n";
|
||||
print " type log file type: xst,tra,map,par,twr, or bgn\n";
|
||||
|
||||
@ -1,7 +1,7 @@
|
||||
#!/usr/bin/perl -w
|
||||
# $Id: xst_count_bels 985 2018-01-03 08:59:40Z mueller $
|
||||
# $Id: xst_count_bels 1089 2018-12-19 10:45:41Z mueller $
|
||||
#
|
||||
# Copyright 2007-2010 by Walter F.J. Mueller <W.F.J.Mueller@gsi.de>
|
||||
# Copyright 2007-2018 by Walter F.J. Mueller <W.F.J.Mueller@gsi.de>
|
||||
#
|
||||
# This program is free software; you may redistribute and/or modify it under
|
||||
# the terms of the GNU General Public License as published by the Free
|
||||
@ -14,6 +14,7 @@
|
||||
#
|
||||
# Revision History:
|
||||
# Date Rev Version Comment
|
||||
# 2018-12-18 1089 1.2.2 add and use bailout
|
||||
# 2010-04-26 284 1.2.1 add error check for GetOptions
|
||||
# 2007-10-28 93 1.2 added -xsts (_ssim based device summary)
|
||||
# 2007-06-30 62 1.1 fixed parser, now all bels counted
|
||||
@ -24,12 +25,10 @@ use strict; # require strict checking
|
||||
|
||||
use Getopt::Long;
|
||||
|
||||
sub do_file;
|
||||
|
||||
my %opts = ();
|
||||
|
||||
GetOptions(\%opts, "xstl", "xsts")
|
||||
or die "bad options";
|
||||
or bailout("bad command options");
|
||||
|
||||
my $do_xstl = defined $opts{xstl};
|
||||
my $do_xsts = defined $opts{xsts};
|
||||
@ -44,7 +43,7 @@ sub do_file {
|
||||
my %bels;
|
||||
my $cur_bel;
|
||||
|
||||
open (IFILE, $filename) or die "can't open for read $filename";
|
||||
open (IFILE, $filename) or bailout("can't open for read '$filename': $!");
|
||||
while(<IFILE>) {
|
||||
chomp;
|
||||
if (m{^\s*[a-zA-Z0-9_]+\s*:\s*([a-zA-Z0-9_]+)\s*$}) {
|
||||
@ -92,7 +91,7 @@ sub do_file {
|
||||
$n_mult += $bels{$_};
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
print "Device utilization summary (_ssim BELS scan):\n";
|
||||
print "---------------------------------------------\n";
|
||||
printf " Number of Flip Flops: %5d\n", $n_flop;
|
||||
@ -104,3 +103,11 @@ sub do_file {
|
||||
printf " Number of MULT18X18s: %5d\n", $n_mult;
|
||||
}
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------------------
|
||||
|
||||
sub bailout {
|
||||
my ($msg) = @_;
|
||||
print STDERR "xst_count_bels-F: $msg\n";
|
||||
exit 1;
|
||||
}
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user