DASM
DASMIO/Address.pm
Go to the documentation of this file.
00001 #!/usr/bin/perl -w
00002 ##
00003 # DCPU-16 assembler I/O functions for reading and writing address dumps.
00004 #
00005 # Address dumps consist of address prefixed word values, eg:
00006 # @code
00007 #   0000 : 1234
00008 # @endcode
00009 # or multiple word values:
00010 # @code
00011 #   0000 : 1234 5678 abce
00012 # @endcode
00013 #
00014 # Address dumps contain no symbols or relocation data. They are just text
00015 # dumps of the content.
00016 #
00017 # @file
00018 # @author Justin Fletcher
00019 #
00020 
00021 package DASMIO::Address;
00022 
00023 use DASM;
00024 
00025 
00026 ##
00027 # Create an object upon which we can work.
00028 #
00029 # @param[in] $proto  Prototype object, or this class's name
00030 # @param[in] $dasm   DASM object we're working on
00031 #
00032 # @return new object
00033 sub new
00034 {
00035     my $proto = shift;
00036     my $dasm  = shift;
00037     my $class = ref($proto) || $proto;
00038     my $self  = {};
00039 
00040     bless $self, $class;
00041     
00042     $self->{'dasm'} = $dasm;
00043     
00044     return $self;
00045 }
00046 
00047 
00048 ##
00049 # Identify whether we can handle reading or writing a given file
00050 # by its filename.
00051 #
00052 # @param[in]  $self     Address object
00053 # @param[in]  $filename Filename we're accessing
00054 # @param[in]  $type     'read' or 'write'
00055 #
00056 # @retval 1 if we can access it
00057 # @retval 0 if we cannot access it
00058 sub identify
00059 {
00060     my ($self, $filename, $type) = @_;
00061     
00062     if ($filename =~ /\.dump$/)
00063     {
00064         return 1;
00065     }
00066     
00067     return 0;
00068 }
00069 
00070 
00071 ##
00072 # List the extensions we support
00073 #
00074 # @param[in]  $self     Address object
00075 #
00076 # @return arrayref of extensions
00077 sub extensions
00078 {
00079     return [ 'dump' ];
00080 }
00081 
00082 
00083 ##
00084 # Read an address dump and populate our core.
00085 #
00086 # @param[in]  $self     Address object
00087 # @param[in]  $content  Content to parse
00088 # @param[in]  $filename File it came from
00089 sub read
00090 {
00091     my ($self, $content, $filename) = @_;
00092     my $dasm = $self->{'dasm'};
00093     
00094     my $pc = $dasm->{'pc'};
00095     for my $line (split /\n/, $content)
00096     {
00097         # Step to the next line for now that we're parsing it
00098         $dasm->stepline($pc++);
00099 
00100         if ($line =~ s/^\s*([0-9a-fA-F]+)\s*://)
00101         {
00102             # New base address at the front of the line
00103             
00104             $pc = hex($1);
00105             $dasm->setpc($pc);
00106             $dasm->stepline($pc++);
00107         }
00108         my @vals = split /\s+/, $line;
00109         for my $val (@vals)
00110         {
00111             next if ($val eq '');
00112             
00113             # Check that we only allow hex numbers, possibly prefixed by
00114             # 0x.
00115             if ($val =~ /^(0x)?[0-9a-fA-F]+$/)
00116             {
00117                 $dasm->storetopc(hex($val));
00118             }
00119             else
00120             {
00121                 $dasm->error("Cannot parse hex value '$val'");
00122             }
00123         }
00124     }
00125 }
00126 
00127 
00128 ##
00129 # Write an address dump from our core.
00130 #
00131 # In order to write an address dump, we need to force a resolve of all
00132 # of the symbols. If there are any symbols that cannot be resolved, that's
00133 # a fatal error - because they would write out as 0s.
00134 #
00135 # @param[in]  $self     Address object
00136 #
00137 # @return     Content to write
00138 sub write
00139 {
00140     my ($self) = @_;
00141     my $dasm = $self->{'dasm'};
00142     my $core = $dasm->{'core'};
00143     
00144     if ($dasm->resolve())
00145     {
00146         # everything was resolved
00147     }
00148     else
00149     {
00150         my %unresolved = reverse %{ $dasm->{'relocations'} };
00151         my $symbols = "Unresolved symbols:\n  " .
00152                       join "\n",
00153                         map {
00154                             "  $_"
00155                         } keys %unresolved;
00156         $dasm->error("Could not resolve all symbols to write out Address file\n$symbols");
00157     }
00158     
00159     my @content;
00160     my $row = "";
00161     my $lastaddress = 0;
00162     for my $address (sort { $a <=> $b } keys %$core)
00163     {
00164         my $value = $core->{$address};
00165         
00166         # We never write out hardware
00167         next if (ref $value ne '');
00168     
00169         # If we moved to a different address range (multiple of 8)
00170         # write out the row
00171         if ($row ne '' &&
00172             ($address & ~7) != ($lastaddress & ~7))
00173         {
00174             push @content, $row;
00175             $row = "";
00176         }
00177 
00178         # If this is the start of a line, put the address on the front
00179         if ($row eq '')
00180         {
00181             $row = sprintf "%04x :", $address;    
00182         }
00183         
00184         # Add on the word from the core
00185         $row .= sprintf " %04x", $value;
00186         
00187         # Remember where we were
00188         $lastaddress = $address;
00189     }
00190     if ($row ne "")
00191     {
00192         push @content, $row;
00193     }
00194     
00195     return join("\n", @content) . "\n";
00196 }
00197 
00198 
00199 # Return a true value
00200 1;