/
diskloader.pl
executable file
·81 lines (63 loc) · 1.84 KB
/
diskloader.pl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
#!/usr/bin/perl
# This script can be used to "bare metal boostrap" a S100 system using the
# Cromemco 4FDC floppy controller, provided that formatted disks are available.
# The image file is written into a track buffer at 0x0200 one track at a time,
# and saved to disk using RDOS's built in disk commands.
use Device::SerialPort qw( :PARAM :STAT 0.07 );
use Time::HiRes qw(usleep);
if ($#ARGV < 1) {
print "Cromemco 4FDC bare metal disk loader\n(c) 2014 Jonathan Chapman\n\nUSAGE: \n\t./diskloader.pl diskimage.img /dev/ttyS0\n";
exit -1;
}
# Open the first arg as a binary image
open (FH, '<', $ARGV[0]) or die "Can't open image file " . $ARGV[0] . " for reading!";
binmode(FH);
$/ = \2304; # 18, 128 byte sectors == 1 track
$count = 0;
# Initialize the serial port, 9600 8/N/1
$port = new Device::SerialPort($ARGV[1]);
if (undef == $port) {
die "Can't open serial port at " . $ARGV[1] . "!";
}
$port->user_msg(ON);
$port->baudrate(9600);
$port->parity("none");
$port->databits(8);
$port->stopbits(1);
$port->handshake("none");
$port->write_settings;
$port->lookclear;
# Get the monitor ready for bytes
$port->read(255);
$port->write("A;;;\r");
sleep(1);
$port->write("S 0\r");
sleep(1);
print "Writing track ";
while (<FH>) {
print $count . "...";
$port->write("SM 0200\r");
usleep(50000);
# Fill memory with 18 sectors' data
$sector = unpack('H*', $_);
@values = unpack("(A2)*", $sector);
foreach (@values) {
$port->write($_ . " ");
$answer=$port->read(255);
if ($answer == /\.$/) {
usleep(20000);
} else {
die "didn't get a confirm";
}
}
$count++;
# Get out of SM and write the track to disk
$port->write("\r");
sleep(1);
$port->write("WD 0200 0AFF 1\r");
sleep(3);
$port->write("S " . sprintf("%x",$count) . "\r");
sleep(1);
}
print "\n\nSent " . $count . " tracks\n";
exit 0;