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(undef, $line);
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         }
00107         my @vals = split /\s+/, $line;
00108         for my $val (@vals)
00109         {
00110             next if ($val eq '');
00111             
00112             # Check that we only allow hex numbers, possibly prefixed by
00113             # 0x.
00114             if ($val =~ /^(0x)?[0-9a-fA-F]+$/)
00115             {
00116                 my $value = hex($val);
00117                 if ($value > 0xFFFF)
00118                 {
00119                     $dasm->error("Overlarge value ('$val' > 0xffff)");
00120                 }
00121                 $dasm->storetopc($value);
00122             }
00123             else
00124             {
00125                 $dasm->error("Cannot parse hex value '$val'");
00126             }
00127         }
00128     }
00129 }
00130 
00131 
00132 ##
00133 # Write an address dump from our core.
00134 #
00135 # In order to write an address dump, we need to force a resolve of all
00136 # of the symbols. If there are any symbols that cannot be resolved, that's
00137 # a fatal error - because they would write out as 0s.
00138 #
00139 # @param[in]  $self     Address object
00140 #
00141 # @return     Content to write
00142 sub write
00143 {
00144     my ($self) = @_;
00145     my $dasm = $self->{'dasm'};
00146     my $core = $dasm->{'core'};
00147     
00148     if ($dasm->resolve())
00149     {
00150         # everything was resolved
00151     }
00152     else
00153     {
00154         my %unresolved = reverse %{ $dasm->{'relocations'} };
00155         my $symbols = "Unresolved symbols:\n  " .
00156                       join "\n",
00157                         map {
00158                             "  $_"
00159                         } keys %unresolved;
00160         $dasm->error("Could not resolve all symbols to write out Address file\n$symbols");
00161     }
00162     
00163     my @content;
00164     my $row = "";
00165     my $lastaddress = -1;
00166     for my $address (sort { $a <=> $b } keys %$core)
00167     {
00168         my $value = $core->{$address};
00169         
00170         # We never write out hardware
00171         next if (ref $value ne '');
00172     
00173         # If we moved to a different address range (multiple of 8)
00174         # write out the row
00175         if ($row ne '' &&
00176             (($address & ~7) != ($lastaddress & ~7) ||
00177              $address != $lastaddress + 1))
00178         {
00179             push @content, $row;
00180             $row = "";
00181         }
00182 
00183         # If this is the start of a line, put the address on the front
00184         if ($row eq '')
00185         {
00186             $row = sprintf "%04x :", $address;    
00187         }
00188         
00189         # Add on the word from the core
00190         $row .= sprintf " %04x", $value;
00191         
00192         # Remember where we were
00193         $lastaddress = $address;
00194     }
00195     if ($row ne "")
00196     {
00197         push @content, $row;
00198     }
00199     
00200     return join("\n", @content) . "\n";
00201 }
00202 
00203 
00204 # Return a true value
00205 1;