#!/usr/bin/perl

##------------------------------------------------------------------------------
##
## ybug		    An application for booting SpiNNaker chips
##
## Copyright (C)    The University of Manchester - 2009-2014
##
## Author           Steve Temple, APT Group, School of Computer Science
## Email            steven.temple@manchester.ac.uk
##
##------------------------------------------------------------------------------

# Copyright (c) 2009-2019 The University of Manchester
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.


use strict;
use warnings;

my $crc32_enabled = 1;
eval {
    require String::CRC32;
    String::CRC32->import();
    print "CRC32 Enabled!\n";
    1;
} or $crc32_enabled = 0;

use SpiNN::Util qw/read_file hex_dump parse_cores parse_region parse_apps
                   parse_bits sllt_version/;
use SpiNN::Struct;
use SpiNN::Boot;
use SpiNN::CLI;
use SpiNN::Cmd;


#-------------------------------------------------------------------------------


my $spin;		# SpiNN::Cmd object for SpiNNaker
my $bmp;		# SpiNN::Cmd object for BMP (or undef)
my $cli;		# SpiNN::CLI object

my $sv;			# SpiNN::Struct object

my $debug = 0;		# Enable verbosity
my $expert = 0;		# Expert mode
my $readline = 1;	# Use readline

my $spin_target;	# Target host name
my $bmp_target;		# BMP host name

my $bmp_range;		# BMP ID range

my $spin_port = 17893;	# UDP port for SpiNNaker
my $bmp_port  = 17893;	# UDP port for BMP
my $TUBE_PORT = 17892;	# UDP port for Tubotron

my $APP_MIN = 16;	# Minimum user AppId
my $APP_MAX = 255;	# Maximum AppId

my ($chip_x, $chip_y, $cpu) = (0, 0, 0);

my $srom_type = "25aa1024";	# SROM type

#-------------------------------------------------------------------------------


my $CMD_REMAP = 16;
my $CMD_ALLOC = 28;
my $CMD_RTR   = 29;
my $CMD_RESET = 55;
my $CMD_POWER = 57;

my $NN_CMD_SIG0 = 0;
my $NN_CMD_SIG1 = 4;


#-------------------------------------------------------------------------------


sub cmd_boot
{
    my $cli = shift;
    my $ac = $cli->{arg_c};
    my $file = $cli->{arg_v}->[0] || "scamp.boot";
    my $conf = $cli->{arg_v}->[1] || "";

    return "bad args" unless $ac <= 2;

    eval
    {
        # Warn if already booted
        eval {
        $spin->ver (addr => [], timeout => 0.1);
        print "Warning: Already booted.\n"
        };

        SpiNN::Boot->boot ($spin_target, $file, $conf, debug => $debug);

        # Wait for boot to complete
        my $booted = 1;
        my $have_waited = 0;
        do
        {
            if (!$booted)
            {
                print ".";
                select (undef, undef, undef, 0.5);
                $have_waited = 1;
            }
            my @version_info = @{$spin->ver (addr => [], raw => 1)};
            $booted = $version_info[3] != 0xFF && $version_info[2] != 0xFF;
        } while (!$booted);
        if ($have_waited)
        {
            print "\n";
        }

        # Inform the user!
        my $s = $spin->ver (addr => []);
        $s =~ s/ at .*//;

        my $n = $sv->read_var ("sv.p2p_active", addr => []);

        $spin->iptag_set (0, $TUBE_PORT, host => "0.0.0.0", addr => []);

        print "Booted $s on $n chips\n";
    };

    # Return to the chip we were on before booting
    $spin->addr ($chip_x, $chip_y, $cpu);

    return $@;
}


sub cmd_sver
{
    eval { print $spin->ver, "\n" };

    return $@;
}


sub cmd_lw
{
    my $cli = shift;
    my $ac = $cli->{arg_c};
    my $link = $cli->{arg_x}->[0];
    my $addr = $cli->{arg_x}->[1];
    my $data = $cli->{arg_x}->[2];

    return "bad args" if $ac < 2 || $ac > 3;

    eval
    {
        if ($ac == 2)
        {
            my $data = $spin->link_read ($link, $addr, 4, unpack => "V");

            printf "%08x = %08x\n", $addr, $data->[0];
        }
        else
        {
            my $d = pack "V", $data;

            $spin->link_write ($link, $addr, $d);
        }
    };

    return $@;
}


sub cmd_lmemw
{
    my $cli = shift;
    my $ac = $cli->{arg_c};
    my $link = $cli->{arg_n}->[0];
    my $addr = $cli->{arg_x}->[1];

    return "bad args" unless $ac == 2;

    eval
    {
        my $data = $spin->link_read ($link, $addr, 256);
        print hex_dump ($data, addr => $addr, format => "word");
    };

    return $@;
}


sub cmd_smemw
{
    my $cli = shift;
    my $ac = $cli->{arg_c};
    my $addr = ($ac >= 1) ? $cli->{arg_x}->[0] : 0;

    eval
    {
        my $data = $spin->read ($addr, 256, type => "word");
        print hex_dump ($data, addr => $addr, format => "word");
    };

    return $@;
}


sub cmd_smemh
{
    my $cli = shift;
    my $ac = $cli->{arg_c};
    my $addr = ($ac >= 1) ? $cli->{arg_x}->[0] : 0;

    eval
    {
        my $data = $spin->read ($addr, 256, type => "half");
        print hex_dump ($data, addr => $addr, format => "half",
                        width => 16);
    };

    return $@;
}


sub cmd_smemb
{
    my $cli = shift;
    my $ac = $cli->{arg_c};
    my $addr = ($ac >= 1) ? $cli->{arg_x}->[0] : 0;

    eval
    {
        my $data = $spin->read ($addr, 256, type => "byte");
        print hex_dump ($data, addr => $addr);
    };

    return $@;
}


sub cmd_sw
{
    my $cli = shift;
    my $ac = $cli->{arg_c};
    my $addr = $cli->{arg_x}->[0];
    my $data = $cli->{arg_x}->[1];

    return "bad args" unless $ac == 1 || $ac == 2;

    eval
    {
        if ($ac == 1)
        {
            my $data = $spin->read ($addr, 4, type => "word", unpack => "V");
            printf "%08x = %08x\n", $addr, $data->[0];
        }
        else
        {
            $data = pack "V", $data;
            $spin->write ($addr, $data, type => "word");
        }
    };

    return $@;
}


sub cmd_sh
{
    my $cli = shift;
    my $ac = $cli->{arg_c};
    my $addr = $cli->{arg_x}->[0];
    my $data = $cli->{arg_x}->[1];

    return "bad args" unless $ac == 1 || $ac == 2;

    eval
    {
        if ($ac == 1)
        {
            my $data = $spin->read ($addr, 2, type => "half", unpack => "v");
            printf "%08x = %04x\n", $addr, $data->[0];
        }
        else
        {
            $data = pack "v", $data;
            $spin->write ($addr, $data, type => "half");
        }
    };

    return $@;
}


sub cmd_sb
{
    my $cli = shift;
    my $ac = $cli->{arg_c};
    my $addr = $cli->{arg_x}->[0];
    my $data = $cli->{arg_x}->[1];

    return "bad args" unless $ac == 1 || $ac == 2;

    eval
    {
        if ($ac == 1)
        {
            my $data = $spin->read ($addr, 1, type => "byte", unpack => "C");
            printf "%08x = %02x\n", $addr, $data->[0];
        }
        else
        {
            $data = pack "C", $data;
            $spin->write ($addr, $data, type => "byte");
        }
    };

    return $@;
}


sub cmd_sfill
{
    my $cli = shift;
    my $ac = $cli->{arg_c};
    my $from = $cli->{arg_x}->[0];
    my $to = $cli->{arg_x}->[1];
    my $fill = $cli->{arg_x}->[2];

    eval { $spin->fill ($from, $fill, $to-$from) };

    return $@;
}


