collapseos/tools/uploadb.pl

80 lines
2.0 KiB
Perl
Executable File

#!/usr/bin/perl
# Push specified file to specified device **running the BASIC shell** and verify
# that the sent contents is correct.
use strict;
use Fcntl;
if (@ARGV != 3) {
print "Usage: ./uploadb.pl device memptr filename\n";
exit 1;
}
my ($device, $memptr, $fname) = @ARGV;
if (hex($memptr) >= 0x10000) { die "memptr is out of range"; }
if (! -e $fname) { die "${fname} does not exist"; }
my $fsize = -s $fname;
my $maxsize = 0x10000 - hex($memptr);
if ($fsize > $maxsize) { die "File too big. ${maxsize} bytes max"; }
my $fh;
unless (open($fh, '<', $fname)) { die "Can't open $fname"; }
my $devh;
unless (sysopen($devh, $device, O_RDWR|O_NOCTTY)) { die "Can't open $device"; }
sub sendcmd {
# The serial link echoes back all typed characters and expects us to read
# them. We have to send each char one at a time.
my $junk;
foreach my $char (split //, shift) {
syswrite $devh, $char;
sysread $devh, $junk, 1;
}
syswrite $devh, "\n";
sysread $devh, $junk, 2; # send back \r\n
}
sendcmd("m=0x${memptr}");
my $rd;
sysread $devh, $rd, 2; # read prompt
# disable buffering
$| = 1;
while (sysread $fh, my $char, 1) {
print ".";
for (my $i=0; $i<5; $i++) { # try 5 times
sendcmd("getc");
syswrite $devh, $char;
sysread $devh, $rd, 2; # read prompt
sendcmd("print a");
my $s = "";
while (1) {
sysread $devh, $rd, 1;
if ($rd !~ /\d/) { last; }
$s .= $rd;
}
sysread $devh, $rd, 3; # read prompt
if ($s == ord($char)) {
last;
} else {
if ($i < 4) {
print "Mismatch at byte ${i}! ${s} != ${ord($char)}. Retrying.\n";
} else {
die "Maximum retries reached, abort.\n";
}
}
}
sendcmd("poke m a");
sysread $devh, $rd, 2; # read prompt
sendcmd("m=m+1");
sysread $devh, $rd, 2; # read prompt
}
print "Done!\n";
close $fh;
close $devh;