#!perl -w
use strict;
$|=1;
use Getopt::Long;
use IO::File;

# this requires a patch to Win32::API, which can be found at
#   http://www.xs4all.nl/~itsme/projects/perl/Win32-API-0.41-wj2.tar.gz
use Win32::API;

my $g_doprint= 0;
my $g_savedir;

# CEDecompress is to be used for wince3.x roms
# CEDecompressROM is to be used for wince4.x roms
#
# problem is that this call sometimes crashes the app.
# 
#
#my $g_decompress= Win32::API->new("CECompress.dll", "CEDecompress", "PNPNNNN", "N", "_cdecl")
my $g_decompress= Win32::API->new("CECompress.dll", "CEDecompressROM", "PNPNNNN", "N", "_cdecl")
     or die "error importing CEDecompress: $!\n";

GetOptions(
    "d:s"=> \$g_savedir,
) or die usage();

sub usage {
    return <<__EOF__
Usage: dumpxip.pl -o baseoffet [-l length] [-d savedir] [-s fileseek] romfile
__EOF__
}

my $g_filename= shift or die "no filename";

die "$g_filename not found\n" if (!-e $g_filename);

my $g_data= ReadFile($g_filename);

my $rom= ROM->new($g_data);
my $mem= MemSpace->new();
my $xipblocks= XipBlock::FindXipBlocks($rom);

# [0x00000000, 0x10078000], [0x00100000, 0x80000000], [0x00900000, 0x82040000], [0x015c0000, 0x82d00000], [0x01640000, 0x82d80000], [0x01940000, 0x83080000] 
for ( @$xipblocks ) {
    $rom->setbase($_->{ofs}, $_->{base});
    $mem->setvbase($_->{ofs}, $_->{base});
    my $xip= XipBlock->new($rom, $mem, $_->{base});

    $xip->ParseXipBlock();
    $xip->SaveFiles($g_savedir) if ($g_savedir);
    $xip->DumpInfo();
}
$mem->pfillblanks($rom, 0, $rom->{size});
$mem->print();
print "finished\n";
exit(0);

sub ReadFile {
    my $fn= shift;
    my $ofs= shift || 0;
    my $len= shift || (-s $fn)-$ofs;
    my $data;
    my $fh= IO::File->new($fn, "r") or die "$fn: $!";
    binmode $fh;
    $fh->seek($ofs, SEEK_SET);
    $fh->read($data, $len);
    $fh->close();

    return $data;
}

#############################################################################
#############################################################################
package XipBlock;