sub cmd_sp
{
    my $cli = shift;
    my $ac = $cli->{arg_c};
    my $arg1 = $cli->{arg_v}->[0];
    my $arg2 = $cli->{arg_v}->[1];
    my $arg3 = $cli->{arg_v}->[2];


    eval
    {
    if ($ac == 0 || ($ac == 1 && $arg1 eq "root"))
    {
        # Try and determine the true coordinates of the root chip
        my $root_x = 0;
        my $root_y = 0;
        eval {
        my @version_info = @{$spin->ver (addr => [], raw => 1, timeout=> 0.1)};
        $root_x = $version_info[3];
        $root_y = $version_info[2];
        };
        ($chip_x, $chip_y, $cpu) = $spin->addr ($root_x, $root_y);
    }
    elsif ($ac == 1 && $arg1 =~ /^\d+$/)
    {
        ($chip_x, $chip_y, $cpu) = $spin->addr ($arg1);
    }
    elsif ($ac == 2 && $arg1 =~ /^\d+$/ && $arg2 =~ /^\d+$/)
    {
        ($chip_x, $chip_y, $cpu) = $spin->addr ($arg1, $arg2);
    }
    elsif ($ac == 3 && $arg1 =~ /^\d+$/ && $arg2 =~ /^\d+$/ &&
        $arg3 =~ /^\d+$/)
    {
        ($chip_x, $chip_y, $cpu) = $spin->addr ($arg1, $arg2, $arg3);
    }
    else
    {
        die "bad args\n";
    }

    $cli->{prompt} =~ s/:.+//;
    $cli->{prompt} .= ":$chip_x,$chip_y,$cpu > ";
    };

    return $@;
}


#-------------------------------------------------------------------------------


sub iodump
{
    my ($fh, $buf) = @_;
    my ($next, $time, $ms, $string) = unpack "V3 V/a*", $buf;

#    my @t = localtime $time;
#    $time = sprintf "[%d:%02d:%02d.%d]", $t[2], $t[1], $t[0], $ms;
#    $string =~ s/\n/\n$time\n/;

    print $fh $string;

    return $next;
}


sub cmd_iobuf
{
    my $cli = shift;
    my $ac = $cli->{arg_c};
    my $core = $cli->{arg_n}->[0];
    my $file = $cli->{arg_v}->[1];

    my $fh = \*STDOUT;

    return "bad args" unless $ac >= 1;

    if ($ac == 2)
    {
        open my $th, ">", $file or return "can't open \"$file\"\n";
        $fh = $th;
    }

    eval
    {
        my $vbase = $sv->read_var ("sv.vcpu_base");
        my $size  = $sv->read_var ("sv.iobuf_size");
        my $vsize = $sv->size ("vcpu");

        $sv->base ("vcpu", $vbase + $vsize * $core);

        my $iobuf = $sv->read_var ("vcpu.iobuf");

        while ($iobuf != 0)
        {
            my $data = $spin->read ($iobuf, $size+16);
            $iobuf = iodump ($fh, $data);
        }
    };

    close $fh if $ac == 2;

    return $@;
}


#-------------------------------------------------------------------------------

# No return codes checked here!

sub dump_heap
{
    my ($heap, $name) = @_;

    my $data = $spin->read ($heap, 16, unpack => "VVVV");
    my $heap_free = $data->[0];
    my $heap_first = $data->[1];
    my $free_bytes = $data->[3];

    printf "\n$name %u\n%s\n", $free_bytes, "-" x length $name;

    my $p = $heap_first;

    while ($p != 0)
    {
        my $data = $spin->read ($p, 8, unpack => "VV");
        my $next = $data->[0];
        my $free = $data->[1];
        my $size = ($next == 0) ? 0 : $next - $p - 8;
        my $fs = sprintf "Free  %08x", $free;

        $fs = sprintf "Tag %3d ID %3d", $free & 255, ($free >> 8) & 255
            if ($free & 0xffff0000) == 0xffff0000;

        printf "BLOCK  %8x  Next %8x  $fs  size %d\n", $p, $next, $size;

        $p = $next;
    }

    $p = $heap_free;

    while ($p != 0)
    {
        my $data = $spin->read ($p, 8, unpack => "VV");
        my $next = $data->[0];
        my $free = $data->[1];
        my $size = ($next == 0) ? 0 : $next - $p - 8;

        printf "FREE   %8x  Next %8x  Free  %08x  Size %d\n",
            $p, $next, $free, $size;

        $p = $free;
    }
}


sub cmd_heap
{
    my $cli = shift;
    my $ac = $cli->{arg_c};
    my $arg1 = $cli->{arg_v}->[0];

    eval
    {
        if ($ac == 0 || $ac == 1 && $arg1 eq "sdram")
        {
            my $sdram_heap = $sv->read_var ("sv.sdram_heap");
            dump_heap ($sdram_heap, "SDRAM");
        }

        if ($ac == 0 || $ac == 1 && $arg1 eq "sysram")
        {
            my $sysram_heap  = $sv->read_var ("sv.sysram_heap");
            dump_heap ($sysram_heap, "SysRAM");
        }

        if ($ac == 0 || $ac == 1 && $arg1 eq "system")
        {
            my $sys_heap  = $sv->read_var ("sv.sys_heap");
            dump_heap ($sys_heap, "System");
        }

        print "\n";
    };

    return $@;
}


#-------------------------------------------------------------------------------


sub cmd_rtr_load
{
    my $cli = shift;
    my $ac = $cli->{arg_c};
    my $file = $cli->{arg_v}->[0];
    my $app_id = $cli->{arg_n}->[1];

    return "bad args" unless $ac == 2;
    return "Bad app_id" if $app_id < $APP_MIN || $app_id > $APP_MAX;

    eval
    {
        my $buf = read_file ($file, 65536);

        die "Failed to load \"$file\"\n" unless defined $buf;

        my $size = length $buf;

        die "Funny file size\n" if ($size % 16) != 0 ||
            $size > 1024 * 16 ||
            $size < 32;

        $size = ($size - 16) / 16;

        my $addr = 0x67800000;

        $spin->write ($addr, $buf);

        my $data = $spin->scp_cmd ($CMD_ALLOC,
                                   arg1 => ($app_id << 8) + 3,
                                   arg2 => $size);

        my $base = unpack "V", $data;

        die "no room in router heap" if $base == 0;

        $spin->scp_cmd ($CMD_RTR,
                        arg1 => ($size << 16) + ($app_id << 8) + 2,
                        arg2 => $addr,
                        arg3 => $base);
    };

    return $@;
}


#-------------------------------------------------------------------------------


my $MIN_TAG = 0; # Bodge!
my $MAX_TAG = 7;


sub ipflag
{
    my $flags = shift;
    my $r = "";

    $r .= "T" if $flags & 0x4000;
    $r .= "A" if $flags & 0x2000;
    $r .= "R" if $flags & 0x0200;
    $r .= "S" if $flags & 0x0100;

    return $r;
}


sub dump_iptag
{
    eval
    {
    my $data = $spin->iptag_tto (255);

    my ($tto, undef, $pool, $fix) = unpack "C4", $data;
    my $max = $pool + $fix;
    $tto = (1 << ($tto - 1)) / 100 if $tto;

    print "IPTags=$max (F=$fix, T=$pool), TTO=${tto}s\n\n";

    print "Tag    IP address    TxPort RxPort  T/O   Flags    Addr    Port      Count\n";
    print "---    ----------    ------ ------  ---   -----    ----    ----      -----\n";

    for (my $i = 0; $i < $max; $i++)
    {
        my $data = $spin->iptag_get ($i, 1);

        my ($ip, $mac, $tx_port, $timeout, $flags, $count, $rx_port,
        $spin_addr, $spin_port) = unpack "a4 a6 v3 V v2 C", $data;

        if ($flags & 0x8000) # Tag in use
        {
        $ip = join ".", unpack "C*", $ip;

        printf "%3d  %-15s  %5d  %5d  %-4s  %-4s   0x%04x    0x%02x %10d\n",
            $i, $ip, $tx_port, $rx_port, $timeout / 100, ipflag ($flags),
            $spin_addr, $spin_port, $count;
        }
    }
    };

    return $@;
}


