#!/usr/bin/perl 
# copy a X1210 or X1215 disk to an SD-card image -- version 0.2 -- date Jan 09 01 2012
#
# The sectors on the p800 disk have a size of 205 16 bit words = 410 bytes
# Sectors on an SD card have a size of 512 bytes (like all disk media of a PC)
# When a p800 is simulated on a PC, the disk is contained in a file, and
# file management on the PC enables easy access to the p800 disk sectors in
# the file.
# However when the p800 is emulated with an FPGA, with the p800 disk on an
# SD-card, no file management is available. The disk control unit implemented
# in the FPGA must have easy access to the p800 disk sectors on the SD-card.
# To enable that easy access, each p800 disk sector is written to a SD-card 
# sector. The 410 bytes of the disk sector are put in the SD-card sector and 
# the remaining 102 bytes are filled with FF.
#
# This program transforms a file representing a X1215 or X1210 diskpack into 
# a file representing that diskpack on the SD-card. The resulting .sdi file
# will contain the number of sectors of a X1215 disk (6528). For a X1210
# pack, which contains 6496 sectors, the last 32 sectors are filled with 0.
#
# usage: p8disk2sdi.pl <X1215/10packfilename>.img
# 
# In order to use the converted image with the P800 implementation on the
# fpga, 4 images must be joint together in a file (an .sdm file).
# This file has a format recognized by the fpga implementation and contains
# a header sector, 4 .sdi images and a trailer sector. The header sector,
# images and the trailer are located at a fixed offset in the .sdm file.

use strict;
use bytes;
my $DEBUG = 1;
my $version = 0.2;
###############################################################
# disk pack parameters
my $cyls  = 204;  # number of tracks per side = number of cylinders
my $heads = 2;    # number of heads
my $spt   = 16;   # number of sectors per track
my $lsec  = 205;  # sector length is 205 16 bit words
#
my $cyl;          # working variable
my $head;         # working variable
my $sector;       # working variable
################################################################ Each sector consists of 205 16 bit data words, 5 overhead and 200 for user data.
# Sector format:
use constant IDENT => 0x0; # word 1 is the sector identifier
use constant SEQM  => 0x2; # word 2 is for sequential file admin
use constant REC   => 0x4; # word 3 is start of the data part
#   xxxxxxxx 2 header words (word 1 and word 2)
#   xxxxxxxx 200 data words (starts with word 3)
#   xxxxxxxx 3   reserved words
#
# Word-1, the sector identifier containes the cylinder number to check the seek 
# operation.
# Of all known disk units supported by the P800 family of minicomputers, the
# maximum number of cylinders was 512, so this identifier needs 9 bits.
#
# Physical sectors in a track are consecutive, logical sectors not.
# The system software uses always logical sectors; mapping in a track is
# as follows (for the X1210/X1215):
#
# physical sector  logical sector
#    sector 0   <->   sector 0
#    sector 1   <->   sector 11
#    sector 2   <->   sector 6
#    sector 3   <->   sector 1
#    sector 4   <->   sector 12
#    sector 5   <->   sector 7
#    sector 6   <->   sector 2
#    sector 7   <->   sector 13
#    sector 8   <->   sector 8
#    sector 9   <->   sector 3
#    sector 10  <->   sector 14
#    sector 11  <->   sector 9
#    sector 12  <->   sector 4
#    sector 13  <->   sector 15
#    sector 14  <->   sector 10
#    sector 15  <->   sector 5
#
# physical-sector-in-track = remainder( modulo-16 (logical-sector-in-track * 3))
#
# For the X1210/X1215 the format of the sector identifier is as follows:
# 0000000 xxxxxxxxx
#                 ^
#                 cylinder
#                 0..203 (0..202 on X1210)
#
# Disk space allocation
# Space on disk is allocated dynamically. Space on disk is organized therefore
# in socalled granules, where each granule is 8 consecutive (logical) sectors. 
# The granule is the unit of space allocation to a file. Space allocation to a 
# file is maintained in an allocation table of 200 entries in the file, one 
# entry for each allocated granule. This limits the maximum file length to 
# 200*8 sectors of 400 bytes = 640 kbytes. The allocation table takes 
# sector 1 of the file (sector 0 is unused by the system)
#
my $n = $cyls*$heads*$spt;                # number of sectors on disk
my $g = int($n/8);                        # number of granules
#
# An X1210 disk contains 203 * 2 * 16 = 6496 sectors
# An X1215 disk contains 204 * 2 * 16 = 6528 sectors
# An X1210/X1215 disk contains 6496/8 = 812  granules
# (to maintain software compatibility between the X1210 and X1215 disk,
#  the last cylinder of the X1215 disk is not used)
#
# In the global disk space allocation table, each granule is represented by a
# bit. For the X1210/15, 102 bytes (= 816 bits) are required to administrate
# the 812 granules (102 bytes = 66 hex bytes).
# The disk allocation table is located in sector 0 of the disk, together
# with the volume administration data of the volume: the "volume label"
my $dbuf1="";                             # diskbuffer 1
my $dbuf2="";                             # diskbuffer 2
my $pos;
my $readerror=0;
my $formaterror=0;
my $seekerror=0;
my $error=0;
my $si;                                   # sector byte (while reading) 0-409
########################################################
print "Convert P800 X1210/X1215 disk to an SD-card image, version $version\n";

