├── README.md ├── extract_tokens ├── rename.pl ├── info.pl ├── opt4.pl ├── access.pl ├── blank_ssd.pl ├── to_stdout.pl ├── delete.pl ├── title.pl ├── compact.pl ├── daccess.pl ├── type.pl ├── dcat.pl ├── dinfo.pl ├── drecat.pl ├── dget_ssd.pl ├── dform.pl ├── dlabel.pl ├── dput_ssd.pl ├── putfile.pl ├── donboot.pl ├── getfile.pl ├── dkill.pl ├── dextend_mmb.pl ├── dblank_mmb.pl ├── dump.pl ├── dreplace_mmb.pl ├── merge_dsd.pl ├── dgetfile.pl ├── split_dsd.pl ├── dmerge_mmb.pl ├── dbase.pl ├── beeb ├── dsplit_mmb.pl ├── bdiag.pl ├── dmmb_info.pl ├── list.pl ├── COPYING ├── README └── BeebUtils.pm /README.md: -------------------------------------------------------------------------------- 1 | # MMB_Utils 2 | Perl library and utilities for manipulating BBC MMB and SSD files 3 | 4 | The "distribution" site (such as it is) and README for this code is [here](http://sweh.spuddy.org/Beeb/mmb_utils.html). 5 | 6 | PRs welcome :-) 7 | -------------------------------------------------------------------------------- /extract_tokens: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | $ROM="basic2.rom"; 4 | $START=0x071; 5 | $END=0x36c; 6 | 7 | open(F,"<$ROM") or die "$ROM: $!\n"; 8 | 9 | $cmd=""; 10 | seek F,$START,0; 11 | while (tell(F)<=$END) 12 | { 13 | $ch=getc(F); 14 | if (ord($ch) < 128) 15 | { 16 | $cmd .="$ch"; 17 | } 18 | else 19 | { 20 | my $flag=getc(F); 21 | printf(" %d => ['%s',0x%02X],\n",ord($ch),$cmd,ord($flag)); 22 | $cmd=""; 23 | } 24 | } 25 | -------------------------------------------------------------------------------- /rename.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | # Beeb Utilities to manipulate MMB and SSD files 5 | # Copyright (C) 2012 Stephen Harris 6 | # 7 | # See file "COPYING" for GPLv2 licensing 8 | 9 | use FindBin; 10 | use lib "$FindBin::Bin"; 11 | use BeebUtils; 12 | 13 | @ARGV=BeebUtils::init_ssd(@ARGV); 14 | 15 | die "Syntax: $BeebUtils::PROG SSD file1 file2\n" unless @ARGV==2 && $BeebUtils::BBC_FILE; 16 | 17 | my $image=BeebUtils::load_external_ssd(undef,1); 18 | 19 | BeebUtils::rename_file(\$image,$ARGV[0],$ARGV[1]); 20 | -------------------------------------------------------------------------------- /info.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | # Beeb Utilities to manipulate MMB and SSD files 5 | # Copyright (C) 2012 Stephen Harris 6 | # 7 | # See file "COPYING" for GPLv2 licensing 8 | 9 | use FindBin; 10 | use lib "$FindBin::Bin"; 11 | use BeebUtils; 12 | 13 | @ARGV=BeebUtils::init_ssd(@ARGV); 14 | die "Syntax: $BeebUtils::PROG filename.ssd\n" if $BeebUtils::BBC_FILE eq ""; 15 | 16 | my $image=BeebUtils::load_external_ssd(undef,0); 17 | 18 | my %files=BeebUtils::read_cat(\$image); 19 | 20 | BeebUtils::print_cat(%files); 21 | -------------------------------------------------------------------------------- /opt4.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | # Beeb Utilities to manipulate MMB and SSD files 5 | # Copyright (C) 2012 Stephen Harris 6 | # 7 | # See file "COPYING" for GPLv2 licensing 8 | 9 | use FindBin; 10 | use lib "$FindBin::Bin"; 11 | use BeebUtils; 12 | 13 | @ARGV=BeebUtils::init_ssd(@ARGV); 14 | die "Syntax: $BeebUtils::PROG filename.ssd [0-3]\n" if $BeebUtils::BBC_FILE eq "" || !@ARGV || $ARGV[0] !~ /^[0-3]$/; 15 | 16 | my $image=BeebUtils::load_external_ssd(undef,1); 17 | BeebUtils::opt4(\$image,$ARGV[0]); 18 | BeebUtils::write_ssd(\$image,$BeebUtils::BBC_FILE); 19 | -------------------------------------------------------------------------------- /access.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | # Beeb Utilities to manipulate MMB and SSD files 5 | # Copyright (C) 2012 Stephen Harris 6 | # 7 | # See file "COPYING" for GPLv2 licensing 8 | 9 | use FindBin; 10 | use lib "$FindBin::Bin"; 11 | use BeebUtils; 12 | 13 | @ARGV=BeebUtils::init_ssd(@ARGV); 14 | 15 | die "Syntax: $BeebUtils::PROG SSD filename [L]\n" unless @ARGV && $BeebUtils::BBC_FILE; 16 | 17 | my $filename=$ARGV[0]; 18 | my $lock=$ARGV[1]?1:0; 19 | 20 | my $image=BeebUtils::load_external_ssd(undef,1); 21 | 22 | BeebUtils::lock_files($filename,$lock,\$image); 23 | -------------------------------------------------------------------------------- /blank_ssd.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | # Beeb Utilities to manipulate MMB and SSD files 5 | # Copyright (C) 2012 Stephen Harris 6 | # 7 | # See file "COPYING" for GPLv2 licensing 8 | 9 | use FindBin; 10 | use lib "$FindBin::Bin"; 11 | use BeebUtils; 12 | 13 | @ARGV=BeebUtils::init_ssd(@ARGV); 14 | my $dest=$BeebUtils::BBC_FILE; 15 | die "Syntax: $BeebUtils::PROG filename.ssd\n" unless $dest; 16 | 17 | die "$dest already exists\n" if -e $dest; 18 | 19 | my $image=BeebUtils::blank_ssd(); 20 | BeebUtils::write_ssd(\$image,$dest); 21 | print "Blank $dest created\n"; 22 | -------------------------------------------------------------------------------- /to_stdout.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | # Beeb Utilities to manipulate MMB and SSD files 5 | # Copyright (C) 2012 Stephen Harris 6 | # 7 | # See file "COPYING" for GPLv2 licensing 8 | 9 | use FindBin; 10 | use lib "$FindBin::Bin"; 11 | use BeebUtils; 12 | 13 | @ARGV=BeebUtils::init_ssd(@ARGV); 14 | die "Syntax: $BeebUtils::PROG filename.ssd filename\n" if $BeebUtils::BBC_FILE eq "" || !@ARGV; 15 | 16 | my $filename=$ARGV[0]; 17 | 18 | my $image=BeebUtils::load_external_ssd(undef,0); 19 | 20 | my ($file)=BeebUtils::ExtractFile(\$image,$filename); 21 | print "$file"; 22 | -------------------------------------------------------------------------------- /delete.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | # Beeb Utilities to manipulate MMB and SSD files 5 | # Copyright (C) 2012 Stephen Harris 6 | # 7 | # See file "COPYING" for GPLv2 licensing 8 | 9 | use FindBin; 10 | use lib "$FindBin::Bin"; 11 | use BeebUtils; 12 | 13 | @ARGV=BeebUtils::init_ssd(@ARGV); 14 | 15 | my $force; 16 | if (@ARGV && $ARGV[0] eq '-y') 17 | { 18 | $force=1; shift @ARGV; 19 | } 20 | 21 | die "Syntax: $BeebUtils::PROG SSD [-y] file(s)\n" unless @ARGV && $BeebUtils::BBC_FILE; 22 | 23 | my $image=BeebUtils::load_external_ssd(undef,1); 24 | 25 | BeebUtils::delete_files($force,\$image,@ARGV); 26 | -------------------------------------------------------------------------------- /title.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | # Beeb Utilities to manipulate MMB and SSD files 5 | # Copyright (C) 2012 Stephen Harris 6 | # 7 | # See file "COPYING" for GPLv2 licensing 8 | 9 | use FindBin; 10 | use lib "$FindBin::Bin"; 11 | use BeebUtils; 12 | 13 | @ARGV=BeebUtils::init_ssd(@ARGV); 14 | my $dest=$BeebUtils::BBC_FILE; 15 | my $title=$ARGV[0]; 16 | die "Syntax: $BeebUtils::PROG filename.ssd title\n" if $dest eq "" || !$title; 17 | 18 | my $image=BeebUtils::load_external_ssd(undef,1); 19 | BeebUtils::set_ssd_title(\$image,$title); 20 | BeebUtils::write_ssd(\$image,$dest); 21 | print "$dest updated\n"; 22 | -------------------------------------------------------------------------------- /compact.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | # Beeb Utilities to manipulate MMB and SSD files 5 | # Copyright (C) 2012 Stephen Harris 6 | # 7 | # See file "COPYING" for GPLv2 licensing 8 | 9 | use FindBin; 10 | use lib "$FindBin::Bin"; 11 | use BeebUtils; 12 | 13 | @ARGV=BeebUtils::init_ssd(@ARGV); 14 | die "Syntax: $BeebUtils::PROG SSD\n" unless $BeebUtils::BBC_FILE; 15 | 16 | my $image=BeebUtils::load_external_ssd(undef,1); 17 | if (BeebUtils::compact_ssd(\$image)) 18 | { 19 | BeebUtils::write_ssd(\$image,$BeebUtils::BBC_FILE); 20 | print "Disk compacted\n"; 21 | } 22 | else 23 | { 24 | print "No action needed\n"; 25 | } 26 | -------------------------------------------------------------------------------- /daccess.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | # Beeb Utilities to manipulate MMB and SSD files 5 | # Copyright (C) 2012 Stephen Harris 6 | # 7 | # See file "COPYING" for GPLv2 licensing 8 | 9 | use FindBin; 10 | use lib "$FindBin::Bin"; 11 | use BeebUtils; 12 | 13 | @ARGV=BeebUtils::init(@ARGV); 14 | my $dr=$ARGV[0]; 15 | die "Syntax: $BeebUtils::PROG [-f MMB_file] image_number [L]\n" unless defined($dr); 16 | die "Not a number\n" unless $dr=~/^[0-9]+$/; 17 | 18 | my $lock=0; 19 | $lock=1 if $ARGV[1]; 20 | 21 | my $disktable=BeebUtils::LoadDiskTable(); 22 | my %disk=BeebUtils::load_dcat(); 23 | 24 | die "Disk $dr not formatted.\n" unless $disk{$dr}{Formatted}; 25 | BeebUtils::lock_disk($dr,$lock,\$disktable); 26 | BeebUtils::SaveDiskTable(\$disktable); 27 | -------------------------------------------------------------------------------- /type.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | # Beeb Utilities to manipulate MMB and SSD files 5 | # Copyright (C) 2012 Stephen Harris 6 | # 7 | # See file "COPYING" for GPLv2 licensing 8 | 9 | use FileHandle; 10 | use FindBin; 11 | use lib "$FindBin::Bin"; 12 | use BeebUtils; 13 | 14 | # Stupid program that reads the passed file, converts 0D to 0A 15 | # (converts BBC to Unix) 16 | # (yeah yeah, tr '\015' '\012' but this is more portable) 17 | 18 | my $file=$ARGV[0]; 19 | die "Syntax: $BeebUtils::PROG filename\n" unless $file; 20 | 21 | my $f=new FileHandle "<$file"; 22 | die "Can not open $file: $!\n" unless $f; 23 | binmode($f); 24 | 25 | my $buffer; 26 | while (sysread($f,$buffer,10000)) 27 | { 28 | $buffer=~tr/\015/\012/; 29 | print $buffer; 30 | } 31 | -------------------------------------------------------------------------------- /dcat.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | # Beeb Utilities to manipulate MMB and SSD files 5 | # Copyright (C) 2012 Stephen Harris 6 | # 7 | # See file "COPYING" for GPLv2 licensing 8 | 9 | use FindBin; 10 | use lib "$FindBin::Bin"; 11 | use BeebUtils; 12 | 13 | @ARGV=BeebUtils::init(@ARGV); 14 | 15 | my $all=0; 16 | if (@ARGV && $ARGV[0] eq '-a') 17 | { 18 | $all=1; 19 | } 20 | 21 | my %disk=BeebUtils::load_dcat(); 22 | 23 | foreach (sort {$a <=> $b} keys %disk) 24 | { 25 | next unless $disk{$_}{Formatted} || $all; 26 | my $t=$disk{$_}{DiskTitle}; 27 | $t="" unless $disk{$_}{Formatted}; 28 | my $d="$_"; $d=" $d" if length($d)==1; $d=" $d" if length($d)==2; $d=" $d" if length($d)==3; 29 | my $L=$disk{$_}{ReadOnly}?" (L)":""; 30 | print "$d: $t$L\n"; 31 | } 32 | -------------------------------------------------------------------------------- /dinfo.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | # Beeb Utilities to manipulate MMB and SSD files 5 | # Copyright (C) 2012 Stephen Harris 6 | # 7 | # See file "COPYING" for GPLv2 licensing 8 | 9 | use FindBin; 10 | use lib "$FindBin::Bin"; 11 | use BeebUtils; 12 | 13 | @ARGV=BeebUtils::init(@ARGV); 14 | my $dr=$ARGV[0]; 15 | die "Syntax: $BeebUtils::PROG [-f MMB_file] image_number\n" unless defined($dr); 16 | die "Not a number\n" unless $dr=~/^[0-9]+$/; 17 | 18 | my %disk=BeebUtils::load_dcat(); 19 | die "Disk $dr not valid\n" unless $disk{$dr}{Formatted}; 20 | 21 | my $L=$disk{$dr}{ReadOnly}?" (L)":""; 22 | print "Catalogue for Disk $dr: $disk{$dr}{DiskTitle}$L\n"; 23 | 24 | my $image=BeebUtils::read_ssd($dr); 25 | 26 | my %files=BeebUtils::read_cat(\$image); 27 | 28 | BeebUtils::print_cat(%files); 29 | -------------------------------------------------------------------------------- /drecat.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | # Beeb Utilities to manipulate MMB and SSD files 5 | # Copyright (C) 2012 Stephen Harris 6 | # 7 | # See file "COPYING" for GPLv2 licensing 8 | 9 | use FindBin; 10 | use lib "$FindBin::Bin"; 11 | use BeebUtils; 12 | @ARGV=BeebUtils::init(@ARGV); 13 | 14 | my $disktable=BeebUtils::LoadDiskTable(); 15 | my %disk=BeebUtils::load_dcat(); 16 | 17 | # For each formatted disk, read the SSD title and update the 18 | # catalogue 19 | foreach (sort {$a <=> $b} keys %disk) 20 | { 21 | next unless $disk{$_}{Formatted}; 22 | my $image=BeebUtils::read_ssd($_); 23 | my %files=BeebUtils::read_cat(\$image); 24 | my $title=$files{""}{title}; 25 | BeebUtils::ChangeDiskName($_,$title,\$disktable); 26 | printf("%4d: %s\n",$_,$title); 27 | } 28 | 29 | BeebUtils::SaveDiskTable(\$disktable); 30 | -------------------------------------------------------------------------------- /dget_ssd.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | # Beeb Utilities to manipulate MMB and SSD files 5 | # Copyright (C) 2012 Stephen Harris 6 | # 7 | # See file "COPYING" for GPLv2 licensing 8 | 9 | use FindBin; 10 | use lib "$FindBin::Bin"; 11 | use BeebUtils; 12 | @ARGV=BeebUtils::init(@ARGV); 13 | 14 | my $dr=$ARGV[0]; 15 | die "Syntax: $BeebUtils::PROG [-f MMB_file] image_number target_file\n" unless defined($dr); 16 | die "Not a number\n" unless $dr=~/^[0-9]+$/; 17 | 18 | my $target=$ARGV[1]; 19 | die "No target file\n" unless $target; 20 | 21 | 22 | my %disk=BeebUtils::load_dcat(); 23 | die "Disk $dr not valid\n" unless $disk{$dr}{Formatted}; 24 | 25 | my $L=$disk{$dr}{ReadOnly}?" (L)":""; 26 | print "Getting disk $dr: $disk{$dr}{DiskTitle}$L\n"; 27 | 28 | my $image=BeebUtils::read_ssd($dr); 29 | BeebUtils::write_ssd(\$image,$target); 30 | print "$target created\n"; 31 | -------------------------------------------------------------------------------- /dform.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | # Beeb Utilities to manipulate MMB and SSD files 5 | # Copyright (C) 2012 Stephen Harris 6 | # 7 | # See file "COPYING" for GPLv2 licensing 8 | 9 | use FindBin; 10 | use lib "$FindBin::Bin"; 11 | use BeebUtils; 12 | @ARGV=BeebUtils::init(@ARGV); 13 | 14 | my $dr=$ARGV[0]; 15 | die "Syntax: $BeebUtils::PROG [-f MMB_file] image_number [title]\n" unless defined($dr); 16 | die "Not a number\n" unless $dr=~/^[0-9]+$/; 17 | 18 | my $title=$ARGV[1] || ''; 19 | 20 | my $disktable=BeebUtils::LoadDiskTable; 21 | my %disk=BeebUtils::load_dcat(\$disktable); 22 | die "Disk $dr already in use; use dkill to erase to reuse.\n" if $disk{$dr}{Formatted}; 23 | 24 | my $image=BeebUtils::blank_ssd(); 25 | BeebUtils::set_ssd_title(\$image,$title); 26 | BeebUtils::put_ssd($image,$dr); 27 | 28 | BeebUtils::DeleteSlot($dr,1,\$disktable); # set's disk type to RW 29 | BeebUtils::ChangeDiskName($dr,$title,\$disktable); 30 | BeebUtils::SaveDiskTable(\$disktable); 31 | 32 | print "Blank disk ($title) written to $dr\n"; 33 | -------------------------------------------------------------------------------- /dlabel.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | # Beeb Utilities to manipulate MMB and SSD files 5 | # Copyright (C) 2012 Stephen Harris 6 | # 7 | # See file "COPYING" for GPLv2 licensing 8 | 9 | use FindBin; 10 | use lib "$FindBin::Bin"; 11 | use BeebUtils; 12 | @ARGV=BeebUtils::init(@ARGV); 13 | 14 | my $dr=$ARGV[0]; 15 | die "Syntax: $BeebUtils::PROG [-f MMB_file] image_number new_label\n" unless defined($dr); 16 | die "Not a number\n" unless $dr=~/^[0-9]+$/; 17 | 18 | my $target=$ARGV[1]; 19 | die "No label\n" unless $target; 20 | 21 | my $disktable=BeebUtils::LoadDiskTable(); 22 | my %disk=BeebUtils::load_dcat(); 23 | die "Disk $dr not valid\n" unless $disk{$dr}{Formatted}; 24 | die "Disk $dr ($disk{$dr}{DiskTitle}) is locked\n" if $disk{$dr}{ReadOnly}; 25 | 26 | print "Getting disk $dr: $disk{$dr}{DiskTitle}\n"; 27 | 28 | BeebUtils::ChangeDiskName($dr,$target,\$disktable); 29 | BeebUtils::SaveDiskTable(\$disktable); 30 | 31 | # Reload the MMB catalogue 32 | %disk=BeebUtils::load_dcat(); 33 | print "Set to disk $dr: $disk{$dr}{DiskTitle}\n"; 34 | -------------------------------------------------------------------------------- /dput_ssd.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | # Beeb Utilities to manipulate MMB and SSD files 5 | # Copyright (C) 2012 Stephen Harris 6 | # 7 | # See file "COPYING" for GPLv2 licensing 8 | 9 | use FindBin; 10 | use lib "$FindBin::Bin"; 11 | use BeebUtils; 12 | @ARGV=BeebUtils::init(@ARGV); 13 | 14 | my $dr=$ARGV[0]; 15 | die "Syntax: $BeebUtils::PROG [-f MMB_file] image_number source_ssd\n" unless defined($dr); 16 | die "Not a number\n" unless $dr=~/^[0-9]+$/; 17 | 18 | my $target=$ARGV[1]; 19 | die "No target file\n" unless $target; 20 | 21 | my $disktable=BeebUtils::LoadDiskTable; 22 | my %disk=BeebUtils::load_dcat(\$disktable); 23 | die "Disk $dr already in use; use dkill to erase to reuse.\n" if $disk{$dr}{Formatted}; 24 | 25 | my $image=BeebUtils::load_external_ssd($target,1); 26 | 27 | my %files=BeebUtils::read_cat(\$image); 28 | my $t=$files{""}{title}; 29 | $t =~ tr/\x20-\x7f//cd; 30 | BeebUtils::put_ssd($image,$dr); 31 | BeebUtils::DeleteSlot($dr,1,\$disktable); # set's disk type to RW 32 | BeebUtils::ChangeDiskName($dr,$t,\$disktable); 33 | BeebUtils::SaveDiskTable(\$disktable); 34 | 35 | print "Disk $target ($t) written to $dr\n"; 36 | -------------------------------------------------------------------------------- /putfile.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | use FindBin; 5 | use lib "$FindBin::Bin"; 6 | use BeebUtils; 7 | 8 | @ARGV=BeebUtils::init_ssd(@ARGV); 9 | 10 | my $compact=0; 11 | if (@ARGV && $ARGV[0] eq '-c') { $compact=1 ; shift @ARGV; } 12 | 13 | die "$BeebUtils::PROG SSD [-c] file(s)\n" unless @ARGV && $BeebUtils::BBC_FILE; 14 | 15 | my $image=BeebUtils::load_external_ssd(undef,1); 16 | 17 | # This is an optimization. The Beeb always adds a file to the end of 18 | # the catalogue, even if there's a gap in the middle. Simple code for 19 | # simple times. We can do the same thing 'cos it's simple. But we can 20 | # _compact_ the image first 'cos we're not throwing physical heads around 21 | # and so we'll always have the most free space possible 22 | BeebUtils::compact_ssd(\$image) if $compact; 23 | 24 | foreach (@ARGV) 25 | { 26 | next unless -f $_; 27 | # If this is an inf file and there's a file of the same name... 28 | # skip! 29 | if (/\.inf$/) 30 | { 31 | my $b=$_; $b=~s/.inf$//; 32 | next if -e $b; 33 | } 34 | BeebUtils::add_file_to_ssd(\$image,$_); 35 | } 36 | 37 | BeebUtils::write_ssd(\$image,$BeebUtils::BBC_FILE); 38 | -------------------------------------------------------------------------------- /donboot.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | # Beeb Utilities to manipulate MMB and SSD files 5 | # Copyright (C) 2012 Stephen Harris 6 | # 7 | # See file "COPYING" for GPLv2 licensing 8 | 9 | use FindBin; 10 | use lib "$FindBin::Bin"; 11 | use BeebUtils; 12 | 13 | @ARGV=BeebUtils::init(@ARGV); 14 | 15 | my ($disktable,%boot)=BeebUtils::load_onboot(); 16 | my %disk=BeebUtils::load_dcat(\$disktable); 17 | 18 | if (!@ARGV) 19 | { 20 | foreach (0..3) 21 | { 22 | my $d=$boot{$_}; 23 | my $t=""; 24 | if ($disk{$d}{Formatted}) 25 | { 26 | my $L=$disk{$d}{ReadOnly}?" (L)":""; 27 | $t="$disk{$d}{DiskTitle}$L"; 28 | } 29 | print "$_: $d - $t\n"; 30 | } 31 | exit; 32 | } 33 | 34 | my $force=0; 35 | if ($ARGV[0] eq '-y') { $force=1; shift @ARGV; } 36 | my $drive=shift @ARGV; 37 | my $disk=shift @ARGV; 38 | die "Syntax: $BeebUtils::PROG [-y] drive disk_number\n" unless defined($disk); 39 | die "Invalid drive\n" unless $drive=~/^[0123]$/; 40 | die "Invalid disk\n" unless $disk=~/^\d+$/; 41 | 42 | die "Disk $disk not formatted. Use -y flag to foce\n" unless $disk{$disk}{Formatted} || $force; 43 | $boot{$drive}=$disk; 44 | BeebUtils::save_onboot(\$disktable,%boot); 45 | -------------------------------------------------------------------------------- /getfile.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | # Beeb Utilities to manipulate MMB and SSD files 5 | # Copyright (C) 2012 Stephen Harris 6 | # 7 | # See file "COPYING" for GPLv2 licensing 8 | 9 | use FindBin; 10 | use lib "$FindBin::Bin"; 11 | use BeebUtils; 12 | 13 | @ARGV=BeebUtils::init_ssd(@ARGV); 14 | 15 | my $merge=0; 16 | if (@ARGV && $ARGV[0] eq '-merge') 17 | { 18 | $merge=1; shift @ARGV; 19 | } 20 | 21 | my $overwrite=0; 22 | if (@ARGV && $ARGV[0] eq '-overwrite') 23 | { 24 | $overwrite=1; shift @ARGV; 25 | } 26 | 27 | die "Syntax: $BeebUtils::PROG filename.ssd [-merge] [-overwrite] destdir [filename_regexp]\n" if $BeebUtils::BBC_FILE eq "" || !@ARGV; 28 | 29 | my $destdir=$ARGV[0]; 30 | 31 | my $filter='^.*$'; 32 | if (defined $ARGV[1]) { 33 | $filter = $ARGV[1]; 34 | } 35 | 36 | if ($merge) 37 | { 38 | if (!-d $destdir) { 39 | mkdir($destdir) || die "mkdir $destdir: $!\n"; 40 | } 41 | } else { 42 | die "$destdir already exists\n" if -e $destdir; 43 | mkdir($destdir) || die "mkdir $destdir: $!\n"; 44 | } 45 | 46 | my $image=BeebUtils::load_external_ssd(undef,0); 47 | 48 | chdir($destdir) || die "chdir $destdir: $!\n"; 49 | BeebUtils::save_all_files_from_ssd(\$image,1,$overwrite,$filter); 50 | -------------------------------------------------------------------------------- /dkill.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | # Beeb Utilities to manipulate MMB and SSD files 5 | # Copyright (C) 2012 Stephen Harris 6 | # 7 | # See file "COPYING" for GPLv2 licensing 8 | 9 | use FindBin; 10 | use lib "$FindBin::Bin"; 11 | use BeebUtils; 12 | @ARGV=BeebUtils::init(@ARGV); 13 | my $force=0; 14 | if (@ARGV && $ARGV[0] eq '-y') { $force=1; shift @ARGV; } 15 | 16 | my $dr=$ARGV[0]; 17 | die "Syntax: $BeebUtils::PROG [-f MMB_file] [-y] image_number [R]\n" unless defined($dr); 18 | die "Not a number\n" unless $dr=~/^[0-9]+$/; 19 | 20 | my $restore=0; $restore=1 if $ARGV[1]; 21 | 22 | my $disktable=BeebUtils::LoadDiskTable(); 23 | my %disk=BeebUtils::load_dcat(); 24 | die "Disk $dr not valid\n" if !$disk{$dr}{Formatted} && !$restore; 25 | die "Disk $dr not deleted\n" if $disk{$dr}{Formatted} && $restore; 26 | 27 | die "Disk $dr ($disk{$dr}{DiskTitle}) is locked\n" if $disk{$dr}{ReadOnly} && !$force; 28 | 29 | print "Deleting disk $dr: $disk{$dr}{DiskTitle}\n"; 30 | if (!$restore && !$force) 31 | { 32 | print "Are you sure (Y/N)? "; 33 | my $x=; 34 | if ($x!~/^[Yy]/) { exit; } 35 | } 36 | 37 | BeebUtils::DeleteSlot($dr,$restore,\$disktable); 38 | BeebUtils::SaveDiskTable(\$disktable); 39 | 40 | print $restore?"Restored\n":"Removed\n"; 41 | -------------------------------------------------------------------------------- /dextend_mmb.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | # Beeb Utilities to manipulate MMB and SSD files 5 | # Copyright (C) 2012 Stephen Harris 6 | # 7 | # See file "COPYING" for GPLv2 licensing 8 | 9 | use FindBin; 10 | use lib "$FindBin::Bin"; 11 | use BeebUtils; 12 | 13 | @ARGV=BeebUtils::init(@ARGV); 14 | my $dest=$BeebUtils::BBC_FILE || 'BEEB.MMB'; 15 | 16 | die "$dest does not exists\n" unless -e $dest; 17 | 18 | my $fh=new FileHandle "+< $dest"; 19 | die "Can not open $dest for extending\n" unless $fh; 20 | 21 | binmode($fh); 22 | 23 | # Check to ensure we don't already have 15 extensions 24 | sysseek($fh,8,0); 25 | my $ext_byte; 26 | sysread($fh,$ext_byte,1); 27 | 28 | $ext_byte=ord($ext_byte); 29 | $ext_byte=160 if $ext_byte==0; 30 | if ($ext_byte < 160 || $ext_byte > 175) 31 | { 32 | die "Base MMB image has unexpected character indicating length\n We got $ext_byte but it should be 0 or between 160 and 175\n"; 33 | } 34 | 35 | die "Already at maximum extent\n" if $ext_byte == 175; 36 | 37 | # Seek to end of file 38 | sysseek($fh,0,2); 39 | 40 | my $image=BeebUtils::blank_mmb(); 41 | syswrite($fh,$image); 42 | 43 | # Update extent record 44 | sysseek($fh,8,0); 45 | syswrite($fh,chr($ext_byte+1),1); 46 | 47 | close($fh); 48 | 49 | print "$dest extended\n"; 50 | -------------------------------------------------------------------------------- /dblank_mmb.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | # Beeb Utilities to manipulate MMB and SSD files 5 | # Copyright (C) 2012 Stephen Harris 6 | # 7 | # See file "COPYING" for GPLv2 licensing 8 | 9 | use FindBin; 10 | use lib "$FindBin::Bin"; 11 | use BeebUtils; 12 | 13 | @ARGV=BeebUtils::init(@ARGV); 14 | my $dest=$BeebUtils::BBC_FILE || 'BEEB.MMB'; 15 | 16 | die "$dest already exists\n" if -e $dest; 17 | 18 | my $extra=$ARGV[0]; 19 | if (defined($extra)) 20 | { 21 | die "Syntax: $BeebUtils::PROG [-f MMB_file] [extra_catalogs]\n extra_catalogues must be a number between 1 and 15 inclusive\n" unless $extra=~/^[0-9]+$/; 22 | ; 23 | 24 | $extra=int($extra); 25 | if ($extra < 1 || $extra > 15) 26 | { 27 | die "extra_catalogues must be a number between 1 and 15 inclusive\n"; 28 | } 29 | } 30 | else 31 | { 32 | $extra=0; 33 | } 34 | 35 | my $image=BeebUtils::blank_mmb(); 36 | 37 | my $fh=new FileHandle ">$dest"; 38 | die "Can not open $dest for saving\n" unless $fh; 39 | 40 | binmode($fh); 41 | print $fh $image; 42 | 43 | if ($extra) 44 | { 45 | foreach my $i (1..$extra) 46 | { 47 | print $fh $image; 48 | } 49 | sysseek($fh,8,0); 50 | syswrite($fh,chr(160+$extra),1); 51 | } 52 | 53 | close($fh); 54 | 55 | print "Blank $dest created (with $extra additional catalogues)\n"; 56 | -------------------------------------------------------------------------------- /dump.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | # Beeb Utilities to manipulate MMB and SSD files 5 | # Copyright (C) 2012 Stephen Harris 6 | # 7 | # See file "COPYING" for GPLv2 licensing 8 | 9 | use FindBin; 10 | use lib "$FindBin::Bin"; 11 | use BeebUtils; 12 | 13 | use FileHandle; 14 | 15 | # *DUMP equivalent 16 | 17 | my $bytes_per_line=8; 18 | my $addrsize=4; 19 | if (@ARGV && $ARGV[0] eq '-w') 20 | { 21 | $bytes_per_line=16; 22 | $addrsize=8; 23 | shift @ARGV; 24 | } 25 | 26 | my $file=$ARGV[0]; 27 | die "Syntax: $BeebUtils::PROG [-w] filename\n" unless $file; 28 | 29 | my $f=new FileHandle "<$file"; 30 | die "Can not open $file: $!\n" unless $f; 31 | binmode($f); 32 | 33 | my $buffer; 34 | my $offset=0; 35 | while (sysread($f,$buffer,$bytes_per_line)) 36 | { 37 | my @d=map { ord($_) } split(//,$buffer); 38 | my ($hex,$ascii); 39 | foreach (0..$bytes_per_line-1) 40 | { 41 | my ($nhex,$nch); 42 | my $ch=$d[$_]; 43 | if (!defined($ch)) 44 | { 45 | $nhex=" "; $nch=" "; 46 | } 47 | else 48 | { 49 | $nhex=sprintf("%02X",$ch); 50 | if ($ch < 32 || $ch > 126) { $nch="."; } else { $nch=chr($ch); } 51 | } 52 | $hex .= "$nhex "; 53 | $ascii .= $nch; 54 | } 55 | printf "%0${addrsize}X %s %s\n",$offset,$hex,$ascii; 56 | $offset += $bytes_per_line; 57 | } 58 | -------------------------------------------------------------------------------- /dreplace_mmb.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | # Beeb Utilities to manipulate MMB and SSD files 5 | # Copyright (C) 2012 Stephen Harris 6 | # 7 | # See file "COPYING" for GPLv2 licensing 8 | 9 | use FindBin; 10 | use lib "$FindBin::Bin"; 11 | use BeebUtils; 12 | 13 | @ARGV=BeebUtils::init(@ARGV); 14 | my $dest=$BeebUtils::BBC_FILE || 'BEEB.MMB'; 15 | 16 | die "$dest does not exists\n" unless -e $dest; 17 | 18 | die "Syntax: $BeebUtils::PROG [-f MMB_file] file1.mmb cat_number\n" unless @ARGV == 2; 19 | 20 | my $source=$ARGV[0]; 21 | my $cat=$ARGV[1]; 22 | 23 | die "Catalogue must be a number\n" unless $cat =~ /^[0-9]+$/; 24 | die "Catalogue must be 0-15\n" if $cat < 0 || $cat > 15; 25 | 26 | # Check file exists and looks like it's an MMB file (right size) 27 | 28 | my @s=stat($source); 29 | die "Could not stat $source: $!\n" unless @s; 30 | my $len=$s[7]; 31 | die "$source is the wrong size; is it an MMB?\n Found $len, should be " . $BeebUtils::MMBSize . "\n" unless $len == $BeebUtils::MMBSize; 32 | 33 | # OK everything looks sane... 34 | my $fh=new FileHandle "+< $dest"; 35 | die "Can not open $dest for updating\n" unless $fh; 36 | 37 | binmode($fh); 38 | 39 | my $image; 40 | my $src=new FileHandle "<$source"; 41 | die "Error opening $source: $!\n" unless $src; 42 | sysread($src,$image,$BeebUtils::MMBSize); 43 | close($src); 44 | 45 | sysseek($fh,$cat*$BeebUtils::MMBSize,0); 46 | syswrite($fh,$image); 47 | 48 | print "$dest updated\n"; 49 | -------------------------------------------------------------------------------- /merge_dsd.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | # Beeb Utilities to manipulate MMB and SSD files 5 | # Copyright (C) 2012 Stephen Harris 6 | # 7 | # See file "COPYING" for GPLv2 licensing 8 | 9 | use FindBin; 10 | use lib "$FindBin::Bin"; 11 | use BeebUtils; 12 | 13 | my $concat=0; 14 | if (@ARGV && $ARGV[0] eq '-concat') { $concat=1; shift @ARGV; } 15 | @ARGV=BeebUtils::init_ssd(@ARGV); 16 | my $src0=$BeebUtils::BBC_FILE; 17 | my ($src2,$dest)=@ARGV; 18 | die "Syntax: $BeebUtils::PROG [-concat] side0.ssd side2.ssd merged_disk.dsd\n" unless $dest; 19 | 20 | die "$dest already exists\n" if -e $dest; 21 | 22 | my $SIZE=256*10; # 10 sectors per track 23 | 24 | my $src0_image=BeebUtils::load_external_ssd($src0,0); 25 | my $src2_image=BeebUtils::load_external_ssd($src2,0); 26 | 27 | # Ensure the disks are big enough; crummy non-ssd SSD images! 28 | $src0_image .= "\0" x ($SIZE*80*2); 29 | $src2_image .= "\0" x ($SIZE*80*2); 30 | 31 | my $dest_image=""; 32 | 33 | # In concat mode, just append, otherwise interleave at the track level 34 | if ($concat) 35 | { 36 | $dest_image = substr($src0_image,0,$SIZE*80) . substr($src2_image,0,$SIZE*80); 37 | } 38 | else 39 | { 40 | foreach my $track (0..79) 41 | { 42 | my $offset=$track*$SIZE; 43 | $dest_image .= substr($src0_image,$offset,$SIZE); 44 | $dest_image .= substr($src2_image,$offset,$SIZE); 45 | } 46 | } 47 | 48 | BeebUtils::write_ssd(\$dest_image,$dest); 49 | print "Disks merged\n"; 50 | -------------------------------------------------------------------------------- /dgetfile.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | # Beeb Utilities to manipulate MMB and SSD files 5 | # Copyright (C) 2012 Stephen Harris 6 | # 7 | # See file "COPYING" for GPLv2 licensing 8 | 9 | use FindBin; 10 | use lib "$FindBin::Bin"; 11 | use BeebUtils; 12 | 13 | @ARGV=BeebUtils::init(@ARGV); 14 | 15 | my $merge=0; 16 | if (@ARGV && $ARGV[0] eq '-merge') 17 | { 18 | $merge=1; shift @ARGV; 19 | } 20 | 21 | my $overwrite=0; 22 | if (@ARGV && $ARGV[0] eq '-overwrite') 23 | { 24 | $overwrite=1; shift @ARGV; 25 | } 26 | 27 | my $dr=$ARGV[0]; 28 | my $destdir=$ARGV[1]; 29 | die "Syntax: $BeebUtils::PROG [-f MMB_file] [-merge] [-overwrite] image_number destdir [filename_regexp]\n" unless defined($destdir); 30 | die "Not a number\n" unless $dr=~/^[0-9]+$/; 31 | 32 | my $filter='^.*$'; 33 | if (defined $ARGV[1]) { 34 | $filter = $ARGV[1]; 35 | } 36 | 37 | my %disk=BeebUtils::load_dcat(); 38 | die "Disk $dr not valid\n" unless $disk{$dr}{Formatted}; 39 | 40 | my $L=$disk{$dr}{ReadOnly}?" (L)":""; 41 | print "Extracting from disk $dr: $disk{$dr}{DiskTitle}$L\n"; 42 | 43 | if ($merge) 44 | { 45 | if (!-d $destdir) { 46 | mkdir($destdir) || die "mkdir $destdir: $!\n"; 47 | } 48 | } else { 49 | die "$destdir already exists\n" if -e $destdir; 50 | mkdir($destdir) || die "mkdir $destdir: $!\n"; 51 | } 52 | 53 | my $image=BeebUtils::read_ssd($dr); 54 | 55 | chdir($destdir) || die "chdir $destdir: $!\n"; 56 | BeebUtils::save_all_files_from_ssd(\$image,1,$overwrite,$filter); 57 | -------------------------------------------------------------------------------- /split_dsd.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | # Beeb Utilities to manipulate MMB and SSD files 5 | # Copyright (C) 2012 Stephen Harris 6 | # 7 | # See file "COPYING" for GPLv2 licensing 8 | 9 | use FindBin; 10 | use lib "$FindBin::Bin"; 11 | use BeebUtils; 12 | 13 | my $concat=0; 14 | if (@ARGV && $ARGV[0] eq '-concat') { $concat=1; shift @ARGV; } 15 | @ARGV=BeebUtils::init_ssd(@ARGV); 16 | my $src=$BeebUtils::BBC_FILE; 17 | my ($dest1,$dest2)=@ARGV; 18 | die "Syntax: $BeebUtils::PROG [-concat] src.dsd side0.ssd side2.ssd\n" unless $dest2; 19 | 20 | die "$dest1 already exists\n" if -e $dest1; 21 | die "$dest2 already exists\n" if -e $dest2; 22 | 23 | my $SIZE=256*10; # 10 sectors per track 24 | 25 | my $src_image=BeebUtils::load_external_ssd(undef,0); 26 | # Ensure the disk is big enough; crummy non-dsd DSD images! 27 | $src_image .= "\0" x ($SIZE*80*2); 28 | 29 | my ($disk1,$disk2); 30 | 31 | # In concat mode the first 200K is for disk1, the second is for disk2 32 | # Otherwise we're interleaved at the track level 33 | 34 | if ($concat) 35 | { 36 | $disk1 = substr($src_image,0,$SIZE*80); 37 | $disk2 = substr($src_image,$SIZE*80,$SIZE*80); 38 | } 39 | else 40 | { 41 | foreach my $track (0..79) 42 | { 43 | my $offset=$track*$SIZE*2; # interleaved 44 | $disk1 .= substr($src_image,$offset,$SIZE); 45 | $disk2 .= substr($src_image,$offset+$SIZE,$SIZE); 46 | } 47 | } 48 | 49 | BeebUtils::write_ssd(\$disk1,$dest1); 50 | BeebUtils::write_ssd(\$disk2,$dest2); 51 | print "Disks created\n"; 52 | -------------------------------------------------------------------------------- /dmerge_mmb.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | # Beeb Utilities to manipulate MMB and SSD files 5 | # Copyright (C) 2012 Stephen Harris 6 | # 7 | # See file "COPYING" for GPLv2 licensing 8 | 9 | use FindBin; 10 | use lib "$FindBin::Bin"; 11 | use BeebUtils; 12 | 13 | @ARGV=BeebUtils::init(@ARGV); 14 | my $dest=$BeebUtils::BBC_FILE || 'BEEB.MMB'; 15 | 16 | die "$dest already exists\n" if -e $dest; 17 | 18 | die "Syntax: $BeebUtils::PROG [-f MMB_file] file1.mmb [file2.mmb ...]\n" unless @ARGV; 19 | die "Max 16 images" if @ARGV > 16; 20 | 21 | my @source=@ARGV; 22 | 23 | # Check each file exists and looks like it's an MMB file (right size) 24 | 25 | foreach (@source) 26 | { 27 | my @s=stat($_); 28 | die "Could not stat $_: $!\n" unless @s; 29 | my $len=$s[7]; 30 | die "$_ is the wrong size; is it an MMB?\n Found $len, should be " . $BeebUtils::MMBSize . "\n" unless $len == $BeebUtils::MMBSize; 31 | } 32 | 33 | # OK everything looks sane... 34 | my $fh=new FileHandle ">$dest"; 35 | die "Can not open $dest for saving\n" unless $fh; 36 | 37 | binmode($fh); 38 | foreach (@source) 39 | { 40 | my $image; 41 | my $src=new FileHandle "<$_"; 42 | die "Error opening $_: $!\n $dest is incomplete\n" unless $src; 43 | sysread($src,$image,$BeebUtils::MMBSize); 44 | close($src); 45 | 46 | syswrite($fh,$image); 47 | } 48 | 49 | # Write out the number of catalogues 50 | sysseek($fh,8,0); 51 | my $ext=159+@source; 52 | $ext=0 if $ext==160; 53 | syswrite($fh,chr($ext),1); 54 | 55 | close($fh); 56 | 57 | print "$dest created\n"; 58 | -------------------------------------------------------------------------------- /dbase.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | # Beeb Utilities to manipulate MMB and SSD files 5 | # Copyright (C) 2012 Stephen Harris 6 | # 7 | # See file "COPYING" for GPLv2 licensing 8 | 9 | use FindBin; 10 | use lib "$FindBin::Bin"; 11 | use BeebUtils; 12 | 13 | @ARGV=BeebUtils::init(@ARGV); 14 | my $dest=$BeebUtils::BBC_FILE || 'BEEB.MMB'; 15 | 16 | die "$dest does not exists\n" unless -e $dest; 17 | 18 | my $base=$ARGV[0]; 19 | if (defined($base)) 20 | { 21 | die "Syntax: $BeebUtils::PROG [-f MMB_file] [base_catalogue]\n base_catalogue must be a number between 1 and 15 inclusive\n" unless $base=~/^[0-9]+$/; 22 | ; 23 | 24 | $base=int($base); 25 | if ($base < 0 || $base > 15) 26 | { 27 | die "base_catalogue must be a number between 0 and 15 inclusive\n"; 28 | } 29 | } 30 | 31 | my $fh=new FileHandle "+< $dest"; 32 | die "Can not open $dest for extending\n" unless $fh; 33 | 34 | binmode($fh); 35 | 36 | # Get the number of extents 37 | sysseek($fh,8,0); 38 | my $ext_byte; 39 | sysread($fh,$ext_byte,1); 40 | 41 | $ext_byte=ord($ext_byte); 42 | $ext_byte=160 if $ext_byte==0; 43 | if ($ext_byte < 160 || $ext_byte > 175) 44 | { 45 | die "Base MMB image has unexpected character indicating length\n We got $ext_byte but it should be 0 or between 160 and 175\n"; 46 | } 47 | $ext_byte-=160; 48 | 49 | if (!defined($base)) 50 | { 51 | sysread($fh,$base,1); 52 | print "Current base setting is: " . ord($base) . "\n"; 53 | } 54 | else 55 | { 56 | if ($base > $ext_byte) 57 | { 58 | die "MMB only has " . $ext_byte . " additional extents; can not set base to " . $base . "\n"; 59 | } 60 | 61 | syswrite($fh,chr($base),1); 62 | print "Base set to: $base\n"; 63 | } 64 | -------------------------------------------------------------------------------- /beeb: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | use FindBin; 5 | # Simple wrapper so you can do "beeb dcat" or similar. In this 6 | # way you just need to symlink this "beeb" program into your PATH 7 | # (eg $HOME/bin) and that's it. 8 | 9 | my $INSTALL_DIR=""; 10 | 11 | # Set this one variable if the program can't work out the symlink 12 | # target properly! 13 | # $INSTALL_DIR="/where/you/installed/the/program"; 14 | 15 | my $prog=$0; $prog=~s!^.*/!!; 16 | 17 | if (!$INSTALL_DIR) 18 | { 19 | $INSTALL_DIR=$FindBin::RealBin; 20 | my $prog2=$INSTALL_DIR . "/$prog"; 21 | die "Can not find myself in $INSTALL_DIR\n" unless -x $prog2; 22 | if ( -l $prog2 ) 23 | { 24 | $INSTALL_DIR=readlink $prog2; 25 | $INSTALL_DIR=~s!/[^/]*$!!; 26 | } 27 | $prog2=$INSTALL_DIR . "/$prog"; 28 | die "Can not find myself in $INSTALL_DIR\n" unless -x $prog2; 29 | } 30 | 31 | my %all_cmds; 32 | map { s!^.*/!!; s/\.pl$//; $all_cmds{$_}=1; } <$INSTALL_DIR/*.pl>; 33 | if (!@ARGV) 34 | { 35 | print "Syntax: $prog command [args]\n"; 36 | print " Possible commands:\n"; 37 | 38 | foreach (sort keys %all_cmds) 39 | { 40 | print " $_\n"; 41 | } 42 | exit; 43 | } 44 | 45 | my $opt=$ARGV[0]; 46 | $opt=~s/\.pl$//; 47 | shift @ARGV; 48 | 49 | # Pretend *. - maps to "info" 50 | $opt="info" if $opt eq "."; 51 | 52 | # If the option ends in a "." then find what commands match 53 | if ($opt =~ /\.$/) 54 | { 55 | my $match; 56 | foreach (sort keys %all_cmds) 57 | { 58 | if ($_ =~ /^$opt/) 59 | { 60 | die "Ambiguous: $opt matches multiple commands\n" if $match; 61 | $match=$_; 62 | } 63 | } 64 | $opt=$match if $match; 65 | } 66 | 67 | die "Bad command: $opt\n" unless $all_cmds{$opt}; 68 | 69 | my $cmd="$INSTALL_DIR/$opt.pl"; 70 | 71 | exec($cmd,@ARGV); 72 | -------------------------------------------------------------------------------- /dsplit_mmb.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | # Beeb Utilities to manipulate MMB and SSD files 5 | # Copyright (C) 2012 Stephen Harris 6 | # 7 | # See file "COPYING" for GPLv2 licensing 8 | 9 | use FindBin; 10 | use lib "$FindBin::Bin"; 11 | use BeebUtils; 12 | 13 | @ARGV=BeebUtils::init(@ARGV); 14 | my $src=$BeebUtils::BBC_FILE || 'BEEB.MMB'; 15 | 16 | die "Syntax: $BeebUtils::PROG [-f MMB_File] destdir [extent]\n" if !@ARGV; 17 | 18 | my $destdir=$ARGV[0]; 19 | my $want_extent=$ARGV[1]; 20 | 21 | if (defined($want_extent) && $want_extent !~ /^[0-9]+$/) 22 | { 23 | die "Extent must be a number\n"; 24 | } 25 | 26 | $want_extent=-1 unless defined($want_extent); 27 | 28 | die "$destdir already exists\n" if -e $destdir; 29 | mkdir($destdir) || die "mkdir $destdir: $!\n"; 30 | 31 | my $fh=new FileHandle "< $src"; 32 | die "Can not open $src for reading\n" unless $fh; 33 | 34 | binmode($fh); 35 | 36 | # How many extents do we have 37 | sysseek($fh,8,0); 38 | my $ext_byte; 39 | sysread($fh,$ext_byte,1); 40 | 41 | $ext_byte=ord($ext_byte); 42 | $ext_byte=160 if $ext_byte==0; 43 | if ($ext_byte < 160 || $ext_byte > 175) 44 | { 45 | die "Base MMB image has unexpected character indicating length\n We got $ext_byte but it should be 0 or between 160 and 175\n"; 46 | } 47 | 48 | my $data; 49 | 50 | foreach my $extent (0..$ext_byte-160) 51 | { 52 | next if $want_extent != -1 && $extent != $want_extent; 53 | 54 | my $newname=sprintf("%X",$extent); 55 | sysseek($fh,$extent*$BeebUtils::MMBSize,0); 56 | sysread($fh,$data,$BeebUtils::MMBSize); 57 | 58 | # Ensure there is no extent information in this image 59 | substr($data,8,1)=chr(0); 60 | 61 | my $newfile=new FileHandle "> $destdir/$newname.MMB"; 62 | die "Could not create $destdir/$newname.MMB" unless $newfile; 63 | print $newfile $data; 64 | close($newfile); 65 | print "Created $destdir/$newname.MMB\n"; 66 | } 67 | -------------------------------------------------------------------------------- /bdiag.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | # Beeb Utilities to manipulate MMB and SSD files 5 | # Copyright (C) 2012 Stephen Harris 6 | # 7 | # See file "COPYING" for GPLv2 licensing 8 | 9 | use FindBin; 10 | use lib "$FindBin::Bin"; 11 | use BeebUtils; 12 | 13 | @ARGV=BeebUtils::init(@ARGV); 14 | 15 | my $dest=$BeebUtils::BBC_FILE || 'BEEB.MMB'; 16 | 17 | die "$dest does not exists\n" unless -e $dest; 18 | 19 | my $fh=new FileHandle "< $dest"; 20 | die "Can not open $dest for reading\n" unless $fh; 21 | 22 | binmode($fh); 23 | 24 | my $size=-s $dest; 25 | my $ext=int($size/$BeebUtils::MMBSize); 26 | 27 | printf("MMB Size is %d (0x%x) bytes\n",$size,$size); 28 | printf("This is equivalent to %d extents\n",$ext); 29 | 30 | if ($ext*$BeebUtils::MMBSize != $size) 31 | { 32 | printf("WARNING: FILE is not correct size.\n Should be: %d\n Is: %d\n",$ext*$BeebUtils::MMBSize, $size); 33 | } 34 | 35 | foreach my $extent (0..$ext-1) 36 | { 37 | print "\n"; 38 | my $offset=$extent*$BeebUtils::MMBSize; 39 | printf("*** Extent %d at offset 0x%X ***\n",$extent,$offset); 40 | 41 | # Read the 8K into memory 42 | sysseek($fh,$offset,0); 43 | my $data; 44 | sysread($fh,$data,8192); 45 | 46 | foreach (0..3) 47 | { 48 | my $disk1=ord(substr($data,$_,1)); 49 | my $disk2=ord(substr($data,$_+4,1)); 50 | printf("%08X: Bytes %02X and %02X (Onboot disk %d): %02X %02X == %d\n",$offset+$_, $_,$_+4,$_,$disk1,$disk2,$disk1+256*$disk2); 51 | } 52 | 53 | my $byte=substr($data,8,1); $byte=ord($byte); 54 | printf("%08X: Byte 08 (Additional Extent): %02X\n",8+$offset,$byte); 55 | 56 | $byte=substr($data,9,1); $byte=ord($byte); 57 | printf("%08X: Byte 09 (DBASE): %02X\n",9+$offset,$byte); 58 | 59 | foreach (10..15) 60 | { 61 | printf("%08X: Byte %02X (Unused): %02X\n", $_+$offset,$_,ord(substr($data,$_,1))); 62 | } 63 | 64 | foreach my $slot (1..511) 65 | { 66 | my $titlehex=""; 67 | my $title=""; 68 | foreach (0..15) 69 | { 70 | my $byte=substr($data,$slot*16+$_,1); $byte=ord($byte); 71 | $titlehex .= sprintf("%02X ",$byte); 72 | if ($byte < 32 || $byte > 126) 73 | { 74 | $title .= "."; 75 | } 76 | else 77 | { 78 | $title .= chr($byte); 79 | } 80 | } 81 | printf("%08X: %4d: %s%s\n", $slot*16+$offset,$slot-1+511*$extent,$titlehex,$title); 82 | } 83 | printf("%08X: image data starts\n",8192+$offset); 84 | } 85 | -------------------------------------------------------------------------------- /dmmb_info.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | # Beeb Utilities to manipulate MMB and SSD files 5 | # Copyright (C) 2012 Stephen Harris 6 | # 7 | # See file "COPYING" for GPLv2 licensing 8 | 9 | use FindBin; 10 | use lib "$FindBin::Bin"; 11 | use BeebUtils; 12 | 13 | @ARGV=BeebUtils::init(@ARGV); 14 | my $dest=$BeebUtils::BBC_FILE || 'BEEB.MMB'; 15 | 16 | die "$dest does not exists\n" unless -e $dest; 17 | 18 | my $fh=new FileHandle "< $dest"; 19 | die "Can not open $dest for reading\n" unless $fh; 20 | 21 | binmode($fh); 22 | 23 | # How many extents do we have 24 | sysseek($fh,8,0); 25 | my $ext_byte; 26 | sysread($fh,$ext_byte,1); 27 | 28 | $ext_byte=ord($ext_byte); 29 | $ext_byte=160 if $ext_byte==0; 30 | if ($ext_byte < 160 || $ext_byte > 175) 31 | { 32 | die "Base MMB image has unexpected character indicating length\n We got $ext_byte but it should be 0 or between 160 and 175\n"; 33 | } 34 | 35 | # Get the base value 36 | my $base; 37 | sysread($fh,$base,1); 38 | $base=ord($base); 39 | 40 | my ($disktable,%boot)=BeebUtils::load_onboot(); 41 | my %disk=BeebUtils::load_dcat(\$disktable); 42 | 43 | my ($disktable2,%boot2)=BeebUtils::load_onboot($base); 44 | 45 | my $form=0; 46 | my $tot=0; 47 | 48 | foreach (keys %disk) 49 | { 50 | $tot++; 51 | $form++ unless $disk{$_}{Formatted}; 52 | } 53 | 54 | print "MMB Filename: $dest\n" . 55 | " Number of extents: " . ($ext_byte-159) . " (0->" . ($ext_byte-160) . ")\n" . 56 | " Base extent: $base (image IDs will be offset by " . ($base*511) . ")\n" . 57 | " Number of disks: $tot\n" . 58 | " #Unformatted: $form\n" . 59 | " Onboot disks:\n"; 60 | 61 | print " Extent 0: (MMB Base)\n" if $base; 62 | 63 | foreach (0..3) 64 | { 65 | my $d=$boot{$_}; 66 | my $t=""; 67 | if ($disk{$d}{Formatted}) 68 | { 69 | my $L=$disk{$d}{ReadOnly}?" (L)":""; 70 | $t="$disk{$d}{DiskTitle}$L"; 71 | } 72 | printf(" %s: %4d - %-12s\n",$_,$d,$t); 73 | } 74 | 75 | if ($base) 76 | { 77 | print "\n Extent $base: (Currently selected)\n" if $base; 78 | foreach (0..3) 79 | { 80 | my $d=$boot2{$_}; 81 | my $t=""; 82 | if ($disk{$d+$base*511}{Formatted}) 83 | { 84 | my $L=$disk{$d+$base*511}{ReadOnly}?" (L)":""; 85 | $t="$disk{$d+$base*511}{DiskTitle}$L"; 86 | } 87 | printf(" %s: %4d - %-12s\n",$_,$d,$t); 88 | } 89 | } 90 | -------------------------------------------------------------------------------- /list.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | 4 | # Beeb Utilities to manipulate MMB and SSD files 5 | # Copyright (C) 2012 Stephen Harris 6 | # 7 | # See file "COPYING" for GPLv2 licensing 8 | 9 | use FindBin; 10 | use lib "$FindBin::Bin"; 11 | use BeebUtils; 12 | 13 | sub syntax() 14 | { 15 | print STDERR "Syntax: $BeebUtils::PROG filename [-o #] [-t variant]\n"; 16 | print STDERR " Known variants (default 'basic2'):\n"; 17 | foreach (sort keys %BeebUtils::basic_tokens) 18 | { 19 | next if $_ eq '_BASE_'; 20 | print STDERR " $_\n"; 21 | } 22 | exit(255); 23 | } 24 | 25 | @ARGV=BeebUtils::init_ssd(@ARGV); 26 | my $filename=$BeebUtils::BBC_FILE; 27 | syntax unless $filename; 28 | 29 | my $listo=0; 30 | my $variant="basic2"; 31 | 32 | while(@ARGV) 33 | { 34 | if (@ARGV > 1 && $ARGV[0] eq "-o") { $listo=$ARGV[1]; shift @ARGV;shift @ARGV;} 35 | elsif (@ARGV && $ARGV[0] =~ /-o(\d+)$/) { $listo=$1; shift @ARGV;} 36 | elsif (@ARGV > 1 && $ARGV[0] eq "-t") { $variant=$ARGV[1]; shift @ARGV;shift @ARGV;} 37 | elsif (@ARGV && $ARGV[0] =~ /-t(.+)$/) { $variant=$1; shift @ARGV;} 38 | else { die "Unexpected arguments: $ARGV[0]\n"; } 39 | } 40 | 41 | $variant=lc($variant); 42 | my $basic=$BeebUtils::basic_tokens{$variant}; 43 | my $extended=$BeebUtils::extended_tokens{$variant}; 44 | my $alt=$BeebUtils::alt_line{$variant} || 0; 45 | 46 | die "Unknown variant: $variant\n" unless defined($basic); 47 | 48 | # Merge later versions of the language 49 | my $tokens=$BeebUtils::basic_tokens{"_BASE_"}; 50 | 51 | foreach (keys %$basic) 52 | { 53 | $tokens->{$_}=$basic->{$_}; 54 | } 55 | 56 | my %indent = ( 'FOR' => 0, 'REPEAT' => 0); 57 | 58 | open(F,"<$filename") or die "$filename: $!\n"; 59 | while (!eof(F)) 60 | { 61 | my %nextindent = ( 'FOR' => 0, 'REPEAT' => 0); 62 | my $ch; 63 | my $line; 64 | my $len; 65 | 66 | # There are two ways a line can be read; the Beeb way or the z80/b4w way. 67 | 68 | if (!$alt) 69 | { 70 | # The beeb way 71 | # First char of each line should be ^M 72 | read F,$ch,1; die "Bad program (expected ^M)\n" unless defined($ch) && $ch eq "\015"; 73 | 74 | # next two bytes are line number or end of program 75 | read F,$ch,1; die "Bad program (line number high)\n" unless defined($ch); 76 | last if $ch eq "\xff"; # end of program 77 | $line=ord($ch)*256; 78 | 79 | read F,$ch,1; die "Bad program (line number low)\n" unless defined($ch); 80 | $line+=ord($ch); 81 | 82 | # next byte is length of line 83 | read F,$ch,1; die "Bad program (length)\n" unless defined($ch); 84 | $len=ord($ch)-4; die "Bad program (bad length)\n" if $len <0; # Already got 4 bytes 85 | } 86 | else 87 | { 88 | # z80 way 89 | # First character is line length; 90 | read F,$ch,1; die "Bad program (length)\n" unless defined($ch); 91 | $len=ord($ch)-3; 92 | 93 | # next two bytes are line number or end of program 94 | read F,$ch,1; die "Bad program (line number low)\n" unless defined($ch); 95 | $line=ord($ch); 96 | 97 | read F,$ch,1; die "Bad program (line number high)\n" unless defined($ch); 98 | $line+=ord($ch)*256; 99 | 100 | last if $line == 65535; 101 | die "Bad program (bad length)\n" if $len <0; # Needs at least 3 bytes 102 | } 103 | # rest of line 104 | my $raw=0; # Set to 1 if in quotes 105 | my $decode=""; 106 | my $prevchar=""; 107 | my $pos=1; 108 | while ($pos++ <= $len) 109 | { 110 | read F,$ch,1; 111 | 112 | die "Bad program (reading line)\n" unless defined($ch); 113 | 114 | my $d; 115 | if ($raw) { $d = $ch; } 116 | elsif (!$prevchar && $ch eq "\x8D") 117 | { # Line token 118 | my $lno; 119 | read F,$lno,3; die "Bad program (line token)\n" unless length($lno) == 3; 120 | $pos+=3; 121 | # This comes from page 41 of "The BASIC ROM User Guide" 122 | my ($n1,$n2,$n3)=map { ord($_) } split(//,$lno); 123 | $n1=($n1*4)&255; 124 | my $low=($n1 & 192) ^ $n2; 125 | $n1=($n1*4)&255; 126 | my $high=$n1 ^ $n3; 127 | $lno=$high*256+$low; 128 | $d=$lno; 129 | } 130 | else 131 | { 132 | $d=""; 133 | if ($prevchar) 134 | { 135 | $d=$extended->{ord($prevchar)}->{ord($ch)} if ($prevchar); 136 | if (!$d) 137 | { 138 | # Not an extended 2-byte code 139 | seek F,-1,1; # Go back one character to re-read it 140 | $pos--; 141 | $d=$tokens->{ord($prevchar)}; 142 | } 143 | $prevchar=""; 144 | } 145 | 146 | if (!$d) 147 | { 148 | if (defined($extended->{ord($ch)})) 149 | { 150 | $prevchar=$ch; 151 | next; 152 | } 153 | $d=$tokens->{ord($ch)}; 154 | } 155 | if ($d) 156 | { 157 | $d=(@$d)[0]; 158 | $d .= " " if $listo & 8; 159 | } 160 | else 161 | { 162 | $d=$ch; 163 | } 164 | } 165 | $raw=1-$raw if $ch eq '"'; 166 | die "trap" unless defined($d); 167 | $decode .= $d; 168 | if ($d eq 'REPEAT' && $listo & 4) { $nextindent{REPEAT}++; } 169 | elsif ($d eq 'UNTIL' && $listo & 4) { $nextindent{REPEAT}--; } 170 | elsif ($d eq 'FOR' && $listo & 2) { $nextindent{FOR}++; } 171 | elsif ($d eq 'NEXT' && $listo & 2) { $nextindent{FOR}--; } 172 | } 173 | 174 | my $i=substr(" "x255,1,$indent{FOR}*2+$indent{REPEAT}*2+($listo&1)); 175 | if ($line) 176 | { 177 | printf("%5d%s%s\n",$line,$i,$decode); 178 | } 179 | else 180 | { 181 | printf(" %s%s\n",$i,$decode); 182 | } 183 | $indent{FOR}+=$nextindent{FOR}; $indent{FOR}=0 if $indent{FOR}<0; 184 | $indent{REPEAT}+=$nextindent{REPEAT}; $indent{REPEAT}=0 if $indent{REPEAT}<0; 185 | } 186 | -------------------------------------------------------------------------------- /COPYING: -------------------------------------------------------------------------------- 1 | GNU GENERAL PUBLIC LICENSE 2 | Version 2, June 1991 3 | 4 | Copyright (C) 1989, 1991 Free Software Foundation, Inc. 5 | 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 6 | Everyone is permitted to copy and distribute verbatim copies 7 | of this license document, but changing it is not allowed. 8 | 9 | Preamble 10 | 11 | The licenses for most software are designed to take away your 12 | freedom to share and change it. By contrast, the GNU General Public 13 | License is intended to guarantee your freedom to share and change free 14 | software--to make sure the software is free for all its users. This 15 | General Public License applies to most of the Free Software 16 | Foundation's software and to any other program whose authors commit to 17 | using it. (Some other Free Software Foundation software is covered by 18 | the GNU Library General Public License instead.) You can apply it to 19 | your programs, too. 20 | 21 | When we speak of free software, we are referring to freedom, not 22 | price. Our General Public Licenses are designed to make sure that you 23 | have the freedom to distribute copies of free software (and charge for 24 | this service if you wish), that you receive source code or can get it 25 | if you want it, that you can change the software or use pieces of it 26 | in new free programs; and that you know you can do these things. 27 | 28 | To protect your rights, we need to make restrictions that forbid 29 | anyone to deny you these rights or to ask you to surrender the rights. 30 | These restrictions translate to certain responsibilities for you if you 31 | distribute copies of the software, or if you modify it. 32 | 33 | For example, if you distribute copies of such a program, whether 34 | gratis or for a fee, you must give the recipients all the rights that 35 | you have. You must make sure that they, too, receive or can get the 36 | source code. And you must show them these terms so they know their 37 | rights. 38 | 39 | We protect your rights with two steps: (1) copyright the software, and 40 | (2) offer you this license which gives you legal permission to copy, 41 | distribute and/or modify the software. 42 | 43 | Also, for each author's protection and ours, we want to make certain 44 | that everyone understands that there is no warranty for this free 45 | software. If the software is modified by someone else and passed on, we 46 | want its recipients to know that what they have is not the original, so 47 | that any problems introduced by others will not reflect on the original 48 | authors' reputations. 49 | 50 | Finally, any free program is threatened constantly by software 51 | patents. We wish to avoid the danger that redistributors of a free 52 | program will individually obtain patent licenses, in effect making the 53 | program proprietary. To prevent this, we have made it clear that any 54 | patent must be licensed for everyone's free use or not licensed at all. 55 | 56 | The precise terms and conditions for copying, distribution and 57 | modification follow. 58 | 59 | GNU GENERAL PUBLIC LICENSE 60 | TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 61 | 62 | 0. This License applies to any program or other work which contains 63 | a notice placed by the copyright holder saying it may be distributed 64 | under the terms of this General Public License. The "Program", below, 65 | refers to any such program or work, and a "work based on the Program" 66 | means either the Program or any derivative work under copyright law: 67 | that is to say, a work containing the Program or a portion of it, 68 | either verbatim or with modifications and/or translated into another 69 | language. (Hereinafter, translation is included without limitation in 70 | the term "modification".) Each licensee is addressed as "you". 71 | 72 | Activities other than copying, distribution and modification are not 73 | covered by this License; they are outside its scope. The act of 74 | running the Program is not restricted, and the output from the Program 75 | is covered only if its contents constitute a work based on the 76 | Program (independent of having been made by running the Program). 77 | Whether that is true depends on what the Program does. 78 | 79 | 1. You may copy and distribute verbatim copies of the Program's 80 | source code as you receive it, in any medium, provided that you 81 | conspicuously and appropriately publish on each copy an appropriate 82 | copyright notice and disclaimer of warranty; keep intact all the 83 | notices that refer to this License and to the absence of any warranty; 84 | and give any other recipients of the Program a copy of this License 85 | along with the Program. 86 | 87 | You may charge a fee for the physical act of transferring a copy, and 88 | you may at your option offer warranty protection in exchange for a fee. 89 | 90 | 2. You may modify your copy or copies of the Program or any portion 91 | of it, thus forming a work based on the Program, and copy and 92 | distribute such modifications or work under the terms of Section 1 93 | above, provided that you also meet all of these conditions: 94 | 95 | a) You must cause the modified files to carry prominent notices 96 | stating that you changed the files and the date of any change. 97 | 98 | b) You must cause any work that you distribute or publish, that in 99 | whole or in part contains or is derived from the Program or any 100 | part thereof, to be licensed as a whole at no charge to all third 101 | parties under the terms of this License. 102 | 103 | c) If the modified program normally reads commands interactively 104 | when run, you must cause it, when started running for such 105 | interactive use in the most ordinary way, to print or display an 106 | announcement including an appropriate copyright notice and a 107 | notice that there is no warranty (or else, saying that you provide 108 | a warranty) and that users may redistribute the program under 109 | these conditions, and telling the user how to view a copy of this 110 | License. (Exception: if the Program itself is interactive but 111 | does not normally print such an announcement, your work based on 112 | the Program is not required to print an announcement.) 113 | 114 | These requirements apply to the modified work as a whole. If 115 | identifiable sections of that work are not derived from the Program, 116 | and can be reasonably considered independent and separate works in 117 | themselves, then this License, and its terms, do not apply to those 118 | sections when you distribute them as separate works. But when you 119 | distribute the same sections as part of a whole which is a work based 120 | on the Program, the distribution of the whole must be on the terms of 121 | this License, whose permissions for other licensees extend to the 122 | entire whole, and thus to each and every part regardless of who wrote it. 123 | 124 | Thus, it is not the intent of this section to claim rights or contest 125 | your rights to work written entirely by you; rather, the intent is to 126 | exercise the right to control the distribution of derivative or 127 | collective works based on the Program. 128 | 129 | In addition, mere aggregation of another work not based on the Program 130 | with the Program (or with a work based on the Program) on a volume of 131 | a storage or distribution medium does not bring the other work under 132 | the scope of this License. 133 | 134 | 3. You may copy and distribute the Program (or a work based on it, 135 | under Section 2) in object code or executable form under the terms of 136 | Sections 1 and 2 above provided that you also do one of the following: 137 | 138 | a) Accompany it with the complete corresponding machine-readable 139 | source code, which must be distributed under the terms of Sections 140 | 1 and 2 above on a medium customarily used for software interchange; or, 141 | 142 | b) Accompany it with a written offer, valid for at least three 143 | years, to give any third party, for a charge no more than your 144 | cost of physically performing source distribution, a complete 145 | machine-readable copy of the corresponding source code, to be 146 | distributed under the terms of Sections 1 and 2 above on a medium 147 | customarily used for software interchange; or, 148 | 149 | c) Accompany it with the information you received as to the offer 150 | to distribute corresponding source code. (This alternative is 151 | allowed only for noncommercial distribution and only if you 152 | received the program in object code or executable form with such 153 | an offer, in accord with Subsection b above.) 154 | 155 | The source code for a work means the preferred form of the work for 156 | making modifications to it. For an executable work, complete source 157 | code means all the source code for all modules it contains, plus any 158 | associated interface definition files, plus the scripts used to 159 | control compilation and installation of the executable. However, as a 160 | special exception, the source code distributed need not include 161 | anything that is normally distributed (in either source or binary 162 | form) with the major components (compiler, kernel, and so on) of the 163 | operating system on which the executable runs, unless that component 164 | itself accompanies the executable. 165 | 166 | If distribution of executable or object code is made by offering 167 | access to copy from a designated place, then offering equivalent 168 | access to copy the source code from the same place counts as 169 | distribution of the source code, even though third parties are not 170 | compelled to copy the source along with the object code. 171 | 172 | 4. You may not copy, modify, sublicense, or distribute the Program 173 | except as expressly provided under this License. Any attempt 174 | otherwise to copy, modify, sublicense or distribute the Program is 175 | void, and will automatically terminate your rights under this License. 176 | However, parties who have received copies, or rights, from you under 177 | this License will not have their licenses terminated so long as such 178 | parties remain in full compliance. 179 | 180 | 5. You are not required to accept this License, since you have not 181 | signed it. However, nothing else grants you permission to modify or 182 | distribute the Program or its derivative works. These actions are 183 | prohibited by law if you do not accept this License. Therefore, by 184 | modifying or distributing the Program (or any work based on the 185 | Program), you indicate your acceptance of this License to do so, and 186 | all its terms and conditions for copying, distributing or modifying 187 | the Program or works based on it. 188 | 189 | 6. Each time you redistribute the Program (or any work based on the 190 | Program), the recipient automatically receives a license from the 191 | original licensor to copy, distribute or modify the Program subject to 192 | these terms and conditions. You may not impose any further 193 | restrictions on the recipients' exercise of the rights granted herein. 194 | You are not responsible for enforcing compliance by third parties to 195 | this License. 196 | 197 | 7. If, as a consequence of a court judgment or allegation of patent 198 | infringement or for any other reason (not limited to patent issues), 199 | conditions are imposed on you (whether by court order, agreement or 200 | otherwise) that contradict the conditions of this License, they do not 201 | excuse you from the conditions of this License. If you cannot 202 | distribute so as to satisfy simultaneously your obligations under this 203 | License and any other pertinent obligations, then as a consequence you 204 | may not distribute the Program at all. For example, if a patent 205 | license would not permit royalty-free redistribution of the Program by 206 | all those who receive copies directly or indirectly through you, then 207 | the only way you could satisfy both it and this License would be to 208 | refrain entirely from distribution of the Program. 209 | 210 | If any portion of this section is held invalid or unenforceable under 211 | any particular circumstance, the balance of the section is intended to 212 | apply and the section as a whole is intended to apply in other 213 | circumstances. 214 | 215 | It is not the purpose of this section to induce you to infringe any 216 | patents or other property right claims or to contest validity of any 217 | such claims; this section has the sole purpose of protecting the 218 | integrity of the free software distribution system, which is 219 | implemented by public license practices. Many people have made 220 | generous contributions to the wide range of software distributed 221 | through that system in reliance on consistent application of that 222 | system; it is up to the author/donor to decide if he or she is willing 223 | to distribute software through any other system and a licensee cannot 224 | impose that choice. 225 | 226 | This section is intended to make thoroughly clear what is believed to 227 | be a consequence of the rest of this License. 228 | 229 | 8. If the distribution and/or use of the Program is restricted in 230 | certain countries either by patents or by copyrighted interfaces, the 231 | original copyright holder who places the Program under this License 232 | may add an explicit geographical distribution limitation excluding 233 | those countries, so that distribution is permitted only in or among 234 | countries not thus excluded. In such case, this License incorporates 235 | the limitation as if written in the body of this License. 236 | 237 | 9. The Free Software Foundation may publish revised and/or new versions 238 | of the General Public License from time to time. Such new versions will 239 | be similar in spirit to the present version, but may differ in detail to 240 | address new problems or concerns. 241 | 242 | Each version is given a distinguishing version number. If the Program 243 | specifies a version number of this License which applies to it and "any 244 | later version", you have the option of following the terms and conditions 245 | either of that version or of any later version published by the Free 246 | Software Foundation. If the Program does not specify a version number of 247 | this License, you may choose any version ever published by the Free Software 248 | Foundation. 249 | 250 | 10. If you wish to incorporate parts of the Program into other free 251 | programs whose distribution conditions are different, write to the author 252 | to ask for permission. For software which is copyrighted by the Free 253 | Software Foundation, write to the Free Software Foundation; we sometimes 254 | make exceptions for this. Our decision will be guided by the two goals 255 | of preserving the free status of all derivatives of our free software and 256 | of promoting the sharing and reuse of software generally. 257 | 258 | NO WARRANTY 259 | 260 | 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY 261 | FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN 262 | OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES 263 | PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED 264 | OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 265 | MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS 266 | TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE 267 | PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, 268 | REPAIR OR CORRECTION. 269 | 270 | 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 271 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR 272 | REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, 273 | INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING 274 | OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED 275 | TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY 276 | YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER 277 | PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE 278 | POSSIBILITY OF SUCH DAMAGES. 279 | 280 | END OF TERMS AND CONDITIONS 281 | 282 | How to Apply These Terms to Your New Programs 283 | 284 | If you develop a new program, and you want it to be of the greatest 285 | possible use to the public, the best way to achieve this is to make it 286 | free software which everyone can redistribute and change under these terms. 287 | 288 | To do so, attach the following notices to the program. It is safest 289 | to attach them to the start of each source file to most effectively 290 | convey the exclusion of warranty; and each file should have at least 291 | the "copyright" line and a pointer to where the full notice is found. 292 | 293 | 294 | Copyright (C) 295 | 296 | This program is free software; you can redistribute it and/or modify 297 | it under the terms of the GNU General Public License as published by 298 | the Free Software Foundation; either version 2 of the License, or 299 | (at your option) any later version. 300 | 301 | This program is distributed in the hope that it will be useful, 302 | but WITHOUT ANY WARRANTY; without even the implied warranty of 303 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 304 | GNU General Public License for more details. 305 | 306 | You should have received a copy of the GNU General Public License 307 | along with this program; if not, write to the Free Software 308 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 309 | 310 | 311 | Also add information on how to contact you by electronic and paper mail. 312 | 313 | If the program is interactive, make it output a short notice like this 314 | when it starts in an interactive mode: 315 | 316 | Gnomovision version 69, Copyright (C) year name of author 317 | Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. 318 | This is free software, and you are welcome to redistribute it 319 | under certain conditions; type `show c' for details. 320 | 321 | The hypothetical commands `show w' and `show c' should show the appropriate 322 | parts of the General Public License. Of course, the commands you use may 323 | be called something other than `show w' and `show c'; they could even be 324 | mouse-clicks or menu items--whatever suits your program. 325 | 326 | You should also get your employer (if you work as a programmer) or your 327 | school, if any, to sign a "copyright disclaimer" for the program, if 328 | necessary. Here is a sample; alter the names: 329 | 330 | Yoyodyne, Inc., hereby disclaims all copyright interest in the program 331 | `Gnomovision' (which makes passes at compilers) written by James Hacker. 332 | 333 | , 1 April 1989 334 | Ty Coon, President of Vice 335 | 336 | This General Public License does not permit incorporating your program into 337 | proprietary programs. If your program is a subroutine library, you may 338 | consider it more useful to permit linking proprietary applications with the 339 | library. If this is what you want to do, use the GNU Library General 340 | Public License instead of this License. 341 | -------------------------------------------------------------------------------- /README: -------------------------------------------------------------------------------- 1 | Beeb Utilities to manipulate MMB and SSD files 2 | Copyright (C) 2012-2015 Stephen Harris 3 | 4 | This program is free software; you can redistribute it and/or 5 | modify it under the terms of the GNU General Public License 6 | as published by the Free Software Foundation; either version 2 7 | of the License, or (at your option) any later version. 8 | 9 | This program is distributed in the hope that it will be useful, 10 | but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | GNU General Public License for more details. 13 | 14 | You should have received a copy of the GNU General Public License 15 | along with this program; if not, write to the Free Software 16 | Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. 17 | 18 | =================================================================== 19 | 20 | HOW TO INSTALL 21 | 22 | Something like 23 | mkdir /usr/local/beeb 24 | cd /usr/local/beeb 25 | tar xvf ..../mmb_utils.tar 26 | ln -s /usr/local/beeb/beeb /usr/local/bin/beeb 27 | 28 | =================================================================== 29 | 30 | For all the commands that work on MMB files, the default MMB is called 31 | "BEEB.MMB" but this can be changed with "-f otherfile" if used as the 32 | first parameter, or by setting $BBC_FILE 33 | 34 | So 35 | beeb dinfo 2 36 | would do a "*INFO" for all files in image 2 in BEEB.MMB 37 | beeb dinfo -f other.MMB 2 38 | would do a "*INFO" for all files in image 2 in other.MMB 39 | export BBC_FILE=myfile.MMB 40 | beeb dinfo 2 41 | would do a "*INFO" for all files in image 2 in myfile.MMB 42 | 43 | For greater control of the MMB file used, see later around $BEEB_UTILS_DFS 44 | 45 | Other commands that work on normal files do not need "-f" as the first 46 | option because they typically always require an filename (no default) 47 | e.g 48 | beeb info filename.ssd 49 | beeb list MYPROG 50 | SSD filenames may be entered as type:filename (eg stl:mydisk.ssd). See 51 | the following section on BEEB_UTILS_DFS for the meaning of "type". 52 | 53 | We never allow disk images in the MMB to be referred to by name; you 54 | must always use the slot number. 55 | 56 | One environment variable may be used: 57 | BEEB_UTILS_DFS 58 | This alters how the catalgue is read. The format is type:filename 59 | Default type is Acorn 60 | Default filename is BEEB.MMB 61 | If there is no : in the value then it is read as a filename with type "acorn" 62 | examples 63 | stl:/mnt/beeb/beeb.mmb 64 | /mnt/beeb/beeb.mmb 65 | watford: 66 | 67 | Allowed values for type are 68 | SOLIDISK (or STL) 69 | WATFORD 70 | OPUS (or DDOS) ---- UNTESTED!! 71 | DISKDOCTOR (or DISCDOCTOR) 72 | ACORN (same as empty) 73 | What this changes is how the "extra byte" information and extra catalogues 74 | are read. 75 | 76 | This value may also be set in $HOME/.beeb_utils_dfs 77 | If the environment variable is set then it overrides the contents of the 78 | file, thus a default may be set but overridden as necessary 79 | 80 | Be careful if setting it wrong; eg if reading a Solidisk disk with 81 | a deleted file in the first catalogue then you will see a file with &7F 82 | as the directory if you're not in SOLIDISK mode! 83 | 84 | =================================================================== 85 | MMB Impacting commands 86 | =================================================================== 87 | * daccess 88 | Does similar to *DLOCK and *DUNLOCK but using "*ACCESS" type syntax 89 | lock disk 40: beeb daccess 40 L 90 | unlock disk 40: beeb daccess 40 91 | 92 | * dblank_mmb 93 | Creates blank 128Mb MMB file 94 | If an additional paramter is added (between 1 and 15) then this will 95 | create an Extended MMB (see below) with that number of additional 96 | catalogues. Note 15 additional catalogues will result in a 1.7Gb 97 | file capable of handling 8176 disk images. 98 | beeb dblank_mmb -f NEW.MMB 15 99 | 100 | * dcat 101 | Catalogue: Show disk images stored in the MMB. The -a flag will also 102 | show unformatted disks 103 | 104 | * dextend 105 | Adds an additional catalogue to the MMB file, effectively adding an extra 106 | 511 disc slots to the image. Will convert a normal MMB to a Extended MMB 107 | 108 | * dget_ssd 109 | Extracts an SSD from an MMB 110 | 111 | * dgetfile 112 | Extracts all the files from an SSD stored in an MMB 113 | A few characters are renamed to an _ 114 | :<>|`'/\*?" 115 | to keep the extracted filename "sane". The leading "$." is removed 116 | (other BBC directory names are retained). 117 | If two files would be extracted with the same name then a -### count is 118 | added to the end. 119 | 120 | Optionally -merge and -overwrite can be used (see below for full syntax) 121 | 122 | For each file a .inf is also created in the form 123 | Filename LOAD EXEC [Locked] CRC=#### 124 | The Filename is the original BBC Filename. 125 | This "inf" file is compatble to the bbcim extraction tool from 126 | W.H.Scholten 127 | 128 | A subset of files can be extracted by adding a filter at the end of 129 | the command line e.g. '^*.eg*$' would match all files containing 'eg' 130 | 131 | * dform 132 | Puts a blank SSD onto the MMB. Allows you to title the disk at the 133 | same time 134 | beeb dform 20 NewDisk 135 | 136 | * dinfo 137 | Does an effective *INFO *.* for an SSD stored in an MMB 138 | (If the disk is multi-catalogue then the catalogue sector is also 139 | shown) 140 | 141 | * dkill 142 | Marks a disk in a slot as Unformatted (*DKILL) 143 | If the optional R flag is passed then it "restores" the image 144 | (*DRESTORE). 145 | beeb dkill 10 146 | beeb dkill 10 R 147 | A -y flag will force answer "yes" to override locked disks and won't 148 | ask you if you're sure; use with care 149 | beeb dkill -y 10 150 | 151 | * dlabel 152 | Changes the label for disk in slot that shows with with *DCAT 153 | Note: this does not change the SSD title 154 | 155 | * dmerge_mmb 156 | Will merge multiple MMB files together to create an Extended MMB 157 | beeb dmerge_mmb -f RESULTS.MMB part1.mmb part2.mmb part3.mmb 158 | 159 | * dmmb_info 160 | Report some basic statistics on the MMB file (number of extents, 161 | number of disks, number unformatted) 162 | 163 | * donboot 164 | Shows the current "boot disk" settings, and lets you change them. 165 | Will not let you set an unformatted disk unless -y flag is used 166 | eg 167 | beeb donboot -y 1 300 168 | 169 | * dput_ssd 170 | Writes an SSD to an MMB. You can't write into a slot that's in 171 | use (so dkill it first if you want to replace it). The MMB 172 | catalogue name for this disk is set to the SSDs name 173 | 174 | * dreplace_mmb 175 | Will replace a complete MMB image in an Extended MMB. This may 176 | be useful if you have an Extended MMB built from multiple sources 177 | (eg a Games image, a Z80 image, a PanOS image) and you want to 178 | update just the Z80 image. It will update the catalogue and the 179 | associated 511 disk images in the target Extended MMB with the 180 | requested MMB 181 | 182 | beeb dreplace_mmb new_z80.MMB 1 183 | 184 | * dsplit_mmb 185 | Will split a Extended MMB into a collection of single extent MMBs 186 | numbered 0.MMB -> F.MMB. If an optional number is given then only 187 | that extent will be extracted 188 | 189 | % beeb dsplit_mmb RESULTS 13 190 | Created RESULTS/D.MMB 191 | 192 | * drecat 193 | Performs similar to *DRECAT; for each disk marked as formatted 194 | the title of the SSD will be read and the master catalogue updated. 195 | 196 | =================================================================== 197 | SSD Impacting commands 198 | =================================================================== 199 | Commands that update SSDs (eg delete, access, compact, putfile) 200 | will not work on multi-catalogue disks. The update commands 201 | are mostly meant to create new SSDs for putting into MMBs. Read commands 202 | should work on multi-catalogues. 203 | 204 | * access 205 | *ACCESS equivalent 206 | e.g. 207 | beeb access mydisk.ssd A.* 208 | beeb access mydisk.ssd B.* L 209 | Defaults to '$.' if no directory specified. 210 | Remember to quote shell characters if necessary! 211 | 212 | * blank_ssd 213 | Creates a new blank 200Kb SSD image 214 | 215 | * compact 216 | *COMPACT equivalent. 217 | 218 | * delete 219 | Deletes files from an SSD. e.g 220 | beeb delete mydisk.ssd A.TESTFIL 221 | Multiple filenames can be used. Directory defaults to '$'. 222 | We attempt to handle BBC wildcards as well. e.g. 223 | beeb delete mydisk.ssd E.* 224 | It will ask a y/n question for each file before deleting. 225 | Optional parameter "-y" will skip the asking and will, instead, 226 | display the files deleted 227 | beeb delete Foo/RAM_Manager_2.ssd -y E.* 228 | Deleted E.OE00 229 | Deleted E.ASM 230 | Deleted E.CONVERT 231 | Deleted E.SE00 232 | Deleted E.E1770 233 | Deleted E.EXMON 234 | 235 | Remember you might need to quote on the command line to prevent the 236 | shell doing filename expansion! 237 | beeb delete Foo/dd.ssd \* 238 | 239 | * getfile 240 | Extracts all the files from an SSD 241 | See dgetfile for details. 242 | 243 | * info 244 | Does an effective *INFO *.* for an SSD 245 | 246 | * merge_dsd 247 | Will take two SSD image and interleave them into a single DSD image 248 | If the -concat option is used then it assumes the DSD is two SSDs 249 | stacked after each other (side0 then side 2). Without this option 250 | it assumes the disk tracks are interleaved (side0 track 0, side 2 251 | track 0, side 0 track 1... etc). Interleaving is more normal. 252 | 253 | * opt4 254 | *OPT4 equivalent 255 | 256 | * putfile 257 | Puts all specified files onto an SSD. 258 | beeb putfile myssd file1 file2 file3 file4... 259 | Can use wildcards, eg 260 | beeb putfile myssd mydir/* 261 | This will attempt to read .inf files to work out load/exec/locked and 262 | filename. If inf file doesn't exist then it'll use the name of the 263 | file with load/exec values of 0. 264 | 265 | e.g 266 | % ls -l mydir 267 | total 16 268 | -rw-r--r-- 1 sweh sweh 6 Mar 20 21:12 Test1 269 | -rw-r--r-- 1 sweh sweh 15 Mar 20 21:12 X.Test2 270 | -rw-r--r-- 1 sweh sweh 13 Mar 20 21:13 foo 271 | -rw-r--r-- 1 sweh sweh 39 Mar 20 21:13 foo.inf 272 | We can see there are three files, but one has a .inf file 273 | 274 | % cat mydir/foo.inf 275 | $.FOO FF1900 FF8023 Locked CRC=AB7A 276 | This means that "foo" is really called $.FOO 277 | 278 | So lets add these to a new SSD 279 | % beeb blank_ssd myssd 280 | Blank myssd created 281 | % beeb putfile myssd mydir/* 282 | % beeb info myssd 283 | Disk title: (1) Disk size: &320 - 200K 284 | Boot Option: 0 (None) File count: 3 285 | 286 | Filename: Lck Lo.add Ex.add Length Sct 287 | $.FOO L FF1900 FF8023 00000D 004 288 | X.Test2 000000 000000 00000F 003 289 | $.Test1 000000 000000 000006 002 290 | note that case was preserved, and Test1 was put into $. 291 | 292 | There is an optional -c flag which will *COMPACT the disk before 293 | adding files. 294 | 295 | The SSD is only saved if all the files get added properly. 296 | 297 | * rename 298 | *RENAME 299 | beeb rename myfile.ssd o.oldname n.newname 300 | 301 | * split_dsd 302 | Will take a DSD image and de-interleave it into two SSD images 303 | If the -concat option is used then it assumes the DSD is two SSDs 304 | stacked after each other (side0 then side 2). Without this option 305 | it assumes the disk tracks are interleaved (side0 track 0, side 2 306 | track 0, side 0 track 1... etc). Interleaving is more normal. 307 | 308 | * title 309 | Does an effective *TITLE for an SSD 310 | 311 | * to_stdout 312 | Will take an SSD and a filename on that disk and send it to stdout. 313 | So could be used in a pipeline, such as: 314 | beeb to_stdout mydisk.ssd '$.!BOOT' | beeb type - 315 | 316 | 317 | =================================================================== 318 | Utility Programs (file commands) 319 | =================================================================== 320 | 321 | * beeb 322 | Simple wrapper so you can do "beeb dcat" or similar. In this 323 | way you just need to symlink this "beeb" program into your PATH 324 | (eg $HOME/bin) and that's it. 325 | 326 | You may need to set the one variable in the file: 327 | # $INSTALL_DIR="/where/you/installed/the/program"; 328 | if the program can't work out the symlink target properly 329 | 330 | In good BBC style, a "." will act as a wildcard. So "beeb i." 331 | might match "beeb info". If multiple commands might match then an 332 | "Ambiguous" error message is returned. 333 | 334 | * dump 335 | *DUMP 336 | 337 | * list 338 | Lists a basic program. 339 | "-o #" applies LISTO options 340 | "-t XXX" uses the XXX decoder 341 | basic2 == BASIC 2 (default) 342 | basic4 == BASIC 4 343 | z80 == BASIC 4 for Z80 344 | arm == BASIC from the Arc 345 | b4w == BASIC for Windows 346 | eg 347 | beeb list myfile -o 7 348 | (Extra LISTO option "8" adds a space after each token) 349 | 350 | If you want a prettier lister (eg html, colour etc) then bbclist 351 | from W.H.Scholten produces nice output. 352 | 353 | * type 354 | *TYPE (converts BBC to Unix line endings) 355 | 356 | =================================================================== 357 | Disk format 358 | =================================================================== 359 | MMB consists of 32 sectors (8Kb) of data, split into 16 byte blocks. 360 | The first block of 8 chars is is in the format 361 | aa bb cc dd AA BB CC DD 362 | where AAaa BBbb CCcc DDdd are the images inserted at boot time. Default 363 | is 00 01 02 03 00 00 00 00 364 | "*ONBOOT 3 500" would make dd=F4 DD=01 (&01F4=500) 365 | 366 | The next 8 bytes (completing the 16 byte block) are unused and are 367 | typically all zero (see "Extended MMB", below). 368 | 369 | After that comes 511 blocks which consist of 370 | DISKNAME(12 chars) 371 | unused (3 chars) 372 | STATUS(1 char) 0 ==> locked (readonly); 15=>Readwrite; 240=>Unformatted 373 | 255 => invalid 374 | 375 | In theory the DISKNAME should match the disk TITLE in each place, but it 376 | can get out of sync. *RECAT on the MMC Utils ROM reads the title from 377 | each SSD and updates this name. 378 | 379 | Then each SSD is a chunk of 200Kb data following. So disk 'n' starts 380 | at 'n'*204800+8192. That's all there is to an MMB. 381 | 382 | An Extended MMB is pretty much just multiple MMBs concatenated on top 383 | of each other. This can extend the number of disks an MMB can hold in 384 | steps of 511. A previously unused byte (offset 8) in the table header 385 | indicates how many additional MMBs there are. It consists of 0xA# where 386 | # is the number of additional entries. 387 | 388 | In this format we have 389 | 390 | <511 SSD images> 391 | 1021> 392 | <511 SSD images> 393 | 1532> 394 | <511 SSD images> 395 | up to a total of 15 additional headers, which results in disk numbers 0->8175. 396 | 397 | If this form of MMB is used in a BBC which doesn't understand the extended 398 | format then that machine should be able to read the first 511 disks, so 399 | is backwards compatible. 400 | 401 | An SSD is a simple 200K (80track 10 sector) image. Since it's literally 402 | an image it follows the standard Acorn DFS layout. 403 | 404 | Sector 0 is split into 32 * 8byte records. Record 0 is the first 8 405 | characters of the disk title. Records 1->31 have filename (7 chars) 406 | and directory(1 char). If the high bit of the directory is set then 407 | the file is locked. 408 | 409 | Sector 1 is similarly split into 32*8 bytes but a lot more complicated. 410 | Bytes 0->3 are the last 4 characters of the disk title. The title is NULL 411 | terminated if it's shorter than 12 chars. 412 | Byte 4 is (BCD) the "write cycle". In theory every write should update 413 | that, but really... who cares? 414 | Byte 5 is "number of files"*8 415 | Byte 6: bits 4 and 5 encode the "*OPT 4" value 416 | bits 0 and 1 are the high bits for "number of sectors" 417 | Byte 7 is the low 8 bits of "number of sectors" 418 | 419 | Now for a "double density" disk, you need 11 bits to encode the disk 420 | size, so Solidisk and others used byte 6 bit 2 (unused) for this. 421 | This code will always assume this bit is part of the sector size. 422 | 423 | See "Solidisk chained catalgues" (below) for a minor variation on this. 424 | 425 | Now we have the remaining 31 records, which match file equivalent 426 | files in sector 0. They are laid out like this: 427 | LL LL EE EE SS SS XX YY 428 | where "LLLL" is the load address, "EEEE" is the exec address, "SSSS" is 429 | the size, and "YY" is the start sector. "XX" is the fun one. 430 | bits 0+1 are high bits of sector start 431 | bits 2+3 are high bits of load address 432 | bits 4+5 are high bits of size 433 | bits 6+7 are high bits of exec address 434 | 435 | That makes 10 bits for start sector and 18 bits for size. 436 | 437 | But on a 320K disk you need 11 bits for stat sector and 19 bits for size. 438 | So Solidisk steals bits 2 and 3 ("load address"). bit 2 is added to the 439 | sector, bit 3 to the size. This means we have now only have 8 bits for 440 | the load address. So, by trial and error (and disk sector editing - 441 | Solidisk DDFS comes with *DZAP :-)) I found that Solidisk reuses the 442 | high bits of the "exec" address as the high bits of the "load" address. 443 | 444 | 445 | Solidisk chained catalogues 446 | --------------------------- 447 | Solidisk also has the concept of "chained catalogues". If 448 | byte 2 & 192 == 192 then the low nibble of byte 2 and byte 3 point to 449 | the next catalogue, where another 30 files might be stored. 450 | 451 | So looking at a hex dump of the first 8 bytes of sector 1: 452 | 00000100 00 00 C0 21 35 F8 03 20 ...!5.. 453 | 454 | You'll notice &102 and &103 have odd values in them. We can see that 455 | &102 AND 192 == 192 so &102 AND 63 and &103 point to the next 456 | catalogue. In this case we have a second catalogue at sector &021. 457 | Yes, this means disk titles are be limited to 10 characters. 458 | 459 | And here it is: 460 | 00002100 3F 3F 3F 3F 3F 3F 3F 3F ???????? 461 | 00002108 46 49 4C 45 36 30 20 24 FILE60 $ 462 | 00002110 46 49 4C 45 35 39 20 24 FILE59 $ 463 | 464 | Obviously the "title" doesn't mean anything in secondary catalogues! 465 | 466 | We note a funky entry in the 2nd catalogue: 467 | 000021f8 3F 3F 3F 3F 3F 3F 3F BF ???????. 468 | and its associated data: 469 | 000022f8 00 00 00 00 00 21 00 02 .....!.. 470 | 471 | Basically this an "invisible" file that pretends to fill up the disk from 472 | sector 2 to where this new catalogue starts. It's a cheap kludge so that 473 | programs like *COMPACT can work on this catalogue without worrying about 474 | what is before. Everything in earlier catalogues is now frozen. So what 475 | happens if you delete or change a file in an earlier catalogue? That 476 | value gets marked "deleted", thus: 477 | 000000a8 46 49 4C 45 31 30 20 FF FILE10 . 478 | (Basically the directory is set to &FF). The space isn't reclaimed, but 479 | DDFS now ignores it. 480 | 481 | Looking, again at the 2nd catalogue, at the "data" sector: 482 | 00002200 00 21 C0 41 30 F8 03 20 .!.A0.. 483 | Oops, a third catalog at sector &41. This follows the same pattern, but 484 | we get: 485 | 000041d0 46 49 4C 45 36 32 20 24 FILE62 $ 486 | 000041d8 46 49 4C 45 36 31 20 24 FILE61 $ 487 | 000041e0 3F 3F 3F 3F 3F 3F 3F BF ???????. 488 | 000041e8 3F 3F 3F 3F 3F 3F 3F 3F ???????? 489 | 490 | Ah ha, the locked ?.??????? entry is the locked file again, and all entries 491 | after that are just ?.??????? because they haven't been used yet. This 492 | means that the locked ?.??????? entry is a good "end of catalogue" marker 493 | because it'll always be the first entry written (so the last in the sector) 494 | when a 2ndary catalogue is created. 495 | 496 | =================================================================== 497 | OPUS DDOS 498 | =================================================================== 499 | 500 | Opus does things differently to everyone else. It's a little bizarre, 501 | but... 502 | 503 | Basically, for a double-density disk (only!) they split the drive into 504 | sub-drives. Drive 0 is really split into drive 0A to 0H. Now some of 505 | these drives may be of zero length and so empty. Each of these drives 506 | can be a maximum of 252K in size (&3F0 sectors). See what they did 507 | there? They avoided the whole problem of handling sector sizes over 508 | 2^10 long, or file sizes over 2^18 long so the catalogues are Acorn 509 | standard. To add more space, the catalogues actually live outside 510 | of the "drive", so files in the drive are allocated from sector zero. 511 | 512 | Now an Opus disk is 18 sectors per track, and allocations are done 513 | per track. 514 | 515 | Track 0 516 | Sector 0, 1 : catalogue A 517 | Sector 2, 3 : catalogue B 518 | Sector 4, 5 : catalogue C 519 | Sector 6, 7 : catalogue D 520 | Sector 8, 9 : catalogue E 521 | Sector 10,11 : catalogue F 522 | Sector 12,13 : catalogue G 523 | Sector 14,15 : catalogue H 524 | Sector 16 : Disk allocation table 525 | Sector 17 : unused 526 | Tracks 1 to 79 are the data. 527 | 528 | The disk allocation table is small. http://beebwiki.jonripley.com/Opus_DDOS 529 | has some details, but #4 doesn't seem to match. We see that bytes 1,2,3,4 530 | allow for different format of disks (eg 40 track, 35 track) and even 531 | different densities. But the standard 80-track double density disk will 532 | be as follows: 533 | byte 0: &20 534 | byte 1,2: disk size (&5A0) 535 | byte 3: sector per track (&12) 536 | byte 4: &50 (but I've also seen &FF in testing!) 537 | byte 8, 9: track start for A 538 | byte 10,11: track start for B 539 | byte 12,13: track start for C 540 | byte 14,15: track start for D 541 | byte 16,17: track start for E 542 | byte 18,19: track start for F 543 | byte 20,21: track start for G 544 | byte 22,23: track start for H 545 | So 546 | 00001000 20 05 A0 12 50 00 00 00 ...P... 547 | 00001008 01 00 39 00 00 00 00 00 ..9..... 548 | 00001010 00 00 00 00 00 00 00 00 ........ 549 | 00001018 00 00 00 00 00 00 00 00 ........ 550 | We have two disks (A, starting at track 1, and B, starting at track &39). 551 | The other disks are not defined. 552 | 553 | This is wasteful of data (a whole unused sector!) but given we have 360K 554 | of data rather than 200K of the original Acorn format, I guess Opus figured 555 | this was a fair trade off. 556 | 557 | =================================================================== 558 | dgetfile and getfile filenames 559 | =================================================================== 560 | 561 | There are potential clashed when extracting files using either dgetfile 562 | or getfile 563 | 564 | There are two types of issue 565 | 566 | 1. Special filenames on the ssd image e.g. filenames called 567 | '<0x81>Hello' and '<0x82>Hello' Whilst these can not be created be 568 | default they can be created (and were for copywrite protction for example) 569 | with tools like *DFIX. In this case MMB_Utils replaces the special characters 570 | with an '_' (underscore) and thus both files would have the same name 571 | 572 | 2. An issue arises if you use the [-merge] or [-overwrite] flags. 573 | The [-merge] flag overwrites the default of requiring an empty directory 574 | 575 | The default behaviour is to create a new folder and put all the files in the 576 | folder. If the folder already exists the programme stops. In this case only 577 | issue 1 can occur, Using the above example '<0x81>Hello' will be extracted 578 | as '_Hello' as the '<0x81>' is replaced by '_'. The second file '<0x82>Hello' 579 | is extracted as '0-_Hello' with the '_' replacing the '<0x82>' and '0-' 580 | being used as a prefix to avoid name clashes. If there was a third file it 581 | would be prefixed with '1-' and so on incrementally. 582 | 583 | The first flag '-merge' allows the programme to continue even if the folder 584 | exists and therefore there could already have a file called '_Hello'. In 585 | this case the next extracted file would have a suffix of '-0' i.e. 586 | '_Hello-0' and each subsequent iteration would inrement the number (-1, -2, 587 | etc.) 588 | 589 | The second fage '-overwrite' allows the programme to overwrite existing files 590 | so if as above there is a file called '_Hello' and a new extracted file also 591 | has that name then the orignal file is overwritten withoput further warning. 592 | '-overwrite' has no effect if '-merge' is not specified. 593 | 594 | In summary an example disk has these files 595 | 596 | <0x81>Hello 597 | <0x82>Hello 598 | Goodbye 599 | 600 | In each case the first run will result in a folder called default being 601 | created with the following files 602 | 603 | _Hello 604 | 0-Hello 605 | Goodbye 606 | 607 | Case 1: dgetfile default.ssd default 608 | 609 | Second run - Programme exits with an error becuase the file already exists 610 | 611 | Case 2: dgetfile -merge default.ssd default 612 | 613 | Second Run - A second copy is created of each file 614 | 615 | _Hello 616 | _Hello-0 617 | 0_Hello 618 | 0_Hello-0 619 | Goodbye 620 | Goodbye-0 621 | 622 | Case 3: dgetfile -merge -overwrite default.ssd default 623 | 624 | Second Run - Each file is replaced with the latst version from the ssd 625 | 626 | _Hello 627 | 0_Hello 628 | Goodbye 629 | 630 | Changelog 631 | ========= 632 | 2015/05/30 - Make opt4 a function (lazy lazy; it should always have been!) 633 | - split add_file_to_ssd into a function that loads inf as 634 | necessary and into add_content_to_ssd() 635 | add_content_to_ssd($image,$fname,$data,$load,$exec,$locked); 636 | e.g. 637 | add_content_to_ssd($image,"!BOOT","*BASIC\r",0,0,1); 638 | 639 | 2015/06/01 - Add some binmode() calls to let this work better on Windows 640 | - safety check on $ENV{HOME} since Windows doesn't define this 641 | 642 | 2015/07/11 - merge_dsd program added 643 | 644 | 2018/09/15 - Change FindBin::Bin to FindBin::RealBin to handle relative 645 | symlinks. Thanks to Ray Bellis 646 | 647 | 2019/09/06 - Allow BBC_FILE to specify the MMB file 648 | 649 | 2019/09/17 - Strip out bad characers in titles in MMB catalogue 650 | 651 | 2020/10/03 - Add drecat 652 | 653 | 2020/11/11 - Add -concat options to split_dsd/merge_dsd 654 | 655 | 2021/08/26 - Allow for "-" to be specified as an SSD name eg for things like 656 | unzip -q -c myssd.zip | beeb info - 657 | Add new command "to_stdout" 658 | 659 | 2021/09/28 - Allow "-a" for dcat to show all disk slots, even unformatted ones 660 | Add the ability to handle Extended MMBs 661 | Add dextend to add an extent to an MMB 662 | Add dmmb_info to report on some basic MMB statistics 663 | Added dsplit_mmb 664 | Added dmerge_mmb 665 | Added dreplace_mmb 666 | 667 | 2021/09/30 - Added dbase command and report BASE value in dmmb_info 668 | 669 | 2021/10/02 - Allow dmmb_info to report on current base MMB onboot settings 670 | Fix critical offset calculation error for first disk in each 671 | extent 672 | Add bdiag 673 | Fix blank_mmb image size so extensions start correctly blank 674 | Have put_ssd abort if request disk is out of range 675 | 676 | 2023/03/21 - Handle z80 basic and basic 4 windows; they code lines differently 677 | 678 | 2024/12/25 - Implemented -merge and -overwrite for (d)getfile functionality (Thanks to datamgmt on Stardot) 679 | 680 | 2024/12/28 - Added filer option to(d)getfile to allow regex filtering of filenames (Thanks to datamgmt on Stardot) 681 | -------------------------------------------------------------------------------- /BeebUtils.pm: -------------------------------------------------------------------------------- 1 | package BeebUtils; 2 | 3 | # Beeb Utilities to manipulate MMB and SSD files 4 | # Copyright (C) 2012 Stephen Harris 5 | # 6 | # This program is free software; you can redistribute it and/or 7 | # modify it under the terms of the GNU General Public License 8 | # as published by the Free Software Foundation; either version 2 9 | # of the License, or (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | # 16 | # You should have received a copy of the GNU General Public License 17 | # along with this program; if not, write to the Free Software 18 | # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. 19 | 20 | use warnings; 21 | use strict; 22 | use FileHandle; 23 | use POSIX; 24 | 25 | # Constants 26 | my $SecSize=256; 27 | my $DiskTableSize=32*$SecSize; 28 | my $DisksPerCatalog = ($DiskTableSize/16)-1; # slot 0 isn't a real disk 29 | my $MaxDisks = $DisksPerCatalog; 30 | my $NumTables = 1; # Multiple tables 31 | 32 | my $DiskCatalogueSize = 2 * $SecSize ; # DFS 33 | my $DiskSectors = 800 ; # Only size supported! 80track single density 34 | my $DiskSize = $DiskSectors * $SecSize; 35 | 36 | our $MMBSize = $DisksPerCatalog*$DiskSize+$DiskTableSize; 37 | 38 | my $CatalogueMaxFiles = 31; # Acorn maximum. Solidisk can exceed this 39 | # but we only read that format 40 | 41 | # Disk table values 42 | my $DiskReadOnly = 0; 43 | my $DiskReadWrite = 0xF; 44 | my $DiskUnformatted = 0xF0; 45 | my $DiskInvalid = 0xFF; 46 | 47 | # Almost a constant. What we're gonna do here is nasty, but it means 48 | # that any program that uses this module will automatically gain an 49 | # optional "-f filename" 50 | my $DEFAULT_BBC_FILE=defined $ENV{'BBC_FILE'} ? $ENV{'BBC_FILE'} : "BEEB.MMB"; 51 | 52 | our $BBC_FILE=""; 53 | 54 | # These values extracted from BASIC 2 ROM 55 | # starting at &8071 and ending at &836C 56 | # (see extract_tokens for how this was built) 57 | 58 | # This is "our" so external programs can see it 59 | our %basic_tokens; 60 | our %extended_tokens; 61 | # z80 uses different line definitions 62 | # Basic 1/2/4 is and ends with linehi=ff 63 | # z80 and Basic 4 windows is and ends with 64 | # len=0 lineno=ffff 65 | our %alt_line; 66 | 67 | $basic_tokens{"_BASE_"}= 68 | { 69 | 128 => ['AND',0x00], 192 => ['LEFT$(',0x00], 70 | 129 => ['DIV',0x00], 193 => ['MID$(',0x00], 71 | 130 => ['EOR',0x00], 194 => ['RIGHT$(',0x00], 72 | 131 => ['MOD',0x00], 195 => ['STR$',0x00], 73 | 132 => ['OR',0x00], 196 => ['STRING$(',0x00], 74 | 133 => ['ERROR',0x04], 197 => ['EOF',0x01], 75 | 134 => ['LINE',0x00], 198 => ['AUTO',0x10], 76 | 135 => ['OFF',0x00], 199 => ['DELETE',0x10], 77 | 136 => ['STEP',0x00], 200 => ['LOAD',0x02], 78 | 137 => ['SPC',0x00], 201 => ['LIST',0x10], 79 | 138 => ['TAB(',0x00], 202 => ['NEW',0x01], 80 | 139 => ['ELSE',0x14], 203 => ['OLD',0x01], 81 | 140 => ['THEN',0x14], 204 => ['RENUMBER',0x10], 82 | 142 => ['OPENIN',0x00], 205 => ['SAVE',0x02], 83 | 143 => ['PTR',0x43], 207 => ['PTR',0x00], 84 | 144 => ['PAGE',0x43], 208 => ['PAGE',0x00], 85 | 145 => ['TIME',0x43], 209 => ['TIME',0x00], 86 | 146 => ['LOMEM',0x43], 210 => ['LOMEM',0x00], 87 | 147 => ['HIMEM',0x43], 211 => ['HIMEM',0x00], 88 | 148 => ['ABS',0x00], 212 => ['SOUND',0x02], 89 | 149 => ['ACS',0x00], 213 => ['BPUT',0x03], 90 | 150 => ['ADVAL',0x00], 214 => ['CALL',0x02], 91 | 151 => ['ASC',0x00], 215 => ['CHAIN',0x02], 92 | 152 => ['ASN',0x00], 216 => ['CLEAR',0x01], 93 | 153 => ['ATN',0x00], 217 => ['CLOSE',0x03], 94 | 154 => ['BGET',0x01], 218 => ['CLG',0x01], 95 | 155 => ['COS',0x00], 219 => ['CLS',0x01], 96 | 156 => ['COUNT',0x01], 220 => ['DATA',0x20], 97 | 157 => ['DEG',0x00], 221 => ['DEF',0x00], 98 | 158 => ['ERL',0x01], 222 => ['DIM',0x02], 99 | 159 => ['ERR',0x01], 223 => ['DRAW',0x02], 100 | 160 => ['EVAL',0x00], 224 => ['END',0x01], 101 | 161 => ['EXP',0x00], 225 => ['ENDPROC',0x01], 102 | 162 => ['EXT',0x01], 226 => ['ENVELOPE',0x02], 103 | 163 => ['FALSE',0x01], 227 => ['FOR',0x02], 104 | 164 => ['FN',0x08], 228 => ['GOSUB',0x12], 105 | 165 => ['GET',0x00], 229 => ['GOTO',0x12], 106 | 166 => ['INKEY',0x00], 230 => ['GCOL',0x02], 107 | 167 => ['INSTR(',0x00], 231 => ['IF',0x02], 108 | 168 => ['INT',0x00], 232 => ['INPUT',0x02], 109 | 169 => ['LEN',0x00], 233 => ['LET',0x04], 110 | 170 => ['LN',0x00], 234 => ['LOCAL',0x02], 111 | 171 => ['LOG',0x00], 235 => ['MODE',0x02], 112 | 172 => ['NOT',0x00], 236 => ['MOVE',0x02], 113 | 173 => ['OPENUP',0x00], 237 => ['NEXT',0x02], 114 | 174 => ['OPENOUT',0x00], 238 => ['ON',0x02], 115 | 175 => ['PI',0x01], 239 => ['VDU',0x02], 116 | 176 => ['POINT(',0x00], 240 => ['PLOT',0x02], 117 | 177 => ['POS',0x01], 241 => ['PRINT',0x02], 118 | 178 => ['RAD',0x00], 242 => ['PROC',0x0A], 119 | 179 => ['RND',0x01], 243 => ['READ',0x02], 120 | 180 => ['SGN',0x00], 244 => ['REM',0x20], 121 | 181 => ['SIN',0x00], 245 => ['REPEAT',0x00], 122 | 182 => ['SQR',0x00], 246 => ['REPORT',0x01], 123 | 183 => ['TAN',0x00], 247 => ['RESTORE',0x12], 124 | 184 => ['TO',0x00], 248 => ['RETURN',0x01], 125 | 185 => ['TRUE',0x01], 249 => ['RUN',0x01], 126 | 186 => ['USR',0x00], 250 => ['STOP',0x01], 127 | 187 => ['VAL',0x00], 251 => ['COLOUR',0x02], 128 | 188 => ['VPOS',0x01], 252 => ['TRACE',0x12], 129 | 189 => ['CHR$',0x00], 253 => ['UNTIL',0x02], 130 | 190 => ['GET$',0x00], 254 => ['WIDTH',0x02], 131 | 191 => ['INKEY$',0x00], 255 => ['OSCLI',0x02] 132 | }; 133 | 134 | $basic_tokens{"basic2"}={}; 135 | $extended_tokens{"basic2"}={}; 136 | 137 | # These extensions from http://mdfs.net/Docs/Comp/BBCBasic/Tokens 138 | $basic_tokens{"basic4"}= { 206 => ['EDIT',0] }; 139 | $extended_tokens{"basic4"}={}; 140 | 141 | $basic_tokens{"z80"}= { 206 => ['PUT',0] }; 142 | $extended_tokens{"z80"}={}; 143 | $alt_line{"z80"}=1; 144 | 145 | $basic_tokens{"arm"}= 146 | { 147 | 127 => ['OTHERWISE',0], 204 => ['ELSE',0], 148 | 201 => ['WHEN',0], 205 => ['ENDIF',0], 149 | 202 => ['OF',0], 206 => ['ENDWHILE',0], 150 | 203 => ['ENDCASE',0] 151 | }; 152 | $extended_tokens{"arm"}{198}={ 142 => ['SUM',0], 143 => ['BEAT',0] }; 153 | $extended_tokens{"arm"}{199}= 154 | { 155 | 142 => ['APPEND',0], 151 => ['NEW',0], 156 | 143 => ['AUTO',0], 152 => ['OLD',0], 157 | 144 => ['CRUNCH',0], 153 => ['RENUMBER',0], 158 | 145 => ['DELETE',0], 154 => ['SAVE',0], 159 | 146 => ['EDIT',0], 155 => ['TEXTLOAD',0], 160 | 147 => ['HELP',0], 156 => ['TEXTSAVE',0], 161 | 148 => ['LIST',0], 157 => ['TWIN',0], 162 | 149 => ['LOAD',0], 158 => ['TWINO',0], 163 | 150 => ['LVAR',0], 159 => ['INSTALL',0] 164 | }; 165 | $extended_tokens{"arm"}{200}= 166 | { 167 | 142 => ['CASE',0], 155 => ['LIBRARY',0], 168 | 143 => ['CIRCLE',0], 156 => ['TINT',0], 169 | 144 => ['FILL',0], 157 => ['ELLIPSE',0], 170 | 145 => ['ORIGIN',0], 158 => ['BEATS',0], 171 | 146 => ['POINT',0], 159 => ['TEMPO',0], 172 | 147 => ['RECTANGLE',0], 160 => ['VOICES',0], 173 | 148 => ['SWAP',0], 161 => ['VOICE',0], 174 | 149 => ['WHILE',0], 162 => ['STEREO',0], 175 | 150 => ['WAIT',0], 163 => ['OVERLAY',0], 176 | 151 => ['MOUSE',0], 164 => ['MANDEL',0], 177 | 152 => ['QUIT',0], 165 => ['PRIVATE',0], 178 | 153 => ['SYS',0], 166 => ['EXIT',0], 179 | 154 => ['INSTALL',0] 180 | }; 181 | 182 | $basic_tokens{"b4w"}= 183 | { 184 | 1 => ['CIRCLE',0], 198 => ['SUM',0], 185 | 2 => ['ELLIPSE',0], 199 => ['WHILE',0], 186 | 3 => ['FILL',0], 200 => ['CASE',0], 187 | 4 => ['MOUSE',0], 201 => ['WHEN',0], 188 | 5 => ['ORIGIN',0], 202 => ['OF',0], 189 | 6 => ['QUIT',0], 203 => ['ENDCASE',0], 190 | 7 => ['RECTANGLE',0], 204 => ['ELSE',0], 191 | 8 => ['SWAP',0], 205 => ['ENDIF',0], 192 | 9 => ['SYS',0], 206 => ['ENDWHILE',0], 193 | 10 => ['TINT',0], 194 | 11 => ['WAIT',0], 195 | 12 => ['INSTALL',0], 196 | 14 => ['PRIVATE',0], 197 | 15 => ['BY',0], 198 | 16 => ['EXIT',0], 199 | }; 200 | $extended_tokens{"b4w"}={}; 201 | $alt_line{"b4w"}=1; 202 | 203 | my $SOLIDISK=0; 204 | my $WATFORD=0; 205 | my $OPUS=0; 206 | my $DISK_DOCTOR=0; 207 | 208 | sub init(@) 209 | { 210 | my (@arg)=@_; 211 | if (@arg >=2 && $arg[0] eq '-f') 212 | { 213 | $BBC_FILE=$arg[1]; 214 | shift @arg; 215 | shift @arg; 216 | } 217 | elsif (@arg && $arg[0] =~ /^-f(.+)$/) 218 | { 219 | $BBC_FILE=$1; 220 | shift @arg; 221 | } 222 | elsif (@arg==1 && $arg[0] eq '-f') 223 | { 224 | die "Missing filename argument to -f\n"; 225 | } 226 | 227 | # We need to check the MMB file to see if it's an extended one 228 | # and if so, set NumTables and MaxDisks 229 | # An entry of 0xA# at offset 8 in the table (previously unused) 230 | # means there's # additional tables 231 | my $fname=$BBC_FILE; 232 | $fname=$DEFAULT_BBC_FILE unless $fname; 233 | my $fh = new FileHandle("+< $fname"); 234 | 235 | if ($fh) 236 | { 237 | binmode($fh); 238 | sysseek($fh,8,0); 239 | my $ext_byte; 240 | sysread($fh,$ext_byte,1); 241 | close($fh); 242 | $ext_byte=ord($ext_byte); 243 | if ($ext_byte > 160 && $ext_byte < 176) 244 | { 245 | # We have 1-15 catalogues 246 | $NumTables = $ext_byte-159; 247 | $MaxDisks = $NumTables * $MaxDisks; 248 | } 249 | } 250 | return(@arg); 251 | } 252 | 253 | sub init_ssd(@) 254 | { 255 | my (@arg)=@_; 256 | if (@arg) 257 | { 258 | my $f=$arg[0]; 259 | if ($f=~/^([^:]+):(.+)$/) 260 | { 261 | $f=$2; 262 | check_and_set_type($1); 263 | } 264 | $BBC_FILE=$f; 265 | shift @arg; 266 | } 267 | return (@arg); 268 | } 269 | 270 | my $file_handle=undef; 271 | 272 | # Open BBC_FILE if it's not already open 273 | sub OpenFile() 274 | { 275 | return if $file_handle; 276 | $BBC_FILE=$DEFAULT_BBC_FILE unless $BBC_FILE; 277 | die "$BBC_FILE is not a file!\n" unless -f $BBC_FILE; 278 | $file_handle = new FileHandle("+< $BBC_FILE"); 279 | die "Could not open $BBC_FILE: $!\n" unless $file_handle; 280 | binmode($file_handle); 281 | return; 282 | } 283 | 284 | sub LoadDiskTable(;$) 285 | { 286 | my ($extent)=@_; 287 | $extent=0 unless $extent; 288 | my ($disktable,$thistable); 289 | OpenFile; 290 | sysseek($file_handle,$extent*$MMBSize,0); 291 | sysread($file_handle,$disktable,$DiskTableSize); 292 | 293 | # Add any secondary catalogues 294 | foreach my $i (1..$NumTables-1) 295 | { 296 | # We skip the first 16 bytes since they're unused in secondary catalogues 297 | sysseek($file_handle,$i*$MMBSize+16,0); 298 | sysread($file_handle,$thistable,$DiskTableSize-16); 299 | # If the MMB is short then abort 300 | if (length($thistable) != $DiskTableSize-16) 301 | { 302 | printf("Unable to read MMB Catalogue %d at location %d\n Got %d bytes but expected %d\n Is this a corrupted MMB?\n",$i,$i*$MMBSize+16,length($thistable),$DiskTableSize-16); 303 | exit(-1); 304 | } 305 | $disktable .= $thistable 306 | } 307 | return $disktable; 308 | } 309 | 310 | sub SaveDiskTable($) 311 | { 312 | my ($disktable)=@_; 313 | OpenFile; 314 | 315 | my $thistable=$$disktable; 316 | sysseek($file_handle,0,0); 317 | syswrite($file_handle,$thistable,$DiskTableSize); 318 | $thistable=substr($thistable,$DiskTableSize); 319 | foreach my $i (1..$NumTables-1) 320 | { 321 | # We skip the first 16 bytes since they're unused in secondary catalogues 322 | sysseek($file_handle,$i*$MMBSize+16,0); 323 | syswrite($file_handle,$thistable,$DiskTableSize-16); 324 | $thistable=substr($thistable,$DiskTableSize-16); 325 | } 326 | } 327 | 328 | # Disk slot and new title and table 329 | sub ChangeDiskName($$$) 330 | { 331 | my ($slot,$title,$disktable)=@_; 332 | return if $slot < 0 || $slot >= $MaxDisks; 333 | $title.=("\0"x15); $title=substr($title,0,15); 334 | substr($$disktable,$slot*16+16,15)=$title; 335 | } 336 | 337 | # Delete slot 338 | sub DeleteSlot($$$) 339 | { 340 | my ($slot,$restore,$disktable)=@_; 341 | return if $slot < 0 || $slot >= $MaxDisks; 342 | substr($$disktable,$slot*16+16+15,1)=chr($restore?$DiskReadWrite:$DiskUnformatted); 343 | } 344 | 345 | # Lock/Unlock a slot 346 | sub lock_disk($$$) 347 | { 348 | my ($slot,$lock,$disktable)=@_; 349 | return if $slot < 0 || $slot >= $MaxDisks; 350 | substr($$disktable,$slot*16+16+15,1)=chr($lock?$DiskReadOnly:$DiskReadWrite); 351 | } 352 | 353 | # disk is disk slot on the MMB (0->$MaxDisks-1) 354 | # disktable is a reference to a already loaded disktable 355 | # eg 356 | # my $disktable=LoadDiskTable; 357 | # my ($title,$type)=GetDskName(10,\$disktable); 358 | sub GetDskName($$) 359 | { 360 | my ($disk,$disktable)=@_; 361 | my $offset=$disk*16+16; 362 | 363 | my $title=substr($$disktable,$offset,12); $title =~ s/\0.*$//; 364 | 365 | # Convert any non-ascii character to a '?' 366 | $title =~ s/[\x01-\x1f\x7f-\xff]/?/g; 367 | 368 | # Ensure title is 12 characters long 369 | $title .= " "x(12-length($title)); 370 | 371 | my $type=substr($$disktable,$offset+15,1); $type=ord($type); 372 | return ($title,$type); 373 | } 374 | 375 | # Returns a simple hashref of boot image and the disk catalog 376 | sub load_onboot(;$) 377 | { 378 | my ($extent)=@_; 379 | my $disktable=LoadDiskTable($extent); 380 | my %boot; 381 | foreach (0..3) 382 | { 383 | $boot{$_}=ord(substr($disktable,$_,1))+ord(substr($disktable,$_+4,1))*256; 384 | } 385 | return ($disktable,%boot); 386 | } 387 | 388 | sub save_onboot($%) 389 | { 390 | my ($disktable,%boot)=@_; 391 | foreach (0..3) 392 | { 393 | substr($$disktable,$_,1)=chr($boot{$_} & 0xff); 394 | substr($$disktable,$_+4,1)=chr(($boot{$_} & 0xff00) >> 8); 395 | } 396 | SaveDiskTable($disktable); 397 | } 398 | 399 | sub DiskPtr($;$) 400 | { 401 | my ($DiskNo,$Sec)=@_; 402 | $Sec=0 unless $Sec; 403 | 404 | # If the image is in a secondary catalogue then we need to add extra 405 | # DiskTableSize offsets 406 | my $offset=1+int($DiskNo/$DisksPerCatalog); 407 | return ($DiskTableSize*$offset)+($DiskNo*$DiskSize)+($Sec*$SecSize); 408 | } 409 | 410 | sub BootOpt($) 411 | { 412 | my ($bytOption)=@_; 413 | 414 | if ($bytOption == 0) { return 'None'; } 415 | if ($bytOption == 1) { return 'LOAD'; } 416 | if ($bytOption == 2) { return 'RUN'; } 417 | if ($bytOption == 3) { return 'EXEC'; } 418 | return ""; 419 | } 420 | 421 | sub DiskSize($) 422 | { 423 | my ($size)=@_; 424 | 425 | # If we want more detail, comment this line out... 426 | return int($size/4) . "K"; 427 | 428 | if ($size == 0x190) { return "100K - 40x10 - SD"; } 429 | if ($size == 0x280) { return "160K - 40x16 - DD"; } 430 | if ($size == 0x2d0) { return "180K - 40x18 - DD"; } 431 | if ($size == 0x320) { return "200K - 80x10 - SD"; } 432 | if ($size == 0x500) { return "320K - 80x16 - DD"; } 433 | if ($size == 0x5a0) { return "360K - 80x18 - DD"; } 434 | return int($size/4) . "K"; 435 | } 436 | 437 | # Loads the main catalog from the MMB file 438 | # (optionally pass an already loaded disktable) 439 | sub load_dcat(;$) 440 | { 441 | my ($tbl)=@_; 442 | 443 | my ($disktable,%disk); 444 | 445 | if ($tbl) 446 | { 447 | $disktable=$$tbl; 448 | } 449 | else 450 | { 451 | $disktable=LoadDiskTable; 452 | } 453 | 454 | foreach (0..$MaxDisks-1) 455 | { 456 | $disk{$_}{ValidDisk}=0; 457 | $disk{$_}{Formatted}=0; 458 | $disk{$_}{ReadOnly}=0; 459 | $disk{$_}{DiskTitle}=""; 460 | 461 | my ($title,$type)=GetDskName($_,\$disktable); 462 | 463 | if ($type == $DiskReadOnly || $type == $DiskReadWrite) 464 | { 465 | $disk{$_}{ValidDisk}=1; 466 | $disk{$_}{Formatted}=1; 467 | $disk{$_}{ReadOnly}=($type == $DiskReadOnly)?1:0; 468 | $disk{$_}{DiskTitle}=$title; 469 | } 470 | elsif ($type == $DiskUnformatted) 471 | { 472 | $disk{$_}{ValidDisk}=1; 473 | $disk{$_}{DiskTitle}=$title; 474 | } 475 | } 476 | return %disk; 477 | } 478 | 479 | sub blank_mmb() 480 | { 481 | my $image="\0" x $MMBSize; 482 | substr($image,0,4)="\0\1\2\3"; # Default onboot disks 483 | foreach (1..$DisksPerCatalog) 484 | { 485 | substr($image,$_*16+15,1)=chr($DiskUnformatted); 486 | } 487 | 488 | return($image); 489 | } 490 | 491 | sub blank_ssd() 492 | { 493 | my $image="\xE5" x $DiskSize; 494 | substr($image,0,512)="\x0" x 512; 495 | substr($image,0x104,4)="\x01\x00\x03\x20"; # 200K disk 496 | return($image); 497 | } 498 | 499 | # Reads an SSD image from an MMB 500 | sub read_ssd(;$) 501 | { 502 | my ($disk)=@_; 503 | OpenFile; 504 | sysseek($file_handle,DiskPtr($disk),0) if defined($disk); 505 | my $image; 506 | sysread($file_handle,$image,$DiskSize); 507 | # Ensure the image is at least the right size 508 | die "Image is too small; not even 2 sectors!\n" if length($image)<512; 509 | $image .= blank_ssd(); 510 | $image=substr($image,0,$DiskSize); 511 | return($image); 512 | } 513 | 514 | # Reads an SSD from an external file 515 | sub load_external_ssd(;$$) 516 | { 517 | my ($fname,$size_check)=@_; 518 | my $target=$fname||$BBC_FILE; 519 | 520 | die "$target is not a file!\n" unless -f $target || $target eq '-'; 521 | my $f=new FileHandle "<$target"; 522 | die "Could not open $target: $!\n" unless $f; 523 | binmode($f); 524 | my $image; 525 | # We won't read more than 400K, regardless 526 | sysread($f,$image,409600); 527 | if ($size_check && length($image)> $DiskSize) 528 | { 529 | die "File $target is over $DiskSize in size\n"; 530 | } 531 | close($f); 532 | 533 | # Ensure the image is at least the right size 534 | die "Image is too small; not even 2 sectors!\n" if length($image)<512; 535 | if (length($image) < $DiskSize) 536 | { 537 | $image .= blank_ssd(); 538 | $image=substr($image,0,$DiskSize); 539 | } 540 | return($image); 541 | } 542 | 543 | sub put_ssd($$) 544 | { 545 | my ($image,$disk)=@_; 546 | 547 | die "$disk is greater than maximum allowed of " . ($MaxDisks-1) . " for this MMB \n" if $disk >= $MaxDisks; 548 | 549 | OpenFile; 550 | sysseek($file_handle,DiskPtr($disk),0); 551 | 552 | syswrite($file_handle,$image,$DiskSize); 553 | } 554 | 555 | sub write_ssd($$) 556 | { 557 | my ($image,$filename)=@_; 558 | 559 | my $fh=new FileHandle ">$filename"; 560 | die "Can not open $filename for saving\n" unless $fh; 561 | binmode($fh); 562 | print $fh $$image; 563 | close($fh); 564 | } 565 | 566 | sub set_ssd_title($$) 567 | { 568 | my ($image,$title)=@_; 569 | 570 | $title .= ("\0"x12); 571 | my $t1=substr($title,0,8); 572 | my $t2=substr($title,8,4); 573 | 574 | # If Solidisk secondary catalog then cut down title by 2 575 | my @b=unpack("C",substr($$image,0x102,1)); 576 | $t2=substr($t2,0,2) if ($b[0] & 192) == 192; 577 | substr($$image,0,8)=$t1; 578 | substr($$image,0x100,length($t2))=$t2; 579 | } 580 | 581 | # Reads a standard BBC DFS catalogue. 582 | # $image is a ref to a loaded disk image 583 | # $start is a sector offset into the image to find the catalog 584 | sub _read_ssd_cat($$) 585 | { 586 | my ($image,$start)=@_; 587 | my $offset=$start*256; 588 | 589 | my %files; 590 | 591 | # BBC disk format: First 8 bytes are part of the disk title; null terminated 592 | my $disk_title=substr($$image,$offset,8); 593 | 594 | # We'll grab the filecount from sector 1 'cos that makes it easier... 595 | my $filecount=ord(substr($$image,$offset+256+5,1))/8; 596 | 597 | # Next lot of 8 data are filenames 598 | foreach (0..$filecount-1) 599 | { 600 | my $t=substr($$image,$offset+$_*8+8,7); $t=~s/ .*$//; 601 | my $d=substr($$image,$offset+$_*8+8+7,1); $d=ord($d); 602 | 603 | my $locked=($d>127)?1:0; 604 | $d=chr($d%128); 605 | $t="$d.$t"; $t=~s/\0.*$//; 606 | $files{$_}{locked}=$locked; 607 | $files{$_}{name}="$t"; 608 | $files{$_}{cat_sector}=$start; 609 | } 610 | 611 | # Second sector. 612 | # First 4 bytes are also part of the title 613 | my $t2=substr($$image,$offset+256,4); $disk_title .= $t2; 614 | 615 | # Disk title is null terminated. But quick check to see if's a solidisk 616 | # chained catalogue. No one should use high-bit characters in disk 617 | # titles, so this is relative safe to do. 618 | my $chained; 619 | if ($SOLIDISK) 620 | { 621 | my @b=unpack("C2",substr($disk_title,10,2)); 622 | if (($b[0] & 192) == 192) 623 | { 624 | $chained=($b[0]&63)*256+$b[1]; 625 | $disk_title=substr($disk_title,0,10); 626 | } 627 | } 628 | $disk_title=~s/\0.*$//; 629 | 630 | # next byte is BCD cycle 631 | my $cycle=substr($$image,$offset+256+4,1); $cycle=ord($cycle); 632 | $cycle=int($cycle/16)*10+($cycle%16); 633 | 634 | # (We'd already got the filecount, earlier) 635 | 636 | # Now the last next two bytes encode both *OPT4 value and disk size 637 | my @b=unpack("C2",substr($$image,$offset+256+6,2)); 638 | 639 | my $opt4=int($b[0]/16) & 3; 640 | # Really this should only be &3 but DD disks need 11 bits, so... 641 | # (relatively safe to do everywhere - bit 3 was unused, otherwise) 642 | my $disk_size=($b[0]&7)*256+$b[1]; 643 | 644 | # Now we have entries for load/exec/size/start-sec 645 | # LL LL EE EE SS SS XX YY 646 | # Load Exec Size Sector 647 | # The first 6 bytes are load/exec/size bottom 16 bits. 648 | # The 8th byte encodes the low 8 bits for start-sec 649 | # The 7th byte is special. For Acorn DFS: 650 | # bits 0+1 are high bits of sector start 651 | # bits 2+3 are high bits of load address 652 | # bits 4+5 are high bits of size 653 | # bits 6+7 are high bits of exec address 654 | # 655 | # That makes 10 bits for start sector and 18 bits for size. 656 | # 657 | # But on a 320K disk you need 11 bits and 19 bits. So Solidisk steals 658 | # bits 2 and 3 ("load address"). bit 2 is added to the sector, bit 3 to 659 | # the size. This means we have now only have 8 bits for the load address. 660 | # Solidisk re-uses the exec high bits for the load high bits. 661 | 662 | foreach (0..$filecount-1) 663 | { 664 | my ($load,$exec,$size,$sec); 665 | @b=unpack("C2",substr($$image,$offset+256+$_*8+8 ,2)); $load=$b[1]*256+$b[0]; 666 | @b=unpack("C2",substr($$image,$offset+256+$_*8+8+2,2)); $exec=$b[1]*256+$b[0]; 667 | @b=unpack("C2",substr($$image,$offset+256+$_*8+8+4,2)); $size=$b[1]*256+$b[0]; 668 | 669 | # Higher bits are encoded 670 | @b=unpack("C",substr($$image,$offset+256+$_*8+8+6,1)); 671 | my $highsec = ($b[0]&3); # bits 0 and 1 672 | my $highload = ($b[0] & 0xc) >> 2; # bits 2 and 3 673 | my $highsize = ($b[0] & 0x30) >> 4; # bits 4 and 5 674 | my $highexec = ($b[0] & 0xc0) >> 6; # bits 6 and 7 675 | 676 | if ($SOLIDISK && $disk_size == 0x500) 677 | { 678 | if ($highload & 1) { $highsec += 4; } 679 | if ($highload & 2) { $highsize += 4; } 680 | $highload=$highexec; 681 | } 682 | 683 | # Watford does it slightly differently and uses high bits in the 684 | # filename which means we'll need to recalculate it. 685 | if ($WATFORD) 686 | { 687 | my $name=$files{$_}{name}; 688 | @b=unpack("C2",substr($$image,$offset+$_*8+8+5,2)); 689 | if ($b[0]>127) 690 | { 691 | substr($name,5,1)=chr($b[0] & 127) if length($name)>5; 692 | $highsize += 4; 693 | } 694 | if ($b[1]>127) 695 | { 696 | substr($name,6,1)=chr($b[1] & 127) if length($name)>6; 697 | $highsec += 4; 698 | } 699 | $files{$_}{name}=$name; 700 | } 701 | $highload=0xff if $highload == 3; 702 | $highexec=0xff if $highexec == 3; 703 | 704 | @b=unpack("C",substr($$image,$offset+256+$_*8+8+7,1)); 705 | $sec=$b[0]; 706 | 707 | $files{$_}{load}=$load+$highload*65536; 708 | $files{$_}{exec}=$exec+$highexec*65536; 709 | $files{$_}{size}=$size+$highsize*65536; 710 | $files{$_}{start}=$sec+$highsec*256; 711 | } 712 | 713 | # Do we have multi-catalogues? We've already checked for solidisk, earlier 714 | # what about the others? 715 | if ($WATFORD && $start==0) 716 | { 717 | if (substr($$image,512,8) eq "\xAA"x8) 718 | { 719 | $chained=2; # Watford DFS allows another catalogue at sector 2 720 | } 721 | } 722 | 723 | if ($start == 0) 724 | { 725 | $files{""}{title}=$disk_title; 726 | $files{""}{cycle}=$cycle; 727 | $files{""}{disk_size}=$disk_size; 728 | $files{""}{opt4}=$opt4; 729 | } 730 | $files{""}{filecount}=$filecount; 731 | $files{""}{chain}=$chained; 732 | 733 | return %files; 734 | } 735 | 736 | # Read disk catalgue. Follow chain if multi-catalogues 737 | # If $0 is a reference to a BBC disk image 738 | sub read_cat($) 739 | { 740 | my ($image)=@_; 741 | 742 | # OPUS is sufficiently different... 743 | if ($OPUS) { return read_cat_opus($image); } 744 | 745 | my %files; 746 | 747 | my $max_file=0; 748 | my $chain=0; 749 | my $deleted=0; 750 | 751 | while ($chain ne "") 752 | { 753 | my %this_cat=_read_ssd_cat($image,$chain); 754 | $files{""}{last_cat}=$chain; 755 | if ($chain == 0) 756 | { 757 | foreach my $k (keys %{$this_cat{""}}) 758 | { 759 | $files{""}{$k}=$this_cat{""}{$k}; 760 | } 761 | } 762 | else 763 | { 764 | $files{""}{filecount}+=$this_cat{""}{filecount}; 765 | } 766 | 767 | my $nextchain=$this_cat{""}{chain} || ""; 768 | delete($this_cat{""}); 769 | 770 | foreach (sort { $a <=> $b } keys %this_cat) 771 | { 772 | next if $_ eq ""; 773 | # Skip deleted files from multi-catalog (directory is 0x7F 774 | # and file is locked 775 | if ($SOLIDISK && $this_cat{$_}{name} =~ /^\x7f\./ && $this_cat{$_}{locked}) 776 | { 777 | $deleted++; 778 | next; 779 | } 780 | # Is this a hidden file that "blocks out" data from first catalogue? 781 | # If so, it's the end of this 2nd catalogue 782 | if ($SOLIDISK && $this_cat{$_}{name} eq '?.???????' && $this_cat{$_}{locked} && $chain) 783 | { 784 | $deleted++; 785 | next; 786 | } 787 | 788 | #Disk doctor? 789 | if ($DISK_DOCTOR && $this_cat{$_}{name} eq '!.!!!!!!!' && $this_cat{$_}{locked}) 790 | { 791 | $deleted++; 792 | $nextchain=2 unless $chain; 793 | next; 794 | } 795 | 796 | foreach my $k (keys %{$this_cat{$_}}) 797 | { 798 | $files{$max_file}{$k}=$this_cat{$_}{$k}; 799 | } 800 | $max_file++ unless $_ eq ""; 801 | } 802 | 803 | $chain=$nextchain; 804 | } 805 | $files{""}{deleted}=$deleted; 806 | return %files; 807 | } 808 | 809 | # OPUS... 810 | sub read_cat_opus($) 811 | { 812 | my ($image)=@_; 813 | 814 | # if this isn't an opus image then abort 'cos it could 815 | # be almost anything 816 | # The four bytes should be 20 05 a0 12 817 | if (substr($$image,0x1000,4) ne "\x20\x05\xa0\x12") 818 | { 819 | die "This does not appear to be an OPUS DDOS image\n"; 820 | } 821 | 822 | my %catstart; 823 | foreach my $cat (0..7) 824 | { 825 | my @b=unpack("C2",substr($$image,0x1008+$cat*2,2)); 826 | # This is measured in tracks, so *18 for sector 827 | $catstart{$cat}=($b[0]+256*$b[1])*18; 828 | # printf "debug: %d at %03X\n",$cat,$catstart{$cat}; 829 | } 830 | 831 | my %files; 832 | 833 | my $max_file=0; 834 | $files{""}{last_cat}=7; # DDOS always has multi-cat even if they're empty 835 | foreach my $chain (0..7) 836 | { 837 | next unless $catstart{$chain}; 838 | 839 | my %this_cat=_read_ssd_cat($image,$chain*2); 840 | if ($chain == 0) 841 | { 842 | foreach my $k (keys %{$this_cat{""}}) 843 | { 844 | $files{""}{$k}=$this_cat{""}{$k}; 845 | } 846 | $files{""}{disk_size}=0x5a0; 847 | } 848 | else 849 | { 850 | $files{""}{filecount}+=$this_cat{""}{filecount}; 851 | } 852 | delete($this_cat{""}); 853 | 854 | foreach (sort { $a <=> $b } keys %this_cat) 855 | { 856 | next if $_ eq ""; 857 | 858 | $this_cat{$_}{start}+=$catstart{$chain}; 859 | foreach my $k (keys %{$this_cat{$_}}) 860 | { 861 | $files{$max_file}{$k}=$this_cat{$_}{$k}; 862 | } 863 | $max_file++ unless $_ eq ""; 864 | } 865 | 866 | } 867 | $files{""}{deleted}=0; 868 | return %files; 869 | } 870 | 871 | # Reference to image; generate a CRC 872 | sub CalcCrc($) 873 | { 874 | my ($image)=@_; 875 | my $crc=0; 876 | 877 | foreach (0..length($$image)-1) 878 | { 879 | $crc ^= (256*ord(substr($$image,$_,1))); 880 | foreach my $x (0..7) 881 | { 882 | $crc *= 2; 883 | if ($crc > 65535) 884 | { 885 | $crc-=65535; $crc ^= 0x1020; 886 | } 887 | } 888 | } 889 | return($crc); 890 | } 891 | # Get a file from an SSD image 892 | # $0 is ref to an image 893 | # $1 is the filename 894 | # $2 is a catalogue; we'll build one if not provided 895 | # If you provide a catalogue for a different image then you get 896 | # all you deserve 897 | 898 | sub ExtractFile($$;%) 899 | { 900 | my ($image,$filename,%cat)=@_; 901 | 902 | my %files; 903 | if (%cat) 904 | { 905 | %files=%cat; 906 | } 907 | else 908 | { 909 | %files=read_cat($image); 910 | } 911 | 912 | my $file=undef; 913 | foreach (sort keys %files) 914 | { 915 | my $f=$files{$_}{name}; 916 | next unless $f; 917 | $file=$_ if lc($filename) eq lc($f); 918 | } 919 | 920 | die "Can not find $filename in image\n" unless defined($file); 921 | 922 | my $start=$files{$file}{start}*256; 923 | my $size=$files{$file}{size}; 924 | return substr($$image,$start,$size); 925 | } 926 | 927 | # SSD image saved to current directory 928 | sub save_all_files_from_ssd($;$$$) 929 | { 930 | my ($image,$verbose,$overwrite,$filter)=@_; 931 | 932 | $overwrite //= 0; 933 | $filter //= '^.*$'; 934 | my $filter_regex = qr/$filter/; 935 | 936 | my %files=read_cat($image); 937 | 938 | # Iterate over each entry in %files 939 | for my $key (keys %files) 940 | { 941 | my $original_name = $files{$key}{name}; 942 | my $converted = $original_name; 943 | next unless $original_name; 944 | 945 | # These keep Unix filenames at least a little sane 946 | $converted =~ tr/ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789_+.!@$%,-/_/c; 947 | $converted =~ s/^\$\.// unless $converted eq '$.'; 948 | 949 | # Start with the converted value 950 | my $unique = $converted; 951 | # Ensure the converted value is unique across all entries 952 | my $prefix = 0; 953 | while (grep { $_ ne $key && $files{$_}{converted} && $files{$_}{converted} eq $unique } keys %files) { 954 | $unique = $prefix++ . '-' . $converted; # Prefix with '0-', '1-', etc. 955 | } 956 | 957 | # Store the unique converted value 958 | $files{$key}{converted} = $unique; 959 | } 960 | 961 | foreach (keys %files) 962 | { 963 | my $n=$files{$_}{name}; 964 | next unless $n; 965 | next unless $n =~ $filter_regex; 966 | my $c=$files{$_}{converted}; 967 | 968 | my $file=ExtractFile($image,$n,%files); 969 | my $crc=CalcCrc(\$file); 970 | 971 | if ( -e $c && !$overwrite ) 972 | { 973 | my $c1=$c; 974 | my $cnt=0; 975 | while ( -e $c1 ) { $c1 = $c . "-" . ($cnt++); } 976 | $c=$c1; 977 | } 978 | 979 | print "Saving $files{$_}{name} as $c\n" if $verbose; 980 | 981 | my $fh=new FileHandle ">$c"; 982 | die "Can not open $c for saving\n" unless $fh; 983 | binmode($fh); 984 | print $fh $file; 985 | close($fh); 986 | 987 | $fh=new FileHandle ">$c.inf"; 988 | die "Can not open $c.inf for saving\n" unless $fh; 989 | printf $fh "%-9s %6X %6X %sCRC=%04X", 990 | $files{$_}{name}, 991 | $files{$_}{load}, 992 | $files{$_}{exec}, 993 | $files{$_}{locked}?"Locked ":"", 994 | $crc; 995 | close($fh); 996 | } 997 | } 998 | 999 | sub add_content_to_ssd($$$$$$;$) 1000 | { 1001 | my ($image,$fname,$data,$load,$exec,$locked,$filename)=@_; 1002 | $filename=$fname unless defined($filename); 1003 | 1004 | die "Bad filename for $filename ($fname)\n" unless $fname=~/^.\./ && length($fname)<=9; 1005 | 1006 | my %files=read_cat($image); 1007 | 1008 | die "Can not operate on large/multi-catalogue disks\n" if $files{""}{chain}; 1009 | die "Can only operate on 200Kb disks\n" if $files{""}{disk_size} != 0x320; 1010 | my $cnt=$files{""}{filecount}; 1011 | die "Catalogue full. Can not add $filename\n" if $cnt == 31; 1012 | 1013 | # Calculate first free sector 1014 | my $first_sect=$files{0}{start}; 1015 | my $len=$files{0}{size}; 1016 | # If we have no files... 1017 | if ($cnt == 0) 1018 | { 1019 | $first_sect=2; 1020 | $len=0; 1021 | } 1022 | 1023 | # Convert to sectors; 1024 | $len=int($len/256)+(($len%256)?1:0); 1025 | $first_sect += $len; 1026 | my $last_sect=$files{""}{disk_size}; 1027 | delete $files{""}; 1028 | 1029 | my $freesect=$last_sect-$first_sect; 1030 | 1031 | my $fsize=length($data); 1032 | if ($fsize > $freesect*256) 1033 | { 1034 | die "Not enough space to add $filename\n"; 1035 | } 1036 | 1037 | 1038 | # Is this file already on the disk? 1039 | foreach (keys %files) 1040 | { 1041 | die "File $fname already present: $filename\n" if defined($files{$_}{name}) && lc($files{$_}{name}) eq lc($fname); 1042 | } 1043 | 1044 | # If we've got here then it's safe to add the file! 1045 | $fname .= " "; 1046 | substr($fname,0,1)=chr(ord(substr($fname,0,1))|128) if $locked; 1047 | substr($$image,16,240)=substr($$image,8,240); 1048 | substr($$image,8,7)=substr($fname,2,7); 1049 | substr($$image,15,1)=substr($fname,0,1); 1050 | 1051 | substr($$image,256+16,240)=substr($$image,256+8,240); 1052 | substr($$image,0x105,1)=chr($cnt*8+8); 1053 | substr($$image,0x108,2)=chr($load&255) . chr(($load>>8) & 255); 1054 | substr($$image,0x10a,2)=chr($exec&255) . chr(($exec>>8) & 255); 1055 | substr($$image,0x10c,2)=chr($fsize&255) . chr(($fsize>>8) & 255); 1056 | 1057 | # Next byte is a little complicated 1058 | my $b=($exec & 0x30000) >>10; 1059 | $b |= ($fsize & 0x30000) >>12; 1060 | $b |= ($load & 0x30000) >>14; 1061 | $b |= ($first_sect>>8); 1062 | substr($$image,0x10e,1)=chr($b); 1063 | 1064 | substr($$image,0x10f,1)=chr($first_sect & 255); 1065 | 1066 | substr($$image,$first_sect*256,length($data))=$data; 1067 | } 1068 | 1069 | sub add_file_to_ssd($$) 1070 | { 1071 | my ($image,$filename)=@_; 1072 | 1073 | die "$filename is not a file!\n" unless -f $filename; 1074 | my $fh=new FileHandle "< $filename"; 1075 | die "Can not open $filename: $!\n" unless $fh; 1076 | binmode($fh); 1077 | my $data; 1078 | sysread($fh,$data,$DiskSize+3); # This will always be too large. 1079 | close($fh); 1080 | 1081 | my $fname=$filename; 1082 | $fname=~s!^.*/!!; 1083 | $fname="\$.$fname" unless $fname=~/^.\./; 1084 | $fname=substr($fname,0,9); 1085 | 1086 | my $load=0; 1087 | my $exec=0; 1088 | my $locked=0; 1089 | 1090 | # If there's an INF file, get that information 1091 | if ( -f "$filename.inf" ) 1092 | { 1093 | $fh=new FileHandle "< $filename.inf"; 1094 | die "Can not open $filename.inf: $!\n" unless $fh; 1095 | my $line=<$fh>; chomp($line); 1096 | close($fh); 1097 | ($fname,$load,$exec,$locked)=split(/\s+/,$line); 1098 | die "Bad load address $load for $filename\n" unless $load=~/^[0-9A-Fa-f]+$/; 1099 | die "Bad exec address $exec for $filename\n" unless $exec=~/^[0-9A-Fa-f]+$/; 1100 | $load=hex("0x$load"); 1101 | $exec=hex("0x$exec"); 1102 | $locked="" unless $locked; 1103 | $locked=($locked =~ /Locked/i)?1:0; 1104 | } 1105 | 1106 | add_content_to_ssd($image,$fname,$data,$load,$exec,$locked,$filename); 1107 | } 1108 | 1109 | sub print_cat(%) 1110 | { 1111 | my (%files)=@_; 1112 | 1113 | printf "Disk title: %s (%d) Disk size: &%03X - %s\n", 1114 | $files{""}{title}, 1115 | $files{""}{cycle}, 1116 | $files{""}{disk_size}, 1117 | BeebUtils::DiskSize($files{""}{disk_size}); 1118 | 1119 | my $count=$files{""}{filecount}-$files{""}{deleted}; 1120 | printf "Boot Option: %s (%s) File count: %d\n", $files{""}{opt4}, 1121 | BeebUtils::BootOpt($files{""}{opt4}), $count; 1122 | 1123 | my $chain=$files{""}{chain}; 1124 | printf("(Multi-catalogues; last at &%02X)\n",$files{""}{last_cat}) if $chain; 1125 | 1126 | delete($files{""}); 1127 | 1128 | print "\n"; 1129 | print "Filename: Lck Lo.add Ex.add Length Sct"; 1130 | print " Cat" if $chain; 1131 | print "\n"; 1132 | foreach (sort { $files{$b}{start} <=> $files{$a}{start} } keys %files) 1133 | { 1134 | next unless $files{$_}{name}; 1135 | my $n=$files{$_}{name} . (" "x10); $n=substr($n,0,10); 1136 | printf "%10s %s %06X %06X %06X %03X", 1137 | $n, 1138 | ($files{$_}{locked}?"L":" "), 1139 | $files{$_}{load}, 1140 | $files{$_}{exec}, 1141 | $files{$_}{size}, 1142 | $files{$_}{start}; 1143 | printf(" %03X",$files{$_}{cat_sector}) if $chain; 1144 | print "\n"; 1145 | } 1146 | } 1147 | 1148 | # Delete a file from a catalogue 1149 | sub delete_file($$$) 1150 | { 1151 | my ($force,$filename,$image)=@_; 1152 | if (!$force) 1153 | { 1154 | print "Delete? $filename (Y/N) "; 1155 | my $x=; 1156 | return unless $x=~/^Y/i; 1157 | } 1158 | my %cat=read_cat($image); 1159 | 1160 | foreach (0..$CatalogueMaxFiles-1) 1161 | { 1162 | if ($filename eq $cat{$_}{name}) 1163 | { 1164 | my $start=8+8*$_; 1165 | my $len=256-$start; 1166 | substr($$image,$start,$len)=substr($$image,$start+8,$len); 1167 | substr($$image,256+$start,$len)=substr($$image,256+$start+8,$len); 1168 | substr($$image,248,8)="\0" x 8; 1169 | substr($$image,256+248,8)="\0" x 8; 1170 | my $nfiles=ord(substr($$image,256+5,1))-8; 1171 | substr($$image,256+5,1)=chr($nfiles); 1172 | print "Deleted $filename\n" if $force; 1173 | last; 1174 | } 1175 | } 1176 | } 1177 | 1178 | # Does the given filename match a wildcard(array) 1179 | sub filename_compare($@) 1180 | { 1181 | my ($filename,@matches)=@_; 1182 | 1183 | foreach (@matches) 1184 | { 1185 | my $x=$_; 1186 | $x = '$.' . $x unless $x=~/^.\./; 1187 | # Convert BBC filepattern to regex 1188 | $x=~s/\./\\./g; 1189 | $x=~s/#/./g; 1190 | $x=~s/\*/.*/g; 1191 | $x=~s/\$/\\\$/g; 1192 | # print "Compare $filename to $x\n"; 1193 | return 1 if ($filename =~ /^$x$/i); 1194 | } 1195 | return 0; 1196 | } 1197 | 1198 | sub delete_files($$@) 1199 | { 1200 | my ($force,$image,@fspec)=@_; 1201 | 1202 | my %files=BeebUtils::read_cat($image); 1203 | 1204 | die "Can not operate on large/multi-catalogue disks\n" if $files{""}{chain}; 1205 | delete $files{""}; 1206 | 1207 | # Make a hash-tree out of the files we want to delete 1208 | my %to_del; 1209 | foreach (@fspec) 1210 | { 1211 | # Put files into "$." if no library specified 1212 | $to_del{$_}=1; 1213 | } 1214 | 1215 | my $matched=0; 1216 | foreach (keys %files) 1217 | { 1218 | if (filename_compare($files{$_}{name},keys %to_del)) 1219 | { 1220 | $matched=1; 1221 | if ($files{$_}{locked}) 1222 | { 1223 | print "$files{$_}{name} Locked\n"; 1224 | } 1225 | else 1226 | { 1227 | delete_file($force,$files{$_}{name},$image); 1228 | } 1229 | } 1230 | } 1231 | 1232 | if ($matched) 1233 | { 1234 | write_ssd($image,$BBC_FILE); 1235 | } 1236 | else 1237 | { 1238 | print "No files matched\n" unless $matched; 1239 | } 1240 | } 1241 | 1242 | sub lock_files($$$) 1243 | { 1244 | my ($filename,$lock,$image)=@_; 1245 | 1246 | my %files=BeebUtils::read_cat($image); 1247 | 1248 | die "Can not operate on large/multi-catalogue disks\n" if $files{""}{chain}; 1249 | delete $files{""}; 1250 | 1251 | my $matched=0; 1252 | foreach (keys %files) 1253 | { 1254 | if (filename_compare($files{$_}{name},($filename))) 1255 | { 1256 | my $offset=$_*8+8+7; 1257 | my $dir=ord(substr($$image,$offset,1)); 1258 | if ($files{$_}{locked} && !$lock) 1259 | { 1260 | substr($$image,$offset,1)=chr($dir & 127); 1261 | $matched=1; 1262 | } 1263 | elsif ($lock && !$files{$_}{locked}) 1264 | { 1265 | substr($$image,$offset,1)=chr($dir | 128); 1266 | $matched=1; 1267 | } 1268 | } 1269 | } 1270 | 1271 | if ($matched) 1272 | { 1273 | write_ssd($image,$BBC_FILE); 1274 | } 1275 | else 1276 | { 1277 | print "No files matched\n" unless $matched; 1278 | } 1279 | } 1280 | 1281 | sub compact_ssd($) 1282 | { 1283 | my ($image)=@_; 1284 | my %files=read_cat($image); 1285 | die "Can not operate on large/multi-catalogue disks\n" if $files{""}{chain}; 1286 | die "Can only operate on 200Kb disks\n" if $files{""}{disk_size} != 0x320; 1287 | my $cnt=$files{""}{filecount}-1; 1288 | delete $files{""}; 1289 | 1290 | my $freesect=2; 1291 | my $changed=0; 1292 | foreach (reverse (0..$cnt)) 1293 | { 1294 | my $thissect=$files{$_}{start}; 1295 | my $len=$files{$_}{size}; 1296 | # Convert to sectors; 1297 | $len=int($len/256)+(($len%256)?1:0); 1298 | 1299 | if ($thissect != $freesect) 1300 | { 1301 | ## printf "Moving $files{$_}{name} (%04X) from %03X to %03X\n",$len,$thissect,$freesect; 1302 | substr($$image,$freesect*256,$len*256)=substr($$image,$thissect*256,$len*256); 1303 | 1304 | # Now we need calculate the new byte6/7 for this entry. We 1305 | # know this is a 200Kb disk and so Acorn standard, so no complications 1306 | # from Solidisk! 1307 | my $b6=ord(substr($$image,256+8+$_*8+6,1)) & 0xfc; 1308 | $b6 |= ($freesect >> 8); 1309 | my $b7=$freesect & 255; 1310 | substr($$image,256+8+$_*8+6,2)=chr($b6).chr($b7); 1311 | $changed=1; 1312 | } 1313 | $freesect+=$len; 1314 | } 1315 | return ($changed); 1316 | } 1317 | 1318 | sub rename_file($$$) 1319 | { 1320 | my ($image,$old_name,$new_name)=@_; 1321 | my %files=read_cat($image); 1322 | die "Can not operate on large/multi-catalogue disks\n" if $files{""}{chain}; 1323 | die "Can only operate on 200Kb disks\n" if $files{""}{disk_size} != 0x320; 1324 | die "Names are same\n" if $old_name eq $new_name; 1325 | 1326 | $old_name = '$.' . $old_name unless $old_name=~/^.\./; 1327 | $new_name = '$.' . $new_name unless $new_name=~/^.\./; 1328 | $old_name=substr($old_name,0,9); 1329 | $new_name=substr($new_name,0,9); 1330 | 1331 | my $cnt=$files{""}{filecount}-1; 1332 | my $changed=0; 1333 | 1334 | # does the new name already exist? 1335 | foreach (0..$cnt) 1336 | { 1337 | die "File already exists\n" if lc($files{$_}{name}) eq lc($new_name); 1338 | } 1339 | 1340 | foreach (0..$cnt) 1341 | { 1342 | next unless $files{$_}{name} eq $old_name; 1343 | 1344 | die "File locked\n" if $files{$_}{locked}; 1345 | 1346 | my $name=substr($new_name . " ",2,7); # skip directory 1347 | my $dir=substr($new_name,0,1); 1348 | 1349 | substr($$image,8+$_*8,8)=$name . $dir; 1350 | $changed=1; 1351 | } 1352 | 1353 | if ($changed) 1354 | { 1355 | write_ssd($image,$BBC_FILE); 1356 | } 1357 | else 1358 | { 1359 | print "File not found.\n"; 1360 | } 1361 | } 1362 | 1363 | sub opt4($$) 1364 | { 1365 | my ($image,$val)=@_; 1366 | 1367 | # We mangle byte 0x106 1368 | my $b=0x106; 1369 | 1370 | # Existing value 1371 | my $v=ord(substr($$image,$b,1)); 1372 | 1373 | # Mask out old value 1374 | $v &= 0xCF; 1375 | 1376 | # Add new value 1377 | $v |= ($val << 4); 1378 | 1379 | # Update image 1380 | substr($$image,$b,1)=chr($v); 1381 | } 1382 | 1383 | sub check_and_set_type($) 1384 | { 1385 | my ($type)=@_; 1386 | 1387 | if ($type =~ /solidisk|stl/i) { $SOLIDISK=1; } 1388 | elsif ($type =~ /watford/i) { $WATFORD=1; } 1389 | elsif ($type =~ /opus|ddos/i) { $OPUS=1; } 1390 | elsif ($type =~ /diskdoctor|discdoctor/i) { $DISK_DOCTOR=1; } 1391 | elsif ($type !~ /acorn/i) { print "Unknown DFS $type\n"; exit(-1); } 1392 | } 1393 | 1394 | my $dfs=$ENV{BEEB_UTILS_DFS}; 1395 | 1396 | if (!defined($dfs) && defined($ENV{HOME}) && -f "$ENV{HOME}/.beeb_utils_dfs") 1397 | { 1398 | my $fh=new FileHandle "<$ENV{HOME}/.beeb_utils_dfs"; 1399 | if ($fh) 1400 | { 1401 | $dfs=<$fh>; chomp($dfs); 1402 | } 1403 | } 1404 | 1405 | if ($dfs) 1406 | { 1407 | $dfs="acorn:$dfs" unless $dfs=~/:/; 1408 | my ($type,$file)=split(/:/,$dfs); 1409 | $DEFAULT_BBC_FILE=$file if $file; 1410 | check_and_set_type($type); 1411 | } 1412 | 1413 | our $PROG=$0; $PROG=~s!^.*/!!; $PROG=~s/\.pl$//; 1414 | 1415 | 1; 1416 | --------------------------------------------------------------------------------