sub cmd_iptag
{
    my $cli = shift;
    my $ac = $cli->{arg_c};

    return dump_iptag () if $ac == 0;

    my $tag = $cli->{arg_v}->[0];
    my $cmd = $cli->{arg_v}->[1];

    my $MIN_TAG = 0; # Bodge!
    my $MAX_TAG = 7;

    return "bad tag" unless $tag =~ /^\d+$/ && $tag >= $MIN_TAG && $tag <= $MAX_TAG;
    return "bad cmd" unless $cmd =~ /^(set|clear|reverse|strip)$/;

    if ($cmd eq "clear")
    {
        eval { $spin->iptag_clear ($tag); };
        return $@;
    }

    if ($cmd eq "set" || $cmd eq "strip")
    {
        my $host = $cli->{arg_v}->[2];
        my $port = $cli->{arg_n}->[3];
        my $strip = $cmd eq "strip";

        return "bad args" if $ac != 4;
        return "pad port" unless $port;

        eval
        {
            $spin->iptag_set ($tag, $port,
                              host => $host,
                              strip => $strip);
        };
        return $@;
    }

    if ($cmd eq "reverse")
    {
        my $port = $cli->{arg_n}->[2];
        my $dest_addr = $cli->{arg_x}->[3];
        my $dest_port = $cli->{arg_x}->[4];

        return "bad args" if $ac != 5;
        return "bad args" unless $port && defined $dest_addr &&
            defined $dest_port;

        eval
        {
            $spin->iptag_set ($tag, $port,
                              reverse => 1,
                              dest_addr => $dest_addr,
                              dest_port => $dest_port);
        };

        return $@;
    }

    return "";
}


#-------------------------------------------------------------------------------

##!!
my %state = (dead  => 0,  pwrdn => 1, rte   => 2,  wdog  => 3,
             init  => 4,  ready => 5, c_main => 6, run   => 7,
             sync0 => 8,  sync1 => 9, pause => 10, exit  => 11,
             idle => 15);

my %signal = (init  => 0,  pwrdn => 1,  stop  => 2,  start => 3,
              sync0 => 4,  sync1 => 5,  pause => 6,  cont => 7,
              exit  => 8,  timer => 9,  usr0  => 10, usr1 => 11,
              usr2  => 12, usr3  => 13,
              or    => 16, and   => 17, count => 18);

# 0->MC, 1->P2P, 2->NN

my %sig_type = (init  => 2,  pwrdn => 2,  stop  => 2,  start => 2,
             sync0 => 0,  sync1 => 0,  pause => 0,  cont => 0,
             exit  => 2,  timer => 0,  usr0  => 0,  usr1 => 0,
             usr2  => 0,  usr3  => 0,
             or    => 1,  and   => 1,  count => 1);

sub cmd_app_sig
{
    my $cli = shift;
    my $ac = $cli->{arg_c};
    my $region = $cli->{arg_v}->[0];
    my $apps = $cli->{arg_v}->[1];
    my $signal = $cli->{arg_v}->[2];
    my $state = $cli->{arg_v}->[3] || 0;

    return "bad args" unless $ac >= 3;

    my ($app_id, $app_mask) = parse_apps ($apps);

    return "bad app_id range" unless defined $app_id;

    return "bad app_id" unless $app_id >=0 && $app_id <= 255;

    my $save_region = $region;
    $region = parse_region ($region);

    return "bad region" if $region == 0;
    return "bad signal" unless exists $signal{$signal};

    my $type = $sig_type{$signal};
    $signal = $signal{$signal};

    if ($signal >= 16) # and/or/count
    {
        return "bad args" unless $ac == 4;
        return "bad state" unless exists $state{$state};
        $state = $state{$state};
    }

    my $level = ($region >> 16) & 3;
    my $data = ($app_mask << 8) + $app_id;
    my $mask = $region & 0xffff;

    if ($type == 1)
    {
        my ($op, $mode) = (2, 2);	# sig, sum
        $op = 1 if $signal >= 16;	# stat

        $mode = $signal - 16 if $signal >= 16;

        $data += ($level << 26) + ($op << 22) + ($mode << 20);
        $data += $state << 16 if $op == 1;	# stat
        $data += $signal << 16 if $op != 1;	# !stat

        printf "Level %d op %d mode %d\n", $level, $op, $mode if $debug;
    }
    else
    {
        $data += $signal << 16;
    }

    printf "Type %d data %08x mask %08x\n", $type, $data, $mask if $debug;
    printf "Region %08x signal %d state %d\n", $region, $signal, $state if $debug;

    if ($type == 1)
    {
	my $xb = $region >> 24;
	my $yb = ($region >> 16) & 0xfc;

	# find a working chip in the target region (try at most 16 addresses)
	my $inc = ($level == 3) ? 1 : 2;  # if possible, spread out target chips

	for (my $i = 0; $i < 16; $i++)
	{
	    my $addr = [$xb + ($inc * ($i >> 2)), $yb + ($inc * ($i & 3)), 0];
	    my $res;

	    eval
	    {
		$res = $spin->signal ($type, $data, $mask, addr => $addr);
	    };

	    if (index($@, "retries") != -1)
	    {
		return $@;
	    };

	    if (index($@, "RC_") != -1)
	    {
		next;
	    };

	    my $r = unpack "V", $res;
	    if ($signal == 18) # Count
	    {
		printf "Count %d\n", $r;
	    }
	    else
	    {
		printf "Mask 0x%08x\n", $r;
	    }

	    return $@;
	}

	printf "Region $save_region is unreachable\n";
    }
    else
    {
	eval
	{
	    my $data = $spin->signal ($type, $data, $mask, addr => []);
	};
    }

    return $@;
}


sub cmd_app_stop
{
    my $cli = shift;
    my $ac = $cli->{arg_c};
    my $apps = $cli->{arg_v}->[0];

    return "bad args" unless $ac == 1;

    my ($app_id, $app_mask) = parse_apps ($apps);

    return "bad app_id range" unless defined $app_id;

    return "bad app_id" if $app_id < $APP_MIN || $app_id > $APP_MAX;

    my $SIG_STOP = $signal{stop};

    my $arg1 = ($NN_CMD_SIG0 << 24) + (0x3f << 16) + (0x00 << 8) +  0;
    my $arg2 = (5 << 28) + ($SIG_STOP << 16) + ($app_mask << 8) + $app_id;
    my $arg3 = (1 << 31) + (0x3f << 8) + 0x00;

    eval { $spin->nnp ($arg1, $arg2, $arg3, addr => []) };

    return $@;
}


#-------------------------------------------------------------------------------


sub cmd_app_load_old
{
    my $cli = shift;
    my $ac = $cli->{arg_c};
    my $file = $cli->{arg_v}->[0];
    my $cores = $cli->{arg_v}->[1];
    my $app_id = $cli->{arg_n}->[2];
    my $flags = $cli->{arg_v}->[3];

    return "bad args" if $ac < 3;

    my $app_flags = 0;
    $app_flags |= 1 if $ac > 3 && $flags eq "wait";

    my $buf = read_file ($file, 65536);
    return "Failed to load \"$file\"" unless defined $buf;

    my $mask = parse_cores ($cores);
    return "Bad core list" if $mask == 0;

    return "Bad app_id" if $app_id < $APP_MIN || $app_id > $APP_MAX;

    my $addr = 0x67800000;

    my $e = $spin->write ($addr, $buf);
    return $e if $e;

    $e = $spin->ar ($mask, $app_id, $app_flags); ##

    return $e;
}


