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($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;