my $file = shift (@ARGV);
my $ty;

if ($file eq "" || $file !~ /\.img/)
{
    print "No filename, or wrong .img extention\n";
    exit;
}

if( -e $file)
{
	open (IN,$file) || die "cannot open disk image file $file: $!";
	print "Verify moving head disk pack: $file\n";
}
else
{
    print "Disc image $file not existing\n";
	exit;
}

my $outfile;
($outfile,$ty) = split(/\./, $file);
$outfile=$outfile . ".sdi";

################################################

print "Verify the sector identifiers.\n";
open (IN,$file) || die "cannot open disk image file $file: $!";
my $i=0;
while($i < $n)
{
	readlsector($i,1,0); # $i is a logical disk sector number (0..$n)
	if($seekerror || $formaterror || $readerror)
	{
		if($seekerror || $readerror)
		{
			# end of disk image (X1210)
			last;
		}
		if($formaterror)
		{
			# wrong disk 
			print "Error: wrong disk image\n";
			exit;
		}
	}
	$i=$i+1;
}
print "$i sector identifiers verified.\n";
$n=$i;
print "The disk image has $n sectors\n"; 
my $j=0;
my $k=0;
$i=0;

print "Convert $file to the SD-card image $outfile\n";
open (OUT,">:raw", $outfile) || die "cannot open ouputfile $outfile: $!";
while($i < $n && $error == 0)
{
        # copy a sector
        readpsector($i,1,0); # $i is a physical disk sector number (0..$n)
	$si=0; # sector byte index
        $j=0;
        while($j<205)
        {
            writeword(rw1()); # copy 16-bit word
            $j=$j+1;
        }
        # fill the other 51 16-bit words of the SD-card sector with FFFF
        $j=0;
        while($j<51)
        {
            writeword(0xFFFF);
            $j=$j+1;
        }
        # sector ready
        $i=$i+1;
}
if($error==0)
{
	print "$i sectors copied\n";
	while($i < 6528)
	{
        	$j=0;
        	while($j<256)
        	{
			writeword(0);
			$j=$j+1;
		}
        	# sector ready
        	$i=$i+1;
        	$k=$k+1;
	}
	print "$k slack sectors written\n";
	print "SD-card file image ready, $i sectors written\n";
}
close (IN)   || die "can't close $file: $!";
close (OUT)  || die "can't close $outfile: $!";


###################################################
# convert a logical sector number in track to a physical sector number in track
sub secphys {
	my $sl = shift;
	$sl=$sl*3;
	if($sl > 16)
	{
		$sl=$sl-16;
		if($sl > 16)
		{
			$sl=$sl-16;
		}
	}
	return $sl;
}

# read a logical disk sector into buffer (1 or 2) dbuf (0..6527)
sub readlsector {
	my $s    = shift;              # logical disk sector number
	my $buff = shift;              # buffer to use (1 or 2) for readin
	my $bool = shift;              # if 1 print diagnostics
    	my $c = int($s/($spt*$heads)); # cylinder
	my $r = $s%($spt*$heads);
	my $h = int($r/$spt);          # head
	my $l = $r%$spt;               # logical sector
	my $p = secphys($l);           # physical sector    
	my $w1;
    	#print " [readsec S:$s C:$c H:$h L:$l PS:$p]\n";   
	$pos = $c*$spt*$heads*$lsec*2 + $h*$spt*$lsec*2 + $p*$lsec*2;
	if(sysseek(IN, $pos, 0) ne undef)
	{
		if($buff==1)
		{
			if(sysread(IN, $dbuf1, $lsec*2) != $lsec*2)
			{
				print "Readsector: Disk read error while reading sector $s\n";
				$readerror=1;
			}	
			$w1 = unpack("C", substr($dbuf1,0,1)) << 8;
			$w1 = $w1 | unpack("C", substr($dbuf1,1,1));
		}
		elsif($buff==2)
		{
			if(sysread(IN, $dbuf2, $lsec*2) != $lsec*2)
			{
				print "Readsector: Disk read error while reading sector $s\n";
				$readerror=1;
			}	
			$w1 = unpack("C", substr($dbuf2,0,1)) << 8;
			$w1 = $w1 | unpack("C", substr($dbuf2,1,1));
		}
		else
		{
			print "Readsector: Program error: wrong disk buffer number\n";
			exit;
		}
		my $dc = $w1 & 0x7FF;
		# added by premark.pl, but not on "real X1210/15 disc images:
		my $dh = $w1 >> 15;
		my $dp = ($w1 >> 11) & 0xF;
		
		# check the cylinder number
		if($c == $dc)
		{
			if($bool)
			{
				print "\nLogical sector $s [";
				print prhex(16,$s);
				print " hex ], sector ident is ok ($c);";
				print " track: cyl=$c, head:$h, physical sector:$p\n";
			}
		}
		else
		{
		  print "Disk format error: requested logical sector:$s [";
		  print prhex(16,$s);		  
		  print " hex ] => ident C=$c (H:$h L:$l P:$p).";
		  print " From disk provided identifier: ident C:$dc\n";
          	  $formaterror=1;
		}
	}
	else
	{
		print "Seek error while reading sector $s\n";
        	$seekerror=1;        
	}	
}