sub cmd_app_load
{
    my $cli = shift;
    my $ac = $cli->{arg_c};
    my $file = $cli->{arg_v}->[0];
    my $region = $cli->{arg_v}->[1];
    my $cores = $cli->{arg_v}->[2];
    my $app_id = $cli->{arg_n}->[3];
    my $flags = $cli->{arg_v}->[4];

    return "bad args" if $ac < 4;

    my $app_flags = 0;
    $app_flags |= 1 if $ac > 4 && $flags eq "wait";

    $region = parse_region ($region, $chip_x, $chip_y);
    return "bad region" if $region == 0;

    my $mask = parse_cores ($cores);
    return "bad core list" if $mask == 0;

    return "bad app_id" if $app_id < $APP_MIN || $app_id > $APP_MAX;

    my $buf = read_file ($file, 65536);
    return "failed to load \"$file\"" unless defined $buf;

    printf "Region %08x, mask %08x\n", $region, $mask if $debug;

    eval
    {
        $spin->flood_fill ($buf, $region, $mask, $app_id, $app_flags, addr => [])
    };

    return $@;
}


#-------------------------------------------------------------------------------


sub cmd_data_load
{
    my $cli = shift;
    my $ac = $cli->{arg_c};
    my $file = $cli->{arg_v}->[0];
    my $region = $cli->{arg_v}->[1];
    my $addr = $cli->{arg_x}->[2];

    return "bad args" if $ac != 3;

    $region = parse_region ($region, $chip_x, $chip_y);
    return "bad region" if $region == 0;

    my $buf = read_file ($file, 1024 * 1024);
    return "failed to load \"$file\"" unless defined $buf;

#    printf "Region %08x, mask %08x\n", $region, $mask;

    eval
    {
        $spin->flood_fill ($buf, $region, 0, 0, 0,
                           base => $addr, addr => [])
    };

    return $@;
}


#-------------------------------------------------------------------------------


sub global_write
{
    my ($addr, $data, $type) = @_;

    my $op = 0;

    return "bad address alignment" if $type == 2 && ($addr & 3) != 0;
    return "bad address alignment" if $type == 1 && ($addr & 1) != 0;

    if ($addr >= 0xf5007f00 && $addr < 0xf5008000)
    {
        $addr -= 0xf5007f00;
        $op = 0;
    }
    elsif ($addr >= 0xf5000000 && $addr < 0xf5000100)
    {
        $addr -= 0xf5000000;
        $op = 1;
    }
    elsif ($addr >= 0xf2000000 && $addr < 0xf2000100)
    {
        $addr -= 0xf2000000;
        $op = 2;
    }
    else
    {
        return "bad address";
    }

    my $key = ($NN_CMD_SIG1 << 24) + (0 << 20) + ($type << 18) +
              ($op << 16) + ($addr << 8) + 0; # const

    my $fr = (1 << 31) + (0x3f << 8) + 0xf8;

    eval
    {
        $spin->nnp ($key, $data, $fr, addr => []);
    };

    return $@;
}


sub cmd_gw
{
    my $cli = shift;
    my $ac = $cli->{arg_c};

    return "bad args" if $ac != 2;

    my $addr = $cli->{arg_x}->[0];
    my $data = $cli->{arg_x}->[1];

    return global_write ($addr, $data, 2);
}


sub cmd_gh
{
    my $cli = shift;
    my $ac = $cli->{arg_c};

    return "bad args" if $ac != 2;

    my $addr = $cli->{arg_x}->[0];
    my $data = $cli->{arg_x}->[1];

    return global_write ($addr, $data, 1);
}


sub cmd_gb
{
    my $cli = shift;
    my $ac = $cli->{arg_c};

    return "bad args" if $ac != 2;

    my $addr = $cli->{arg_x}->[0];
    my $data = $cli->{arg_x}->[1];

    return global_write ($addr, $data, 0);
}


#-------------------------------------------------------------------------------


sub cmd_sload
{
    my $cli = shift;
    my $ac = $cli->{arg_c};
    my $file = $cli->{arg_v}->[0];
    my $addr = $cli->{arg_x}->[1];

    return "bad args" if $ac < 2;

    eval { $spin->write_file ($addr, $file) };

    return $@;
}


#-------------------------------------------------------------------------------


sub cmd_sdump
{
    my $cli = shift;
    my $ac = $cli->{arg_c};
    my $file = $cli->{arg_v}->[0];
    my $addr = $cli->{arg_x}->[1];
    my $len = $cli->{arg_x}->[2];

    return "bad args" if $ac != 3;

    my $bytes = 0;
    my $size = 4096;

    open my $fh, ">", $file or return "can't open \"$file\"";

    eval
    {
        while ($bytes != $len)
        {
            my $l = ($len - $bytes > $size) ? $size : $len - $bytes;
            $bytes += $l;

            my $data = $spin->read ($addr, $l);

            $addr += $l;

            die "Length mismatch" unless $l == length ($data);
            die "syswrite failed" unless syswrite $fh, $data;
        }
    };

    close $fh;

    return $@;
}


#-------------------------------------------------------------------------------


sub cpu_dump
{
    my ($num, $long, $fmt) = @_;

    my @cs = (
    "----", "PWRDN", "RTE", "WDOG",
        "INIT", "WAIT",  "SARK", "RUN",
        "SYNC0", "SYNC1", "PAUSE", "EXIT",
    "ST_12", "ST_13", "ST_14", "IDLE");

    my @rte = qw/NONE RESET UNDEF SVC PABT DABT IRQ FIQ VIC
        ABORT MALLOC DIV0 EVENT SWERR IOBUF ENABLE
                 NULL PKT TIMER API VER /;

    my @mon = qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/;

    eval
    {
        my $base = $sv->read_var ("sv.vcpu_base");
        $sv->base ("vcpu", $base + $sv->size ("vcpu") * $num);
        $sv->read_struct ("vcpu");
    };

    return $@ if $@;

    my $time = $sv->get_var ("vcpu.time");
    my @time = localtime $time;
    my $et = time () - $time;

    if ($time != 0)
    {
        $time = sprintf "%2d %s %02d:%02d", $time[3], $mon[$time[4]], $time[2], $time[1];
        $et = sprintf "%d:%02d:%02d", $et / 3600, ($et / 60) % 60, $et % 60;
    }
    else
    {
        $time = " " x 12;
        $et = " " x 9;
    }

    if ($long)
    {
        my $rt_code = $sv->get_var ("vcpu.rt_code");
        printf "Core %2d: app \"%s\", state %s, app_id %d, running $et ($time)\n",
        $num, $sv->get_var ("vcpu.app_name"),
        $cs[$sv->get_var ("vcpu.cpu_state")],
        $sv->get_var ("vcpu.app_id");

        printf "AP mbox:   cmd      %02x  msg     %08x\n",
        $sv->get_var ("vcpu.mbox_ap_cmd"),
        $sv->get_var ("vcpu.mbox_ap_msg");

        printf "MP mbox:   cmd      %02x  msg     %08x\n",
        $sv->get_var ("vcpu.mbox_mp_cmd"),
        $sv->get_var ("vcpu.mbox_mp_msg");

        printf "SW error:  line %6d  file    %08x count %d\n",
        $sv->get_var ("vcpu.sw_line"),
        $sv->get_var ("vcpu.sw_file"),
        $sv->get_var ("vcpu.sw_count");

        printf "RT error:  %-6s  PSR     %08x SP %08x LR %08x\n",
        $rte[$rt_code],
        $sv->get_var ("vcpu.psr"),
        $sv->get_var ("vcpu.sp"),
        $sv->get_var ("vcpu.lr");

        printf "r0-r7: %08x %08x %08x %08x %08x %08x %08x %08x\n",
        $sv->get_var ("vcpu.r0"), $sv->get_var ("vcpu.r1"),
        $sv->get_var ("vcpu.r2"), $sv->get_var ("vcpu.r3"),
        $sv->get_var ("vcpu.r4"), $sv->get_var ("vcpu.r5"),
        $sv->get_var ("vcpu.r6"), $sv->get_var ("vcpu.r7") if $rt_code != 0;
    }
    else
    {
        if ($num == 0)
        {
            printf "Core State  Application       ID   ";

            if ($fmt == 0)
            {
                printf "Running  Started\n";
                printf "---- -----  -----------       --   ";
                printf "-------  -------\n";
            }
            elsif ($fmt == 1 || $fmt == 2)
            {
                printf "     User0      User1      User2      User3\n";
                printf "---- -----  -----------       --   ";
                printf "     -----      -----      -----      -----\n";
            }
            else
            {
                printf "PCore  SWver\n";
                printf "---- -----  -----------       --   ";
                printf "-----  --------\n";
            }
        }

        printf "%3d  %-6s %-16s %3d ",
        $num,
        $cs[$sv->get_var ("vcpu.cpu_state")],
        $sv->get_var ("vcpu.app_name"),
        $sv->get_var ("vcpu.app_id");

        if ($fmt == 1)
        {
            printf "    %08x   %08x   %08x   %08x\n",
            $sv->get_var ("vcpu.user0"),
            $sv->get_var ("vcpu.user1"),
            $sv->get_var ("vcpu.user2"),
            $sv->get_var ("vcpu.user3");
        }
        elsif ($fmt == 2)
        {
            printf "  %10u %10u %10u %10u\n",
            $sv->get_var ("vcpu.user0"),
            $sv->get_var ("vcpu.user1"),
            $sv->get_var ("vcpu.user2"),
            $sv->get_var ("vcpu.user3");
        }
        elsif ($fmt == 3)
        {
            printf "   %2u  ", $sv->get_var ("vcpu.phys_cpu");
            my $v = $sv->get_var ("vcpu.sw_ver");
            printf "  %d.%d.%d\n", ($v >> 16) & 255, ($v >> 8) & 255, $v & 255;
        }
        else
        {
            my $swc = $sv->get_var ("vcpu.sw_count");
            my $sw = ($swc) ? " SWC $swc" : "";
            printf "%9s  %s $sw\n", $et, $time;
        }
    }

    return "";
}


