DASM
|
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;