File Coverage

blib/lib/CPU/Emulator/Memory/Banked.pm
Criterion Covered Total %
statement 74 81 91.3
branch 49 66 74.2
condition 28 42 66.6
subroutine 10 10 100.0
pod 4 4 100.0
total 165 203 81.2


line stmt bran cond sub pod time code
1             package CPU::Emulator::Memory::Banked;
2              
3 3     3   204925 use strict;
  3         29  
  3         88  
4 3     3   16 use warnings;
  3         6  
  3         93  
5              
6 3     3   17 use base qw(CPU::Emulator::Memory);
  3         5  
  3         1484  
7 3     3   20 use Scalar::Util qw(reftype);
  3         7  
  3         139  
8              
9 3     3   15 use vars qw($VERSION);
  3         7  
  3         3459  
10              
11             $VERSION = '1.1002';
12              
13             =head1 NAME
14              
15             CPU::Emulator::Memory::Banked - banked memory for a CPU emulator
16              
17             =head1 SYNOPSIS
18              
19             my $memory = CPU::Emulator::Memory::Banked->new();
20             $memory->poke(0xBEEF, ord('s'));
21            
22             my $value = $memory->peek(0xBEEF); # 115 == ord('s')
23              
24             $memory->bank(
25             address => 0x8000,
26             size => 0x4000,
27             type => 'ROM',
28             file => '.../somerom.rom',
29             writethrough => 1
30             );
31              
32             my $value = $memory->peek(0xBEEF); # read from ROM instead
33             $memory->poke(0xBEEF, 0); # write to underlying RAM
34              
35             =head1 DESCRIPTION
36              
37             This class adds multiple memory banks to the flat memory space provided
38             by CPU::Emulator::Memory. These
39             temporarily replace chunks of memory with other chunk, to
40             simulate bank-switching. Those chunks can be of arbitrary size,
41             and can be either RAM, ROM, or 'dynamic', meaning that instead
42             of being just dumb storage, when you read or write them perl code
43             gets run.
44              
45             =head1 METHODS
46              
47             It inherits all the methods from CPU::Emulator::Memory, including the
48             constructor, and also implements ...
49              
50             =head2 bank
51              
52             This method performs a bank switch. This changes your view of
53             the memory, mapping another block of memory in place of part of the
54             main RAM. The main RAM's contents are preserved (although see
55             below for an exception). It takes several named parameters, three
56             of which are compulsory:
57              
58             =over
59              
60             =item address
61              
62             The base address at which to swap in the extra bank of memory.
63              
64             =item size
65              
66             The size of the bank to swap. This means that you'll be swapping
67             addresses $base_address to $base_address + $size - 1.
68             This defaults to the size of the given C, if supplied.
69              
70             =item type
71              
72             Either 'ROM' (for read-only memory), or 'RAM' to swap in a block of
73             RAM. Support will be added in the future for type 'dynamic' which
74             will let you run arbitrary perl code for reads and writes to/from
75             the memory.
76              
77             =back
78              
79             When you change memory banks, any banks already loaded which would
80             overlap are unloaded.
81              
82             The following optional parameters are also supported:
83              
84             =over
85              
86             =item file
87              
88             A file which backs the memory. For ROM memory this is compulsory,
89             for RAM it is optional.
90              
91             Note, however, that for RAM it must be a read/writeable *file* which
92             will be created if necessary, whereas
93             for ROM it must be a readable file or a readable *file handle*. It is
94             envisioned that ROMs will often be initialised from data embedded in
95             your program. You can turn a string into a filehandle using IO::Scalar -
96             there's an example of this in the tests.
97              
98             =item writethrough
99              
100             This is only meaningful for ROM. If set, then any writes to the
101             addresses affected will be directed through to the underlying main
102             RAM. Otherwise writes will be ignored.
103              
104             =item function_read and function_write
105              
106             Coderefs which will be called when 'dynamic' memory is read/written.
107             Both are compulsory for 'dynamic' memory. They are called with a
108             reference to the memory object, the address being accessed, and
109             (for function_write) the byte to be written. function_read should
110             return a byte. function_write's return value is ignored.
111              
112             =back
113              
114             =cut
115              
116             sub bank {
117 15     15 1 2657 my($self, %params) = @_;
118            
119             # init size from file
120 15 50 66     161 if(
      33        
      33        
121             !exists($params{size}) && # no size given
122             exists($params{file}) && # but a file given
123             !ref($params{file}) && # file is not filehandle
124             -s $params{file} # file exists and has size > 0
125             ) {
126 6         68 $params{size} = -s $params{file};
127             }
128              
129 15         47 my($address, $size, $type) = @params{qw(address size type)};
130 15         38 foreach (qw(address size type)) {
131             die("bank: No $_ specified\n")
132 45 50       106 if(!exists($params{$_}));
133             }
134             die("bank: address and size is out of range\n")
135 15 100 66     90 if($address < 0 || $address + $size - 1 > $self->{size} - 1);
136              
137 14         29 my $contents ='';
138 14 100       39 if($type eq 'ROM') {
    50          
    50          
139             die("For ROM banks you need to specify a file\n")
140 13 100       34 unless(exists($params{file}));
141 12         33 $contents = $self->_readROM($params{file}, $size);
142             } elsif($type eq 'RAM') {
143             $contents = (exists($params{file}))
144 0 0       0 ? $self->_readRAM($params{file}, $size)
145             : chr(0) x $size;
146             } elsif($type eq 'dynamic') {
147             die("For dynamic banks you need to specify function_read and function_write\n")
148 1 50 33     14 unless(exists($params{function_read}) && exists($params{function_write}));
149             }
150 12         26 foreach my $bank (@{$self->{overlays}}) {
  12         40  
151 8 50 66     59 if(
      33        
      66        
152             ( # does an older bank start in the middle of this one?
153             $bank->{address} >= $address &&
154             $bank->{address} < $address + $size
155             ) || ( # does this start in the middle of an older bank?
156             $address >= $bank->{address} &&
157             $address < $bank->{address} + $bank->{size}
158             )
159 8         21 ) { $self->unbank(address => $bank->{address}) }
160             }
161 12         178 push @{$self->{overlays}}, {
162             address => $address,
163             size => $size,
164             type => $type,
165             (length($contents) ? (contents => $contents) : ()),
166             (exists($params{file}) ? (file => $params{file}) : ()),
167             (exists($params{writethrough}) ? (writethrough => $params{writethrough}) : ()),
168             (exists($params{function_read}) ? (function_read => $params{function_read}) : ()),
169 12 100       33 (exists($params{function_write}) ? (function_write => $params{function_write}) : ())
    100          
    100          
    100          
    100          
170             };
171             }
172              
173             =head2 unbank
174              
175             This method unloads a bank of memory, making the main RAM visible
176             again at the affected addresses. It takes a single named parameter
177             'address' to tell which bank to switch.
178              
179             =cut
180              
181             sub unbank {
182 10     10 1 31 my($self, %params) = @_;
183 10 50       24 die("unbank: No address specified\n") unless(exists($params{address}));
184             $self->{overlays} = [
185 10         53 grep { $_->{address} != $params{address} }
186 10         20 @{$self->{overlays}}
  10         21  
187             ];
188             }
189              
190             =head2 peek
191              
192             This is replaced by a version that is aware of memory banks but has the
193             same interface. peek8
194             and peek16 are wrappers around it and so are unchanged.
195              
196             =cut
197              
198             sub peek {
199 38     38 1 2067 my($self, $addr) = @_;
200 38 100 100     206 die("Address $addr out of range") if($addr< 0 || $addr > $self->{size} - 1);
201 35         60 foreach my $bank (@{$self->{overlays}}) {
  35         82  
202 28 100 100     113 if(
203             $bank->{address} <= $addr &&
204             $bank->{address} + $bank->{size} > $addr
205             ) {
206 23 100       57 if($bank->{type} eq 'dynamic') {
207 2         5 return $bank->{function_read}->($self, $addr);
208             } else {
209 21         148 return ord(substr($bank->{contents}, $addr - $bank->{address}, 1));
210             }
211             }
212             }
213 12         77 return ord(substr($self->{contents}, $addr, 1));
214             }
215              
216             =head2 poke
217              
218             This method is replaced by a bank-aware version with the same interface.
219             poke8 and poke16 are wrappers around it and so are unchanged.
220              
221             =cut
222              
223             sub poke {
224 13     13 1 1541 my($self, $addr, $value) = @_;
225 13 100 100     75 die("Value $value out of range") if($value < 0 || $value > 255);
226 11 100 100     70 die("Address $addr out of range") if($addr< 0 || $addr > $self->{size} - 1);
227 9         24 $value = chr($value);
228 9         13 foreach my $bank (@{$self->{overlays}}) {
  9         22  
229 7 100 66     48 if(
230             $bank->{address} <= $addr &&
231             $bank->{address} + $bank->{size} > $addr
232             ) {
233 5 50 66     31 if($bank->{type} eq 'RAM') {
    100          
    100          
    50          
234 0         0 substr($bank->{contents}, $addr - $bank->{address}, 1) = $value;
235             $self->_writeRAM($bank->{file}, $bank->{contents})
236 0 0       0 if(exists($bank->{file}));
237 0         0 return 1;
238             } elsif($bank->{type} eq 'ROM' && $bank->{writethrough}) {
239 2         7 substr($self->{contents}, $addr, 1) = $value;
240             $self->_writeRAM($self->{file}, $self->{contents})
241 2 50       24 if(exists($self->{file}));
242 2         21 return 1;
243             } elsif($bank->{type} eq 'ROM') {
244 1         4 return 0;
245             } elsif($bank->{type} eq 'dynamic') {
246 2         15 return $bank->{function_write}->($self, $addr, ord($value));
247             } else {
248 0         0 die("Type ".$bank->{type}." NYI");
249             }
250             }
251             }
252 4         16 substr($self->{contents}, $addr, 1) = $value;
253             $self->_writeRAM($self->{file}, $self->{contents})
254 4 100       16 if(exists($self->{file}));
255 4         13 return 1;
256             }
257              
258             sub _readROM {
259 12     12   31 my($self, $file, $size) = @_;
260 12 100       32 if(!ref($file)) { return $self->_read_file($file, $size); }
  9         34  
261              
262 3 50       40 if(reftype($file) eq 'GLOB') {
263 3         13 local $/ = undef;
264             # Win32 is stupid, see RT 62379
265 3 50       7 if (eval {$file->can('binmode')}) {
  3         28  
266 3         12 $file->binmode; # IO::HANDLE
267             } else {
268 0         0 binmode $file; # file handle
269             }
270 3         70 my $contents = <$file>;
271 3 50       52 die("data in filehandle is wrong size (got ".length($contents).", expected $size)\n") unless(length($contents) == $size);
272 3         14 return $contents;
273             } else {
274 0           die("file mustn't be a ".reftype($file)."-ref");
275             }
276             }
277              
278             =head1 SUBCLASSING
279              
280             The private method _readROM may be useful for subclasses. If passed
281             a filename, it is just a wrapper around the parent class's _read_file.
282             If passed a reference to a filehandle, it reads from that.
283              
284             =head1 BUGS/WARNINGS/LIMITATIONS
285              
286             All those inherited from the parent class.
287              
288             No others known.
289              
290             =head1 FEEDBACK
291              
292             I welcome feedback about my code, including constructive criticism
293             and bug reports. The best bug reports include files that I can add
294             to the test suite, which fail with the current code and will
295             pass once I've fixed the bug.
296              
297             Feature requests are far more likely to get implemented if you submit
298             a patch yourself.
299              
300             =head1 SOURCE CODE REPOSITORY
301              
302             L
303              
304             =head1 AUTHOR, LICENCE and COPYRIGHT
305              
306             Copyright 2008 David Cantrell EFE
307              
308             This module is free-as-in-speech software, and may be used,
309             distributed, and modified under the same terms as Perl itself.
310              
311             =head1 CONSPIRACY
312              
313             This module is also free-as-in-mason software.
314              
315             =cut
316              
317             1;