sub cmd_ps
{
    my $cli = shift;
    my $ac = $cli->{arg_c};
    my $arg0 = $cli->{arg_v}->[0];

    if ($ac == 1 && $arg0 =~ /^\d+$/)
    {
        my $vc = $arg0;
        return "bad args" unless $vc >= 0 && $vc < 18;

        my $e = cpu_dump ($vc, 1, 0);
        return $e if $e;
    }
    elsif ($ac == 1 && ($arg0 eq "x" || $arg0 eq "d" || $arg0 eq "p"))
    {
        my $fmt = ($arg0 eq "x") ? 1 : ($arg0 eq "d") ? 2 : 3;

        for (my $vc = 0; $vc < 18; $vc++)
        {
            my $e = cpu_dump ($vc, 0, $fmt);
            return $e if $e;
        }
    }
    else
    {
        for (my $vc = 0; $vc < 18; $vc++)
        {
            my $e = cpu_dump ($vc, 0, 0);
            return $e if $e;
        }
    }

    return "";
}


#-------------------------------------------------------------------------------


my %srom_info = ("25aa1024" => {PAGE => 256, ADDR => 24},
        "25aa080a" => {PAGE => 16,  ADDR => 16},
        "25aa160b" => {PAGE => 32,  ADDR => 16});


sub cmd_srom_type
{
    my $cli = shift;
    my $ac = $cli->{arg_c};
    my $type = $cli->{arg_v}->[0];

    return "bad args" if $ac > 1;

    if ($ac == 1)
    {
        return "bad type" unless exists $srom_info{$type};

        $srom_type = $type;
    }

    print "SROM type $srom_type (page $srom_info{$srom_type}->{PAGE}, " .
    "addr $srom_info{$srom_type}->{ADDR})\n";

    return "";
}


sub cmd_srom_read
{
    my $cli = shift;
    my $ac = $cli->{arg_c};
    my $addr = $cli->{arg_x}->[0];

    $addr = 0 if $ac < 1;

    eval
    {
        my $data = $spin->srom_read ($addr, 256,
                                     addr_size => $srom_info{$srom_type}->{ADDR});
        print hex_dump ($data, addr => $addr);
    };

    return $@;
}


sub cmd_srom_erase
{
    eval { $spin->srom_erase () };

    return $@;
}


sub cmd_srom_write
{
    my $cli = shift;
    my $ac = $cli->{arg_c};
    my $file = $cli->{arg_v}->[0];
    my $addr = $cli->{arg_x}->[1];

    return "bad args" if $ac < 2;

    my $buf = read_file ($file, 128 * 1024);

    return "can't read file" unless defined $buf;

    if ($crc32_enabled) {
        printf "Length %d, CRC32 0x%08x\n", length ($buf), crc32 ($buf);
    } else {
        printf "Length %d\n", length ($buf);
    }

    eval
    {
    $spin->srom_write ($addr, $buf,
                       page_size => $srom_info{$srom_type}->{PAGE},
                       addr_size => $srom_info{$srom_type}->{ADDR})
    };

    return $@;
}


sub cmd_srom_dump
{
    my $cli = shift;
    my $ac = $cli->{arg_c};
    my $file = $cli->{arg_v}->[0];
    my $addr = $cli->{arg_x}->[1];
    my $len = $cli->{arg_n}->[2];

    return "bad args" if $ac != 3;

    my $bytes = 0;
    my $size = 256;
    my $buf;

    eval
    {
        while ($bytes != $len)
        {
            my $l = ($len - $bytes > $size) ? $size : $len - $bytes;
            $bytes += $l;

            my $data = $spin->srom_read ($addr, $l,
                                         addr_size => $srom_info{$srom_type}->{ADDR});

            $addr += $l;

            die "Length mismatch" unless $l == length ($data);
            $buf .= $data;
        }
    };

    if ($crc32_enabled) {
        printf "Length %d, CRC32 0x%08x\n", length ($buf), crc32 ($buf);
    } else {
        printf "Length %d\n", length ($buf);
    }

    open my $fh, ">", $file or return "can't open \"$file\"";
    syswrite $fh, $buf or return "write failed\n";
    close $fh;

    return $@;
}


#-------------------------------------------------------------------------------


sub check_ip
{
    my $s = shift;

    if ($s =~ /^\/(\d+)$/) # Special case /nn -> 255.255....
    {
        $s = $1;
        return () if $s > 32 || $s < 8;
        $s = (0xffffffff << (32 - $s)) & 0xffffffff;
        $s = join ".", ($s >> 24) & 255, ($s >> 16) & 255,
                       ($s >> 8)  & 255, ($s >> 0)  & 255;
    }

    return () unless $s =~ /^\d+\.\d+\.\d+\.\d+$/;

    my @v = reverse split /\./, $s;

    for my $n (@v)
    {
        return () if $n < 0 || $n > 255;
    }
    return @v;
}


sub cmd_srom_info
{
    my $long = shift;

    my $addr = 8; #const
    my $len = 32;

    my $data = $spin->srom_read ($addr, $len,
                                 addr_size => $srom_info{$srom_type}->{ADDR});

    my @d = unpack "C8 C4 C4 C4 C2 n", $data;

    my $flag = ($d[2] << 8) + $d[3];
    my $mac = sprintf "%02x:%02x:%02x:%02x:%02x:%02x",
        $d[1], $d[0], $d[7], $d[6], $d[5], $d[4];
    my $ip = join (".", reverse @d[8..11]);
    my $gw = join (".", reverse @d[12..15]);
    my $nm = join (".", reverse @d[16..19]);
    my $port = $d[22];

    if ($long)
    {
        printf "Flag: %04x\n", $flag;
        printf "MAC:  %s\n", $mac;
        printf "IP:   %s\n", $ip;
        printf "GW:   %s\n", $gw;
        printf "NM:   %s\n", $nm;
        printf "Port: %d\n", $port;
    }
    else
    {
        printf "%04x ", $flag;
        printf "%s ", $mac;
        printf "%s %s %s ", $ip, $gw, $nm;
        printf "%d\n", $port;
    }

    return "";
}


