From a73bda34de5f35b6863a74063d50c7b64cbd5a6c Mon Sep 17 00:00:00 2001 From: wfjm Date: Mon, 24 Dec 2018 09:02:41 +0100 Subject: [PATCH] perl scripts: add and use bailout --- doc/CHANGELOG.md | 1 + tools/bin/config_wrapper | 67 ++++++++++++++++----------------------- tools/bin/create_disk | 59 +++++++++++++++++----------------- tools/bin/dmscntanal | 35 ++++++++++---------- tools/bin/dmscntconv | 26 ++++++++------- tools/bin/fx2load_wrapper | 9 ++---- tools/bin/github_md2html | 27 ++++++++++------ tools/bin/ip_inspect | 56 ++++++++++++++------------------ tools/bin/njobihtm | 32 +++++++++---------- tools/bin/svn_set_ignore | 33 ++++++++++++------- tools/bin/tap2file | 28 +++++++++------- tools/bin/tbw | 62 +++++++++++++++++------------------- tools/bin/ti_w11 | 4 +-- tools/bin/ticonv_pdpcp | 34 ++++++++++---------- tools/bin/ticonv_rri | 65 ++++++++++++++----------------------- tools/bin/tmuconv | 22 +++++++------ tools/bin/xise_msg_filter | 33 ++++++++++--------- tools/bin/xst_count_bels | 21 ++++++++---- 18 files changed, 304 insertions(+), 310 deletions(-) diff --git a/doc/CHANGELOG.md b/doc/CHANGELOG.md index 62f03539..cdf8c8e2 100644 --- a/doc/CHANGELOG.md +++ b/doc/CHANGELOG.md @@ -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 diff --git a/tools/bin/config_wrapper b/tools/bin/config_wrapper index 830d68bf..1cb12d0f 100755 --- a/tools/bin/config_wrapper +++ b/tools/bin/config_wrapper @@ -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 +# Copyright 2010-2018 by Walter F.J. Mueller # # 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"; diff --git a/tools/bin/create_disk b/tools/bin/create_disk index 0475a6c1..7792fd6d 100755 --- a/tools/bin/create_disk +++ b/tools/bin/create_disk @@ -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 # @@ -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] \n"; diff --git a/tools/bin/dmscntanal b/tools/bin/dmscntanal index 1999bc06..889ca4e7 100755 --- a/tools/bin/dmscntanal +++ b/tools/bin/dmscntanal @@ -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 +# Copyright 2015-2018 by Walter F.J. Mueller # # 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 () { 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"; diff --git a/tools/bin/dmscntconv b/tools/bin/dmscntconv index 03a89308..08657482 100755 --- a/tools/bin/dmscntconv +++ b/tools/bin/dmscntconv @@ -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 +# Copyright 2015-2018 by Walter F.J. Mueller # # 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) { @@ -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 () { 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"; diff --git a/tools/bin/fx2load_wrapper b/tools/bin/fx2load_wrapper index 4415bbd4..cbe0849a 100755 --- a/tools/bin/fx2load_wrapper +++ b/tools/bin/fx2load_wrapper @@ -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 # @@ -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; } diff --git a/tools/bin/github_md2html b/tools/bin/github_md2html index 249abea7..f2e4af58 100755 --- a/tools/bin/github_md2html +++ b/tools/bin/github_md2html @@ -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 # @@ -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 () { 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 = ; 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 '',"\n"; print OFILE '',"\n"; print OFILE '',"\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"; diff --git a/tools/bin/ip_inspect b/tools/bin/ip_inspect index 4fee8c84..946dbaf9 100755 --- a/tools/bin/ip_inspect +++ b/tools/bin/ip_inspect @@ -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 +# Copyright 2017-2018 by Walter F.J. Mueller # # 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 () { 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 () { 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 () { 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 \n"; print " ip_inspect defeif # get default eth interface\n"; diff --git a/tools/bin/njobihtm b/tools/bin/njobihtm index 3a592f28..089480fe 100755 --- a/tools/bin/njobihtm +++ b/tools/bin/njobihtm @@ -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 +# Copyright 2016-2018 by Walter F.J. Mueller # # 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 () { 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 () { chomp; @@ -117,3 +110,10 @@ sub get_meminfo { return; } +#------------------------------------------------------------------------------- + +sub bailout { + my ($msg) = @_; + print STDERR "njobihtm-F: $msg\n"; + exit 1; +} diff --git a/tools/bin/svn_set_ignore b/tools/bin/svn_set_ignore index 6edba17a..1cfe830c 100755 --- a/tools/bin/svn_set_ignore +++ b/tools/bin/svn_set_ignore @@ -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 +# Copyright 2007-2018 by Walter F.J. Mueller # # 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 () { 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 () { 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 () { 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; +} diff --git a/tools/bin/tap2file b/tools/bin/tap2file index 9c3be579..4f90b3f2 100755 --- a/tools/bin/tap2file +++ b/tools/bin/tap2file @@ -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 +# Copyright 2015-2018 by Walter F.J. Mueller # # 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"; diff --git a/tools/bin/tbw b/tools/bin/tbw index 84625834..5c8ee9e4 100755 --- a/tools/bin/tbw +++ b/tools/bin/tbw @@ -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 +# Copyright 2007-2018 by Walter F.J. Mueller # # 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 () { 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 "") { # 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; } # ---------------------------------------------------------------------------- diff --git a/tools/bin/ti_w11 b/tools/bin/ti_w11 index b24968aa..b47ebcf3 100755 --- a/tools/bin/ti_w11 +++ b/tools/bin/ti_w11 @@ -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 # 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"; diff --git a/tools/bin/ticonv_pdpcp b/tools/bin/ticonv_pdpcp index aa00e575..92fdc551 100755 --- a/tools/bin/ticonv_pdpcp +++ b/tools/bin/ticonv_pdpcp @@ -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 +# Copyright 2013-2018 by Walter F.J. Mueller # # 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 \n"; - exit 1; -} +bailout("usage: ticonv_pdpcp ") 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 () { # .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 () { push @mask, "0"; $domask = 1; } else { - exit 1; + bailout("# FAIL: unsupported brm construct"); } $i++; } @@ -233,8 +225,7 @@ while () { 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; +} diff --git a/tools/bin/ticonv_rri b/tools/bin/ticonv_rri index 5335abc5..df676aff 100755 --- a/tools/bin/ticonv_rri +++ b/tools/bin/ticonv_rri @@ -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 +# Copyright 2014-2018 by Walter F.J. Mueller # # 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 \n"; - exit 1; -} +bailout("usage: ticonv_rri ") 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; +} diff --git a/tools/bin/tmuconv b/tools/bin/tmuconv index ee0a2d09..a7558616 100755 --- a/tools/bin/tmuconv +++ b/tools/bin/tmuconv @@ -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 # @@ -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 file\n"; print " --help this message\n"; diff --git a/tools/bin/xise_msg_filter b/tools/bin/xise_msg_filter index 7fe031f9..eb05bbc2 100755 --- a/tools/bin/xise_msg_filter +++ b/tools/bin/xise_msg_filter @@ -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 +# Copyright 2011-2018 by Walter F.J. Mueller # # 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"; diff --git a/tools/bin/xst_count_bels b/tools/bin/xst_count_bels index 712845ab..eb9134c5 100755 --- a/tools/bin/xst_count_bels +++ b/tools/bin/xst_count_bels @@ -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 +# Copyright 2007-2018 by Walter F.J. Mueller # # 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() { 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; +}