DASM
|
00001 #!/usr/bin/perl -w 00002 ## 00003 # DCPU-16 execution environment - hardware profile initialisation 00004 # 00005 # This module provides the initialisation of the hardware mapped devices 00006 # in the core of the DCPU-16 emulation. The mappings are defined in a 00007 # hardware profile which describes the base address of the devices. 00008 # 00009 # Each device is implemented by a device module in the directory DExecHW. 00010 # An instance of the devices is created and attached to the addresses 00011 # through a DExecHWAdapter. The adapter supplies the offset parameter to 00012 # the device object, allowing multiple registers to be easily implemented 00013 # in the device, despite not being known to the execution environment. 00014 # 00015 # The hardware profiles take the form of lines in a file of the form: 00016 # 00017 # @code 00018 # <address> <device> [ '(' <arguments> ')' ] 00019 # @endcode 00020 # 00021 # @li @c <address> : a 4 character hexadecimal address that the hardware is 00022 # mapped to 00023 # @li @c <device> : device, as a module in the DExecHW directory. 00024 # @li @c <arguments> : comma separated arguments to pass to the device 00025 # 00026 # Comments are prefixed by a '#' character. 00027 # 00028 # Devices may be registered in multiple locations with different arguments. 00029 # 00030 # Each device has a window size, which it defines. This is the number of 00031 # registers it provides and which will be allocated in the core. 00032 # 00033 # @file 00034 # @author Justin Fletcher 00035 # 00036 00037 package DASMIO::Hardware; 00038 00039 use DASM; 00040 use DCPU; 00041 00042 use DExecHWAdapter; 00043 00044 use Carp; 00045 00046 ## Whether we debug the registrations 00047 my $debug_reg = 0; 00048 00049 00050 ## 00051 # Create an object upon which we can work. 00052 # 00053 # @param[in] $proto Prototype object, or this class's name 00054 # @param[in] $dasm DASM object we're working on 00055 # 00056 # @return new object 00057 sub new 00058 { 00059 my $proto = shift; 00060 my $dasm = shift; 00061 my $class = ref($proto) || $proto; 00062 my $self = {}; 00063 00064 bless $self, $class; 00065 00066 $self->{'dasm'} = $dasm; 00067 00068 # Prefix on all hardware symbols 00069 $self->{'symbolprefix'} = ""; 00070 00071 # Separator for symbols 00072 $self->{'symbolseparator'} = "_"; 00073 00074 # Base symbol name 00075 $self->{'symbolbase'} = "_Base"; 00076 00077 return $self; 00078 } 00079 00080 00081 00082 ## 00083 # Register a region of memory with a device. 00084 # 00085 # @param[in] $self This hardware object 00086 # @param[in] $address The address to assign the device at 00087 # @param[in] $device The device name 00088 # @param[in] $args arrayref of arguments for the device 00089 sub register 00090 { 00091 my ($self, $address, $device, $args) = @_; 00092 my $dasm = $self->{'dasm'}; 00093 00094 if (!defined $device || $device eq '') 00095 { 00096 confess "No device supplied to Hardware::register"; 00097 } 00098 00099 # Load the device class 00100 eval { 00101 require "DExecHW/$device.pm"; 00102 }; 00103 if ($@) 00104 { 00105 $dasm->error( sprintf "Cannot attach device '%s' at %04x: %s", 00106 $device, 00107 $address, 00108 $@); 00109 } 00110 00111 # Create the object for the hardware device, with the 00112 # arguments supplied 00113 my $object = "DExecHW::$device"->new( @$args ); 00114 00115 # Create the initial symbol name 00116 my $symbol = $self->{'symbolprefix'} . $device; 00117 $symbol =~ s/::/$symbolseparator/g; 00118 00119 # Set the base symbol to the address 00120 # FIXME: This does not cope with multiple instances of a device 00121 $dasm->setsymbol($symbol . $self->{'symbolbase'}, $address, 'constant'); 00122 00123 # Create one adapter for each offset of the window of this device 00124 my $window = $object->window(); 00125 for my $offset (0..$window-1) 00126 { 00127 my $regaddress = $address + $offset; 00128 00129 # FIXME: Replace with a method 00130 if (defined $dasm->{'core'}->{$regaddress}) 00131 { 00132 die "Overlapping data/devices at ".sprintf("%04x",$regaddress); 00133 } 00134 00135 my $obj = new DExecHWAdapter( $object, $offset); 00136 $dasm->store($regaddress, $obj); 00137 00138 # Create a symbol for this address. 00139 my $symname = $obj->symbol(); 00140 if (defined $symname) 00141 { 00142 $dasm->setsymbol($symbol . $self->{'symbolseparator'} . $symname, 00143 $regaddress, 00144 'constant'); 00145 } 00146 } 00147 00148 # Register the hardware so that we know about it. 00149 $dasm->addhardware($address, $object); 00150 } 00151 00152 00153 ## 00154 # Identify whether we can handle reading or writing a given file 00155 # by its filename. 00156 # 00157 # @param[in] $self Our object 00158 # @param[in] $filename Filename we're accessing 00159 # @param[in] $type 'read' or 'write' 00160 # 00161 # @retval 1 if we can access it 00162 # @retval 0 if we cannot access it 00163 sub identify 00164 { 00165 my ($self, $filename, $type) = @_; 00166 00167 # We can only read the hardware definitions, not write them 00168 if ($filename =~ /\.hw$/ && $type eq 'read') 00169 { 00170 return 1; 00171 } 00172 00173 return 0; 00174 } 00175 00176 00177 ## 00178 # List the extensions we support 00179 # 00180 # @param[in] $self Our object 00181 # 00182 # @return arrayref of extensions 00183 sub extensions 00184 { 00185 return [ 'hw' ]; 00186 } 00187 00188 00189 ## 00190 # Parse an instruction line. 00191 # 00192 # @param[in] $self IO object 00193 # @param[in] $line Line to process 00194 sub parseline 00195 { 00196 my ($self, $line) = @_; 00197 my $dasm = $self->{'dasm'}; 00198 00199 # Trim any trailing newline that might have been left 00200 chomp $line; 00201 00202 if ($line =~ /^\s*#/ || 00203 $line =~ /^\s*$/) 00204 { 00205 # Skip comments and blank lines 00206 return; 00207 } 00208 00209 # Parse the address and device from: 00210 # <hex address> <device name> ... 00211 my ($address, $device, $_) = ($line =~ /^(?:0x)?([A-Fa-f0-9]+)\s*([\w:]+)\s*(.*$)/); 00212 if (!defined $address || 00213 !defined $device) 00214 { 00215 $self->error("Unrecognised line '$_' in hardware profile"); 00216 } 00217 00218 # Convert the address to a number 00219 $address = hex($address); 00220 00221 if ($address >= 0x10000) 00222 { 00223 $self->error(sprintf "Address 0x%x too large", $address); 00224 } 00225 00226 # The device name can be followed by a list of arguments in brackets, 00227 # which we parse into an array. 00228 my $args = []; 00229 if ($line =~ s/^\(\s*//) 00230 { 00231 while (1) 00232 { 00233 $line =~ s/\s*//; # Strip leading spaces 00234 if ($line =~ s/^(\d+)//) 00235 { 00236 # Basic number 00237 push @$args, $1; 00238 } 00239 elsif ($line =~ s/^0x([A-Fa-f0-9]+)//) 00240 { 00241 # Hex number 00242 push @$args, hex($1); 00243 } 00244 elsif ($line =~ s/^"([^"]+)"// || 00245 $line =~ s/^'([^']+)'//) 00246 { 00247 # "d string (double or single) 00248 push @$args, $1; 00249 } 00250 else 00251 { 00252 $self->error("Unrecognised argument to $device device: '$line'"); 00253 } 00254 00255 if ($line =~ s/\s*,\s*//) 00256 { 00257 # There's more arguments coming, so go around for 00258 # more 00259 } 00260 elsif ($line =~ s/\s*\)//) 00261 { 00262 # That's the end of the arguments, so we can stop 00263 last; 00264 } 00265 elsif ($line =~ /\s*$/) 00266 { 00267 # End of the arguments list... odd 00268 $self->error("Unexpected end of arguments"); 00269 } 00270 else 00271 { 00272 $self->error("Garbage after arguments '$line'"); 00273 } 00274 } 00275 } 00276 00277 # Having parsed the arguments, the rest of the line should be 00278 # empty (or a comment) 00279 if (!$line =~ /\s*$/ && 00280 !$line =~ /\s*#/) 00281 { 00282 $self->error("Garbage at end of device $device: $1"); 00283 } 00284 00285 printf "Registering at 0x%04x: %s\n", $address, $device if ($debug_reg); 00286 $self->register($address, $device, $args); 00287 } 00288 00289 # Must return true. 00290 1;