sub cmd_srom_init
{
    my $cli = shift;
    my $ac = $cli->{arg_c};

    if ($ac == 0)
    {
        eval { cmd_srom_info (0) };
        return $@;
    }

    return "bad args" unless $ac == 6;

    my $flag = $cli->{arg_x}->[0];
    my $mac = $cli->{arg_v}->[1];
    my @ip = check_ip ($cli->{arg_v}->[2]);
    my @gw = check_ip ($cli->{arg_v}->[3]);
    my @nm = check_ip ($cli->{arg_v}->[4]);
    my $port = $cli->{arg_n}->[5];

    return "bad flag" unless $flag >= 0x8000 && $flag < 0x10000;
    return "bad MAC" unless $mac =~ /^([0-9a-f]{1,2}:){5}[0-9a-f]{1,2}$/i;
    return "bad IP" unless $#ip == 3;
    return "bad GW" unless $#gw == 3;
    return "bad NM" unless $#nm == 3;
    return "bad port" unless $port >= 1024 && $port < 65536;

    my @mac = reverse split /:/, $mac;
    $_ = hex $_ for @mac;

    my $d = pack "N2 C2 n C4 C4 C4 C4 C2 n N2 N",
                 0x553a0008, 0xf5007fe0, $mac[4], $mac[5], $flag,
                 $mac[0], $mac[1], $mac[2], $mac[3],
                 @ip, @gw, @nm, 0, 0, $port, 0, 0,
                 0xaaaaaaaa;


    eval
    {
        $spin->srom_write (0, $d,
                           page_size => $srom_info{$srom_type}->{PAGE},
                           addr_size => $srom_info{$srom_type}->{ADDR});
        cmd_srom_info (1);
    };

    return $@;
}


sub cmd_srom_ip
{
    my $cli = shift;
    my $ac = $cli->{arg_c};
    my $addr = 16; #const

    return "bad args" if $ac < 0 || $ac > 3;

    eval
    {
        return cmd_srom_info (1) if $ac == 0;

        my $data = "";

        for my $a (0..$ac-1)
        {
            my $s = $cli->{arg_v}->[$a];
            my @ip = check_ip ($s);

            return "bad IP ($s)" if $#ip != 3;

            $data .= pack "C4", @ip;
        }

        my $len = length $data;

        print "Writing $len bytes at address $addr\n";

        $spin->srom_write ($addr, $data,
                           page => $srom_info{$srom_type}->{PAGE},
                           addr => $srom_info{$srom_type}->{ADDR});

        print "Checking...\n";

        cmd_srom_info (1);

        my $rdata = $spin->srom_read ($addr, $len,
                                      addr_size => $srom_info{$srom_type}->{ADDR});

        my $lr = length ($rdata);

        if ($lr != $len || $data ne $rdata)
        {
            print "Oops! - try again?\n";
        }
        else
        {
            print "Looks OK!\n";
        }
    };

    return $@;
}


#-------------------------------------------------------------------------------


