1 |
22 |
wfjm |
#!/usr/bin/perl -w
|
2 |
25 |
wfjm |
# $Id: create_disk 562 2014-06-15 17:23:18Z mueller $
|
3 |
22 |
wfjm |
#
|
4 |
25 |
wfjm |
# Copyright 2013-2014 by Walter F.J. Mueller
|
5 |
22 |
wfjm |
#
|
6 |
|
|
# This program is free software; you may redistribute and/or modify it under
|
7 |
|
|
# the terms of the GNU General Public License as published by the Free
|
8 |
|
|
# Software Foundation, either version 2, or at your option any later version.
|
9 |
|
|
#
|
10 |
|
|
# This program is distributed in the hope that it will be useful, but
|
11 |
|
|
# WITHOUT ANY WARRANTY, without even the implied warranty of MERCHANTABILITY
|
12 |
|
|
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
|
13 |
|
|
# for complete details.
|
14 |
|
|
#
|
15 |
|
|
# Revision History:
|
16 |
|
|
# Date Rev Version Comment
|
17 |
25 |
wfjm |
# 2014-06-14 562 1.1 BUGFIX: repair --boot; add RM02,RM05,RP04,RP07
|
18 |
22 |
wfjm |
# 2013-05-20 521 1.0 First draft
|
19 |
|
|
#
|
20 |
|
|
|
21 |
|
|
use 5.10.0; # require Perl 5.10 or higher
|
22 |
|
|
use strict; # require strict checking
|
23 |
|
|
|
24 |
|
|
use Getopt::Long;
|
25 |
|
|
use FileHandle;
|
26 |
|
|
use Fcntl qw(:seek);
|
27 |
|
|
|
28 |
|
|
my %opts = ();
|
29 |
|
|
|
30 |
|
|
GetOptions(\%opts, "help", "typ=s", "ini=s", "bad", "boot"
|
31 |
|
|
)
|
32 |
|
|
or exit 1;
|
33 |
|
|
|
34 |
|
|
sub do_inipatt;
|
35 |
|
|
sub do_badtable;
|
36 |
25 |
wfjm |
sub do_boot;
|
37 |
22 |
wfjm |
sub print_help;
|
38 |
|
|
|
39 |
|
|
# disk type table
|
40 |
|
|
my %disktype = (
|
41 |
|
|
RK05 => {cyl=> 203, hd=> 2, sec=> 12, bps=> 512, bad=>0},
|
42 |
|
|
RL01 => {cyl=> 256, hd=> 2, sec=> 40, bps=> 256, bad=>1},
|
43 |
|
|
RL02 => {cyl=> 512, hd=> 2, sec=> 40, bps=> 256, bad=>1},
|
44 |
25 |
wfjm |
RM02 => {cyl=> 823, hd=> 5, sec=> 32, bps=> 512, bad=>1},
|
45 |
|
|
RM05 => {cyl=> 823, hd=> 19, sec=> 32, bps=> 512, bad=>1},
|
46 |
|
|
RP04 => {cyl=> 411, hd=> 19, sec=> 22, bps=> 512, bad=>1},
|
47 |
|
|
RP06 => {cyl=> 815, hd=> 19, sec=> 22, bps=> 512, bad=>1},
|
48 |
|
|
RP07 => {cyl=> 630, hd=> 32, sec=> 50, bps=> 512, bad=>1}
|
49 |
22 |
wfjm |
);
|
50 |
|
|
|
51 |
|
|
autoflush STDOUT 1 if (-p STDOUT); # autoflush if output into pipe
|
52 |
|
|
|
53 |
|
|
if (exists $opts{help}) {
|
54 |
|
|
print_help(1);
|
55 |
|
|
exit 0;
|
56 |
|
|
}
|
57 |
|
|
|
58 |
|
|
if (scalar(@ARGV) != 1) {
|
59 |
|
|
print STDERR "create_disk-E: specify one and only one output file\n";
|
60 |
|
|
print_help(0);
|
61 |
|
|
exit 1;
|
62 |
|
|
}
|
63 |
|
|
|
64 |
|
|
my $fnam = shift @ARGV;
|
65 |
|
|
|
66 |
|
|
if (-e $fnam) {
|
67 |
|
|
print STDERR "create_disk-E: file '$fnam' exists already\n";
|
68 |
|
|
exit 1;
|
69 |
|
|
}
|
70 |
|
|
|
71 |
|
|
my $typ = uc($opts{typ});
|
72 |
|
|
unless (defined $typ && exists $disktype{$typ}) {
|
73 |
|
|
print STDERR "create_disk-E: no or invalid --typ specification, use --help\n";
|
74 |
|
|
exit 1;
|
75 |
|
|
}
|
76 |
|
|
|
77 |
|
|
my $cyl = $disktype{$typ}{cyl};
|
78 |
|
|
my $hd = $disktype{$typ}{hd};
|
79 |
|
|
my $sec = $disktype{$typ}{sec};
|
80 |
|
|
my $bps = $disktype{$typ}{bps};
|
81 |
|
|
my $bad = $disktype{$typ}{bad};
|
82 |
|
|
|
83 |
|
|
if ($opts{bad} && !$bad) {
|
84 |
|
|
print STDERR "create_disk-E: --bad not supported for type '$typ', abort\n";
|
85 |
|
|
exit 1;
|
86 |
|
|
}
|
87 |
|
|
|
88 |
|
|
my $nblk = $cyl*$hd*$sec;
|
89 |
|
|
my $cap = $nblk * $bps;
|
90 |
|
|
|
91 |
|
|
my $fh = new FileHandle;
|
92 |
|
|
sysopen($fh, $fnam, O_RDWR|O_CREAT)
|
93 |
|
|
or die "failed to create '$fnam': $!";
|
94 |
|
|
|
95 |
|
|
# seek to end, wrte 1 byte at end
|
96 |
|
|
my $rc = $fh->seek($cap-1, SEEK_SET);
|
97 |
|
|
if (not $rc) {die "seek failed: $!";}
|
98 |
|
|
my $buf = pack('C1',0);
|
99 |
|
|
$rc = syswrite($fh, $buf, length($buf));
|
100 |
|
|
if ($rc<=0) {die "write failed: $!";}
|
101 |
|
|
|
102 |
|
|
# handle init patterns
|
103 |
|
|
do_inipatt if $opts{ini};
|
104 |
|
|
|
105 |
|
|
# handle factory bad block table
|
106 |
|
|
do_badtable if $opts{bad};
|
107 |
|
|
|
108 |
|
|
# write dummy boot block
|
109 |
25 |
wfjm |
do_boot if $opts{boot};
|
110 |
22 |
wfjm |
|
111 |
|
|
#-------------------------------------------------------------------------------
|
112 |
|
|
|
113 |
|
|
sub do_inipatt {
|
114 |
|
|
my $ini = $opts{ini};
|
115 |
|
|
|
116 |
|
|
if ($ini eq 'zero' ||$ini eq 'ones' || $ini eq 'dead') {
|
117 |
|
|
my @dat;
|
118 |
|
|
for (my $i=0; $i<$bps/4; $i++) {
|
119 |
|
|
push @dat, 0,0 if $ini eq 'zero';
|
120 |
|
|
push @dat, -1,-1 if $ini eq 'ones';
|
121 |
|
|
push @dat, 0xdead,0xbeaf if $ini eq 'dead';
|
122 |
|
|
}
|
123 |
|
|
my $buf = pack('v*',@dat);
|
124 |
|
|
my $rc = $fh->seek(0, SEEK_SET);
|
125 |
|
|
if (not $rc) {die "seek failed: $!";}
|
126 |
|
|
for (my $i=0; $i<$nblk; $i++) {
|
127 |
|
|
$rc = syswrite($fh, $buf, length($buf));
|
128 |
|
|
if ($rc<=0) {die "write failed: $!";}
|
129 |
|
|
}
|
130 |
|
|
|
131 |
|
|
} elsif ($ini eq 'test') {
|
132 |
|
|
my $addr = 0;
|
133 |
|
|
my $cur_sec = 0;
|
134 |
|
|
my $cur_trk = 0;
|
135 |
|
|
my $cur_cyl = 0;
|
136 |
|
|
my $rc = $fh->seek(0, SEEK_SET);
|
137 |
|
|
if (not $rc) {die "seek failed: $!";}
|
138 |
|
|
for (my $i=0; $i<$nblk; $i++) {
|
139 |
|
|
my @dat;
|
140 |
|
|
for (my $i=0; $i<$bps/16; $i++) {
|
141 |
|
|
push @dat, ($addr & 0xffff);
|
142 |
|
|
push @dat, (($addr>>16) & 0xffff);
|
143 |
|
|
push @dat, $cur_cyl, $cur_trk, $cur_sec;
|
144 |
|
|
push @dat, $cyl, $hd, $sec;
|
145 |
|
|
$addr += 16;
|
146 |
|
|
}
|
147 |
|
|
my $buf = pack('v*',@dat);
|
148 |
|
|
$rc = syswrite($fh, $buf, length($buf));
|
149 |
|
|
if ($rc<=0) {die "write failed: $!";}
|
150 |
|
|
$cur_sec += 1;
|
151 |
|
|
if ($cur_sec >= $sec) {
|
152 |
|
|
$cur_sec = 0;
|
153 |
|
|
$cur_trk += 1;
|
154 |
|
|
if ($cur_trk >= $hd) {
|
155 |
|
|
$cur_trk = 0;
|
156 |
|
|
$cur_cyl += 1;
|
157 |
|
|
}
|
158 |
|
|
}
|
159 |
|
|
}
|
160 |
|
|
|
161 |
|
|
} else {
|
162 |
|
|
print STDERR "create_disk-W: unknown --ini mode '$ini', --ini ignored\n";
|
163 |
|
|
}
|
164 |
|
|
return;
|
165 |
|
|
}
|
166 |
|
|
|
167 |
|
|
#-------------------------------------------------------------------------------
|
168 |
|
|
|
169 |
|
|
sub do_badtable {
|
170 |
|
|
my @dat;
|
171 |
|
|
push @dat, 012345, 012345; # pack number
|
172 |
|
|
push @dat, 0,0; # dummy c/s/h spec
|
173 |
|
|
for (my $i=4; $i<$bps/2; $i++) {
|
174 |
|
|
push @dat, -1; # end of table
|
175 |
|
|
}
|
176 |
|
|
my $buf = pack('v*',@dat);
|
177 |
|
|
|
178 |
|
|
my $pos = $cap - $sec*$bps; # position of last track
|
179 |
|
|
my $rc = $fh->seek($pos, SEEK_SET);
|
180 |
|
|
if (not $rc) {die "seek failed: $!";}
|
181 |
|
|
my $nsec = ($sec > 10) ? 10 : $sec; # write last track, at most 10 sec
|
182 |
|
|
for (my $i=0; $i<$nsec; $i++) {
|
183 |
|
|
$rc = syswrite($fh, $buf, length($buf));
|
184 |
|
|
if ($rc<=0) {die "write failed: $!";}
|
185 |
|
|
}
|
186 |
|
|
return;
|
187 |
|
|
}
|
188 |
|
|
|
189 |
|
|
#-------------------------------------------------------------------------------
|
190 |
|
|
|
191 |
25 |
wfjm |
sub do_boot {
|
192 |
22 |
wfjm |
my @dat;
|
193 |
|
|
|
194 |
|
|
push @dat, 0012700, 0000100; # start: mov #text, r0
|
195 |
|
|
push @dat, 0105710; # 1$: tstb (r0)
|
196 |
|
|
push @dat, 0001406; # beq 3$
|
197 |
|
|
push @dat, 0105737, 0177564; # 2$: tstb @#XCSR
|
198 |
|
|
push @dat, 0100375; # bpl 2$
|
199 |
|
|
push @dat, 0112037, 0177566; # movb (r0)+,@#XBUF
|
200 |
|
|
push @dat, 0000770; # br 1$
|
201 |
|
|
push @dat, 0000000; # 3$: halt
|
202 |
|
|
|
203 |
|
|
my $buf = pack('v*',@dat);
|
204 |
|
|
my $rc = $fh->seek(0, SEEK_SET);
|
205 |
|
|
if (not $rc) {die "seek failed: $!";}
|
206 |
|
|
$rc = syswrite($fh, $buf, length($buf));
|
207 |
|
|
if ($rc<=0) {die "write failed: $!";}
|
208 |
|
|
|
209 |
|
|
$buf = "\r\n";
|
210 |
|
|
$buf .= "\r\n";
|
211 |
|
|
$buf .= "++======================================++\r\n";
|
212 |
|
|
$buf .= "|| This is not a hardware bootable disk ||\r\n";
|
213 |
|
|
$buf .= "++======================================++\r\n";
|
214 |
|
|
$buf .= "\r\n";
|
215 |
|
|
$buf .= "Disk image created with 'create_disk --typ=$typ':\r\n";
|
216 |
|
|
$buf .= sprintf " number of cylinders: %6d\r\n", $cyl;
|
217 |
|
|
$buf .= sprintf " tracks per cylinder: %6d\r\n", $hd;
|
218 |
|
|
$buf .= sprintf " sectors per track: %6d\r\n", $sec;
|
219 |
|
|
$buf .= sprintf " block size: %6d\r\n", $bps;
|
220 |
|
|
$buf .= sprintf " total number of sectors: %6d\r\n", $nblk;
|
221 |
|
|
$buf .= sprintf " capacity in kByte: %6d\r\n", $cap/1024;
|
222 |
|
|
$buf .= "\r\n";
|
223 |
|
|
$buf .= "CPU WILL HALT\r\n";
|
224 |
|
|
$buf .= "\r\n";
|
225 |
|
|
|
226 |
|
|
# NOTE: the text above almost fills the first 512 bytes !!
|
227 |
25 |
wfjm |
# don't add more text, all has been said anyway !!
|
228 |
22 |
wfjm |
|
229 |
|
|
$rc = $fh->seek(0100, SEEK_SET);
|
230 |
|
|
if (not $rc) {die "seek failed: $!";}
|
231 |
|
|
$rc = syswrite($fh, $buf, length($buf));
|
232 |
|
|
if ($rc<=0) {die "write failed: $!";}
|
233 |
|
|
|
234 |
|
|
return;
|
235 |
|
|
}
|
236 |
|
|
|
237 |
|
|
#-------------------------------------------------------------------------------
|
238 |
|
|
|
239 |
|
|
sub print_help {
|
240 |
|
|
my ($ptyp) = @_;
|
241 |
|
|
print "usage: create_disk [options] \n";
|
242 |
|
|
print " --typ= specified disk type, must be specified\n";
|
243 |
|
|
print " --ini= initialization pattern, can be\n";
|
244 |
|
|
print " --bad create factory bad block table on last track\n";
|
245 |
|
|
print " --boot write dummy boot block, print volume info and HALT\n";
|
246 |
|
|
print " --help print full help, with list --typ and --ini options\n";
|
247 |
|
|
return unless $ptyp;
|
248 |
|
|
|
249 |
|
|
print "\n";
|
250 |
|
|
print "currently supported disk types:\n";
|
251 |
|
|
print " type #cyl #trk #sec bps tot_sec blocks -bad\n";
|
252 |
|
|
foreach my $typ (sort keys %disktype) {
|
253 |
|
|
my $cyl = $disktype{$typ}{cyl};
|
254 |
|
|
my $hd = $disktype{$typ}{hd};
|
255 |
|
|
my $sec = $disktype{$typ}{sec};
|
256 |
|
|
my $bps = $disktype{$typ}{bps};
|
257 |
|
|
printf " %4s %4d %4d %4d %4d %7d %7d %3s\n",
|
258 |
|
|
$typ, $cyl, $hd, $sec, $bps,
|
259 |
|
|
($cyl*$hd*$sec), ($cyl*$hd*$sec*$bps)/1024,
|
260 |
|
|
($disktype{$typ}{bad} ? 'yes' : ' no');
|
261 |
|
|
}
|
262 |
|
|
|
263 |
|
|
print "\n";
|
264 |
|
|
print "currently supported initialization patterns:\n";
|
265 |
|
|
print " zero all zero (the default anyway if no -ini given)\n";
|
266 |
|
|
print " ones all ones\n";
|
267 |
|
|
print " dead alternating 0xdead 0xbeaf pattern\n";
|
268 |
|
|
print " test writes unique groups of 8 16bit words\n";
|
269 |
|
|
print "\n";
|
270 |
|
|
print "For further details consults the create_disk man page.\n";
|
271 |
|
|
return;
|
272 |
|
|
}
|