sub new {
    my $class= shift;
    my $rom= shift;
    my $mem= shift;
    my $start= shift;

    return bless { xipstart=>$start, rom=>$rom, mem=>$mem }, $class;
}
sub ParseXipBlock {
    my $self= shift;

    my $rom= $self->{rom};
    my $mem= $self->{mem};

    if ($rom->GetDword($self->{xipstart}+0x40) != 0x43454345) {
        die "ECEC signature not found\n";
    }

    my $romhdrofs= $rom->GetDword($self->{xipstart}+0x44);
    $mem->vadd($self->{xipstart}+0x40, 8, "ECEC signature + romhdr ptr");
    my $romhdr= $self->{romhdr}= $self->ParseRomHdr($rom->GetVData($romhdrofs, 0x54));

    $mem->vadd($romhdrofs, 0x54, $romhdr->{desc});
    my $modlistofs= $romhdrofs+ 0x54;
    my $modules= $self->{modules}= $self->ParseModulesList($rom->GetVData($modlistofs, 0x20*$romhdr->{nummods}));
    $mem->vadd($modlistofs, 0x20*$romhdr->{nummods}, "modules list, %d modules", $romhdr->{nummods});
    $_->{filename}= $rom->GetString($_->{lpszFileName}) for (@$modules);

    my $filesofs= $modlistofs + 0x20*$romhdr->{nummods};
    my $files= $self->{files}= $self->ParseFilesList($rom->GetVData($filesofs, 0x1c*$romhdr->{numfiles}));
    $mem->vadd($filesofs, 0x1c*$romhdr->{numfiles}, "files list, %d files", $romhdr->{numfiles});
    $_->{filename}= $rom->GetString($_->{lpszFileName}) for (@$files);

    if ($romhdr->{ulCopyEntries}) {
        $self->{copylist}= $self->ParseCopyList($rom->GetVData($romhdr->{ulCopyOffset}, 0x10*$romhdr->{ulCopyEntries}));
        $mem->vadd($romhdr->{ulCopyOffset}, 0x10*$romhdr->{ulCopyEntries}, "copy list, %d entries", $romhdr->{ulCopyEntries});
    }
    else {
        $self->{copylist}= [];
    }

    $self->AddModuleHeaders($_) for (@{$modules});

    $self->ParseExtensions($romhdr->{pExtensions});
}
sub ParseExtension {
    my $self= shift;
    my $data= shift;
    my @fields= unpack("A24V5", $data);
    my @names= qw(name type pdata length reserved pNextExt);
    my @fmt= qw(%s %08lx %08lx %08lx %08lx %08lx);
    return  {
        desc=>sprintf("extension: %s", join ", ", map { sprintf("%s:$fmt[$_]", $names[$_], $fields[$_]) } (0..$#names)),
        map { ( $names[$_] => $fields[$_] ) } (0..$#names)
    };
}
sub ParseExtensions {
    my ($self, $extptr)= @_;

    while ($extptr) {
        last if (!$self->{rom}->IsInRange($extptr));

        my $ext= $self->ParseExtension($self->{rom}->GetVData($extptr, 44));
        $self->{mem}->vadd($extptr, 44, $ext->{desc});
        $self->{mem}->vadd($ext->{pdata}, $ext->{length}, "data for extension %s: %s", $ext->{name},
            join(",", map { sprintf("%08lx", $_); } unpack("V*", $self->{rom}->GetVData($ext->{pdata}, $ext->{length})))
        ) if ($ext->{pdata});


        $extptr= $ext->{pNextExt};
    }
}
sub SaveFiles {
    my $self= shift;
    my $savedir= shift;

    return if (!$savedir);
    die "$savedir does not exist\n" if (!-d $savedir);

    print "saving files\n";
    $self->SaveFile($_, $savedir) for (@{$self->{files}});
    #print "saving modules\n";
    #$self->SaveModule($_, $savedir) for (@{$self->{modules}});
}
sub DumpInfo {
    my $self= shift;
    $self->DumpFilesAreas();
    $self->DumpModulesAreas();

    $self->{mem}->vfillblanks($self->{rom}, $self->{romhdr}{physfirst}, $self->{romhdr}{physlast});
    #$self->{mem}->print();
}

sub ParseRomHdr {
    my $self= shift;
    my $data= shift;
    my @fields= unpack("V17v2V3", $data);
    my @names= qw(dllfirst dlllast physfirst physlast nummods ulRAMStart ulRAMFree ulRAMEnd ulCopyEntries ulCopyOffset ulProfileLen ulProfileOffset numfiles ulKernelFlags ulFSRamPercent ulDrivglobStart ulDrivglobLen usCPUType usMiscFlags pExtensions ulTrackingStart ulTrackingLen);
    return  {
        desc=>sprintf("romhdr : %s", join ", ", map { sprintf("%s:%08lx", $names[$_], $fields[$_]) } (0..$#names)),
        map { ( $names[$_] => $fields[$_] ) } (0..$#names)
    };
}
sub ParseModulesList {
    my $self= shift;
    my $data= shift;
    my @modules;

    my $i;
    for ($i= 0 ; $i<length($data) ; $i+=0x20) {
        push @modules, ParseModuleEntry(substr($data, $i, 0x20), sprintf("module entry %d", $i/0x20));
    }
    if ($i!=length($data)) {
        warn "uneven modules list\n";
    }

    return \@modules;
}
sub ParseModuleEntry {
    my $data= shift;
    my $desc= shift;
    my @fields= unpack("V8", $data);
    my @names= qw(dwFileAttributes ftTime_high ftTime_low nFileSize lpszFileName ulE32Offset ulO32Offset ulLoadOffset);
    return  {
        desc=>sprintf("%s : %s", $desc, join ", ", map { sprintf("%s:%08lx", $names[$_], $fields[$_]) } (0..$#names)),
        map { ( $names[$_] => $fields[$_] ) } (0..$#names)
    };
}
sub ParseFilesList {
    my $self= shift;
    my $data= shift;
    my @files;

    my $i;
    for ($i= 0 ; $i<length($data) ; $i+=0x1c) {
        push @files, $self->ParseFilesEntry(substr($data, $i, 0x1c), sprintf("files entry %d", $i/0x1c));
    }
    if ($i!=length($data)) {
        warn "uneven files list\n";
    }

    return \@files;
}
sub ParseFilesEntry {
    my $self= shift;
    my $data= shift;
    my $desc= shift;
    my @fields= unpack("V7", $data);
    my @names= qw(dwFileAttributes ftTime_high ftTime_low nRealFileSize nCompFileSize lpszFileName ulLoadOffset);
    return  {
        desc=>sprintf("%s : %s", $desc, join ", ", map { sprintf("%s:%08lx", $names[$_], $fields[$_]) } (0..$#names)),
        map { ( $names[$_] => $fields[$_] ) } (0..$#names)
    };
}
sub ParseCopyList {
    my $self= shift;
    my $data= shift;
    my @list;

    my $i;
    for ($i= 0 ; $i<length($data) ; $i+=0x10) {
        push @list, $self->ParseCopyEntry(substr($data, $i, 0x10), sprintf("copy entry %d", $i/0x10));
    }
    if ($i!=length($data)) {
        warn "uneven copy list\n";
    }

    return \@list;
}
sub ParseCopyEntry {
    my $self= shift;
    my $data= shift;
    my $desc= shift;
    my @fields= unpack("V4", $data);
    my @names= qw(ulSource ulDest ulCopyLen ulDestLen);
    return  {
        desc=>sprintf("%s : %s", $desc, join ", ", map { sprintf("%s:%08lx", $names[$_], $fields[$_]) } (0..$#names)),
        map { ( $names[$_] => $fields[$_] ) } (0..$#names)
    };
}
sub AddModuleHeaders {
    my $self= shift;
    my $module= shift;
    my $rom= $self->{rom};
    my $mem= $self->{mem};

    $module->{e32}= ParseE32Header($rom->GetVData($module->{ulE32Offset}, 0x6a));
    $mem->vadd($module->{ulE32Offset}, 0x6a, "e32 header %s", $module->{filename});

    for (1..$module->{e32}{e32_objcnt}) {
        push @{$module->{o32}}, ParseO32Header($rom->GetVData($module->{ulO32Offset}+($_-1)*0x18, 0x18));
    }
    $mem->vadd($module->{ulO32Offset}, 0x18*$module->{e32}{e32_objcnt}, "o32 headers %s", $module->{filename});
}
sub ParseE32Header {
    my $data= shift;
    my @fields= unpack("v2V2v2V4V18v", $data);
    my @names= qw(e32_objcnt e32_imageflags e32_entryrva e32_vbase e32_subsysmajor e32_subsysminor e32_stackmax e32_vsize e32_sect14rva e32_sect14size e32_unit_EXP_rva e32_unit_EXP_size e32_unit_IMP_rva e32_unit_IMP_size e32_unit_RES_rva e32_unit_RES_size e32_unit_EXC_rva e32_unit_EXC_size e32_unit_SEC_rva e32_unit_SEC_size e32_unit_FIX_rva e32_unit_FIX_size e32_unit_DEB_rva e32_unit_DEB_size e32_unit_IMD_rva e32_unit_IMD_size e32_unit_MSP_rva e32_unit_MSP_size e32_subsys);
    return  {
        map { ( $names[$_] => $fields[$_] ) } (0..$#names)
    };
}
sub ParseO32Header {
    my $data= shift;
    my @fields= unpack("V6", $data);
    my @names= qw(o32_vsize o32_rva o32_psize o32_dataptr o32_realaddr o32_flags);
    return  {
        map { ( $names[$_] => $fields[$_] ) } (0..$#names)
    };
}
sub DumpFilesAreas {
    my $self= shift;
    for (@{$self->{files}}) {
        my $desc= $_->{filename};
        $self->{mem}->vadd($_->{ulLoadOffset}, $_->{nCompFileSize}, "file data %s", $desc);
        $self->{mem}->vadd($_->{lpszFileName}, length($_->{filename})+1, "filename %s", $desc);
    }
}
sub DumpModulesAreas {
    my $self= shift;
    my $mem= $self->{mem};
    for (@{$self->{modules}}) {
        my $desc= $_->{filename};
        $mem->vadd($_->{lpszFileName}, length($_->{filename})+1, "filename %s", $desc);
        for (@{$_->{o32}}) {
            my $l= $_->{o32_psize}; $l= $_->{o32_vsize} if ($_->{o32_vsize}<$l);
            $mem->vadd($_->{o32_dataptr}, $l, "module data %s", $desc);
        }
    }
}
sub GetUniqueFilename {
    my ($dir, $filename)= @_;

    my $fn= "$dir/$filename";
    my $i= 1;
    while (-e $fn) {
        $fn= sprintf("%s/%s-%d", $dir, $filename, $i++);
    }

    return $fn;
}
sub GetUncompressedData {
    my ($rom, $ofs, $size, $fullsize, $compressed)= @_;

    my $data= $rom->GetVData($ofs, $size);
    if ($compressed) {
        my $decomp= " " x (($fullsize|4095)+4096+1);
        printf("decompressing %08lx L%08lx -> %08lx buf=%08lx\n", $ofs, $size, $fullsize,  ($fullsize|4095)+4096+1);
        print "  ", unpack("H*", substr($data, 0, 32)), "\n";
        my $res= $g_decompress->Call($data, length($data), $decomp, length($decomp), 0, 1, 4096);
        if ($res!=-1) {
            $data= substr($decomp, 0, $res);
        }
        else {
            printf("failed to decompress file\n");
        }
    }
    return $data;
}

sub IMAGE_SCN_COMPRESSED { 0x2000; }
sub FILE_ATTRIBUTE_COMPRESSED{ 0x0800; }
sub SaveFile {
    my $self= shift;
    my $rom= $self->{rom};
    my $file= shift;
    my $savedir= shift;

    print "saving file $file->{filename}\n";
    my $data= GetUncompressedData($rom, $file->{ulLoadOffset}, $_->{nCompFileSize}, $_->{nRealFileSize}, $_->{dwFileAttributes}&FILE_ATTRIBUTE_COMPRESSED);
    my $filename= GetUniqueFilename($savedir, $file->{filename});
    my $fh= IO::File->new($filename, "w+") or die "$filename: $!\n";
    binmode $fh;
    $fh->print($data);
    $fh->close();
}
sub SaveModule {
    my ($self, $module, $savedir)= @_;

    print "saving module $module->{filename}\n";
    my $exe= ExeFile->new();

    for (@{$module->{o32}}) {
        my $size= $_->{o32_vsize}; $size= $_->{o32_psize} if ($size>$_->{o32_psize});

        $_->{data}= GetUncompressedData($rom, $_->{o32_dataptr}, $size, $_->{o32_vsize}, $_->{o32_flags} & IMAGE_SCN_COMPRESSED);
        $exe->addo32($_);
    }
    $exe->adde32($module->{e32});

    my $filename= GetUniqueFilename($savedir, $module->{filename});

    $exe->SaveToFile($filename);
}

# ... these are class methods / static functions

# finds the rom header, which points back to the specified start offset.
sub FindRomHdr {
    my ($rom, $firstofs)= @_;
    my $hdrptr= $rom->GetPDword($firstofs+0x44);

    #printf("searching for header at ptr=%08lx from ofs=%08lx\n", $hdrptr, $firstofs+0x48);
    # search for romheader, starting directly after 'ECEC', until end of rom.
    for(my $hdrofs=$firstofs+0x48 ; $hdrofs < $rom->{size}-0x54 ; $hdrofs+=4)
    {
        my $firstptr= $rom->GetPDword($hdrofs+8);

        if ($hdrptr-$firstptr==$hdrofs-$firstofs) {
            #printf("found romheader at ptr:f=%08lx, h=%08lx  | ofs:f=%08lx, h=%08lx\n",
            #    $firstptr, $hdrptr, $firstofs, $hdrofs);

            return $hdrofs;
        }
    }
    return -1;
}
# finds the rom header, which points back to the specified start offset.
# this is optimized by looking for the cpuid
sub FindRomHdrByCpu {
    my $rom= shift;
    my $firstofs= shift;
    my $cpuid= pack("V",shift);
    my $hdrptr= $rom->GetPDword($firstofs+0x44);

    #printf("searching for cpuid in header at ptr=%08lx from ofs=%08lx\n", $hdrptr, $firstofs+0x48);
    # search for romheader, starting directly after 'ECEC', until end of rom.
    #   ( 0x48 = ofs directly ofter romhdr-ptr, 0x44 is ofs of cpuid in romhdr )
    my $ofs=$rom->find($cpuid, $firstofs+0x48+0x44);
    #   0x10 is size of rest of romhdr of cpuid.
    while ($ofs!=-1 && $ofs < $rom->{size}-0x10)
    {
        my $hdrofs= $ofs-0x44;
        my $firstptr= $rom->GetPDword($hdrofs+8);

        #print unpack("H*", $rom->GetPData($hdrofs, 0x50)), "\n";
        #printf(" cpuid at %08lx  ptr:f=%08lx, h=%08lx  | ofs:f=%08lx, h=%08lx\n",
        #    $ofs, $firstptr, $hdrptr, $firstofs, $hdrofs);

        if ($hdrptr-$firstptr==$hdrofs-$firstofs) {
            #printf("found romheader at ptr:f=%08lx, h=%08lx  | ofs:f=%08lx, h=%08lx\n",
            #    $firstptr, $hdrptr, $firstofs, $hdrofs);

            return $hdrofs;
        }

        $ofs=$rom->find($cpuid, $ofs+4);
    }
    return -1;
}
sub FindXipBlocks {
    my $rom= shift;

    my $cpuid;
    my @xiplist;
    my $ofs= 0;
    while ($ofs < $rom->{size}) {
        my $ececofs= $rom->find("ECEC", $ofs);
        last if ($ececofs==-1);

        my $firstofs= $ececofs-0x40;
        my $hdrptr= $rom->GetPDword($firstofs+0x44);
        my $hdrofs= $cpuid? FindRomHdrByCpu($rom, $firstofs, $cpuid) : FindRomHdr($rom, $firstofs);
        if ($hdrofs==-1) {
            $ofs= $ececofs+4;
        }
        else {
            my $firstptr= $rom->GetPDword($hdrofs+8);
            my $lastptr= $rom->GetPDword($hdrofs+12);
            $cpuid= $rom->GetPDword($hdrofs+68);
            my $lastofs= $lastptr-$hdrptr+$hdrofs;

            push @xiplist, { ofs=>$firstofs, len=>$lastptr-$firstptr, base=>$firstptr };

            $ofs= $lastofs+0x40;
        }
    }
    #printf("found %d xip blocks\n", scalar @xiplist);

    return \@xiplist;
}

#############################################################################
#############################################################################
package ROM;

sub new {
    my $class= shift;
    my $data= shift;
    my $base= shift;
    return bless { data=>$data, size=>length($data) }, $class;
}
sub setbase {
    my ($self, $dataofs, $base)= @_;

    $self->{base}= $base- $dataofs;
}
sub IsInRange {
    my ($self, $ofs)= @_;
    return $ofs-$self->{base}>=0 && $ofs-$self->{base}<$self->{size};
}
sub find {
    my ($self, $str, $ofs)= @_;
    return index($self->{data}, $str, $ofs);
}
sub GetDword {
    my ($self, $ofs)= @_;

    return unpack("V", $self->GetVData($ofs, 4));
}
# get data by virtual offset
sub GetVData {
    my ($self, $ofs, $len)= @_;
    return substr($self->{data}, $ofs-$self->{base}, $len)
}
# get data by physical offset
sub GetPData {
    my ($self, $ofs, $len)= @_;
    return substr($self->{data}, $ofs, $len)
}
# get dword by physical offset
sub GetPDword {
    my ($self, $ofs)= @_;
    return unpack("V", $self->GetPData($ofs, 4));
}

sub GetString {
    my ($self, $ofs)= @_;

    my $nulpos= $self->{base}+index($self->{data}, "\x00", $ofs-$self->{base});

    return $self->GetVData($ofs, $nulpos-$ofs);
}

#############################################################################
#############################################################################
package MemSpace;

sub new {
    return bless {}, shift;
}
sub setvbase {
    my ($self, $physical, $virtual)= @_;

    $self->{base}= $virtual - $physical;

    # virtualaddr = physical + base
}

# add region by virtual address.
sub vadd {
    my ($self, $vstart, $len, $fmt, @args)= @_;

    my $paddr= $vstart-$self->{base};
    push @{$self->{items}{$paddr}}, {
        pstart=>$paddr,
        vstart=>$vstart,
        len=>$len,
        desc=>sprintf($fmt, @args)
    };
}

# fill blanks in virtual region.
sub vfillblanks {
    my ($self, $rom, $first, $last)= @_;
    my $vprev;
    for my $pofs (sort {$a<=>$b} keys %{$self->{items}}) {
        my $vofs= $pofs+$self->{base};
        next if ($vofs<$first);
        last if ($vofs>$last);

        $self->vadd_unknown($rom, $first, $vofs-$first) if (!$vprev && $vofs>$first);
        $self->vadd_unknown($rom, $vprev, $vofs-$vprev) if ($vprev && $vofs>$vprev);
        my $maxlen;
        for (sort {$a->{len}<=>$b->{len}} @{$self->{items}{$pofs}}) {
            $maxlen= $_->{len} if (!defined $maxlen || $maxlen < $_->{len});
        }
        $vprev= $vofs+$maxlen;
    }

    $self->vadd_unknown($rom, $vprev, $last-$vprev) if ($vprev && $last > $vprev);
}
sub vadd_unknown {
    my ($self, $rom, $start, $len)= @_;
    my $data= $rom->GetVData($start, $len);
    my $desc;
    if ($data =~ /^\x00+$/) {
        $desc= "NUL";
    }
    elsif ($data =~ /^\xff+$/) {
        $desc= "ONE";
    }
    else {
        if (length($data)>64) {
            $desc= "unknown-large: ".unpack("H*", substr($data, 0, 64));
        }
        else {
            $desc= "unknown: ".unpack("H*", $data);
        }

    }
    $self->vadd($start, $len, $desc);
}

# functions dealing with physical offsets.
sub padd {
    my ($self, $pstart, $len, $fmt, @args)= @_;

    push @{$self->{items}{$pstart}}, {
        pstart=>$pstart,
        len=>$len,
        desc=>sprintf($fmt, @args)
    };
}

# fill blanks in physical region.
sub pfillblanks {
    my ($self, $rom, $first, $last)= @_;

    my $pprev;
    for my $pofs (sort {$a<=>$b} keys %{$self->{items}}) {
        next if ($pofs<$first);
        last if ($pofs>$last);

        $self->padd_unknown($rom, $first, $pofs-$first) if (!$pprev && $pofs>$first);
        $self->padd_unknown($rom, $pprev, $pofs-$pprev) if ($pprev && $pofs>$pprev);
        my $maxlen;
        for (sort {$a->{len}<=>$b->{len}} @{$self->{items}{$pofs}}) {
            $maxlen= $_->{len} if (!defined $maxlen || $maxlen < $_->{len});
        }
        $pprev= $pofs+$maxlen;
    }

    $self->padd_unknown($rom, $pprev, $last-$pprev) if ($pprev && $last > $pprev);
}
# add unknown region by physical address
sub padd_unknown {
    my ($self, $rom, $start, $len)= @_;
    my $data= $rom->GetPData($start, $len);
    my $desc;
    if ($data =~ /^(\x00*)(\xff*)$/) {
        my $l_nul= length($1);
        my $l_one= length($2);
        $self->padd($start, $l_nul, "NUL") if ($l_nul);
        $self->padd($start+$l_nul, $l_one, "ONE") if ($l_one);
    }
    else {
        my $bofs= 0;
        pos($data)= $bofs;
        if ($data =~ /\G\x00+/) {
            if (length($&)>16) {
                $self->padd($start+$bofs, length($&), "NUL");
                $bofs += length($&);
            }
        }
        pos($data)= $bofs;
        if ($data =~ /\G\xff+/) {
            if (length($&)>16) {
                $self->padd($start+$bofs, length($&), "ONE");
                $bofs += length($&);
            }
        }
        my $eofs= length($data);
        pos($data)= $eofs;
        if ($data =~ /\xff+\G/) {
            if (length($&)>16) {
                $eofs -= length($&);
                if ($eofs>$bofs) {
                    $self->padd($start+$eofs, length($&), "ONE");
                }
            }
        }
        pos($data)= $eofs;
        if ($data =~ /\x00+\G/) {
            if (length($&)>16) {
                $eofs -= length($&);
                if ($eofs>$bofs) {
                    $self->padd($start+$eofs, length($&), "NUL");
                }
            }
        }
        if ($eofs-$bofs>64) {
            $desc= "unknown-large: ".unpack("H*", substr($data, $bofs, 64));
        }
        else {
            $desc= "unknown: ".unpack("H*", substr($data, $bofs, $eofs-$bofs));
        }
        $self->padd($start+$bofs, $len, $desc);

    }
}

sub print {
    my $self= shift;
    my $prev;
    for my $pofs (sort {$a<=>$b} keys %{$self->{items}}) {
        if ($prev && $pofs>$prev) {
            printf("%08lx-%08lx L%08lx  unknown\n", $prev, $pofs, $pofs-$prev);
        }
        elsif ($prev && $pofs<$prev) {
            printf("%08lx-%08lx L%08lx  overlap!!\n", $pofs, $prev, $prev-$pofs);
        }
        my $maxlen;
        for (sort {$a->{len}<=>$b->{len}} @{$self->{items}{$pofs}}) {
            $maxlen= $_->{len} if (!defined $maxlen || $maxlen < $_->{len});

            # ... not printing information from blanks.
            if ($_->{desc} eq "NUL" || $_->{desc} eq "ONE") {
                next;
            }

            if (exists $_->{vstart}) {
                printf("%08lx-%08lx | %08lx-%08lx L%08lx %s\n", 
                    $_->{pstart}, $_->{pstart}+$_->{len},
                    $_->{vstart}, $_->{vstart}+$_->{len},
                    $_->{len}, $_->{desc});
            }
            else {
                printf("%08lx-%08lx  L%08lx %s\n", 
                    $_->{pstart}, $_->{pstart}+$_->{len},
                    $_->{len}, $_->{desc});
            }
        }
        $prev= $pofs+$maxlen;
    }
}

#############################################################################
#############################################################################
package ExeFile;

sub new {
    return bless {}, shift;
}
sub addo32 {
    my ($self, $o32)= @_;
    push @{$self->{romo32}}, $o32;
}
sub adde32 {
    my ($self, $e32)= @_;
    $self->{rome32}= $e32;
}
sub SaveToFile {
    my ($self, $fn)= @_;

    my $fh= IO::File->new($fn, "w+") or die "$fn: $!\n";

    # todo: finish this.

    $fh->close();
}