sub cmd_led
{
    my $cli = shift;
    my $ac = $cli->{arg_c};
    my $num = $cli->{arg_v}->[0];
    my $action = $cli->{arg_v}->[1];

    return "bad args" if $ac != 2 || $num !~ /^[0-3]+$/ ||
    $action !~ /^(on|off|inv|flip)$/;

    my %led = (on => 3, off => 2, inv => 1, flip => 1);

    my $c = 0;

    for my $l (split //, $num)
    {
        $c |= $led{$action} << ($l * 2);
    }

    eval { $spin->led ($c, addr => [0]) };

    return $@;
}


#-------------------------------------------------------------------------------


sub cmd_remap
{
    my $cli = shift;
    my $ac = $cli->{arg_c};
    my $arg0 = $cli->{arg_n}->[0];
    my $arg1 = $cli->{arg_v}->[1];

    $arg1 ||= "virt";

    return "bad args" if $ac < 1;
    return "bad args" if $arg0 < 0 || $arg0 > 17;
    return "bad args" if $arg1 !~ /^phys|virt$/;

    $arg1 = ($arg1 eq "virt") ? 0 : 1;

    eval
    {
        $spin->scp_cmd ($CMD_REMAP,
                        arg1 => $arg0,
                        arg2 => $arg1);
    };

    return $@;
}

#-------------------------------------------------------------------------------


sub app_dump
{
    my $data = shift;

    print " ID Cores Clean  Sema  Lead Mask\n";
    print "--- ----- -----  ----  ---- ----\n";

    for (my $i = 0; $i < 256; $i++)
    {
        my ($cores, $clean, $sema, $lead, $mask) =
            unpack "C4 V", substr $data, $i * 8, 8;
        printf "%3d %5d %5d %5d %5d %08x\n", $i, $cores, $clean, $sema,
            $lead, $mask if $cores != 0 || $clean != 0;
    }
}


sub cmd_app_dump
{
    my $cli = shift;
    my $ac = $cli->{arg_c};

    my $a = $sv->read_var ("sv.app_data");
    return "Failed to read sv->app_data" unless $a;

    eval { app_dump ($spin->read ($a, 256 * 8)) };

    return $@;
}


#-------------------------------------------------------------------------------

# No return codes checked here!

sub rtr_heap
{
    my ($rtr_copy, $rtr_free) = @_;
    my $p = 1;			# RTR_ALLOC_FIRST;
    my $name = "Router";

    printf "\n$name\n%s\n", "-" x length $name;

    while ($p != 0)
    {
        my $data = $spin->read ($rtr_copy + 16 * $p, 4, unpack => "vv");
        my $next = $data->[0];
        my $free = $data->[1];
        my $size = ($next == 0) ? 0 : $next - $p;

        my $fs = sprintf "Free %5d", $free;
        $fs = sprintf "AppID  %3d", $free & 255 if $free & 0x8000;

        printf "BLOCK %5d  Next %5d  $fs  Size %d\n",
        $p, $next, $size;

        $p = $next;
    }

    $p = $rtr_free;

    while ($p != 0)
    {
        my $data = $spin->read ($rtr_copy + 16 * $p, 4, unpack => "vv");
        my $next = $data->[0];
        my $free = $data->[1];
        my $size = ($next == 0) ? 0 : $next - $p;

        printf "FREE  %5d  Next %5d  Free %5d  Size %d\n",
        $p, $next, $free, $size;

        $p = $free;
    }

    print "\n";
}


sub rtr_dump
{
    my ($buf, $fr) = @_;

    print "Entry  Route       (Core) (Link)  Key       Mask      AppID  Core\n";
    print "-----  765432109876543210 543210  ---       ----      -----  ----\n\n";

    for (my $i = 0; $i < 1024; $i++)
    {
        my ($next, $free, $route, $key, $mask) =
            unpack "v2 V3", substr $buf, 16 * $i, 16;

        next if $route >= 0xff000000;

        printf "%4d:  %018b %06b  %08x  %08x  %5d  %4d\n", $i,
            ($route >> 6) & 0x3ffff, $route & 63, $key, $mask,
            $free & 255, ($free >> 8) & 31;
    }
    printf "  FR:  %018b %06b\n", ($fr >> 6) & 0x3ffff, $fr & 63
}


sub cmd_rtr_init
{
    my $cli = shift;
    my $ac = $cli->{arg_c};

    return "bad args" unless $ac == 0;

    eval { $spin->scp_cmd ($CMD_RTR) };

    return $@;
}


sub cmd_rtr_dump
{
    my $cli = shift;
    my $ac = $cli->{arg_c};

    return "bad args" unless $ac == 0;

    eval
    {
        my $rtr = $sv->read_var ("sv.rtr_copy");
        return "Failed to read sv->rtr_copy" unless defined $rtr;

        my $fr = $sv->read_var ("sv.fr_copy");
        return "Failed to read sv->fr_copy" unless defined $fr;

        rtr_dump ($spin->read ($rtr, 1025 * 16), $fr);
    };

    return $@;
}


sub rtr_wait
{
    my $v = shift;
    my $m = $v & 15;
    my $e = ($v >> 4) & 15;
    return ($m + 16) * 2 ** $e if $e > 4;
    return ($m + 16 - 2 ** (4 - $e)) * 2 ** $e;
}


sub cmd_rtr_diag
{
    my $cli = shift;
    my $ac = $cli->{arg_c};
    my $arg0 = $cli->{arg_v}->[0];

    return "bad args" unless $ac < 2;

    my @rtrc = ("Loc  MC:", "Ext  MC:", "Loc  PP:", "Ext  PP:",
                "Loc  NN:", "Ext  NN:", "Loc  FR:", "Ext  FR:",
                "Dump MC:", "Dump PP:", "Dump NN:", "Dump FR:",
                "Cntr 12:", "Cntr 13:", "Cntr 14:", "Cntr 15:");

    eval
    {
        my $rcr = $spin->read (0xe1000000, 4, type => "word", unpack => "V*");

        printf "\nCtrl Reg:  0x%08x (Mon %d, Wait1 %d, Wait2 %d)\n",
            $rcr->[0],
            ($rcr->[0] >> 8) & 31,
            rtr_wait ($rcr->[0] >> 16),
            rtr_wait ($rcr->[0] >> 24);

        my $es = $spin->read (0xe1000014, 4, type => "word", unpack => "V*");
        printf "Err Stat:  0x%08x\n\n", $es->[0];

        my $data = $spin->read (0xe1000300, 64,
                    type => "word", unpack => "V*");

        for (my $i = 0; $i < 16; $i++)
        {
            printf "%-10s %u\n", $rtrc[$i], $data->[$i];
        }

        if ($ac == 1 && $arg0 eq "clr")
        {
            my $c = pack "V", 0xffffffff;
            $spin->write (0xf100002c, $c, type => "word");
        }
    };

    return $@;
}


sub cmd_rtr_heap
{
    my $cli = shift;
    my $ac = $cli->{arg_c};

    return "bad args" unless $ac == 0;

    eval
    {
        my $rtr_copy  = $sv->read_var ("sv.rtr_copy");
        my $rtr_free  = $sv->read_var ("sv.rtr_free");

        rtr_heap ($rtr_copy, $rtr_free);
    };

    return $@;
}


#-------------------------------------------------------------------------------


sub cmd_reset
{
    my $cli = shift;
    my $ac = $cli->{arg_c};

    return "BMP not set" unless defined $bmp;
    return "bad args" unless $ac == 0;

    eval
    {
        $bmp->reset ($bmp_range);
    };

    return $@;
}


sub cmd_power
{
    my $cli = shift;
    my $ac = $cli->{arg_c};
    my $arg0 = $cli->{arg_v}->[0];

    return "BMP not set" unless defined $bmp;
    return "bad args" if $ac != 1 && $arg0 !~ /^on|off$/;

    eval
    {
        $bmp->power (($arg0 eq "on") ? 1 : 0, $bmp_range,
                     timeout => ($arg0 eq "on") ? 3.0 : $bmp->timeout);
    };

    return $@;
}


sub cmd_p2p_route
{
    my $cli = shift;
    my $ac = $cli->{arg_c};
    my $arg = $cli->{arg_v}->[0];

    return "bad args" if $ac > 1;
    return "bad args" if $ac == 1 && $arg !~ /^(on|off)$/;

    if ($ac == 0)
    {
        printf "Flags 0x%02x\n", $spin->flags;
        return "";
    }

    $spin->flags ($spin->flags & ~0x20) if $arg eq "on";
    $spin->flags ($spin->flags |  0x20) if $arg eq "off";

    return "";
}


#-------------------------------------------------------------------------------


sub cmd_debug
{
    my $cli = shift;
    my $ac = $cli->{arg_c};
    my $d = $cli->{arg_n}->[0];

    $debug = $d if $ac > 0;

    $spin->debug ($debug);
    $bmp->debug ($debug) if $bmp;

    print "Debug $debug\n";
    return "";
}


sub cmd_sleep
{
    my $cli = shift;
    my $ac = $cli->{arg_c};
    my $t = $cli->{arg_v}->[0];

    my $time = 1;

    $time = $t if $ac > 0 && $t =~ /^\d+\.?\d*$/;

    select (undef, undef, undef, $time);

    return "";
}


sub cmd_timeout
{
    my $cli = shift;
    my $ac = $cli->{arg_c};
    my $t = $cli->{arg_v}->[0];

    $spin->timeout ($t) if defined $t && $t =~ /^\d+\.?\d*$/;

    printf "Timeout %s\n", $spin->timeout;

    return "";
}


sub cmd_cmd
{
    my $cli = shift;
    my $ac = $cli->{arg_c};
    my $cmd = $cli->{arg_n}->[0];
    my $arg1 = $cli->{arg_x}->[1];
    my $arg2 = $cli->{arg_x}->[2];
    my $arg3 = $cli->{arg_x}->[3];

    return "bad args" if $ac < 1;

    $arg1 ||= 0;
    $arg2 ||= 0;
    $arg3 ||= 0;

    eval
    {
    $spin->scp_cmd ($cmd,
                    arg1 => $arg1,
                    arg2 => $arg2,
                    arg3 => $arg3);
    };

    return $@;
}


sub cmd_version
{
    print "# ybug - version ", sllt_version (), "\n";

    return "";
}


#-------------------------------------------------------------------------------


my $spin_cmds =
{
    version =>   [\&cmd_version,
        "",
        "Show ybug version"],
    expert =>   [\&cmd_expert,
        "",
        "Enable expert commands"],
    debug =>    [\&cmd_debug,
        "<num.D>",
        "Set debug level"],
    timeout =>  [\&cmd_timeout,
        "<secs.R>",
        "Set target timeout"],
    sleep =>    [\&cmd_sleep,
        "<secs.D>",
        "Sleep (secs)"],
    sp =>       [\&cmd_sp,
        "<chip_x.D> <chip_y.D> <core.D>",
        "Select SpiNNaker chip and core"],
    sver =>     [\&cmd_sver,
        "",
        "Show SpiNNaker S/W version"],
    ps =>       [\&cmd_ps,
        "[<core.D>|d|x|p]",
        "Display core state"],
    smemb =>    [\&cmd_smemb,
        "<addr.X>",
        "Read SpiNNaker memory (bytes)"],
    smemh =>    [\&cmd_smemh,
        "<addr.X>",
        "Read SpiNNaker memory (half-words)"],
    smemw =>    [\&cmd_smemw,
        "<addr.X>",
        "Read SpiNNaker memory (words)"],
    sload =>    [\&cmd_sload,
        "<file.F> <addr.X>",
        "Load SpiNNaker memory from file"],
    sw =>       [\&cmd_sw,
        "<addr.X> [<data.X>]",
        "Read/write Spinnaker word"],
    sh =>       [\&cmd_sh,
        "<addr.X> [<data.X>]",
        "Read/write Spinnaker half-word"],
    sb =>       [\&cmd_sb,
        "<addr.X> [<data.X>]",
        "Read/write Spinnaker byte"],
    sfill =>     [\&cmd_sfill,
        "<from_addr.X> <to_addr.X> <word.X>",
        "Fill Spinnaker memory (words)"],
    boot =>     [\&cmd_boot,
        "[<boot_file.F>] [<conf_file.F>]",
        "System bootstrap"],
    app_load => [\&cmd_app_load,
        "<file.F> .|@<X.D>,<Y.D>|<region> <cores> <app_id.D> [wait]",
        "Load application"],
    app_stop => [\&cmd_app_stop,
        "<app_id.D>[-<app_id.D>]",
        "Stop application(s)"],
    app_sig =>  [\&cmd_app_sig,
        "<region> <app_id.D>[-<app_id.D>] <signal> [state]",
        "Send signal to application"],
    data_load => [\&cmd_data_load,
        "<file.F> <region> <addr.X>",
        "Load data to all chips in region"],
    rtr_load => [\&cmd_rtr_load,
        "<file.F> <app_id.D>",
        "Load router file"],
    rtr_dump =>  [\&cmd_rtr_dump,
        "",
        "Dump router MC table"],
#    rtr_init =>  [\&cmd_rtr_init,
#		 "",
#		 "Initialise router MC table and heap"],
    rtr_heap =>  [\&cmd_rtr_heap,
        "",
        "Dump router MC heap"],
    rtr_diag =>  [\&cmd_rtr_diag,
        "[clr]",
        "Show router diagnostic counts, etc"],
    iobuf     => [\&cmd_iobuf,
        "<core.D> [<file.F>]",
        "Display/write I/O buffer for core"],
    sdump =>    [\&cmd_sdump,
        "<file.F> <addr.X> <len.X>",
        "Dump SpiNNaker memory to file"],
    iptag =>    [\&cmd_iptag,
        "<tag.D> <cmd.S> args...
               <tag.D> clear
               <tag.D> set     <host.P> <port.D>
               <tag.D> strip   <host.P> <port.D>
               <tag.D> reverse <port.D> <address.X> <port.X>",
        "Set up IPTags"],
    led =>      [\&cmd_led,
        "<0123>* on|off|inv|flip",
        "Set/clear LEDs"],
    heap =>      [\&cmd_heap,
        "sdram|sysram|system",
        "Dump heaps"],
    reset =>     [\&cmd_reset,
        "",
        "Reset Spinnakers via BMP"],
    power =>     [\&cmd_power,
        "on|off",
        "Switch power on/off via BMP"],
    pause =>    [\&SpiNN::CLI::pause,
        "<text.S>",
        "Print string and wait for Enter key"],
    echo =>    [\&SpiNN::CLI::echo,
        "<text.S>",
        "Print string"],
    quit =>     [\&SpiNN::CLI::quit,
        "",
        "Quit"],
    help =>     [\&SpiNN::CLI::help,
        "",
        "Provide help"],
    "@" =>      [\&SpiNN::CLI::at,
        "<file.F> [quiet]",
        "Read commands from file"],
    "?" =>      [\&SpiNN::CLI::query,
        "",
        "List commands"],
};


my $expert_cmds =
{
    gw =>        [\&cmd_gw,
        "<addr.X> <data.X>",
        "Global word write"],
    gh =>        [\&cmd_gh,
        "<addr.X> <data.X>",
        "Global half-word write"],
    gb =>        [\&cmd_gb,
        "<addr.X> <data.X>",
        "Global byte write"],
    lmemw =>    [\&cmd_lmemw,
        "<link.D> <addr.X>",
        "Read SpiNNaker memory via link (words)"],
    lw =>       [\&cmd_lw,
        "<link.D> <addr.X> [<data.X]",
        "Read/write SpiNNaker word via link"],
    srom_ip =>  [\&cmd_srom_ip,
        "[<ip_addr.P> [<gw_addr.P> [<net_mask.P>]]]",
        "Set IP address in serial ROM"],
    srom_read => [\&cmd_srom_read,
        "<addr.X>",
        "Read serial ROM data"],
    srom_type => [\&cmd_srom_type,
        "25aa1024|25aa080a|25aa160b",
        "Set SROM type"],
    srom_dump => [\&cmd_srom_dump,
        "<file.F> <addr.X> <len.D>",
        "Dump serial ROM data"],
    srom_write => [\&cmd_srom_write,
        "<file.F> <addr.X>",
        "Write serial ROM data"],
    srom_erase => [\&cmd_srom_erase,
        "",
        "Erase (all) serial ROM data"],
    srom_init => [\&cmd_srom_init,
        "<Flag.X> <MAC.M> <ip_addr.P> <gw_addr.P> <net_mask.P> <port.D>",
        "Initialise serial ROM"],
    remap =>     [\&cmd_remap,
        "<core.D> [phys|virt]",
        "Remove bad core from core map"],
    p2p_route => [\&cmd_p2p_route,
        "[on|off]",
        "Control P2P routing"],
    app_dump =>  [\&cmd_app_dump,
        "",
        "Show app data for this chip"],
    cmd =>       [\&cmd_cmd,
        '<cmd.D> <arg1.X> <arg2.X> <arg3.X>',
        'User specified command'],
};


sub cmd_expert
{
    return "" if $expert;

    $expert = 1;
    $cli->cmd ($expert_cmds, 0);

    print "# You are now an expert!\n";
    return "";
}


#-------------------------------------------------------------------------------


sub usage
{
    warn "usage: ybug <options> <hostname>\n";
    warn "  -bmp  <name>[/<slots>]   - set BMP target\n";
    warn "  -version                 - print version number\n";
    warn "  -norl                    - don't use 'ReadLine'\n";
    warn "  -expert                  - set 'expert' mode\n";
    die  "  -debug                   - set debug variable\n";
}


sub process_args
{
    my $range = "0";

    while ($#ARGV >= 0)
    {
        my $arg = shift @ARGV;

        if ($arg eq "-bmp")
        {
            die "BMP not specified\n" unless $bmp_target = shift @ARGV;
            $range = $1 if $bmp_target =~ s/\/(\S+)$//;
        }
        elsif ($arg eq "-version")
        {
            cmd_version ();
            exit 0;
        }
        elsif ($arg eq "-debug")
        {
            die "debug not specified\n" unless $debug = shift @ARGV &&
            $debug =~ /^\d+$/;
        }
        elsif ($arg eq "-norl")
        {
            $readline = 0;
        }
        elsif ($arg eq "-expert")
        {
            $expert = 1;
        }
        elsif ($arg !~ /^-/)
        {
            $spin_target = $arg;
        }
        else
        {
            usage ();
        }
    }

    $bmp_range = parse_bits ($range, 0, 23);

    die "bad BMP range\n" unless $bmp_range;
    die "target not specified\n" unless defined $spin_target;

#    $spin_port = $1 if $spin_target =~ s/:(\d+)$//;

    my $prompt = $spin_target;
    $prompt =~ s/\..+// unless $prompt =~ /^\d/;
    $prompt = "$prompt:0,0,0 > ";

    return $prompt;
}


sub open_targets
{
    $spin = SpiNN::Cmd->new (target => $spin_target,
                             port => $spin_port,
                             debug => $debug);

    die "Failed to open \"$spin_target\"\n" unless $spin;

    $sv = SpiNN::Struct->new (scp => $spin);

    die "Error reading structs\n" unless $sv;

    if (defined $bmp_target)
    {
        $bmp = SpiNN::Cmd->new (target => $bmp_target,
                                port => $bmp_port,
                                debug => $debug);

        die "Failed to open \"$bmp_target\"\n" unless $bmp;
    }
}


sub init_readline
{
    return undef unless $readline;

    use Term::ReadLine;
    $ENV{PERL_RL} = "Gnu o=0";

    my $term = Term::ReadLine->new ("ybug");
    my $attribs = $term->Attribs;

    $attribs->{completion_function} = sub
    {
        my ($text, $line, $start) = @_;
        return $cli->list if $start == 0;
        return $term->completion_matches ($text,
                $attribs->{filename_completion_function});
    };

    return $term;
}


sub main
{
    my $prompt = process_args ();

    my $term = init_readline ();

    open_targets ();

    cmd_version ();

    $cli = SpiNN::CLI->new (\*STDIN, $prompt, $spin_cmds, $term);

    $cli->cmd ($expert_cmds, 0) if $expert;

    $cli->run;
}


main ();
