DASM
|
00001 #!/usr/bin/perl -w 00002 ## 00003 # DCPU-16 assembler I/O functions for reading and writing binary files. 00004 # 00005 # The specification doesn't say anything about the 8bit representation of 00006 # a 16bit word output. The backstory only talks about the 16bit word 00007 # ordering. Consequently, the representation could be either way around. 00008 # 00009 # By default we assume little endian, although an explicit ordering can 00010 # be forced by using a different file extension: 00011 # 00012 # @li `.bin` - default ordering (little endian) 00013 # @li `.binle` - little-endian 00014 # @li `.binbe` - big-endian 00015 # 00016 # Binary dumps contain no symbols or relocation data. They are raw 00017 # dumps of the content. 00018 # 00019 # @file 00020 # @author Justin Fletcher 00021 # 00022 00023 package DASMIO::Binary; 00024 00025 use DASM; 00026 00027 ## Default endian order; use 'binle' or 'binbe'. 00028 my $default_endian = 'binle'; 00029 00030 00031 ## 00032 # Create an object upon which we can work. 00033 # 00034 # @param[in] $proto Prototype object, or this class's name 00035 # @param[in] $dasm DASM object we're working on 00036 # 00037 # @return new object 00038 sub new 00039 { 00040 my $proto = shift; 00041 my $dasm = shift; 00042 my $class = ref($proto) || $proto; 00043 my $self = {}; 00044 00045 bless $self, $class; 00046 00047 $self->{'dasm'} = $dasm; 00048 00049 return $self; 00050 } 00051 00052 00053 ## 00054 # Identify whether we can handle reading or writing a given file 00055 # by its filename. 00056 # 00057 # @param[in] $self Address object 00058 # @param[in] $filename Filename we're accessing 00059 # @param[in] $type 'read' or 'write' 00060 # 00061 # @retval 1 if we can access it 00062 # @retval 0 if we cannot access it 00063 sub identify 00064 { 00065 my ($self, $filename, $type) = @_; 00066 00067 if ($filename =~ /\.bin(le|be)?$/) 00068 { 00069 return 1; 00070 } 00071 00072 return 0; 00073 } 00074 00075 00076 ## 00077 # List the extensions we support 00078 # 00079 # @param[in] $self Address object 00080 # 00081 # @return arrayref of extensions 00082 sub extensions 00083 { 00084 return [ 'bin', 'binle', 'binbe' ]; 00085 } 00086 00087 00088 ## 00089 # Read a binary dump and populate our core. 00090 # 00091 # @param[in] $self Address object 00092 # @param[in] $content Content to parse 00093 # @param[in] $filename File it came from 00094 sub read 00095 { 00096 my ($self, $content, $filename) = @_; 00097 my $dasm = $self->{'dasm'}; 00098 00099 my ($format) = ($filename =~ /\.(\w+)$/); 00100 $format = $default_endian if ($format eq 'bin'); 00101 00102 my $packing; 00103 $packing = 'v*' if ($format eq 'binle'); 00104 $packing = 'n*' if ($format eq 'binbe'); 00105 00106 for my $value (unpack $packing, $content) 00107 { 00108 $dasm->storetopc($value); 00109 } 00110 } 00111 00112 00113 ## 00114 # Write a binary dump from our core. 00115 # 00116 # In order to write an address dump, we need to force a resolve of all 00117 # of the symbols. If there are any symbols that cannot be resolved, that's 00118 # a fatal error - because they would write out as 0s. 00119 # 00120 # @param[in] $self Address object 00121 # @param[in] $filename Filename we're writing 00122 # 00123 # @return Content to write 00124 sub write 00125 { 00126 my ($self, $filename) = @_; 00127 my $dasm = $self->{'dasm'}; 00128 my $core = $dasm->{'core'}; 00129 00130 if ($dasm->resolve()) 00131 { 00132 # everything was resolved 00133 } 00134 else 00135 { 00136 my %unresolved = reverse %{ $dasm->{'relocations'} }; 00137 my $symbols = "Unresolved symbols:\n " . 00138 join "\n", 00139 map { 00140 " $_" 00141 } keys %unresolved; 00142 $dasm->error("Could not resolve all symbols to write out Address file\n$symbols"); 00143 } 00144 00145 # Determine the format we're using 00146 my ($format) = ($filename =~ /\.(\w+)$/); 00147 $format = $default_endian if ($format eq 'bin'); 00148 00149 my $packing; 00150 $packing = 'v*' if ($format eq 'binle'); 00151 $packing = 'n*' if ($format eq 'binbe'); 00152 00153 my @content; 00154 my $lastaddress = -1; 00155 for my $address (sort { $a <=> $b } keys %$core) 00156 { 00157 my $value = $core->{$address}; 00158 00159 # We never write out hardware 00160 next if (ref $value ne ''); 00161 00162 while ($lastaddress+1 != $address) 00163 { 00164 push @content, 0; 00165 $lastaddress++; 00166 } 00167 00168 push @content, $value; 00169 00170 # Remember where we were 00171 $lastaddress = $address; 00172 } 00173 00174 return pack($packing, @content); 00175 } 00176 00177 00178 # Return a true value 00179 1;