# read a physical disk sector into buffer (1 or 2) dbuf (0..6527)
sub readpsector {
	my $s    = shift;              # physical disk sector number
	my $buff = shift;              # buffer to use (1 or 2) for readin
	my $bool = shift;              # if 1 print diagnostics
    	my $c = int($s/($spt*$heads)); # cylinder
	my $r = $s%($spt*$heads);
	my $h = int($r/$spt);          # head
	my $p = $r%$spt;               # physical sector
	my $w1;
    	# print " [readsec S:$s C:$c H:$h PS:$p]\n";
	$pos = $c*$spt*$heads*$lsec*2 + $h*$spt*$lsec*2 + $p*$lsec*2;
	if(sysseek(IN, $pos, 0) ne undef)
	{
		if($buff==1)
		{
			if(sysread(IN, $dbuf1, $lsec*2) != $lsec*2)
			{
				print "Readsector: Disk read error while reading sector $s\n";
				exit;
			}	
			$w1 = unpack("C", substr($dbuf1,0,1)) << 8;
			$w1 = $w1 | unpack("C", substr($dbuf1,1,1));
		}
		elsif($buff==2)
		{
			if(sysread(IN, $dbuf2, $lsec*2) != $lsec*2)
			{
				print "Readsector: Disk read error while reading sector $s\n";
				exit;
			}	
			$w1 = unpack("C", substr($dbuf2,0,1)) << 8;
			$w1 = $w1 | unpack("C", substr($dbuf2,1,1));
		}
		else
		{
			print "Readsector: Program error: wrong disk buffer number\n";
			exit;
		}
		my $dc = $w1 & 0x7FF;
		# added by premark.pl, but not on "real X1210/15 disc images:
		my $dh = $w1 >> 15;
		my $dp = ($w1 >> 11) & 0xF;
		
		# check the cylinder number
		if($c == $dc)
		{
			if($bool)
			{
				print "\nPhysical sector $s [";
				print prhex(16,$s);
				print " hex ], sector ident is ok ($c);";
				print " track: cyl=$c, head:$h, physical sector:$p\n";
			}
		}
		else
		{
		  print "Disk format error: requested physical sector:$s [";
		  print prhex(16,$s);		  
		  print " hex ] => ident C=$c (H:$h P:$p).";
		  print " From disk provided identifier: ident C:$dc\n";
          	  $error=1;
		}
	}
	else
	{
		print "Seek error while reading sector $s\n";
        	$error=1;        
	}	
}

# get byte from diskbuffer 1
sub rb1
{
	$si=$si+1;
	return(unpack("C", substr($dbuf1,$si-1,1)));
}

# get word from diskbuffer 1
sub rw1
{
	my $w;
	$w=rb1() << 8;
	$w=$w | rb1();
	return $w;
}

sub writeword {
    my($w) = @_; # 16 bit word
    my $bl = ($w >> 8) & 0xFF;
    my $br = $w & 0xFF;
    my $byte=0;
    $byte = pack("C", $bl);
    print OUT $byte; # output left byte
    $byte = pack("C", $br);
    print OUT $byte; # output right byte	
}

sub prhex {
	# print hex
	# $n is number of bits
	# $v is value
	my $n = shift;
	my $v = shift;
	my $s;
	if($n == 0)
	{
		return "";
	}
	elsif($n<5)
	{
		$s = sprintf(" %01X", $v);	
	}
	elsif($n<9)
	{
		$s = sprintf(" %02X", $v);
	}
	elsif($n<13)
	{		
		$s = sprintf(" %03X", $v);
	}
	elsif($n<17)
	{		
		$s = sprintf(" %04X", $v);
	}
	elsif($n<21)
	{
		$s = sprintf(" %05X", $v);
	}
	elsif($n<25)
	{						
		$s = sprintf(" %06X", $v);
	}
	elsif($n<29)
	{		
		$s = sprintf(" %07X", $v);
	}
	elsif($n<33)
	{
		$s = sprintf(" %08X", $v);
	}
	# print "prhex: $s ";
	return $s;
}